← Back to branch summary

~ubuntu-branches/ubuntu/maverick/mew-beta/maverick

« back to all changes in this revision

Viewing changes to mew-nmz.el

  • Committer: Bazaar Package Importer
  • Author(s): Tatsuya Kinoshita
  • Date: 2010-04-30 22:58:18 UTC
  • mfrom: (1.1.18 upstream)
  • Revision ID: james.westby@ubuntu.com-20100430225818-mkeltwh37mn90q2f
Tags: 7.0.50~0.20100430-1
New upstream release. (development snapshot on 2010-04-30,
kazu-yamamoto-Mew-01eac29)

Show diffs side-by-side

added added

removed removed

Lines of Context:
mew-nmz.el
 
1
;; -*- Mode: Emacs-Lisp -*-
 
2
;;
 
3
;; mew-nmz.el --- Namazu interfaces for Mew
 
4
;;
 
5
;;   Author: Hideyuki SHIRAI
 
6
;;   Created: Dec 24, 2004
 
7
;;
 
8
;; Put your ~/.mew.el
 
9
;; (require 'mew-nmz)
 
10
;; (setq mew-search-method 'namazu)
 
11
;;
 
12
 
 
13
(require 'mew)
 
14
 
 
15
(eval-when-compile
 
16
  (condition-case nil
 
17
      (require 'w3m-namazu)
 
18
    (error nil)))
 
19
 
 
20
;; Variables
 
21
(defconst mew-nmz-version "01��30��(��)")
 
22
 
 
23
(defgroup mew-nmz nil
 
24
  "Namazu support with Mew."
 
25
  :group 'mew)
 
26
 
 
27
(defcustom mew-nmz-index-path "~/Namazu"
 
28
  "*Namazu index top directory."
 
29
  :group 'mew-nmz
 
30
  :type 'directory)
 
31
 
 
32
(defcustom mew-nmz-index-mail "Mail"
 
33
  "*Namazu index mail directory name."
 
34
  :group 'mew-nmz
 
35
  :type 'string)
 
36
 
 
37
(defcustom mew-nmz-setup-hook nil
 
38
  "*Hook called on mew-nmz-setup."
 
39
  :group 'mew-nmz
 
40
  :type 'hook)
 
41
 
 
42
(defcustom mew-nmz-prog "namazu"
 
43
  "*Namazu program name."
 
44
  :group 'mew-nmz
 
45
  :type 'string)
 
46
 
 
47
(defcustom mew-nmz-prog-args nil
 
48
  "*Namazu's arguments."
 
49
  :group 'mew-nmz
 
50
  :type '(repeat string))
 
51
 
 
52
(defcustom mew-nmz-prog-mknmz "mknmz"
 
53
  "*Namazu make index program."
 
54
  :group 'mew-nmz
 
55
  :type 'string)
 
56
 
 
57
(defcustom mew-nmz-prog-mknmz-args '("--decode-base64")
 
58
  "*Mknmz's argument, in addition to \"--no-encode-uri\", \"--mailnews\"."
 
59
  :group 'mew-nmz
 
60
  :type '(repeat string))
 
61
 
 
62
(defcustom mew-nmz-prog-mknmz-include "~/Namazu/mknmz-inc.pl"
 
63
  "*Include file for mknmz."
 
64
  :group 'mew-nmz
 
65
  :type 'file)
 
66
 
 
67
(defcustom mew-nmz-mknmz-skip-folders-regexp
 
68
  (mapcar 'regexp-quote
 
69
          (delq nil
 
70
                `(,mew-draft-folder ,mew-trash-folder ,mew-queue-folder ,mew-attach-folder
 
71
                                    ,mew-imap-queue-folder ,mew-imap-trash-folder ,mew-postq-folder
 
72
                                    ,@mew-trash-folder-list ,@mew-imap-trash-folder-list
 
73
                                    "+schedule")))
 
74
  "*Folders regexp to skip the index creating."
 
75
  :group 'mew-nmz
 
76
  :type '(repeat regexp))
 
77
 
 
78
(defcustom mew-nmz-mknmz-use-mode-line t
 
79
  "*Display indicator of namazu in mode line."
 
80
  :group 'mew-nmz
 
81
  :type 'boolean)
 
82
 
 
83
(defcustom mew-nmz-line-id '("Mew(nmz): %7b")
 
84
  "*A value of mode-line-buffer-identification for Mew summary mode, when mknmzing."
 
85
  :group 'mew-nmz
 
86
  :type '(list string))
 
87
 
 
88
(defcustom mew-nmz-mknmz-timer-interval 0.1
 
89
  "*Seconds of interval to execute next mknmz."
 
90
  :group 'mew-nmz
 
91
  :type 'number)
 
92
 
 
93
(defcustom mew-nmz-pick-default-field nil
 
94
  "*Default prefix string to be appeared when inputting a namazu pick pattern.
 
95
A good example is \"+from:\"."
 
96
  :group 'mew-nmz
 
97
  :type '(choice string (const nil)))
 
98
 
 
99
(defcustom mew-nmz-pick-field-list
 
100
  '("subject=" "from=" "to=" "newsgroups=" "date="
 
101
    "message-id=" "cc=" "in-reply-to=" "references=")
 
102
  "*A list of key for namazu pick pattern."
 
103
  :group 'mew-nmz
 
104
  :type '(repeat string))
 
105
 
 
106
(defcustom mew-nmz-pick-gather-field-list
 
107
  `((,mew-from: address "from=" "to=" "cc=")
 
108
    (,mew-to: address "from=" "to=" "cc=")
 
109
    (,mew-cc: address "from=" "to=" "cc=")
 
110
    (,mew-message-id: msgid "message-id=" "in-reply-to=" "references=")
 
111
    (,mew-in-reply-to: msgid "message-id=" "in-reply-to=" "references=")
 
112
    (,mew-references: msgid "message-id=" "in-reply-to=" "references="))
 
113
  "*A list of completion keyword from message."
 
114
  :group 'mew-nmz
 
115
  :type '(repeat (list string
 
116
                       (choice (const address) (const msgid))
 
117
                       string string string)))
 
118
 
 
119
(defcustom mew-nmz-search-parent-folder `(,mew-inbox-folder)
 
120
  "*Search folder for parent or child, "
 
121
  :group 'mew-nmz
 
122
  :type '(repeat string))
 
123
 
 
124
(defcustom mew-nmz-db-max 64
 
125
  "*Namazu max index.
 
126
This value MUST be less then equal `INDEX_MAX' of libnamazu.h."
 
127
  :group 'mew-nmz
 
128
  :type 'integer)
 
129
 
 
130
(defcustom mew-nmz-query-max-length 256
 
131
  "*Namazu query string max length.
 
132
 This value MUST be less then equal `QUERY_MAX' of libnamazu.h."
 
133
  :group 'mew-nmz
 
134
  :type 'integer)
 
135
 
 
136
(defcustom mew-nmz-mark-pick mew-mark-review
 
137
  "*Mark for Namazu pick."
 
138
  :group 'mew-nmz
 
139
  :type 'character)
 
140
 
 
141
(defcustom mew-nmz-mark-unindexed mew-mark-review
 
142
  "*Mark for type unindexed messages."
 
143
  :group 'mew-nmz
 
144
  :type 'character)
 
145
 
 
146
(defcustom mew-ask-virtual-folder-name nil
 
147
  "*If *non-nil*, ask a virtual folder name."
 
148
  :group 'mew-summary
 
149
  :type 'boolean)
 
150
 
 
151
(defcustom mew-nmz-cache-file-prefix ".mew-nmz-"
 
152
  "*Prefix of the cache filename.  Expand with mew-conf-path when use it."
 
153
  :group 'mew-nmz
 
154
  :type 'string)
 
155
 
 
156
(defcustom mew-nmz-mknmz-index-file ".mewmknmz"
 
157
  "*File name of the input file of mewmknmz. Expand with mew-conf-path when use it."
 
158
  :group 'mew-nmz
 
159
  :type 'string)
 
160
 
 
161
(defcustom mew-nmz-input-folders-asterisk t
 
162
  "*Add \"*\" at the end of input folder name."
 
163
  :group 'mew-nmz
 
164
  :type 'boolean)
 
165
 
 
166
(defcustom mew-nmz-prog-gcnmz "gcnmz"
 
167
  "*Program name for the garbage collection."
 
168
  :group 'mew-nmz
 
169
  :type 'string)
 
170
 
 
171
(defcustom mew-nmz-use-gcnmz-folders-regexp `(,(regexp-quote mew-inbox-folder))
 
172
  "*Folders regexp to execute gcnmz."
 
173
  :group 'mew-nmz
 
174
  :type '(repeat regexp))
 
175
 
 
176
(defcustom mew-nmz-gcnmz-line-id '("Mew(gcn): %7b")
 
177
  "*A value of mode-line-buffer-identification for Mew summary mode, when gcnmzing."
 
178
  :group 'mew-nmz
 
179
  :type '(list string))
 
180
 
 
181
(defcustom mew-nmz-prog-rfnmz "rfnmz"
 
182
  "*Program name for the re-index."
 
183
  :group 'mew-nmz
 
184
  :type 'string)
 
185
 
 
186
(defcustom mew-nmz-mknmz-index-file-coding-system
 
187
  (when (boundp 'default-file-name-coding-system)
 
188
    default-file-name-coding-system)
 
189
  "*Coding system of index-file."
 
190
  :group 'mew-nmz
 
191
  :type '(coding-system :size 0))
 
192
 
 
193
;; internal variable, don't modify.
 
194
(defvar mew-nmz-gather-header-list nil)
 
195
(defvar mew-nmz-indexed-folders nil)
 
196
 
 
197
(defvar mew-nmz-input-folder-hist nil)
 
198
 
 
199
(defvar mew-nmz-mknmz-process nil)
 
200
(defvar mew-nmz-mknmz-process-folder nil)
 
201
(defvar mew-nmz-mknmz-process-file nil)
 
202
 
 
203
(make-variable-buffer-local 'mew-nmz-mknmz-process)
 
204
(make-variable-buffer-local 'mew-nmz-mknmz-process-folder)
 
205
(make-variable-buffer-local 'mew-nmz-mknmz-process-file)
 
206
 
 
207
(defconst mew-nmz-namazu-index-alias "_mew-namazu"
 
208
  "*Alias name for mew-nmz-namazu.")
 
209
(defvar mew-nmz-namazu-content-type "message/mew")
 
210
(defvar mew-nmz-namazu-pattern nil)
 
211
(defvar mew-nmz-namazu-miss-folders nil)
 
212
 
 
213
(defvar mew-nmz-setup-p nil)
 
214
(defvar mew-nmz-imap-case-alist nil)
 
215
(defvar mew-nmz-nntp-case-alist nil)
 
216
(defvar mew-nmz-pop-case-alist nil)
 
217
(defvar mew-nmz-fld-index-alist nil)
 
218
(defvar mew-nmz-url-fld-alist nil)
 
219
(defvar mew-nmz-mknmz-all-folders nil)
 
220
(defvar mew-nmz-mknmz-continue-timer nil)
 
221
 
 
222
(defvar mew-nmz-mknmz-lang-alist
 
223
  '(("Japanese" "ja")))
 
224
 
 
225
(defvar mew-nmz-cs-index (cond
 
226
                          ((mew-coding-system-p 'euc-japan-unix)
 
227
                           'euc-japan-unix)
 
228
                          ((mew-coding-system-p 'euc-jp-unix)
 
229
                           'euc-jp-unix)
 
230
                          (t mew-cs-text-for-write))
 
231
  "*Coding system to write 'NMZ.field.uri'.")
 
232
 
 
233
(defconst mew-nmz-result-regex
 
234
  (concat "^\\(.*\\)" (regexp-quote mew-path-separator) "\\([0-9]+\\)"))
 
235
 
 
236
(defconst mew-nmz-use-drive-letter
 
237
  (memq system-type '(OS/2 emx windows-nt cygwin)))
 
238
 
 
239
;; Set up
 
240
(defvar mew-nmz-search-method `(namazu "Namazu" ,mew-nmz-prog
 
241
                                       mew-nmz-search
 
242
                                       mew-nmz-search-virtual
 
243
                                       mew-nmz-mknmz
 
244
                                       mew-nmz-mknmz-all-folders
 
245
                                       mew-nmz-pick-canonicalize-pattern))
 
246
 
 
247
(eval-after-load "mew-search"
 
248
  `(setq mew-search-switch
 
249
         (cons mew-nmz-search-method mew-search-switch)))
 
250
 
 
251
;;  (define-key mew-summary-mode-map "k"  (make-sparse-keymap))
 
252
;;  (define-key mew-summary-mode-map "kc" 'mew-summary-search-change-method)
 
253
;;  (define-key mew-summary-mode-map "k?" 'mew-summary-search)
 
254
;;  (define-key mew-summary-mode-map "k/" 'mew-summary-selection-by-search)
 
255
;;  (define-key mew-summary-mode-map "km" 'mew-summary-make-index-folder)
 
256
;;  (define-key mew-summary-mode-map "kM" 'mew-summary-make-index-all)
 
257
 
 
258
(add-hook 'mew-summary-mode-hook
 
259
          (lambda ()
 
260
            (define-key mew-summary-mode-map "kg" 'mew-nmz-gcnmz)
 
261
            (define-key mew-summary-mode-map "ks" 'mew-nmz-mknmz-save-mewmknmz)
 
262
            (define-key mew-summary-mode-map "kK" 'mew-nmz-mknmz-kill-process)
 
263
            (define-key mew-summary-mode-map "ku" 'mew-nmz-mark-unindexed)
 
264
            (define-key mew-summary-mode-map "k^" 'mew-nmz-search-parent)
 
265
            (define-key mew-summary-mode-map "kp" 'mew-nmz-search-parent)
 
266
            (define-key mew-summary-mode-map "kn" 'mew-nmz-search-child)
 
267
            (define-key mew-summary-mode-map "kN" 'mew-nmz-namazu)
 
268
            (define-key mew-summary-mode-map "kj" 'mew-nmz-jump-message)))
 
269
 
 
270
(add-hook 'mew-message-mode-hook
 
271
          (lambda ()
 
272
            (define-key mew-message-mode-map "k"  (make-sparse-keymap))
 
273
            (define-key mew-message-mode-map "kp" 'mew-nmz-search-msgid-at-point)
 
274
            (define-key mew-message-mode-map "kr" 'mew-nmz-search-msgid-region)))
 
275
 
 
276
(defun mew-nmz-pick-field-list ()
 
277
  (let ((lst (append mew-pick-field-list
 
278
                     mew-nmz-pick-field-list
 
279
                     (mew-nmz-pick-pattern-gather-header))))
 
280
    (mew-uniq-list lst)))
 
281
 
 
282
(defadvice mew-summary-search (around mew-nmz activate compile)
 
283
  "Use mew-nmz gather-header."
 
284
  (if (eq mew-search-method 'namazu)
 
285
      (let ((mew-pick-field-list (mew-nmz-pick-field-list)))
 
286
        ad-do-it)
 
287
    ad-do-it))
 
288
 
 
289
(defadvice mew-summary-selection-by-search (around mew-nmz activate compile)
 
290
  "Use mew-nmz gather-header."
 
291
  (if (eq mew-search-method 'namazu)
 
292
      (let ((mew-pick-field-list (mew-nmz-pick-field-list)))
 
293
        ad-do-it)
 
294
    ad-do-it))
 
295
 
 
296
(add-hook 'mew-summary-rename-folder-hook 'mew-nmz-folder-index-rename)
 
297
(add-hook 'mew-summary-delete-folder-hook 'mew-nmz-folder-index-delete)
 
298
(add-hook 'mew-status-update-hook 'mew-nmz-status-update)
 
299
(add-hook 'mew-quit-hook 'mew-nmz-cleanup)
 
300
 
 
301
(when (and (featurep 'mw32script)
 
302
           (fboundp 'define-process-argument-editing))
 
303
  ;; Argument setting for mknmz.bat, gcnmz.bat, rfnmz.bat
 
304
  (let ((progs '("mknmz" "gcnmz" "rfnmz"))
 
305
        prog)
 
306
    (while progs
 
307
      (setq prog (mew-which-exec (car progs)))
 
308
      (setq progs (cdr progs))
 
309
      (when (and prog (string-match "\\.bat$" prog))
 
310
        (setq prog (regexp-quote prog))
 
311
        ;; (general-process-argument-editing-function
 
312
        ;;     ARGUMENT QUOTING ARGV0ISP &optional EP H2SP QP S2ISP)
 
313
        (define-process-argument-editing
 
314
          prog
 
315
          (lambda (x) (general-process-argument-editing-function x nil nil))
 
316
          'first)))))
 
317
 
 
318
;; macro
 
319
(defmacro mew-nmz-imap-directory-file-name (fld case)
 
320
  `(condition-case nil
 
321
       (mew-imap-directory-file-name ,fld ,case)
 
322
     (error ,fld)))
 
323
 
 
324
(defmacro mew-nmz-cache-file-name (part)
 
325
  `(expand-file-name (concat mew-nmz-cache-file-prefix
 
326
                             (symbol-name ,part)
 
327
                             "-alist")
 
328
                     mew-conf-path))
 
329
 
 
330
(defmacro mew-nmz-cache-alist-name (part)
 
331
  `(intern (concat "mew-nmz-" (symbol-name ,part) "-alist")))
 
332
 
 
333
(defsubst mew-nmz-expand-folder (case:folder)
 
334
  "Convert case:folder to the directory name of namazu's index."
 
335
  (let* ((fld (mew-case:folder-folder case:folder))
 
336
         (imapp (mew-folder-imapp fld))
 
337
         (mew-mail-path (concat (file-name-as-directory mew-nmz-index-path)
 
338
                                mew-nmz-index-mail))
 
339
         (nmzdir (directory-file-name (mew-expand-folder case:folder))))
 
340
    (if (not imapp)
 
341
        nmzdir
 
342
      (while (string-match "[][]" nmzdir)
 
343
        (setq nmzdir (concat (substring nmzdir 0 (match-beginning 0))
 
344
                             "%%"
 
345
                             (substring nmzdir (match-end 0)))))
 
346
      nmzdir)))
 
347
 
 
348
(defsubst mew-nmz-case-folder-normalize (case:folder)
 
349
  (let ((case (mew-case:folder-case case:folder))
 
350
        (fld (mew-case:folder-folder case:folder))
 
351
        (newcase ""))
 
352
    (setq fld (directory-file-name fld))
 
353
    (when (mew-folder-imapp fld)
 
354
      (setq fld (mew-nmz-imap-directory-file-name fld case)))
 
355
    (cond
 
356
     ((or (string= fld "")
 
357
          (string= fld "*")
 
358
          (mew-folder-imapp fld))
 
359
      (setq newcase (or (cdr (assoc case mew-nmz-imap-case-alist)) "")))
 
360
     ((mew-folder-popp fld)
 
361
      (setq newcase (or (cdr (assoc case mew-nmz-pop-case-alist)) "")))
 
362
     ((mew-folder-nntpp fld)
 
363
      (setq newcase (or (cdr (assoc case mew-nmz-nntp-case-alist)) ""))))
 
364
    (if (string= newcase "")
 
365
        fld
 
366
      (concat newcase ":" fld))))
 
367
 
 
368
(defsubst mew-nmz-case-normalize (case:folder)
 
369
  (let ((case (mew-case:folder-case case:folder))
 
370
        (fld (mew-case:folder-folder case:folder))
 
371
        (newcase ""))
 
372
    (cond
 
373
     ((or (string= fld "")
 
374
          (string= fld "*")
 
375
          (mew-folder-imapp fld))
 
376
      (setq newcase (or (cdr (assoc case mew-nmz-imap-case-alist)) "")))
 
377
     ((mew-folder-popp fld)
 
378
      (setq newcase (or (cdr (assoc case mew-nmz-pop-case-alist)) "")))
 
379
     ((mew-folder-nntpp fld)
 
380
      (setq newcase (or (cdr (assoc case mew-nmz-nntp-case-alist)) ""))))
 
381
    newcase))
 
382
 
 
383
(defsubst mew-nmz-folder-to-nmzdir (folder)
 
384
  (mew-nmz-setup)
 
385
  (cdr (assoc (directory-file-name folder) mew-nmz-fld-index-alist)))
 
386
 
 
387
(defsubst mew-nmz-url-to-folder (url)
 
388
  (mew-nmz-setup)
 
389
  (when (and mew-nmz-use-drive-letter
 
390
             (string-match "^/\\([a-zA-Z]\\)|\\(/.*\\)" url))
 
391
    (setq url (concat
 
392
               (substring url (match-beginning 1) (match-end 1))
 
393
               ":"
 
394
               (substring url (match-beginning 2) (match-end 2)))))
 
395
  (cdr (assoc (expand-file-name url) mew-nmz-url-fld-alist)))
 
396
 
 
397
(defsubst mew-nmz-indexed-folder-p (fld)
 
398
  (let ((nmzdir (mew-nmz-expand-folder fld)))
 
399
    (and nmzdir
 
400
         (file-directory-p nmzdir)
 
401
         (file-exists-p (expand-file-name "NMZ.i" nmzdir)))))
 
402
 
 
403
;; Mew interface
 
404
(defun mew-nmz-search (pattern folder &rest args)
 
405
  (mew-nmz-multi-pick
 
406
   (list (mew-nmz-expand-folder folder)) pattern nil 'single))
 
407
 
 
408
(defun mew-nmz-search-virtual (pattern flds &rest args)
 
409
  (mew-nmz-setup)
 
410
  (let* ((nmzdirs (mew-nmz-flds-to-indexs (or flds (list "*:*"))))
 
411
         (fldmsgs (mew-nmz-multi-pick nmzdirs pattern nil))
 
412
         (file (mew-make-temp-name))
 
413
         (rttl 0)
 
414
         fld)
 
415
    (with-temp-buffer
 
416
      (dolist (fldmsg fldmsgs)
 
417
        (setq fld (car fldmsg))
 
418
        (unless (mew-folder-localp fld)
 
419
          (setq fld (mew-path-to-folder (mew-expand-folder fld))))
 
420
        (insert (format "CD:%s\n" fld))
 
421
        (dolist (msg (cdr fldmsg))
 
422
          (insert msg "\n")
 
423
          (setq rttl (1+ rttl))))
 
424
      (mew-frwlet
 
425
       mew-cs-text-for-read mew-cs-text-for-write
 
426
       (write-region (point-min) (point-max) file nil 'no-msg)))
 
427
    (list file rttl)))
 
428
 
 
429
;; codes
 
430
(defun mew-nmz-jump-message ()
 
431
  "Jump to physical folder and message from virtual folder
 
432
or jump to virtual folder from physical folder."
 
433
  (interactive)
 
434
  (let ((disp (mew-sinfo-get-disp-msg))
 
435
        fld msg)
 
436
    (cond
 
437
     ((mew-thread-p)
 
438
      (mew-summary-goto-message)
 
439
      (setq fld (or (mew-vinfo-get-original-folder)
 
440
                    (mew-vinfo-get-physical-folder)))
 
441
      (setq msg (mew-summary-message-number)))
 
442
     ((mew-virtual-p)
 
443
      (mew-summary-goto-message)
 
444
      (setq fld (mew-summary-folder-name))
 
445
      (setq msg (mew-summary-message-number)))
 
446
     (t
 
447
      (setq fld (mew-summary-folder-name))
 
448
      (setq msg (mew-summary-message-number))
 
449
      (save-excursion
 
450
        (let ((regex (format "\r %s %s[^0-9]" (regexp-quote fld) msg)))
 
451
          (setq fld (catch 'detect
 
452
                      (dolist (buf (delq (current-buffer) (buffer-list)))
 
453
                        (set-buffer buf)
 
454
                        (save-excursion
 
455
                          (when (and (mew-virtual-p)
 
456
                                     (or (re-search-forward regex nil t)
 
457
                                         (re-search-backward regex nil t)))
 
458
                            (throw 'detect (buffer-name buf)))))
 
459
                      nil))))))
 
460
    (if (not fld)
 
461
        (message "Nothing to do")
 
462
      (mew-nmz-goto-folder-msg fld msg nil disp)
 
463
      (message "Jump to %s/%s" fld msg))))
 
464
 
 
465
(defun mew-nmz-mknmz-lang-arg ()
 
466
  (when (boundp 'current-language-environment)
 
467
    (let* ((env current-language-environment)
 
468
           (alist mew-nmz-mknmz-lang-alist)
 
469
           (lang (nth 1 (assoc env alist))))
 
470
      (if lang (format "--indexing-lang=%s" lang)))))
 
471
 
 
472
;; "Make Index" functions.
 
473
(defun mew-nmz-mknmz (&optional fld all disp)
 
474
  "Make namazu index for mew-nmz.
 
475
If executed with '\\[universal-argument]', make indices without the check of timestamp files.
 
476
If executed with '\\[universal-argument] 0', remove indices before make index."
 
477
  (interactive
 
478
   (list (directory-file-name
 
479
          (mew-input-folder (mew-sinfo-get-case)
 
480
                            (or (mew-sinfo-get-folder) mew-inbox-folder)))
 
481
         nil))
 
482
  (save-excursion
 
483
    (let ((msgenb (or (interactive-p)
 
484
                      (eq this-command 'mew-summary-make-index-folder)
 
485
                      disp))
 
486
          (force (and current-prefix-arg
 
487
                      (not (eq current-prefix-arg 0))))
 
488
          (remove (eq current-prefix-arg 0))
 
489
          (flddir (mew-expand-folder fld))
 
490
          (nmzdir (mew-nmz-expand-folder fld))
 
491
          (bufname (format "%s*Mew* mknmz*%s"
 
492
                           (if (memq mew-debug '(namazu t)) "" " ")
 
493
                           fld))
 
494
          (args mew-nmz-prog-mknmz-args)
 
495
          (procname (concat mew-nmz-prog-mknmz "-" fld))
 
496
          (procname2 (concat mew-nmz-prog-gcnmz "-" fld))
 
497
          (incfile (and mew-nmz-prog-mknmz-include
 
498
                        (expand-file-name mew-nmz-prog-mknmz-include)))
 
499
          (tmpfile (mew-make-temp-name))
 
500
          flist continue)
 
501
      (unless fld
 
502
        (setq fld (directory-file-name
 
503
                   (mew-input-folder (mew-sinfo-get-case) (mew-sinfo-get-folder)))))
 
504
      (cond
 
505
       ((not (mew-which-exec mew-nmz-prog-mknmz))
 
506
        (message "Please install mknmz"))
 
507
       ((or (mew-folder-virtualp fld) (mew-nmz-skip-folder-p fld))
 
508
        (and msgenb (message "Cannot make namazu index in %s" fld))
 
509
        (setq continue t))
 
510
       ((or (get-process procname) (get-process procname2))
 
511
        (and msgenb (message "Detect running mknmz/gcnmz process in %s" fld))
 
512
        (setq continue t))
 
513
       ((and (not remove) (not force) (mew-nmz-index-new-p fld))
 
514
        (and msgenb (message "%s has a newer namazu index" fld))
 
515
        (setq continue t))
 
516
       ((and (not remove) (file-exists-p (expand-file-name "NMZ.lock2" nmzdir)))
 
517
        (message "Something error in %s's index" fld)
 
518
        (setq continue t))
 
519
       ((not (setq flist (mew-dir-messages (file-chase-links flddir)
 
520
                                           nil 'full)))
 
521
        (and msgenb (message "%s has no message" fld))
 
522
        (mew-nmz-index-delete nmzdir)
 
523
        (setq continue t))
 
524
       ((and flddir nmzdir (file-directory-p flddir))
 
525
        (with-temp-buffer
 
526
          (dolist (file flist)
 
527
            (insert file "\n"))
 
528
          (mew-frwlet
 
529
           mew-cs-autoconv mew-cs-text-for-write
 
530
           (write-region (point-min) (point-max) tmpfile nil 'nomsg)))
 
531
        (setq args (delq nil
 
532
                         (append args
 
533
                                 (list "--no-encode-uri"
 
534
                                       ;; "--mailnews"
 
535
                                       (mew-nmz-mknmz-lang-arg)
 
536
                                       (when (and incfile (file-exists-p incfile))
 
537
                                         (format "--include=%s" incfile))
 
538
                                       (format "--target-list=%s" tmpfile)
 
539
                                       ;; (format "--exclude=%s"
 
540
                                       ;; (expand-file-name ".+/" flddir))
 
541
                                       (format "--output-dir=%s" nmzdir)))))
 
542
        ;; flddir))))
 
543
        (unless (file-directory-p nmzdir)
 
544
          (mew-make-directory nmzdir))
 
545
        (when remove
 
546
          (mew-nmz-index-delete nmzdir))
 
547
        (set-buffer (get-buffer-create bufname))
 
548
        (erase-buffer)
 
549
        ;; folder set
 
550
        (and msgenb (message "Namazu indexing for %s..." fld))
 
551
        (insert (format "mew-mknmz-prog: %s\nmew-mknmz-args: %s\n"
 
552
                        (mew-which-exec mew-nmz-prog-mknmz)
 
553
                        (mapconcat 'identity args " ")))
 
554
        (mew-nmz-timestamp-new fld)
 
555
        (mew-piolet
 
556
         mew-cs-autoconv mew-cs-text-for-write
 
557
         (setq mew-nmz-mknmz-process
 
558
               (apply (function start-process)
 
559
                      procname (current-buffer) mew-nmz-prog-mknmz args)))
 
560
        (setq mew-nmz-mknmz-process-folder fld)
 
561
        (setq mew-nmz-mknmz-process-file tmpfile)
 
562
        (set-process-sentinel mew-nmz-mknmz-process 'mew-nmz-mknmz-sentinel)
 
563
        (when (and mew-nmz-mknmz-use-mode-line
 
564
                   fld (get-buffer fld) (buffer-name (get-buffer fld)))
 
565
          (save-excursion
 
566
            (set-buffer (get-buffer fld))
 
567
            (setq mode-line-buffer-identification mew-nmz-line-id)
 
568
            (set-buffer-modified-p nil)))))
 
569
      (when (and continue all mew-nmz-mknmz-all-folders)
 
570
        (mew-nmz-mknmz-continue-with-timer)))))
 
571
 
 
572
(defun mew-nmz-mknmz-continue-with-timer ()
 
573
  (unless mew-nmz-mknmz-continue-timer
 
574
    (setq mew-nmz-mknmz-continue-timer
 
575
          (run-at-time mew-nmz-mknmz-timer-interval nil 'mew-nmz-mknmz-continue))))
 
576
 
 
577
(defun mew-nmz-mknmz-continue ()
 
578
  (when mew-nmz-mknmz-continue-timer
 
579
    (cancel-timer mew-nmz-mknmz-continue-timer)
 
580
    (setq mew-nmz-mknmz-continue-timer nil))
 
581
  (setq mew-nmz-mknmz-all-folders (cdr mew-nmz-mknmz-all-folders))
 
582
  (if mew-nmz-mknmz-all-folders
 
583
      (mew-nmz-mknmz (car mew-nmz-mknmz-all-folders) 'all)
 
584
    (ding)
 
585
    (message "All mknmz done")))
 
586
 
 
587
(defun mew-nmz-mknmz-sentinel (process event)
 
588
  (save-excursion
 
589
    (set-buffer (process-buffer process))
 
590
    (let* ((fld mew-nmz-mknmz-process-folder)
 
591
           (nmzdir (mew-nmz-expand-folder fld))
 
592
           msg success)
 
593
      (when (and (file-exists-p mew-nmz-mknmz-process-file)
 
594
                 (file-writable-p mew-nmz-mknmz-process-file))
 
595
        (delete-file mew-nmz-mknmz-process-file))
 
596
      (goto-char (point-min))
 
597
      (if (search-forward-regexp "^ERROR:.*$" nil t)
 
598
          (progn
 
599
            (setq msg (format "Mew mknmz (%s)...%s" fld (match-string 0)))
 
600
            (condition-case nil
 
601
                (progn
 
602
                  (mew-nmz-index-delete nmzdir 'tmpfiles)
 
603
                  (delete-file (expand-file-name "NMZ.lock2" nmzdir))
 
604
                  (delete-file (expand-file-name "NMZ.stamp.new" nmzdir)))
 
605
              (error nil)))
 
606
        (setq success t)
 
607
        (mew-nmz-timestamp-rename fld)
 
608
        (setq msg (format "Namazu indexing %s...done" fld))
 
609
        (when mew-nmz-setup-p
 
610
          (setq fld (mew-nmz-case-folder-normalize fld))
 
611
          (unless (mew-nmz-folder-to-nmzdir fld)
 
612
            (setq mew-nmz-fld-index-alist
 
613
                  (cons (cons fld nmzdir) mew-nmz-fld-index-alist))
 
614
            (setq mew-nmz-url-fld-alist
 
615
                  (cons (cons (mew-expand-folder fld) fld)
 
616
                        mew-nmz-url-fld-alist))
 
617
            (mew-nmz-cache-save))))
 
618
      (setq mew-nmz-mknmz-process nil)
 
619
      (setq mew-nmz-mknmz-process-folder nil)
 
620
      (when (and mew-nmz-mknmz-use-mode-line
 
621
                 fld (get-buffer fld) (buffer-name (get-buffer fld)))
 
622
        (save-excursion
 
623
          (set-buffer (get-buffer fld))
 
624
          (setq mode-line-buffer-identification mew-mode-line-id)
 
625
          (set-buffer-modified-p nil)))
 
626
      (set-buffer-modified-p nil)
 
627
      (unless (memq mew-debug '(namazu t))
 
628
        (kill-buffer (current-buffer)))
 
629
      (message "%s" msg)
 
630
      (when (and success (mew-nmz-gcnmz-folder-p fld))
 
631
        (mew-nmz-gcnmz fld nmzdir))
 
632
      (when mew-nmz-mknmz-all-folders
 
633
        (mew-nmz-mknmz-continue-with-timer)))))
 
634
 
 
635
(defun mew-nmz-gcnmz (&optional fld nmzdir)
 
636
  "Garbage collection for mew-nmz."
 
637
  (interactive
 
638
   (list (directory-file-name
 
639
          (mew-input-folder (mew-sinfo-get-case)
 
640
                            (or (mew-sinfo-get-folder) mew-inbox-folder)))
 
641
         nil))
 
642
  (unless nmzdir
 
643
    (setq nmzdir (mew-nmz-expand-folder fld)))
 
644
  (if (and (mew-which-exec mew-nmz-prog-gcnmz)
 
645
           (file-directory-p nmzdir)
 
646
           (file-exists-p (expand-file-name "NMZ.i" nmzdir)))
 
647
      (let ((buf (get-buffer-create
 
648
                  (format "%s*Mew* gcnmz*%s"
 
649
                          (if (memq mew-debug '(namazu t)) "" " ")
 
650
                          fld)))
 
651
            (procname (concat mew-nmz-prog-gcnmz "-" fld))
 
652
            (args `("--no-backup" ,nmzdir))
 
653
            process)
 
654
        (save-excursion
 
655
          (set-buffer buf)
 
656
          (erase-buffer)
 
657
          (setq mew-nmz-mknmz-process-folder fld)
 
658
          (message "Mew gcnmz (%s)..." mew-nmz-mknmz-process-folder)
 
659
          (insert (format "mew-gcnmz-prog: %s\nmew-gcnmz-args: %s\n"
 
660
                          (mew-which-exec mew-nmz-prog-gcnmz)
 
661
                          (mapconcat 'identity args " ")))
 
662
          (setq process
 
663
                (apply (function start-process)
 
664
                       procname (current-buffer) mew-nmz-prog-gcnmz args))
 
665
          (set-process-sentinel process 'mew-nmz-gcnmz-sentinel)
 
666
          (when (and mew-nmz-mknmz-use-mode-line
 
667
                     fld (get-buffer fld) (buffer-name (get-buffer fld)))
 
668
            (save-excursion
 
669
              (set-buffer (get-buffer fld))
 
670
              (setq mode-line-buffer-identification mew-nmz-gcnmz-line-id)
 
671
              (set-buffer-modified-p nil)))))
 
672
    (when (interactive-p)
 
673
      (message "gcnmz cannot run on %s" fld))))
 
674
 
 
675
(defun mew-nmz-gcnmz-sentinel (process event)
 
676
  (when (buffer-name (process-buffer process))
 
677
    (set-buffer (process-buffer process))
 
678
    (let ((fld mew-nmz-mknmz-process-folder))
 
679
      (if (and fld event (stringp event) (string= event "kill"))
 
680
          (progn
 
681
            (message "Mew gcnmz (%s)...kill from user" fld)
 
682
            (condition-case nil
 
683
                (mew-nmz-index-delete (mew-nmz-expand-folder fld) 'tmpfiles)
 
684
              (error nil)))
 
685
        (message "Mew gcnmz (%s)...done" fld))
 
686
      (when (and mew-nmz-mknmz-use-mode-line
 
687
                 fld (get-buffer fld) (buffer-name (get-buffer fld)))
 
688
        (save-excursion
 
689
          (set-buffer (get-buffer fld))
 
690
          (setq mode-line-buffer-identification mew-mode-line-id)
 
691
          (set-buffer-modified-p nil)))
 
692
      (unless (memq mew-debug '(namazu t))
 
693
        (kill-buffer (current-buffer))))))
 
694
 
 
695
(defun mew-nmz-mknmz-kill-process ()
 
696
  "Kill the all processes of mknmz."
 
697
  (interactive)
 
698
  (when mew-nmz-mknmz-continue-timer
 
699
    (cancel-timer mew-nmz-mknmz-continue-timer)
 
700
    (setq mew-nmz-mknmz-continue-timer nil))
 
701
  (let ((proc-list (process-list))
 
702
        (regex1 (concat "^" mew-nmz-prog-mknmz "-"))
 
703
        (regex2 (concat "^" mew-nmz-prog-gcnmz "-"))
 
704
        buf kill)
 
705
    (dolist (process proc-list)
 
706
      (cond
 
707
       ((string-match regex1 (process-name process))
 
708
        ;; mknmz
 
709
        (setq buf (process-buffer process))
 
710
        (when (buffer-name buf)
 
711
          (save-excursion
 
712
            (set-buffer buf)
 
713
            (set-process-sentinel process 'ignore)
 
714
            (goto-char (point-max))
 
715
            (insert "\nERROR: Kill from user.\n")
 
716
            (kill-process process)
 
717
            (mew-nmz-mknmz-sentinel process "kill")
 
718
            (setq kill t))))
 
719
       ((string-match regex2 (process-name process))
 
720
        ;; gcnmz
 
721
        (setq buf (process-buffer process))
 
722
        (when (buffer-name buf)
 
723
          (set-process-sentinel process 'ignore)
 
724
          (kill-process process)
 
725
          (mew-nmz-gcnmz-sentinel process "kill")
 
726
          (setq kill t)))))
 
727
    (setq mew-nmz-mknmz-all-folders nil)
 
728
    (when (interactive-p)
 
729
      (if kill
 
730
          (message "All process of mknmz killed")
 
731
        (message "No process of mknmz")))))
 
732
 
 
733
(defun mew-nmz-mknmz-get-all-folders ()
 
734
  (let ((protos (delq mew-folder-virtual (copy-sequence mew-folder-prefixes)))
 
735
        (allcases (or mew-config-cases '("")))
 
736
        flist cases donecases flds fld dir)
 
737
    (message "mew-nmz getting all folders...")
 
738
    (dolist (proto protos)
 
739
      (setq flds nil)
 
740
      (setq cases allcases)
 
741
      (setq donecases nil)
 
742
      (dolist (case cases)
 
743
        (if (or (string= case mew-case-default)
 
744
                (string= case ""))
 
745
            (setq case (mew-nmz-case-normalize proto))
 
746
          (setq case (mew-nmz-case-normalize
 
747
                      (concat case ":" proto))))
 
748
        (unless (member case donecases)
 
749
          (setq donecases (cons case donecases))
 
750
          (setq flds
 
751
                (cond
 
752
                 ((mew-folder-imapp proto)
 
753
                  (mapcar (lambda (x) (car x))
 
754
                          (mew-imap-folder-alist case)))
 
755
                 ((mew-folder-nntpp proto)
 
756
                  (mapcar (lambda (x) (car x))
 
757
                          (mew-nntp-folder-alist case)))
 
758
                 ((mew-folder-popp proto)
 
759
                  (mapcar (lambda (x) (car x))
 
760
                          (mew-pop-folder-alist)))
 
761
                 (t
 
762
                  (mapcar (lambda (x) (car x))
 
763
                          (mew-local-folder-alist)))))
 
764
          (setq case (if (string= case "")
 
765
                         ""
 
766
                       (concat case ":")))
 
767
          (dolist (fld flds)
 
768
            (setq fld (concat case fld))
 
769
            (setq dir (mew-expand-folder fld))
 
770
            (when (and dir
 
771
                       (file-exists-p dir)
 
772
                       (file-directory-p dir)
 
773
                       (file-exists-p (expand-file-name mew-summary-touch-file dir)))
 
774
              (setq flist (cons (directory-file-name fld) flist)))))))
 
775
    (prog1
 
776
        (setq flist (nreverse flist))
 
777
      (with-temp-buffer
 
778
        (dolist (fld flist)
 
779
          (unless (mew-nmz-skip-folder-p fld)
 
780
            (insert (format "%s\t%s\t%s\n"
 
781
                            fld
 
782
                            (mew-expand-folder fld)
 
783
                            (mew-nmz-expand-folder fld))))
 
784
          (setq flist (cdr flist)))
 
785
        (mew-frwlet
 
786
         mew-cs-text-for-read mew-nmz-mknmz-index-file-coding-system
 
787
         (write-region (point-min) (point-max)
 
788
                       (expand-file-name mew-nmz-mknmz-index-file mew-conf-path)
 
789
                       nil 'nomsg)))
 
790
      (message "mew-nmz getting all folders...done"))))
 
791
 
 
792
(defun mew-nmz-mknmz-all-folders (&optional args)
 
793
  "Make namazu index all folders."
 
794
  (interactive "P")
 
795
  (setq args (or args current-prefix-arg))
 
796
  (when (or (null mew-nmz-mknmz-all-folders)
 
797
            (and mew-nmz-mknmz-all-folders
 
798
                 (prog1
 
799
                     (y-or-n-p "Another mew-nmz-mknmz-all-folders() detect. Kill it? ")
 
800
                   (mew-nmz-mknmz-kill-process))))
 
801
    (when (y-or-n-p (format "Make index in all %s? "
 
802
                            (if args "folders" "indexed folders")))
 
803
      (let (alist flist)
 
804
        (if args
 
805
            (progn
 
806
              ;; all exist folder
 
807
              (mew-nmz-cleanup 'remove)
 
808
              (setq flist (mew-nmz-mknmz-get-all-folders)))
 
809
          ;; all indexed folder
 
810
          (mew-nmz-setup)
 
811
          (setq alist mew-nmz-fld-index-alist)
 
812
          (while alist
 
813
            (setq flist (cons (car (car alist)) flist))
 
814
            (setq alist (cdr alist))))
 
815
        (setq flist (nreverse flist))
 
816
        ;; for mew-nmz-mknmz()
 
817
        (setq current-prefix-arg nil)
 
818
        (setq mew-nmz-mknmz-all-folders flist)
 
819
        (when flist
 
820
          (mew-nmz-mknmz (car flist) 'all))))))
 
821
 
 
822
(defun mew-nmz-mknmz-save-mewmknmz ()
 
823
  "Save the information for mknmz."
 
824
  (interactive)
 
825
  (mew-nmz-cleanup 'remove)
 
826
  (mew-nmz-setup)
 
827
  (mew-nmz-mknmz-get-all-folders))
 
828
 
 
829
(defun mew-nmz-mark-unindexed ()
 
830
  "Mark unindexed messages."
 
831
  (interactive)
 
832
  (mew-summary-only
 
833
   (if (mew-summary-exclusive-p)
 
834
       (save-excursion
 
835
         (if (and (mew-summary-mark-collect
 
836
                   mew-nmz-mark-unindexed (point-min) (point-max))
 
837
                  (y-or-n-p (format "Unmark '%c'? " mew-nmz-mark-unindexed)))
 
838
             (mew-mark-undo-mark mew-nmz-mark-unindexed 'nomsg))
 
839
         (let* ((ufname
 
840
                 (expand-file-name "NMZ.field.uri"
 
841
                                   (mew-nmz-expand-folder (buffer-name))))
 
842
                (mmsgs 0)
 
843
                (umsgs 0)
 
844
                msgnums)
 
845
           (if (not (file-exists-p ufname))
 
846
               (message "%s has no index file" (buffer-name))
 
847
             (with-temp-buffer
 
848
               (message "checking %s..." (file-name-nondirectory ufname))
 
849
               (insert-file-contents ufname)
 
850
               (while (re-search-forward "/\\([0-9]+\\)$" nil t)
 
851
                 (setq msgnums (cons (string-to-number (match-string 1)) msgnums))))
 
852
             (message "checking %s..." (buffer-name))
 
853
             (goto-char (point-min))
 
854
             (while (not (eobp))
 
855
               (if (and (mew-sumsyn-match mew-regex-sumsyn-short)
 
856
                        (not (memq (string-to-number (mew-sumsyn-message-number)) msgnums))
 
857
                        (not (mew-in-decode-syntax-p)))
 
858
                   (progn
 
859
                     (setq umsgs (1+ umsgs))
 
860
                     (when (mew-summary-markable)
 
861
                       (mew-summary-mark-as mew-nmz-mark-unindexed)
 
862
                       (setq mmsgs (1+ mmsgs)))))
 
863
               (forward-line))
 
864
             (cond
 
865
              ((= umsgs 1)
 
866
               (message "%d message does not have index, %d marked"
 
867
                        umsgs mmsgs))
 
868
              ((> umsgs 1)
 
869
               (message "%d messages do not have index, %d marked"
 
870
                        umsgs mmsgs))
 
871
              (t
 
872
               (message "all messages have index")))))))))
 
873
 
 
874
;; "search Message-ID" functions.
 
875
(defun mew-nmz-search-parent (&optional child mid)
 
876
  "Search *parent* message and jump to that.
 
877
If executed with '\\[universal-argument]', search *child* message."
 
878
  (interactive "P")
 
879
  (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
 
880
    (mew-summary-goto-message))
 
881
  (let ((fld (mew-summary-folder-name))
 
882
        (msg (mew-summary-message-number))
 
883
        (idh (list (list mew-in-reply-to: mew-references:)
 
884
                   (list mew-message-id:)))
 
885
        (message (if child "children" "parent"))
 
886
        (refilefld (copy-sequence mew-nmz-search-parent-folder))
 
887
        (proto (or (mew-proto-to-refile (or (mew-sinfo-get-folder)
 
888
                                            (mew-minfo-get-summary)
 
889
                                            "+"))
 
890
                   "+"))
 
891
        (case (mew-sinfo-get-case))
 
892
        refiledir mess ref pid pos killbuff)
 
893
    (if mid
 
894
        (setq pid (list mid) idh nil)
 
895
      (if (not (or msg (mew-syntax-number)))
 
896
          (message "No message here")
 
897
        (save-excursion
 
898
          (mew-nmz-setup)
 
899
          (mew-summary-display)
 
900
          (if (setq mess (mew-cache-hit fld msg))
 
901
              (set-buffer mess)
 
902
            (setq mess (generate-new-buffer mew-buffer-prefix))
 
903
            (setq killbuff t)
 
904
            (set-buffer mess)
 
905
            (mew-erase-buffer)
 
906
            (mew-insert-message
 
907
             fld msg mew-cs-text-for-read mew-header-reasonable-size))
 
908
          (let ((mew-inherit-refile-proto proto)
 
909
                (mew-inherit-refile-case case))
 
910
            (setq refilefld (append (car (mew-refile-guess nil t)) refilefld)))
 
911
          (if child
 
912
              (setq idh (car (cdr idh)))
 
913
            (setq idh (car idh)))
 
914
          (dolist (rh idh)
 
915
            (setq ref (mew-header-get-value rh))
 
916
            (while (and ref (string-match "<\\([^>]+\\)>" ref))
 
917
              (setq pid (cons (concat "\"" (match-string 1 ref) "\"") pid))
 
918
              (setq refilefld
 
919
                    (cons (nth 1 (assoc (car pid) mew-refile-msgid-alist)) refilefld))
 
920
              (setq ref (substring ref (match-end 0)))))
 
921
          (setq refilefld (cons fld refilefld))
 
922
          (setq refilefld (mew-uniq-list (delete nil refilefld)))
 
923
          (setq refiledir
 
924
                (delete nil (mapcar
 
925
                             (lambda (x)
 
926
                               (mew-nmz-expand-folder x))
 
927
                             refilefld))))))
 
928
    (when killbuff (mew-kill-buffer mess))
 
929
    (if (null pid)
 
930
        (message "No required header")
 
931
      (if (mew-syntax-number)
 
932
          (while (not (mew-summary-message-number))
 
933
            (forward-line -1)))
 
934
      (mew-sinfo-set-ret-pos (point))
 
935
      (let ((pattern1 "")
 
936
            (pattern2 "")
 
937
            (addpattern (if child "+in-reply-to:" "+message-id:"))
 
938
            (range nil))
 
939
        (if (not child)
 
940
            (setq pattern1 (concat addpattern (car pid)))
 
941
          (setq pattern1 (concat addpattern (car pid)))
 
942
          (setq addpattern "+references:")
 
943
          (setq pattern1 (concat pattern1 " | " addpattern (car pid))))
 
944
        (setq pid (delete (car pid) pid))
 
945
        (while pid
 
946
          (if (> (length (concat pattern2 addpattern (car pid)))
 
947
                 mew-nmz-query-max-length)
 
948
              (setq pid nil)
 
949
            (setq pattern2 (concat pattern2 addpattern (car pid)))
 
950
            (setq addpattern (if child " | +references:" " | +message-id:"))
 
951
            (setq pid (delete (car pid) pid))))
 
952
        (message "Searching %s..." message)
 
953
        (let ((pattern (list pattern1 pattern2)))
 
954
          (while (and (null range) pattern)
 
955
            (if mid
 
956
                ()
 
957
              (message "Searching %s...%s" message (mew-join ", " refilefld))
 
958
              (setq range (mew-nmz-multi-pick refiledir (car pattern)))
 
959
              (when range
 
960
                (catch 'detect
 
961
                  (dolist (ref refilefld)
 
962
                    (if (null (setq idh (assoc ref range)))
 
963
                        ()
 
964
                      (setq fld (car idh))
 
965
                      (if child
 
966
                          (setq range (cdr idh))
 
967
                        (setq range (nreverse (cdr idh))))
 
968
                      (throw 'detect t)))
 
969
                  nil)))
 
970
            (unless range
 
971
              ;; all folder search
 
972
              (message "Searching %s...all folders" message)
 
973
              (setq range (mew-nmz-multi-pick
 
974
                           (mew-nmz-expand-folder-regexp "*:*")
 
975
                           (car pattern) 'catch))
 
976
              (if (null range)
 
977
                  (setq pattern (cdr pattern))
 
978
                (setq fld (car (car range)))
 
979
                (setq range (cdr (car range)))
 
980
                (if (not child) (setq range (nreverse range)))
 
981
                ))))
 
982
        (if (null range)
 
983
            (message "No message found")
 
984
          (when (or (and (mew-thread-p)
 
985
                         (string= (mew-summary-folder-name) fld))
 
986
                    (and (mew-virtual-p)
 
987
                         (not (mew-thread-p))))
 
988
            (save-excursion
 
989
              (goto-char (point-min))
 
990
              (when (re-search-forward
 
991
                     (concat "\r \\(" (regexp-quote fld) "\\)? +" (car range) " ") nil t)
 
992
                (setq fld (buffer-name))
 
993
                (goto-char (match-beginning 0))
 
994
                (beginning-of-line)
 
995
                (setq pos (point)))))
 
996
          (if (listp (car range))
 
997
              (setq fld (car (car range))
 
998
                    mess (car (cdr (car range))))
 
999
            (setq mess (car range)))
 
1000
          (mew-nmz-goto-folder-msg fld mess pos)
 
1001
          (message "Searching %s...%s/%s" message fld mess))))))
 
1002
 
 
1003
(defun mew-nmz-search-child (&optional arg)
 
1004
  (interactive "P")
 
1005
  (mew-nmz-search-parent (not arg)))
 
1006
 
 
1007
(defun mew-nmz-search-msgid-at-point ()
 
1008
  (interactive)
 
1009
  (let (start end)
 
1010
    (if (and (re-search-backward "<" (save-excursion (beginning-of-line) (point)) t)
 
1011
             (setq start (point))
 
1012
             (re-search-forward ">" (save-excursion (end-of-line) (point)) t)
 
1013
             (setq end (point)))
 
1014
        (mew-nmz-search-msgid (buffer-substring start end))
 
1015
      (message "No Message-ID"))))
 
1016
 
 
1017
(defun mew-nmz-search-msgid-region (start end)
 
1018
  (interactive "r")
 
1019
  (mew-nmz-search-msgid (buffer-substring start end)))
 
1020
 
 
1021
(defun mew-nmz-search-msgid (mid)
 
1022
  (interactive "sMessage-ID: ")
 
1023
  (if (string-match "<\\([^>]+\\)>" mid)
 
1024
      (let ((mew-use-full-window t)
 
1025
            (pattern (concat "\"" (mew-match-string 1 mid) "\"")))
 
1026
        (when (eq major-mode 'mew-message-mode)
 
1027
          (mew-message-goto-summary))
 
1028
        (mew-nmz-search-parent nil pattern))
 
1029
    (message "No Message-ID")))
 
1030
 
 
1031
;; "Namazu virtual" function.
 
1032
(defun mew-nmz-input-folders ()
 
1033
  (mew-input-clear)
 
1034
  (mew-input-folder-clean-up)
 
1035
  (let ((map (copy-keymap mew-input-folder-map))
 
1036
        (case:folder (concat (or (mew-summary-folder-name) "+")
 
1037
                             (if mew-nmz-input-folders-asterisk "*" ""))))
 
1038
    (define-key map "*" 'mew-input-folder-self-insert)
 
1039
    (let* ((init "+*") ;; (mew-canonicalize-case-folder case:folder))
 
1040
           (mew-input-complete-function 'mew-complete-folder)
 
1041
           (mew-circular-complete-function 'mew-circular-complete-case:)
 
1042
           (mew-input-folder-search-multi t)
 
1043
           (minibuffer-setup-hook (cons 'backward-char minibuffer-setup-hook))
 
1044
           ;; mew-inherit-case must be nil
 
1045
           (ret (read-from-minibuffer "Namazu folder name: "
 
1046
                                      init map nil
 
1047
                                      'mew-nmz-input-folder-hist)))
 
1048
      (when (string= ret "")
 
1049
        (setq ret init))
 
1050
      (setq ret (mapcar 'mew-chop (mew-split ret ?,))))))
 
1051
 
 
1052
;; Use namazu-mode.
 
1053
;; (setq w3m-namazu-arguments
 
1054
;;       '("-r" "-h" "-H" "-n" w3m-namazu-page-max "-w" whence))
 
1055
 
 
1056
(defun mew-nmz-namazu (&optional pattern indexs)
 
1057
  "Execute w3m-namazu.
 
1058
If executed with '\\[universal-argument]', search result indexes."
 
1059
  (interactive)
 
1060
  (if (not (or (featurep 'w3m-namazu)
 
1061
               (condition-case nil
 
1062
                   (require 'w3m-namazu)
 
1063
                 (error nil))))
 
1064
      (message "Please install \"emacs-w3m\"")
 
1065
    (mew-nmz-setup)
 
1066
    (if current-prefix-arg
 
1067
        ;; rest indexes
 
1068
        (let (current-prefix-arg)
 
1069
          (mew-nmz-namazu mew-nmz-namazu-pattern mew-nmz-namazu-miss-folders))
 
1070
      (let ((i mew-nmz-db-max)
 
1071
            flds nmzdirs fldmsgs pickflds overmsg)
 
1072
        (setq flds (or indexs (mew-nmz-input-folders)))
 
1073
        (setq mew-nmz-namazu-pattern
 
1074
              (setq pattern
 
1075
                    (or pattern
 
1076
                        (let ((mew-pick-field-list (mew-nmz-pick-field-list)))
 
1077
                          (mew-nmz-pick-canonicalize-pattern
 
1078
                           (mew-input-pick-pattern "Namazu pick"))))))
 
1079
        (setq mew-nmz-namazu-miss-folders nil)
 
1080
        (setq nmzdirs (mew-nmz-flds-to-indexs flds))
 
1081
        (when (> (length nmzdirs) mew-nmz-db-max)
 
1082
          (setq fldmsgs (mew-nmz-multi-pick nmzdirs pattern))
 
1083
          (when fldmsgs
 
1084
            (dolist (fldmsg fldmsgs)
 
1085
              (setq pickflds (cons (car fldmsg) pickflds)))
 
1086
            (when (> (length pickflds) mew-nmz-db-max)
 
1087
              (setq mew-nmz-namazu-miss-folders
 
1088
                    (nthcdr mew-nmz-db-max (nreverse pickflds)))
 
1089
              (setq overmsg (format "Warning: %d indexes over"
 
1090
                                    (length mew-nmz-namazu-miss-folders))))
 
1091
            (setq nmzdirs nil)
 
1092
            (while (and pickflds (> i 0))
 
1093
              (setq nmzdirs (cons (mew-nmz-expand-folder (car pickflds))
 
1094
                                  nmzdirs))
 
1095
              (setq pickflds (cdr pickflds))
 
1096
              (setq i (1- i)))))
 
1097
        ;; message viewer set
 
1098
        (unless (assoc mew-nmz-namazu-content-type w3m-content-type-alist)
 
1099
          (setq w3m-content-type-alist
 
1100
                (cons `(,mew-nmz-namazu-content-type "/[0-9]+$" nil "text/plain")
 
1101
                      w3m-content-type-alist)))
 
1102
        (add-hook 'w3m-display-hook 'w3m-mew-message-view t)
 
1103
        ;; remove pre mew-nmz-namazu's alist
 
1104
        (when (assoc mew-nmz-namazu-index-alias w3m-namazu-index-alist)
 
1105
          (setq w3m-namazu-index-alist
 
1106
                (delete (assoc mew-nmz-namazu-index-alias w3m-namazu-index-alist)
 
1107
                        w3m-namazu-index-alist)))
 
1108
        ;; for next page
 
1109
        (setq w3m-namazu-index-alist
 
1110
              (append (list (cons mew-nmz-namazu-index-alias nmzdirs))
 
1111
                      w3m-namazu-index-alist))
 
1112
        (w3m-namazu mew-nmz-namazu-index-alias pattern 'reload)
 
1113
        (when overmsg (message overmsg))))))
 
1114
 
 
1115
(defun w3m-mew-message-view (url)
 
1116
  (if (and (boundp 'mew-mail-path)
 
1117
           (w3m-url-local-p url)
 
1118
           (string-match (concat (file-name-as-directory
 
1119
                                  (expand-file-name mew-mail-path))
 
1120
                                 ".+/[0-9]+$")
 
1121
                         (expand-file-name (w3m-url-to-file-name url))))
 
1122
      (unless (get-text-property (point-min) 'w3m-mew-namazu)
 
1123
        (mew-elet
 
1124
         (goto-char (point-min))
 
1125
         (condition-case nil
 
1126
             (let (pos)
 
1127
               (mew-decode-rfc822-header)
 
1128
               (mew-header-goto-end)
 
1129
               (mew-header-arrange (point-min) (point))
 
1130
               (mew-highlight-body-region (point) (point-max))
 
1131
               ;; for emacs-w3m
 
1132
               (remove-text-properties (point-min) (point-max)
 
1133
                                       '(read-only nil))
 
1134
               (setq pos (if (get-text-property (point-min) 'mew-visible)
 
1135
                             (point-min)
 
1136
                           (or (next-single-property-change (point-min) 'mew-visible)
 
1137
                               (point-min))))
 
1138
               (set-window-start (selected-window) pos))
 
1139
           (error nil))
 
1140
         (put-text-property (point-min) (point-min) 'w3m-mew-namazu t)
 
1141
         (set-buffer-modified-p nil)))
 
1142
    (remove-text-properties (point-min) (point-min) '(w3m-mew-namazu nil))))
 
1143
 
 
1144
;; Input "Namazu pattern" functions.
 
1145
 
 
1146
;; Mew pickpattern converter
 
1147
(defun mew-nmz-pick-canonicalize-pattern (pattern)
 
1148
  (let ((mew-inherit-pick-omit-and t))
 
1149
    (mapconcat
 
1150
     'mew-nmz-pick-native-text-namazu
 
1151
     (mew-pick-parse (mew-pick-lex pattern))
 
1152
     " ")))
 
1153
 
 
1154
(defun mew-nmz-pick-native-text-namazu (token)
 
1155
  (mew-pick-native-text "mew-nmz-pick-pattern-namazu-" token))
 
1156
 
 
1157
(defun mew-nmz-pick-pattern-namazu-and   (sym) "and")
 
1158
(defun mew-nmz-pick-pattern-namazu-or    (sym) "or")
 
1159
(defun mew-nmz-pick-pattern-namazu-open  (sym) "(")
 
1160
(defun mew-nmz-pick-pattern-namazu-close (sym) ")")
 
1161
(defun mew-nmz-pick-pattern-namazu-not   (sym) "not")
 
1162
(defun mew-nmz-pick-pattern-namazu-key   (key) key)
 
1163
(defun mew-nmz-pick-pattern-namazu-kyvl  (kyvl)
 
1164
  (when (string= (nth 0 kyvl) "=")
 
1165
    (format "+%s:%s" (nth 1 kyvl) (nth 2 kyvl))))
 
1166
 
 
1167
(defun mew-nmz-pick-pattern-gather-header ()
 
1168
  (when mew-nmz-pick-gather-field-list
 
1169
    (save-excursion
 
1170
      (let* ((fld (mew-summary-folder-name))
 
1171
             (msg (mew-summary-message-number))
 
1172
             (buf (mew-cache-hit fld msg))
 
1173
             (gathers mew-nmz-pick-gather-field-list)
 
1174
             killbuff retlst gather header duplchk mid addrs addr prefix)
 
1175
        (when (and (not buf) fld msg)
 
1176
          (setq buf (generate-new-buffer mew-buffer-prefix))
 
1177
          (setq killbuff t)
 
1178
          (set-buffer buf)
 
1179
          (mew-erase-buffer)
 
1180
          (mew-insert-message
 
1181
           fld msg mew-cs-text-for-read mew-header-reasonable-size))
 
1182
        (when (and buf (get-buffer buf) (buffer-name (get-buffer buf)))
 
1183
          (set-buffer buf)
 
1184
          (while gathers
 
1185
            (setq gather (car gathers))
 
1186
            (setq header (mew-header-get-value (car gather)))
 
1187
            (when (and header (car (cdr gather)))
 
1188
              (cond
 
1189
               ((eq (car (cdr gather)) 'msgid)
 
1190
                (while (and header (string-match "<\\([^>]+\\)>" header))
 
1191
                  (setq mid (match-string 1 header))
 
1192
                  (setq header (substring header (match-end 0)))
 
1193
                  (if (member mid duplchk)
 
1194
                      ()
 
1195
                    (setq prefix (nthcdr 2 gather))
 
1196
                    (setq duplchk (cons mid duplchk))
 
1197
                    (while prefix
 
1198
                      (setq retlst (cons (concat (car prefix) mid) retlst))
 
1199
                      (setq prefix (cdr prefix))))))
 
1200
               ((eq (car (cdr gather)) 'address)
 
1201
                (setq addrs (mew-addrstr-parse-address-list header))
 
1202
                (while (setq addr (car addrs))
 
1203
                  (setq addr (downcase addr))
 
1204
                  (if (not (member addr duplchk))
 
1205
                      (let ((prefix (nthcdr 2 gather)))
 
1206
                        (setq duplchk (cons addr duplchk))
 
1207
                        (while prefix
 
1208
                          (setq retlst (cons (concat (car prefix) addr) retlst))
 
1209
                          (setq prefix (cdr prefix)))))
 
1210
                  (setq addrs (cdr addrs))))))
 
1211
            (setq gathers (cdr gathers)))
 
1212
          (when killbuff (mew-kill-buffer buf))
 
1213
          (when retlst
 
1214
            (setq retlst (append
 
1215
                          retlst
 
1216
                          (list
 
1217
                           (concat " " (make-string (- (window-width) 10) ?-))))))
 
1218
          (nreverse retlst))))))
 
1219
 
 
1220
;; "Namazu search engine" functions.
 
1221
(defun mew-nmz-multi-pick (nmzdirs pattern &optional catch single)
 
1222
  "Get message numbers with many folders."
 
1223
  (let ((tmpdirs nmzdirs)
 
1224
        (defaultregex
 
1225
          (concat "^" (regexp-opt
 
1226
                       (delq mew-folder-virtual (copy-sequence mew-folder-prefixes)))))
 
1227
        nxt prog-args intmsgs retmsgs sortfld defmsgs casemsgs cell)
 
1228
    (setq pattern (mew-cs-encode-arg pattern))
 
1229
    (setq nmzdirs nil)
 
1230
    (while tmpdirs
 
1231
      (setq nxt (nthcdr mew-nmz-db-max tmpdirs))
 
1232
      (if nxt (setcdr (nthcdr (1- mew-nmz-db-max) tmpdirs) nil))
 
1233
      (setq nmzdirs (cons tmpdirs nmzdirs))
 
1234
      (setq tmpdirs nxt))
 
1235
    (setq nmzdirs (nreverse nmzdirs))
 
1236
    (with-temp-buffer
 
1237
      (while (and nmzdirs
 
1238
                  (or (not catch)
 
1239
                      (and catch (null intmsgs))))
 
1240
        (setq prog-args (delq nil (append mew-nmz-prog-args
 
1241
                                          (list "--all" "--list" "--no-decode-uri")
 
1242
                                          (list pattern)
 
1243
                                          (car nmzdirs))))
 
1244
        (erase-buffer)
 
1245
        (mew-piolet
 
1246
         mew-cs-text-for-read mew-cs-text-for-write
 
1247
         (let ((file-name-coding-system nil))
 
1248
           (apply (function call-process)
 
1249
                  mew-nmz-prog nil t nil prog-args)))
 
1250
        (goto-char (point-min))
 
1251
        (let (dir msgnum)
 
1252
          (while (not (eobp))
 
1253
            (when (looking-at mew-nmz-result-regex)
 
1254
              (setq dir (mew-buffer-substring (match-beginning 1) (match-end 1)))
 
1255
              (setq msgnum (string-to-number
 
1256
                            (mew-buffer-substring (match-beginning 2) (match-end 2))))
 
1257
              (if (not (setq cell (assoc dir intmsgs)))
 
1258
                  (setq intmsgs (cons (list dir (list msgnum)) intmsgs))
 
1259
                (unless (memq msgnum (car (cdr cell)))
 
1260
                  (nconc (car (cdr cell)) (list msgnum)))))
 
1261
            (forward-line))
 
1262
          (setq nmzdirs (cdr nmzdirs))))
 
1263
      (when intmsgs
 
1264
        (if single
 
1265
            ;; for search-mark
 
1266
            (mapcar 'number-to-string (sort (car (cdr (car intmsgs))) '<))
 
1267
          ;; for virtual or w3m-namazu
 
1268
          (setq retmsgs intmsgs)
 
1269
          (while retmsgs
 
1270
            (setq sortfld (cons (car (car retmsgs)) sortfld))
 
1271
            (setq retmsgs (cdr retmsgs)))
 
1272
          ;; no sort
 
1273
          ;; (setq sortfld (sort sortfld 'string<))
 
1274
          (while sortfld
 
1275
            (setq cell (assoc (car sortfld) intmsgs))
 
1276
            (setq retmsgs
 
1277
                  (cons
 
1278
                   (cons (mew-nmz-url-to-folder (car cell))
 
1279
                         (mapcar 'number-to-string (sort (car (cdr cell)) '<)))
 
1280
                   retmsgs))
 
1281
            (setq sortfld (cdr sortfld)))
 
1282
          ;; '((folder msg ...) (folder msg ...) ...)
 
1283
          (while retmsgs
 
1284
            (when (car (car retmsgs))
 
1285
              (if (string-match defaultregex (car (car retmsgs)))
 
1286
                  (setq defmsgs (cons (car retmsgs) defmsgs))
 
1287
                (setq casemsgs (cons (car retmsgs) casemsgs))))
 
1288
            (setq retmsgs (cdr retmsgs)))
 
1289
          (append defmsgs casemsgs))))))
 
1290
 
 
1291
;; miscellaneous functions
 
1292
(defun mew-nmz-flds-to-indexs (flds)
 
1293
  (let ((suffix (append
 
1294
                 '("*")
 
1295
                 (delq mew-folder-virtual (copy-sequence mew-folder-prefixes))))
 
1296
        nmzdirs tmp)
 
1297
    (setq suffix (concat (regexp-opt suffix) "$"))
 
1298
    (dolist (fld flds)
 
1299
      (setq fld (mew-nmz-case-folder-normalize fld))
 
1300
      (cond
 
1301
       ((or (string-match suffix fld)
 
1302
            (string-match "^\\*" fld))
 
1303
        (setq nmzdirs (append nmzdirs
 
1304
                              (mew-nmz-expand-folder-regexp fld))))
 
1305
       ((setq tmp (mew-nmz-folder-to-nmzdir fld))
 
1306
        (setq nmzdirs (cons tmp nmzdirs)))))
 
1307
    (nreverse (mew-uniq-list nmzdirs))))
 
1308
 
 
1309
(defun mew-nmz-expand-folder-regexp (case:folder)
 
1310
  (mew-nmz-setup)
 
1311
  (let ((alist mew-nmz-fld-index-alist)
 
1312
        case fld caseregex nmzdirs tmpfld nmzdir protos newcase lst)
 
1313
    (if (string= case:folder "*:*")
 
1314
        ;; all case, all proto, all folder
 
1315
        (dolist (lst alist)
 
1316
          (setq nmzdirs (cons (cdr lst) nmzdirs)))
 
1317
      (if (string-match "^\\([^:]+\\):\\(.*\\)$" case:folder)
 
1318
          (setq case (match-string 1 case:folder)
 
1319
                fld (match-string 2  case:folder))
 
1320
        (setq case "")
 
1321
        (setq fld case:folder))
 
1322
      (when (string-match "^.*\\*$" fld)
 
1323
        (setq fld (substring fld 0 -1))
 
1324
        (setq fld (directory-file-name fld)))
 
1325
      (cond
 
1326
       ((string= case "*")
 
1327
        ;; all case
 
1328
        (setq caseregex "^\\([^:]+:\\)?"))
 
1329
       ((or (string= case "") (string= mew-case-default case))
 
1330
        ;; default case
 
1331
        (setq caseregex "^"))
 
1332
       ((string= fld "")
 
1333
        (setq protos (delq mew-folder-virtual (copy-sequence mew-folder-prefixes)))
 
1334
        (setq caseregex
 
1335
              (concat "^\\(\\("
 
1336
                      (mapconcat
 
1337
                       (lambda (x)
 
1338
                         (setq newcase (mew-nmz-case-normalize
 
1339
                                        (concat case ":" x)))
 
1340
                         (if (string= newcase "")
 
1341
                             (regexp-quote x)
 
1342
                           (regexp-quote (concat case ":" x))))
 
1343
                       protos "\\)\\|\\(")
 
1344
                      "\\)\\)")))
 
1345
       (t
 
1346
        (setq case (mew-nmz-case-normalize (concat case ":" fld)))
 
1347
        (if (string= case "")
 
1348
            (setq caseregex "^")
 
1349
          (setq caseregex (concat "^" (regexp-quote case) ":")))))
 
1350
      (if (string= fld "")
 
1351
          (setq caseregex (concat caseregex "[^:]+$"))
 
1352
        (setq caseregex (concat caseregex (regexp-quote fld))))
 
1353
      (dolist (lst alist)
 
1354
        (setq tmpfld (car lst))
 
1355
        (setq nmzdir (cdr lst))
 
1356
        (when (string-match caseregex tmpfld)
 
1357
          (setq nmzdirs (cons nmzdir nmzdirs)))))
 
1358
    nmzdirs))
 
1359
 
 
1360
(defun mew-nmz-goto-folder-msg (fld msg &optional pos disp)
 
1361
  (mew-summary-visit-folder fld)
 
1362
  (if (mew-virtual-p)
 
1363
      (mew-summary-move-and-display msg disp)
 
1364
    (goto-char (point-min))
 
1365
    (if (mew-nmz-re-search-message msg)
 
1366
        (setq pos (point))
 
1367
      (setq pos
 
1368
            (catch 'det
 
1369
              (while mew-summary-buffer-process
 
1370
                (sit-for 0.1)
 
1371
                ;; accept-process-output or sleep-for is not enough
 
1372
                (discard-input)
 
1373
                (unless pos
 
1374
                  (goto-char (point-min))
 
1375
                  (when (mew-nmz-re-search-message msg)
 
1376
                    (setq pos (point))
 
1377
                    (throw 'det t))))
 
1378
              pos)))
 
1379
    (if pos (goto-char pos))
 
1380
    (mew-thread-move-cursor)
 
1381
    (mew-summary-display disp)))
 
1382
 
 
1383
(defun mew-nmz-index-new-p (fld)
 
1384
  (let ((touchtime (mew-file-get-time
 
1385
                    (expand-file-name
 
1386
                     mew-summary-touch-file
 
1387
                     (file-chase-links (mew-expand-folder fld)))))
 
1388
        (stamptime (mew-file-get-time
 
1389
                    (expand-file-name
 
1390
                     "NMZ.stamp" (mew-nmz-expand-folder fld)))))
 
1391
    (cond
 
1392
     ((null touchtime) nil)
 
1393
     ((null stamptime) nil)
 
1394
     ((> (nth 0 stamptime) (nth 0 touchtime)) t)
 
1395
     ((and (= (nth 0 stamptime) (nth 0 touchtime))
 
1396
           (> (nth 1 stamptime) (nth 1 touchtime))) t)
 
1397
     (t nil))))
 
1398
 
 
1399
(defun mew-nmz-index-delete (nmzdir &optional tmpfiles)
 
1400
  "Delete namazu index files."
 
1401
  (when (file-directory-p nmzdir)
 
1402
    (let* ((regex (if tmpfiles "^NMZ\..*tmp$" "^NMZ\."))
 
1403
           (flist (directory-files nmzdir 'full regex 'nosort)))
 
1404
      (dolist (file flist)
 
1405
        (setq file (expand-file-name file nmzdir))
 
1406
        (and (file-exists-p file)
 
1407
             (file-writable-p file)
 
1408
             (delete-file file))))))
 
1409
 
 
1410
(defun mew-nmz-skip-folder-p (fld)
 
1411
  (let ((skips mew-nmz-mknmz-skip-folders-regexp))
 
1412
    (catch 'match
 
1413
      (setq fld (mew-nmz-case-folder-normalize fld))
 
1414
      (dolist (skip skips)
 
1415
        (when (string-match skip fld)
 
1416
          (throw 'match t)))
 
1417
      nil)))
 
1418
 
 
1419
(defun mew-nmz-gcnmz-folder-p (fld)
 
1420
  (let ((regexps mew-nmz-use-gcnmz-folders-regexp))
 
1421
    (catch 'match
 
1422
      (setq fld (mew-nmz-case-folder-normalize fld))
 
1423
      (while regexps
 
1424
        (when (string-match (car regexps) fld)
 
1425
          (throw 'match t))
 
1426
        (setq regexps (cdr regexps)))
 
1427
      nil)))
 
1428
 
 
1429
(defun mew-nmz-timestamp-new (fld)
 
1430
  (let ((file (expand-file-name "NMZ.stamp.new" (mew-nmz-expand-folder fld))))
 
1431
    (if (file-writable-p file)
 
1432
        (write-region "touched by Mew." nil file nil 'no-msg))))
 
1433
 
 
1434
(defun mew-nmz-timestamp-rename (fld)
 
1435
  (let ((nfile (expand-file-name "NMZ.stamp.new" (mew-nmz-expand-folder fld)))
 
1436
        (tfile (expand-file-name "NMZ.stamp" (mew-nmz-expand-folder fld))))
 
1437
    (if (and (file-readable-p nfile) (file-writable-p tfile))
 
1438
        (rename-file nfile tfile 'ok)
 
1439
      (if (file-writable-p nfile)
 
1440
          (delete-file nfile)))))
 
1441
 
 
1442
(defun mew-nmz-re-search-message (msg)
 
1443
  (let ((here (point)))
 
1444
    (if (not (re-search-forward (concat "^.*\r +" msg "[^0-9]") nil t))
 
1445
        (progn (goto-char here)
 
1446
               nil)
 
1447
      (beginning-of-line)
 
1448
      t)))
 
1449
 
 
1450
;; index delete/rename
 
1451
;; call from mew-summary-delete-folder()
 
1452
;; case:folder MUST not branch
 
1453
(defun mew-nmz-folder-index-delete (case:folder)
 
1454
  (let ((nmzdir (mew-nmz-expand-folder case:folder))
 
1455
        (fld (mew-nmz-case-folder-normalize case:folder)))
 
1456
    (when (and (file-exists-p nmzdir) (file-directory-p nmzdir))
 
1457
      (mew-delete-directory-recursively nmzdir)
 
1458
      (setq mew-nmz-fld-index-alist
 
1459
            (delete (assoc fld mew-nmz-fld-index-alist) mew-nmz-fld-index-alist))
 
1460
      (setq mew-nmz-url-fld-alist
 
1461
            (delete (assoc (mew-expand-folder fld) mew-nmz-url-fld-alist)
 
1462
                    mew-nmz-url-fld-alist))
 
1463
      (mew-nmz-cache-save))))
 
1464
 
 
1465
;; call from mew-summary-rename-folder()
 
1466
(defun mew-nmz-folder-index-rename (case:folder case:new-folder)
 
1467
  (let ((nmzdir (mew-nmz-expand-folder case:folder))
 
1468
        (new-nmzdir (mew-nmz-expand-folder case:new-folder))
 
1469
        (dir (file-name-as-directory (mew-expand-folder case:folder)))
 
1470
        (new-dir (file-name-as-directory (mew-expand-folder case:new-folder))))
 
1471
    (when (and (file-exists-p nmzdir) (file-directory-p nmzdir)
 
1472
               (not (file-exists-p new-nmzdir)))
 
1473
      (mew-nmz-cleanup 'remove)
 
1474
      (rename-file nmzdir new-nmzdir)
 
1475
      (when mew-nmz-use-drive-letter
 
1476
        (when (string-match "^\\([a-zA-Z]\\):\\(/.*\\)" dir)
 
1477
          (setq dir (concat "/"
 
1478
                            (substring dir (match-beginning 1) (match-end 1))
 
1479
                            "|"
 
1480
                            (substring dir (match-beginning 2) (match-end 2)))))
 
1481
        (when (string-match "^\\([a-zA-Z]\\):\\(/.*\\)" new-dir)
 
1482
          (setq new-dir (concat "/"
 
1483
                                (substring new-dir (match-beginning 1) (match-end 1))
 
1484
                                "|"
 
1485
                                (substring new-dir (match-beginning 2) (match-end 2))))))
 
1486
      (mew-nmz-folder-reindex-recursively new-nmzdir dir new-dir))))
 
1487
 
 
1488
(defun mew-nmz-folder-reindex-recursively (dir from to)
 
1489
  (let ((files (directory-files dir 'full mew-regex-files 'no-sort))
 
1490
        urifile)
 
1491
    (when (member (setq urifile (expand-file-name "NMZ.field.uri" dir)) files)
 
1492
      (mew-nmz-folder-index-reindex dir urifile from to))
 
1493
    (dolist (file files)
 
1494
      (when (file-directory-p file)
 
1495
        (mew-nmz-folder-reindex-recursively file from to)))))
 
1496
 
 
1497
(defun mew-nmz-folder-index-reindex (dir file from to)
 
1498
  (setq from (concat "^" (regexp-quote from)))
 
1499
  (when (and (file-readable-p file) (file-regular-p file))
 
1500
    (message "mew-nmz: reindexing %s..." dir)
 
1501
    (with-temp-buffer
 
1502
      (mew-frwlet
 
1503
       mew-cs-autoconv mew-nmz-cs-index
 
1504
       (insert-file-contents file)
 
1505
       (goto-char (point-min))
 
1506
       (while (not (eobp))
 
1507
         (when (looking-at from)
 
1508
           (delete-region (match-beginning 0) (match-end 0))
 
1509
           (insert to))
 
1510
         (forward-line 1))
 
1511
       (write-region (point-min) (point-max) file nil 'nomsg)))
 
1512
    (when (mew-which-exec mew-nmz-prog-rfnmz)
 
1513
      (call-process mew-nmz-prog-rfnmz nil nil nil dir))
 
1514
    (message "mew-nmz: reindexing %s...done" dir)))
 
1515
 
 
1516
;; mew-nmz-setup
 
1517
(defun mew-nmz-gather-indexed-folder (case folders-alist &optional proto)
 
1518
  (let ((ocase case)
 
1519
        fld nmzdir fld-index-alist url-fld-alist)
 
1520
    (unless case (setq case ""))
 
1521
    (dolist (flds folders-alist)
 
1522
      (setq fld (car flds))
 
1523
      (when fld
 
1524
        (when (eq proto 'imap)
 
1525
          (setq fld (mew-nmz-imap-directory-file-name fld ocase)))
 
1526
        (setq fld (directory-file-name (if (string= case "")
 
1527
                                           fld
 
1528
                                         (concat case ":" fld))))
 
1529
        (when (and (or (not (eq proto 'nntp))
 
1530
                       (file-directory-p (mew-expand-folder fld)))
 
1531
                   (setq nmzdir (mew-nmz-expand-folder fld))
 
1532
                   (file-directory-p nmzdir)
 
1533
                   (file-exists-p (expand-file-name "NMZ.i" nmzdir)))
 
1534
          (setq fld-index-alist (cons (cons fld nmzdir) fld-index-alist))
 
1535
          (setq url-fld-alist (cons (cons (mew-expand-folder fld) fld) url-fld-alist)))))
 
1536
    (setq mew-nmz-fld-index-alist
 
1537
          (append mew-nmz-fld-index-alist (nreverse fld-index-alist)))
 
1538
    (setq mew-nmz-url-fld-alist
 
1539
          (append mew-nmz-url-fld-alist (nreverse url-fld-alist)))))
 
1540
 
 
1541
(defun mew-nmz-setup ()
 
1542
  (unless mew-nmz-setup-p
 
1543
    (unless (and (mew-which-exec mew-nmz-prog-mknmz)
 
1544
                 (mew-which-exec mew-nmz-prog))
 
1545
      (error "Please install namazu"))
 
1546
    (message "mew-nmz setup...")
 
1547
    (unless (mew-nmz-cache-load)
 
1548
      (mew-nmz-cleanup)
 
1549
      (let ((prefixes (delq mew-folder-virtual (copy-sequence mew-folder-prefixes)))
 
1550
            nmzdir-case-alist
 
1551
            case-alist cases case ocase gcase nmzdir alst)
 
1552
        (dolist (prefix prefixes)
 
1553
          (setq cases (mapcar (lambda (x)
 
1554
                                (if (string= x mew-case-default) "" x))
 
1555
                              mew-config-cases))
 
1556
          (when (member "" cases)
 
1557
            (setq cases (cons "" (delete "" cases))))
 
1558
          (setq nmzdir-case-alist nil)
 
1559
          (setq case-alist nil)
 
1560
          (setq gcase nil)
 
1561
          (while (setq case (car cases))
 
1562
            (setq nmzdir (mew-nmz-expand-folder (if (string= case "")
 
1563
                                                    prefix
 
1564
                                                  (concat case ":" prefix))))
 
1565
            (if (setq alst (assoc nmzdir nmzdir-case-alist))
 
1566
                (progn
 
1567
                  (setq ocase (car (assoc (cdr alst) case-alist)))
 
1568
                  (setq case-alist (cons (cons case ocase) case-alist)))
 
1569
              (setq nmzdir-case-alist
 
1570
                    (cons (cons nmzdir case) nmzdir-case-alist))
 
1571
              (setq case-alist (cons (cons case case) case-alist))
 
1572
              (setq gcase (cons case gcase)))
 
1573
            (setq cases (cdr cases)))
 
1574
          (setq gcase (nreverse gcase))
 
1575
          (cond
 
1576
           ((mew-folder-imapp prefix)
 
1577
            (setq mew-nmz-imap-case-alist (nreverse case-alist))
 
1578
            (while (setq case (car gcase))
 
1579
              (mew-nmz-gather-indexed-folder case (mew-imap-folder-alist case) 'imap)
 
1580
              (setq gcase (cdr gcase))))
 
1581
           ((mew-folder-popp prefix)
 
1582
            (setq mew-nmz-pop-case-alist (nreverse case-alist))
 
1583
            (while (setq case (car gcase))
 
1584
              (mew-nmz-gather-indexed-folder case `((,mew-pop-inbox-folder)))
 
1585
              (setq gcase (cdr gcase))))
 
1586
           ((mew-folder-nntpp prefix)
 
1587
            (setq mew-nmz-nntp-case-alist (nreverse case-alist))
 
1588
            (while (setq case (car gcase))
 
1589
              (mew-nmz-gather-indexed-folder case (mew-nntp-folder-alist case) 'nntp)
 
1590
              (setq gcase (cdr gcase))))
 
1591
           (t ;; local
 
1592
            (mew-nmz-gather-indexed-folder nil (mew-local-folder-alist)))))
 
1593
        (mew-nmz-cache-save)))
 
1594
    (message "mew-nmz setup...done")
 
1595
    (setq mew-nmz-setup-p t)
 
1596
    (run-hooks 'mew-nmz-setup-hook)))
 
1597
 
 
1598
(defun mew-nmz-status-update ()
 
1599
  (mew-nmz-cleanup 'remove))
 
1600
 
 
1601
(defconst mew-nmz-cache-parts '(imap-case nntp-case pop-case fld-index url-fld))
 
1602
 
 
1603
(defun mew-nmz-cleanup (&optional remove)
 
1604
  (if remove (mew-nmz-cache-remove))
 
1605
  (setq mew-nmz-setup-p nil)
 
1606
  (let ((parts (copy-sequence mew-nmz-cache-parts)))
 
1607
    (dolist (part parts)
 
1608
      (set (mew-nmz-cache-alist-name part) nil))))
 
1609
 
 
1610
(defun mew-nmz-cache-save ()
 
1611
  (when (stringp mew-nmz-cache-file-prefix)
 
1612
    (let ((parts (copy-sequence mew-nmz-cache-parts))
 
1613
          file alist)
 
1614
      (dolist (part parts)
 
1615
        (setq file (mew-nmz-cache-file-name part))
 
1616
        (setq alist (symbol-value (mew-nmz-cache-alist-name part)))
 
1617
        (mew-lisp-save file alist 'nobackup 'unlimit)))))
 
1618
 
 
1619
(defun mew-nmz-cache-load ()
 
1620
  (when (stringp mew-nmz-cache-file-prefix)
 
1621
    (let ((parts (copy-sequence mew-nmz-cache-parts))
 
1622
          file)
 
1623
      (catch 'noexist
 
1624
        (dolist (part parts)
 
1625
          (setq file (mew-nmz-cache-file-name part))
 
1626
          (if (file-readable-p file)
 
1627
              (set (mew-nmz-cache-alist-name part) (mew-lisp-load file))
 
1628
            (throw 'noexist nil)))
 
1629
        t))))
 
1630
 
 
1631
(defun mew-nmz-cache-remove ()
 
1632
  (when (stringp mew-nmz-cache-file-prefix)
 
1633
    (let ((parts (copy-sequence mew-nmz-cache-parts))
 
1634
          file)
 
1635
      (dolist (part parts)
 
1636
        (setq file (mew-nmz-cache-file-name part))
 
1637
        (when (and (file-exists-p file) (file-writable-p file))
 
1638
          (delete-file file))))))
 
1639
 
 
1640
;; mew-nmz-fixer
 
1641
;; to be continue ...
 
1642
 
 
1643
(provide 'mew-nmz)
 
1644
 
 
1645
;;; Copyright Notice:
 
1646
 
 
1647
;; Copyright (C) 1999-2007 Hideyuki SHIRAI
 
1648
;; Copyright (C) 1994-2007 Mew developing team.
 
1649
;; All rights reserved.
 
1650
 
 
1651
;; Redistribution and use in source and binary forms, with or without
 
1652
;; modification, are permitted provided that the following conditions
 
1653
;; are met:
 
1654
;;
 
1655
;; 1. Redistributions of source code must retain the above copyright
 
1656
;;    notice, this list of conditions and the following disclaimer.
 
1657
;; 2. Redistributions in binary form must reproduce the above copyright
 
1658
;;    notice, this list of conditions and the following disclaimer in the
 
1659
;;    documentation and/or other materials provided with the distribution.
 
1660
;; 3. Neither the name of the team nor the names of its contributors
 
1661
;;    may be used to endorse or promote products derived from this software
 
1662
;;    without specific prior written permission.
 
1663
;;
 
1664
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 
1665
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
1666
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
1667
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 
1668
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 
1669
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 
1670
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 
1671
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 
1672
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 
1673
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 
1674
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
1675
 
 
1676
;;; mew-nmz.el ends here