cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-nmz.el

   1 ;; -*- Mode: Emacs-Lisp -*-
   2 ;;                       $Id: mew-nmz.el,v 1.2 2000-10-06 09:01:39 youngs Exp $
   3 ;;
   4 ;; mew-nmz.el: Another Mew search method, powered by Namazu.
   5 ;;
   6 ;;                                "Hideyuki SHIRAI" <shirai@rdmg.mgcs.mei.co.jp>
   7 ;;
   8 ;;;; Usage: Put your ~/.emacs.
   9 ;; (eval-after-load "mew" '(require 'mew-nmz))
  10 ;;
  11
  12 (defconst mew-nmz-version "mew-nmz.el 0.50")
  13
  14 (eval-when-compile (require 'mew))
  15 (and (locate-library "namazu")
  16      (eval-when-compile (require 'namazu)))
  17
  18 ;; Variables
  19 (defvar mew-nmz-index-path "~/Namazu" "*Namazu index top directory.")
  20 (defvar mew-nmz-index-mail "Mail" "*Namazu index mail directory.")
  21 (defvar mew-nmz-index-news "News" "*Namazu index local news directory.")
  22 (defvar mew-nmz-index-imap "Imap" "*Namazu index IMAP directory.")
  23
  24 (defvar mew-nmz-namazu-version nil
  25   "*Automatically set 'v1 if Namazu version 1. Set 'v2 if Namazu version 2.")
  26
  27 (defvar mew-nmz-use-fast-pick t "*Use fast pick mode.")
  28 (defvar mew-nmz-use-backslash
  29   (if (memq system-type '(OS/2 emx windows-nt)) t nil)
  30   "*If non-nil, convert / => \ for Windows")
  31
  32 (defvar mew-nmz-prog "namazu" "*Namazu program name.")
  33
  34 (defvar mew-nmz-db-max 64 "*Namazu max index")
  35 (defvar mew-nmz-query-max-length 256 "*Namazu query string max length.")
  36
  37 (defvar mew-nmz-prog-mknmz "mknmz" "*Namazu make index program.")
  38 (defvar mew-nmz-prog-mknmz-args '("-q")
  39   "*Mknmz's argment, in addition to \"-U\", \"-h\".")
  40 (defvar mew-nmz-prog-mknmz-include "~/Namazu/mknmz-inc.pl" "*Include file for mknmz.")
  41
  42 (defvar mew-nmz-prog-gcnmz "gcnmz" "*Namazu refresh index program.")
  43 (defvar mew-nmz-use-gcnmz-folders (list mew-inbox-folder)
  44   "*Exec gcnmz after mknmz for index refresh, 't' means all folders.")
  45
  46 (defvar mew-nmz-mknmz-skip-folders
  47   (if (and (boundp 'mew-draft-folder) (boundp 'mew-trash-folder)
  48            (boundp 'mew-queue-folder) (boundp 'mew-attach-folder)
  49            mew-draft-folder mew-trash-folder mew-queue-folder mew-attach-folder)
  50       (list mew-draft-folder mew-trash-folder mew-queue-folder mew-attach-folder
  51             "+schedule" "=draft")
  52     (list "+draft" "+trash" "+schedule" "=draft"))
  53   "*Skip folders regexp, when make index.")
  54 (defvar mew-nmz-mknmz-skip-news t "*Skip local news folders, when make index.")
  55 (defvar mew-nmz-mknmz-use-mode-line t "*Display \"nmz\" in mode line , when mknmzing.")
  56 (defvar mew-nmz-line-id '("Mew(nmz): %7b")
  57   "*A value of mode-line-buffer-identification for Mew summary mode, when mknmzing.")
  58
  59 (defvar mew-nmz-pick-default-field nil
  60   "*Default prefix string to be appeared when inputing a namazu pick pattern.
  61 A good example is \"+from:\".")
  62 (defvar mew-nmz-pick-field-list
  63   '("+subject:" "+from:" "+to:" "+newsgroups:" "+date:"
  64     "+message-id:" "+cc:" "+in-reply-to:" "+references:")
  65   "*A list of key for namazu pick pattern.")
  66
  67 (defvar mew-nmz-imap-localfile-suffix ".gz"
  68   "*IMAP local file's suffix, need mew-fake-imap.el.")
  69
  70 (defvar mew-nmz-pick-gather-field-list
  71   (list (list mew-from: 'address "+from:" "+to:" "+cc:")
  72         (list mew-to: 'address "+from:" "+to:" "+cc:")
  73         (list mew-cc: 'address "+from:" "+to:" "+cc:")
  74         (list mew-message-id: 'msgid "+message-id:" "+in-reply-to:" "+references:")
  75         (list mew-in-reply-to: 'msgid "+message-id:" "+in-reply-to:" "+references:")
  76         (list mew-references: 'msgid "+message-id:" "+in-reply-to:" "+references:"))
  77   "*A list of completion keyword from message.")
  78
  79 (defvar mew-nmz-mark-unindexed mew-mark-review "*Mark for type unindexed messages.")
  80
  81 (defvar mew-nmz-use-namazu-el (locate-library "namazu")
  82   "*Use namazu-mode from mew.")
  83 (defvar mew-nmz-namazu-full-window t "*Use namazu-mode full window.")
  84
  85 ;; Key Bind
  86 (add-hook 'mew-summary-mode-hook
  87           '(lambda ()
  88              (define-key mew-summary-mode-map "z/" 'mew-nmz-search)
  89              (define-key mew-summary-mode-map "z?" 'mew-nmz-search-mark)
  90              (define-key mew-summary-mode-map "zV" 'mew-nmz-virtual)
  91              (define-key mew-summary-mode-map "zm" 'mew-nmz-mknmz)
  92              (define-key mew-summary-mode-map "zu" 'mew-nmz-mark-unindexed)
  93              (define-key mew-summary-mode-map "z^" 'mew-nmz-search-parent)
  94              (define-key mew-summary-mode-map "zp" 'mew-nmz-search-parent)
  95              (define-key mew-summary-mode-map "zn" '(lambda (arg)
  96                                                       (interactive "P")
  97                                                       (mew-nmz-search-parent t)))
  98              (define-key mew-summary-mode-map "zN" 'mew-nmz-namazu)))
  99
 100 (add-hook 'mew-message-mode-hook
 101           '(lambda ()
 102              (define-key mew-message-mode-map "zp" 'mew-nmz-search-msgid-at-point)
 103              (define-key mew-message-mode-map "zr" 'mew-nmz-search-msgid-region)))
 104
 105 (add-hook 'mew-quit-hook
 106           '(lambda ()
 107              (setq mew-nmz-indexed-folders nil)))
 108
 109 ;; An addition for virtual mode.
 110 (add-hook 'mew-virtual-mode-hook
 111           '(lambda ()
 112              (define-key mew-summary-mode-map "zj" 'mew-virtual-original-message)))
 113
 114 (defun mew-virtual-original-message (&optional arg)
 115   "Show original message location.
 116 If executed with 'C-u', jump to original message folder and number."
 117   (interactive "P")
 118   (if (not (equal major-mode 'mew-virtual-mode))
 119       (message "This command can be used in Virtual mode only")
 120     (save-excursion
 121       (let (folder msg)
 122         (beginning-of-line)
 123         (if (not (re-search-forward
 124                   "\r \\([^ ]*\\) \\([1-9][0-9]*\\)$"
 125                   (save-excursion (end-of-line) (point)) t))
 126             ()
 127           (setq folder (mew-match 1)
 128                 msg (mew-match 2))
 129           (message "Original message at %s/%s" folder msg)
 130           (if (not arg)
 131               ()
 132             (mew-nmz-goto-folder-msg folder msg)
 133             (message "Original message at %s/%s... jump done." folder msg)))))))
 134
 135 ;; internal variable, don't modify.
 136 (defvar mew-nmz-mknmz-process nil)
 137 (make-variable-buffer-local 'mew-nmz-mknmz-process)
 138 (defvar mew-nmz-pick-pattern-hist nil)
 139 (defvar mew-nmz-gather-header-list nil)
 140 (defvar mew-nmz-namazu-last-folder nil)
 141 (defvar mew-nmz-indexed-folders nil)
 142 (defvar mew-nmz-namazu-version1-str "^  Search Program of Namazu v1\.[34]\.")
 143 (defvar mew-nmz-namazu-version2-str "^namazu of Namazu [1-9.]+")
 144
 145 ;; macros
 146 (defmacro mew-nmz-expand-folder (folder)
 147   "Convert folder to namazu-index-dir."
 148   (` (cond
 149       ((mew-folder-mailp (, folder))
 150        (expand-file-name
 151         (substring (, folder) 1 nil)
 152         (expand-file-name  mew-nmz-index-mail mew-nmz-index-path)))
 153       ((mew-folder-local-newsp (, folder))
 154        (expand-file-name
 155         (substring (, folder) 1 nil)
 156         (expand-file-name mew-nmz-index-news mew-nmz-index-path)))
 157       ((mew-folder-imapp (, folder))
 158        (mew-imap-folder-dir
 159         (, folder)
 160         (expand-file-name mew-nmz-index-imap mew-nmz-index-path)))
 161       (t nil))))
 162
 163 (defmacro mew-nmz-dir-to-folder (nmzdir)
 164   "Convert namazu-index-directory to folder."
 165   (` (progn
 166        (if (string-match (concat "^\\(.*\\)" (regexp-quote mew-path-separator) "$")
 167                          (, nmzdir))
 168            (setq (, nmzdir) (substring (, nmzdir) (match-beginning 1) (match-end 1))))
 169        (cond
 170         ((string-match
 171           (concat "^"
 172                   (regexp-quote (expand-file-name mew-nmz-index-mail mew-nmz-index-path))
 173                   (regexp-quote mew-path-separator)
 174                   "\\(.*\\)$")
 175           (, nmzdir))
 176          (concat "+" (substring (, nmzdir) (match-beginning 1) (match-end 1))))
 177         ((string-match
 178           (concat "^"
 179                   (regexp-quote (expand-file-name mew-nmz-index-news mew-nmz-index-path))
 180                   (regexp-quote mew-path-separator)
 181                   "\\(.*\\)$")
 182           (, nmzdir))
 183          (concat "=" (substring (, nmzdir) (match-beginning 1) (match-end 1))))
 184         ((string-match
 185           (concat "^"
 186                   (regexp-quote (expand-file-name mew-nmz-index-imap mew-nmz-index-path))
 187                   (regexp-quote mew-path-separator)
 188                   "\\(.*\\)$")
 189           (, nmzdir))
 190          (mew-nmz-dir-to-folder-imap (substring (, nmzdir) (match-beginning 1) (match-end 1))))
 191         (t nil)))))
 192
 193 ;;
 194 ;; Namazu Version check.
 195 (defun mew-nmz-version-set ()
 196   (interactive)
 197   (if mew-nmz-namazu-version
 198       ()
 199     (mew-set-buffer-tmp)
 200     (mew-piolet
 201      mew-cs-autoconv mew-cs-pick
 202      (apply (function call-process)
 203             mew-nmz-prog nil t nil (list "-L" "en" "-v")))
 204     (goto-char (point-min))
 205     (if (re-search-forward mew-nmz-namazu-version2-str nil t)
 206         (setq mew-nmz-namazu-version 'v2)
 207       (goto-char (point-min))
 208       (if (re-search-forward mew-nmz-namazu-version1-str nil t)
 209           (setq mew-nmz-namazu-version 'v1)
 210         (ding)
 211         (message "Something error occor. (Namazu version check)")
 212         (sit-for 1)))))
 213
 214 (add-hook 'mew-init-hook 'mew-nmz-version-set)
 215
 216 ;;
 217 ;; "Make Index" functions.
 218 (defun mew-nmz-mknmz (&optional folder remove callp)
 219   "Make namazu index for mew-nmz.
 220 If executed with 'C-u', remove index files at the specified folder."
 221   (interactive)
 222   (save-excursion
 223     (let ((msgenb (interactive-p))
 224           (suffix "")
 225           procname)
 226       (if (not (mew-which mew-nmz-prog-mknmz exec-path))
 227           (message "Please install mknmz.")
 228         (and current-prefix-arg (setq remove t))
 229         (if  (not folder)
 230             (setq folder (mew-input-folder (buffer-name)))
 231           (setq folder (directory-file-name folder)))
 232         (if (mew-folder-imapp folder)
 233             (setq suffix mew-nmz-imap-localfile-suffix))
 234         (if (or (mew-folder-newsp folder)
 235                 (mew-folder-virtualp folder)
 236                 (mew-nmz-skip-folder folder)
 237                 (and mew-nmz-mknmz-skip-news
 238                      (string-match "^=" folder)))
 239             (and msgenb (message "Can't make namazu index in %s." folder))
 240           (let ((folder-dir (mew-expand-folder folder))
 241                 (namazu-dir (mew-nmz-expand-folder folder))
 242                 (bufname (concat " *mew mknmz*" folder)))
 243             (setq procname (concat mew-nmz-prog-mknmz "-" folder))
 244             (if (get-process procname)
 245                 (and msgenb (message "Detect running mknmz process in %s." folder))
 246               (if (and folder-dir namazu-dir
 247                        (file-directory-p folder-dir))
 248                   (let ((file-list (directory-files folder-dir 'full-name
 249                                                     (concat "^[1-9][0-9]*" suffix "$")
 250                                                     'no-sort))
 251                         (temp-file (expand-file-name
 252                                     (mew-nmz-make-temp-name "mknmz_") mew-temp-dir))
 253                         (prog-args mew-nmz-prog-mknmz-args)
 254                         (exist-msg nil)
 255                         file)
 256                     (if (and (eq 'v2 mew-nmz-namazu-version)
 257                              (not (string= suffix "")))
 258                         (setq prog-args (append prog-args (list "-U")))
 259                       (setq prog-args (append prog-args (list "-Uh"))))
 260                     (while (and mew-nmz-use-backslash (file-exists-p temp-file))
 261                       (message "Warning!! same name det.")
 262                       (sit-for 1)
 263                       (setq temp-file (expand-file-name
 264                                        (mew-nmz-make-temp-name "mknmz_") mew-temp-dir)))
 265                     (mew-set-buffer-tmp)
 266                     (while file-list
 267                       (setq file (car file-list))
 268                       (setq exist-msg t)
 269                       (if (not (file-directory-p file))
 270                           (if (and mew-nmz-use-backslash
 271                                    (eq mew-nmz-namazu-version 'v1))
 272                               (insert (mew-nmz-slash-to-backslash file) "\n")
 273                             (insert file "\n")))
 274                       (setq file-list (cdr file-list)))
 275                     (mew-frwlet
 276                      mew-cs-autoconv mew-cs-pick
 277                      (write-region (point-min) (point-max) temp-file nil 'no-msg))
 278                     (kill-buffer (current-buffer))
 279                     (if (or (not exist-msg) remove)
 280                         (and (file-directory-p namazu-dir)
 281                              (mew-nmz-index-delete namazu-dir)))
 282                     (if (not exist-msg)
 283                         (progn
 284                           (delete-file temp-file)
 285                           (and msgenb (message "%s has no message." folder)))
 286                       (and (not (file-directory-p namazu-dir))
 287                            (mew-make-directory namazu-dir))
 288                       (if mew-nmz-prog-mknmz-include
 289                           (let ((inc-file (expand-file-name mew-nmz-prog-mknmz-include)))
 290                             (and (file-exists-p inc-file)
 291                                  (setq prog-args (append prog-args
 292                                                          (list "-I" inc-file))))))
 293                       (setq prog-args (append prog-args
 294                                               (list "-F" temp-file
 295                                                     "-O" namazu-dir)))
 296                       (if (file-name-all-completions "NMZ.lock" namazu-dir)
 297                           (progn
 298                             (message "Warning!! Something error in %s's index." folder)
 299                             (sit-for 1)))
 300                       (set-buffer (get-buffer-create bufname))
 301                       (buffer-disable-undo (current-buffer))
 302                       (erase-buffer)
 303                       (mew-frwlet
 304                        mew-cs-autoconv mew-cs-pick
 305                        (insert folder "\n")
 306                        (insert temp-file "\n"))
 307                       (if callp
 308                           (progn
 309                             (message "Mew mknmz (%s) ..." folder)
 310                             (mew-piolet
 311                              mew-cs-autoconv mew-cs-pick
 312                              (apply (function call-process)
 313                                     mew-nmz-prog-mknmz
 314                                     nil
 315                                     (current-buffer)
 316                                     nil
 317                                     prog-args))
 318                             (if (and mew-nmz-prog-gcnmz
 319                                      (not remove)
 320                                      (or (eq mew-nmz-use-gcnmz-folders t)
 321                                          (member folder mew-nmz-use-gcnmz-folders))
 322                                      (mew-which mew-nmz-prog-gcnmz exec-path))
 323                                 (progn
 324                                   (message "Mew mknmz (%s) ... refresh" folder)
 325                                   (mew-piolet
 326                                    mew-cs-autoconv mew-cs-pick
 327                                    (apply (function call-process)
 328                                           mew-nmz-prog-gcnmz
 329                                           nil
 330                                           (current-buffer)
 331                                           nil
 332                                           (list
 333                                            (and (eq mew-nmz-namazu-version 'v2)
 334                                                 "--no-backup")
 335                                            (expand-file-name "NMZ" namazu-dir)))
 336                                    (if (eq mew-nmz-namazu-version 'v1)
 337                                        (let ((backfn (directory-files namazu-dir t ".*.BAK$")))
 338                                          (while backfn
 339                                            (if (file-writable-p (car backfn))
 340                                                (delete-file (car backfn)))
 341                                            (setq backfn (cdr backfn))))))))
 342                             (delete-file temp-file)
 343                             (goto-char (point-min))
 344                             (if (search-forward-regexp "^ERROR:.*$" nil t)
 345                                 (message "Mew mknmz (%s) ... %s." folder (mew-match 0))
 346                               (message "Mew mknmz (%s) ... done." folder))
 347                             (set-buffer-modified-p nil)
 348                             (kill-buffer (current-buffer)))
 349                         (and msgenb (message "Mew mknmz (%s) ..." folder))
 350                         (mew-piolet
 351                          mew-cs-autoconv mew-cs-pick
 352                          (setq mew-nmz-mknmz-process
 353                                (apply (function start-process)
 354                                       procname
 355                                       (current-buffer)
 356                                       mew-nmz-prog-mknmz
 357                                       prog-args)))
 358                         (if (and mew-nmz-mknmz-use-mode-line
 359                                  folder
 360                                  (get-buffer folder)
 361                                  (buffer-name (get-buffer folder)))
 362                             (save-excursion
 363                               (set-buffer (get-buffer folder))
 364                               (setq mode-line-buffer-identification mew-nmz-line-id)
 365                               (set-buffer-modified-p nil)))
 366                         (set-process-sentinel mew-nmz-mknmz-process
 367                                               'mew-nmz-mknmz-sentinel))
 368                       ))))))))))
 369
 370 (defun mew-nmz-mknmz-sentinel (process event)
 371   (save-excursion
 372     (let (folder msg)
 373       (set-buffer (process-buffer process))
 374       (goto-char (point-min))
 375       (if (not (looking-at "^.*$"))
 376           (setq msg "Mew mknmz ... something error occur.")
 377         (setq folder (mew-match 0))
 378         (forward-line)
 379         (if (not (looking-at "^.*$"))
 380             (setq msg (format "Mew mknmz (%s) ... something error occur." folder))
 381           (let ((tmpfile (mew-match 0)))
 382             (if (search-forward-regexp "^ERROR:.*$" nil t)
 383                 (setq msg (format "Mew mknmz (%s) ... %s." folder (mew-match 0)))
 384               (setq msg (format "Mew mknmz (%s) ... done" folder))
 385               (if (not (or (null mew-nmz-indexed-folders)
 386                            (member folder mew-nmz-indexed-folders)))
 387                   (setq mew-nmz-indexed-folders
 388                         (cons folder mew-nmz-indexed-folders))))
 389             (and (file-readable-p tmpfile)
 390                  (file-writable-p tmpfile)
 391                  (condition-case err
 392                      (delete-file tmpfile)
 393                    (error nil))))))
 394       (setq mew-nmz-mknmz-process nil)
 395       (if (and mew-nmz-mknmz-use-mode-line
 396                folder
 397                (get-buffer folder)
 398                (buffer-name (get-buffer folder)))
 399           (save-excursion
 400             (set-buffer (get-buffer folder))
 401             (setq mode-line-buffer-identification mew-mode-line-id)
 402             (set-buffer-modified-p nil)))
 403       (set-buffer-modified-p nil)
 404       (kill-buffer (current-buffer))
 405       (message "%s" msg)
 406       (sit-for 1))))
 407
 408 ;; mode-line-buffer-identification modifier
 409 (add-hook 'mew-summary-mode-hook
 410           '(lambda ()
 411              (if (and mew-nmz-mknmz-use-mode-line
 412                       (get-process (concat mew-nmz-prog-mknmz "-" (buffer-name))))
 413                  (setq mode-line-buffer-identification mew-nmz-line-id)
 414                (setq mode-line-buffer-identification mew-mode-line-id))
 415              (set-buffer-modified-p nil)))
 416
 417 (defun mew-nmz-mknmz-all-folders (&optional arg)
 418   "Make namazu index all folders."
 419   (interactive "P")
 420   (if (not arg)
 421       ()
 422     (message "folder setup ...")
 423     (mew-folder-setup nil (interactive-p))
 424     (message "folder setup ... Done."))
 425   (save-excursion
 426     (let ((folder-list mew-folder-list))
 427       (while (car folder-list)
 428         (condition-case err
 429             (mew-nmz-mknmz (car folder-list) nil t)
 430           (error nil))
 431         (setq folder-list (cdr folder-list)))))
 432   (message "Namazu make index done."))
 433
 434 (defun mew-nmz-mark-unindexed ()
 435   "Mark unindexed messages."
 436   (interactive)
 437   (mew-summary-only
 438    (if (mew-summary-exclusive-p)
 439        (save-excursion
 440          (if (and (mew-summary-mark-collect
 441                    mew-nmz-mark-unindexed (point-min) (point-max))
 442                   (y-or-n-p (format "Unmark '%c' ? " mew-nmz-mark-unindexed)))
 443              (if (fboundp 'mew-summary-batch-unmark) ;; 1.94.2
 444                  (mew-summary-batch-unmark (list mew-nmz-mark-unindexed) 'msg)
 445                (mew-mark-undo-marks (list mew-nmz-mark-unindexed))))
 446          (let* ((url-file-name
 447                  (expand-file-name
 448                   (if (eq 'v2 mew-nmz-namazu-version)
 449                       "NMZ.field.uri" "NMZ.field.url")
 450                   (mew-nmz-expand-folder (buffer-name))))
 451                 (marked-messages 0)
 452                 (unindexed-messages 0)
 453                 (suffix (if (mew-folder-imapp (buffer-name))
 454                             mew-nmz-imap-localfile-suffix ""))
 455                 msgnums)
 456            (if (not (file-exists-p url-file-name))
 457                (message "%s has no index file." (buffer-name))
 458              (save-excursion
 459                (mew-set-buffer-tmp)
 460                (message "checking %s..." (file-name-nondirectory url-file-name))
 461                (insert-file-contents url-file-name)
 462                (while (search-forward-regexp
 463                        (concat "/\\([1-9][0-9]*\\)" suffix "$") nil t)
 464                  (setq msgnums
 465                        (cons (string-to-number
 466                               (buffer-substring (match-beginning 1) (match-end 1)))
 467                              msgnums)))
 468                (kill-buffer (current-buffer)))
 469              (message "checking %s ..." (buffer-name))
 470              (goto-char (point-min))
 471              (while (not (eobp))
 472                (if (and
 473                     (looking-at "^ *\\([1-9][0-9]*\\)")
 474                     (not (memq (string-to-number (mew-match 1)) msgnums))
 475                     (not (mew-in-decode-syntax-p)))
 476                    (progn
 477                      (setq unindexed-messages (1+ unindexed-messages))
 478                      (if (mew-summary-marked-p)
 479                          ()
 480                        (mew-summary-mark-as mew-nmz-mark-unindexed)
 481                        (setq marked-messages (1+ marked-messages)))))
 482                (forward-line))
 483              (cond
 484               ((= unindexed-messages 1)
 485                (message "%d message doesn't have index, %d marked."
 486                         unindexed-messages marked-messages))
 487               ((> unindexed-messages 1)
 488                (message "%d messages don't have index, %d marked."
 489                         unindexed-messages marked-messages))
 490               (t
 491                (message "all messages have index.")))))))))
 492
 493 ;;
 494 ;; "search Message-ID" functions.
 495 (defun mew-nmz-search-parent (&optional child mid)
 496   "Search *parent* message and jump to that.
 497 If executed with 'C-u', search *child* message."
 498   (interactive "P")
 499   (let ((folder (mew-summary-folder-name))
 500         (idh (list (list mew-references: mew-in-reply-to:)
 501                    (list mew-message-id:)))
 502         (message (if child "children" "parent"))
 503         mess ref pid rh)
 504     (if mid
 505         (setq pid (list mid)
 506               idh nil)
 507       (if (not (or (mew-summary-message-number) (mew-syntax-number)))
 508           (error "No message here.")
 509         (save-excursion
 510           (mew-summary-display nil)
 511           (setq mess (or (mew-cache-hit
 512                           (cons (buffer-name) (mew-summary-message-number)))
 513                          (mew-buffer-message)))
 514           (set-buffer mess)
 515           (if child
 516               (setq idh (car (cdr idh)))
 517             (setq idh (car idh)))
 518           (while idh
 519             (setq rh (car idh))
 520             (setq ref (mew-header-get-value rh))
 521             (while (and ref (string-match "<[^>]+>" ref))
 522               (setq pid (cons (mew-match 0 ref) pid))
 523               (setq ref (substring ref (match-end 0))))
 524             (setq idh (cdr idh)))
 525           (if (not pid)
 526               (error "No required header.")))))
 527     (if (mew-syntax-number)
 528         (while (not (mew-summary-message-number))
 529           (forward-line -1)))
 530     (set-marker mew-summary-inbox-position (point) (current-buffer))
 531     (message "Searching %s ..." message)
 532     (let ((pattern1 "")
 533           (pattern2 "")
 534           (addpattern (if child "+in-reply-to:" "+message-id:"))
 535           (range nil))
 536       (setq pattern1 (concat addpattern (car pid)))
 537       (if child
 538           (setq addpattern "+references:")
 539         (setq pid (delete (car pid) pid)))
 540       (while pid
 541         (if (> (length (concat pattern2 addpattern (car pid)))
 542                mew-nmz-query-max-length)
 543             (setq pid nil)
 544           (setq pattern2 (concat pattern2 addpattern (car pid)))
 545           (setq addpattern (if child " | +references:" " | +message-id:"))
 546           (setq pid (delete (car pid) pid))))
 547       (let ((pattern (list pattern1 pattern2)))
 548         (while (and (null range) pattern)
 549           (if mid
 550               ()
 551             (message "Searching %s ... %s" message folder)
 552             (setq range (mew-nmz-pick folder (car pattern)))
 553             (if (not child) (setq range (nreverse range))))
 554           (if range
 555               ()
 556             ;; all folder search
 557             (message "Searching %s ... other folders" message)
 558             (setq range (mew-nmz-multi-pick
 559                          (mew-nmz-expand-folder-regexp "*")
 560                          (car pattern) t))
 561             (if (null range)
 562                 (setq pattern (cdr pattern))
 563               (setq folder (car (car range)))
 564               (setq range (car (cdr (car range))))
 565               (if (not child) (setq range (nreverse range)))
 566               ))))
 567       (if (null range)
 568           (error "No message found.")
 569         (if (eq major-mode 'mew-virtual-mode)
 570             (save-excursion
 571               (goto-char (point-min))
 572               (if (not (re-search-forward
 573                         (concat "\r " (regexp-quote folder) " " (car range) "$")
 574                         nil t))
 575                   ()
 576                 (setq folder (buffer-name))
 577                 (beginning-of-line)
 578                 (looking-at "^ *\\([1-9][0-9]*\\)[^0-9]")
 579                 (setq range (list (mew-match 1))))))
 580         (mew-nmz-goto-folder-msg folder (car range))
 581         (message "Searching %s ... %s/%s." message folder (car range))))))
 582
 583 (defun mew-nmz-search-msgid-at-point ()
 584   (interactive)
 585   (let (start end (pos (point)))
 586     (if (and (re-search-backward "<" (save-excursion (beginning-of-line) (point)) t)
 587              (setq start (point))
 588              (re-search-forward ">" (save-excursion (end-of-line) (point)) t)
 589              (setq end (point)))
 590         (mew-nmz-search-msgid (buffer-substring start end))
 591       (message "No Message-ID."))))
 592
 593 (defun mew-nmz-search-msgid-region (start end)
 594   (interactive "r")
 595   (mew-nmz-search-msgid (buffer-substring start end)))
 596
 597 (defun mew-nmz-search-msgid (mid)
 598   (interactive "sMessage-ID: ")
 599   (if (string-match "\\(<[^>]+>\\)" mid)
 600       (let ((mew-window-use-full t)
 601             (mew-use-full-window t))
 602         (mew-nmz-search-parent nil (mew-match 1 mid)))
 603     (message "No Message-ID.")))
 604
 605 ;;
 606 ;; "Search(like mew + im)" functions.
 607 (defun mew-nmz-search-mark (&optional arg)
 608   "Namazu pick messages according to a pick pattern which you input,
 609 then put the '*' mark onto them. If called with C-u, target is
 610 the messages in the region."
 611   (interactive "P")
 612   (mew-summary-only
 613    (if arg
 614        (mew-nmz-search-mark-region (region-beginning) (region-end))
 615      (mew-nmz-search-mark-region (point-min) (point-max)))))
 616
 617 (defun mew-nmz-search-mark-region (r1 r2)
 618   (interactive "r")
 619   (if (equal (point-min) (point-max))
 620       (message "No messages in this buffer.")
 621     (let ((folder (buffer-name))
 622           pattern first last range)
 623       (setq pattern (mew-nmz-input-pick-pattern))
 624       (message "Namazu picking messages in %s ..." folder)
 625       (goto-char r1)
 626       (if (eobp)
 627           () ;; r1 <= r2, so if r1 = (point-max) then no messages.
 628         (setq first (mew-summary-message-number))
 629         (goto-char r2)
 630         (if (eobp)
 631             (progn
 632               (forward-line -1)
 633               (setq r2 (point))))
 634         (setq last (mew-summary-message-number))
 635         (setq range (mew-nmz-pick folder pattern first last)))
 636       (message "Namazu picking messages in %s ... done" folder)
 637       (if (null range)
 638           (message "No message to be marked.")
 639         (message "Marking messages ... ")
 640         (goto-char r1)
 641         (while (and range (< (point) r2))
 642           (if (re-search-forward (format "^[ ]*%s[^0-9]" (car range)) nil t)
 643               (if (not (mew-summary-marked-p))
 644                   (mew-summary-mark-as mew-mark-review)))
 645           (setq range (cdr range)))
 646         (beginning-of-line)
 647         (set-buffer-modified-p nil)
 648         (message "Marking messages ... done")))))
 649
 650 (defun mew-nmz-search (&optional arg)
 651   "Namazu pick messages according to a pick pattern which you input,
 652 then list them up used."
 653   (interactive "P")
 654   (mew-summary-only
 655    (let ((folder (mew-input-folder (buffer-name)))
 656          (pattern nil)
 657          (range nil))
 658      (if (null (file-directory-p (mew-expand-folder folder)))
 659          (message "No such folder %s" folder)
 660        (setq pattern (mew-nmz-input-pick-pattern))
 661        (message "Namazu picking messages in %s ..." folder)
 662        (setq range (mew-nmz-pick folder pattern))
 663        (message "Namazu picking messages in %s ... done" folder)
 664        (if (fboundp 'mew-summary-folder-create)  ;; 1.94.2
 665            (if (get-buffer folder)
 666                (switch-to-buffer folder)
 667              (mew-summary-folder-create folder))
 668          (mew-summary-switch-to-folder folder))
 669        (if range
 670            (if (and (not arg)
 671                     mew-nmz-use-fast-pick
 672                     mew-summary-cache-use
 673                     (not (mew-summary-folder-dir-newp))
 674                     (mew-summary-exclusive-p))
 675                (let ((buffer-read-only nil))
 676                  (goto-char (point-min))
 677                  (while (not (eobp))
 678                    (if (or (not (looking-at "^[ ]*\\([1-9][0-9]*\\)"))
 679                            (and (looking-at "^[ ]*\\([1-9][0-9]*\\)")
 680                                 (not (member (mew-match 1) range))))
 681                        (delete-region (point)
 682                                       (progn (forward-line) (point)))
 683                      (forward-line)))
 684                  (goto-char (point-min))
 685                  (set-buffer-modified-p nil))
 686              (mew-summary-scan-body mew-prog-imls
 687                                     'mew-summary-mode
 688                                     folder
 689                                     mew-cs-scan
 690                                     (list range 'erase))))))))
 691
 692 ;;
 693 ;; "Namazu virtual" function.
 694 (defun mew-nmz-virtual ()
 695   "Another virtual mode with namazu."
 696   (interactive)
 697   (mew-summary-only
 698    (let ((vfolder (concat
 699                    "++"
 700                    (mew-input-string "Namazu virtual folder name %s(%s): "
 701                                      "" ;; dummy
 702                                      "vnamazu")))
 703          (folders (mew-input-folders (buffer-name)))
 704          (grep (mew-nmz-input-pick-pattern))
 705          (imapregex (concat
 706                      "^"
 707                      (regexp-quote (expand-file-name mew-nmz-index-imap mew-nmz-index-path))))
 708          namazu-dirs namazu-fast-dirs namazu-im-dirs)
 709      (if (null mew-nmz-indexed-folders)
 710          (mew-nmz-gather-indexed-folder))
 711      (mapcar '(lambda (folder)
 712                 (cond
 713                  ((string-match "^.*\\*$" folder)
 714                   (setq namazu-dirs (append namazu-dirs
 715                                             (mew-nmz-expand-folder-regexp folder))))
 716                  ((member folder mew-nmz-indexed-folders)
 717                   (setq namazu-dirs (cons (mew-nmz-expand-folder folder) namazu-dirs)))))
 718              folders)
 719      (setq namazu-dirs (mew-uniq-list namazu-dirs))
 720      (if (null namazu-dirs)
 721          (message "Please make namazu index.")
 722        (let ((num 1) fld)
 723          (if (and mew-nmz-use-fast-pick mew-summary-cache-use)
 724              (mapcar '(lambda (dir)
 725                         (if (mew-nmz-folder-dir-newp dir)
 726                             (if (string-match imapregex dir)
 727                                 (if (and
 728                                      (setq fld (mew-nmz-dir-to-folder dir))
 729                                      (get-buffer fld)
 730                                      (mew-summary-exclusive-p))
 731                                     (setq namazu-fast-dirs (cons dir namazu-fast-dirs))
 732                                   (message "IMAP folder (%s) is exclusive." fld))
 733                               (setq namazu-im-dirs (cons dir namazu-im-dirs)))
 734                           (setq namazu-fast-dirs (cons dir namazu-fast-dirs))))
 735                      namazu-dirs)
 736            (mapcar '(lambda (dir)
 737                       (if (string-match imapregex dir)
 738                           ()
 739                         (setq namazu-im-dirs (cons dir namazu-im-dirs))))
 740                    namazu-dirs))
 741          (set-buffer (get-buffer-create vfolder))
 742          (switch-to-buffer vfolder)
 743          (buffer-disable-undo (current-buffer))
 744          (setq buffer-read-only nil)
 745          (erase-buffer)
 746          (mew-window-configure (current-buffer) 'summary)
 747          (mew-virtual-mode)
 748          (mew-folder-setup (buffer-name))
 749          (mew-buffers-setup (buffer-name))
 750          (mew-current-set 'message nil)
 751          (mew-current-set 'part nil)
 752          (mew-current-set 'cache nil)
 753          (setq mew-summary-buffer-direction 'down)
 754          (mew-decode-syntax-delete)
 755          (setq buffer-read-only nil)
 756          (switch-to-buffer vfolder)
 757          (if namazu-fast-dirs
 758              (progn
 759                (message "Namazu picking ...")
 760                (let ((fld-msgs (mew-nmz-multi-pick namazu-fast-dirs grep)))
 761                  (while fld-msgs
 762                    (let* ((fld (car (car fld-msgs)))
 763                           (msgs (car (cdr (car fld-msgs))))
 764                           (cache (expand-file-name mew-summary-cache-file
 765                                                    (mew-expand-folder fld))))
 766                      (message "Namazu picking ... (%s)" fld)
 767                      (set-buffer (get-buffer-create mew-buffer-tmp))
 768                      (erase-buffer)
 769                      (mew-frwlet mew-cs-scan mew-cs-dummy
 770                                  (insert-file-contents cache))
 771                      (goto-char (point-min))
 772                      (let ((str ""))
 773                        (while (not (eobp))
 774                          (if (and (looking-at "^[ ]*\\([1-9][0-9]*\\)\\([ ]*.*\\)$")
 775                                   (member (mew-match 1) msgs))
 776                              (setq str (concat str
 777                                                (format "%5d%s" num (mew-match 2))
 778                                                "\r " fld " " (mew-match 1) "\n")
 779                                    num (1+ num)))
 780                          (forward-line))
 781                        (set-buffer vfolder)
 782                        (insert str)
 783                        (setq str "")))
 784                    (setq fld-msgs (cdr fld-msgs))))
 785                (if (fboundp 'mew-summary-batch-unmark) ;; 1.94.2
 786                    (mew-summary-batch-unmark (list mew-mark-multi
 787                                                    mew-mark-review
 788                                                    mew-mark-delete
 789                                                    mew-mark-refile
 790                                                    mew-mark-tmp) nil)
 791                  (mew-mark-undo-marks (list mew-mark-multi
 792                                             mew-mark-review
 793                                             mew-mark-delete
 794                                             mew-mark-unlink
 795                                             mew-mark-refile
 796                                             mew-mark-tmp) 'nomsg))))
 797          (goto-char (point-min))
 798          (setq buffer-read-only t)
 799          (if (null namazu-im-dirs)
 800              (message "Listing %s ... done" vfolder)
 801            (condition-case nil
 802                (let ((process-connection-type mew-connection-type1))
 803                  (message "Listing %s ..." vfolder)
 804                  (setq mew-summary-buffer-start-point (point))
 805                  (setq mew-summary-buffer-string nil) ;; just in case
 806                  (mew-pioalet
 807                   mew-cs-virtual mew-cs-pick mew-cs-pick
 808                   (setq mew-summary-buffer-process
 809                         ;; imls --namazu=yes --grep=pattern --src=namazu's index,... number
 810                         (apply (function start-process)
 811                                mew-prog-imls    ;; name
 812                                (current-buffer)
 813                                mew-prog-imls    ;; program
 814                                (format "--width=%d" (if mew-summary-scan-width
 815                                                         mew-summary-scan-width
 816                                                       (if (< (window-width) 80)
 817                                                           80
 818                                                         (window-width))))
 819                                (format "--mimedecodequoted=%s" (if mew-decode-quoted
 820                                                                    "yes" "no"))
 821                                (append mew-prog-im-arg
 822                                        (list
 823                                         "--namazu=yes"
 824                                         (concat "--grep=" grep)
 825                                         (concat "--src=" (mew-join "," namazu-im-dirs))
 826                                         (int-to-string num))))))
 827                  (mew-set-process-cs mew-summary-buffer-process
 828                                      mew-cs-virtual mew-cs-dummy)
 829                  (set-process-filter mew-summary-buffer-process
 830                                      'mew-summary-scan-filter)
 831                  (set-process-sentinel mew-summary-buffer-process
 832                                        'mew-summary-scan-sentinel)
 833                  (setq mew-summary-buffer-reviews nil)
 834                  (process-kill-without-query mew-summary-buffer-process))
 835              (quit
 836               (set-process-sentinel mew-summary-buffer-process nil)
 837               (setq mew-summary-buffer-start-point nil)
 838               (setq mew-summary-buffer-process nil)
 839               (setq mew-summary-buffer-string nil)
 840               (setq mew-summary-buffer-reviews nil)))))))))
 841
 842 ;;
 843 ;; Use namazu-mode.
 844 (add-hook 'namazu-mode-hook
 845           '(lambda ()
 846              (define-key namazu-mode-map "m" 'mew-nmz-namazu-goto-mew)
 847              (define-key namazu-mode-map "M" 'mew-nmz-namazu-return-mew)
 848              (if (featurep 'xemacs)
 849                  (define-key namazu-mode-map [(shift button2)] 'mew-nmz-namazu-view-at-mouse)
 850                (define-key namazu-mode-map [S-mouse-2] 'mew-nmz-namazu-view-at-mouse))))
 851
 852 (defun mew-nmz-namazu (&optional arg)
 853   "Use namazu-mode from mew."
 854   (interactive "P")
 855   (mew-summary-only
 856    (if (not mew-nmz-use-namazu-el)
 857        (message "Please install \"namazu.el\".")
 858      (if (null mew-nmz-indexed-folders)
 859          (mew-nmz-gather-indexed-folder))
 860      (setq mew-nmz-namazu-last-folder (mew-summary-folder-name))
 861      (if (or arg (not (mew-nmz-namazu-goto-namazu)))
 862          (let ((folders (mew-input-folders (buffer-name)))
 863                (grep (mew-nmz-input-pick-pattern))
 864                namazu-dirs dirlen)
 865            (mapcar '(lambda (folder)
 866                       (cond
 867                        ((string-match "^.*\\*$" folder)
 868                         (setq namazu-dirs (append namazu-dirs
 869                                                   (mew-nmz-expand-folder-regexp folder))))
 870                        ((member folder mew-nmz-indexed-folders)
 871                         (setq namazu-dirs (cons (mew-nmz-expand-folder folder) namazu-dirs)))))
 872                    folders)
 873            (setq namazu-dirs (mew-uniq-list namazu-dirs))
 874            (setq dirlen (length namazu-dirs))
 875            (if (not (> dirlen mew-nmz-db-max))
 876                ()
 877              (message "Warning: assigned indexes over DB_MAX.")
 878              (sit-for 1))
 879            ;; (setq dirlen (- dirlen mew-nmz-db-max))
 880            ;; (setq namazu-dirs (nreverse (nthcdr dirlen namazu-dirs))))
 881            (and (not (fboundp 'namazu))
 882                 (require 'namazu))
 883            (namazu 0 (mew-join " " namazu-dirs) grep)
 884            (cond
 885             ((boundp 'namazu-history)
 886              (setq namazu-history (cons grep namazu-history)))
 887             ((boundp 'namazu-keyword-history)
 888              (setq namazu-keyword-history (cons grep namazu-keyword-history))))
 889            (namazu-jump-next)
 890            (if mew-nmz-namazu-full-window (delete-other-windows)))))))
 891
 892 (defun mew-nmz-namazu-goto-mew ()
 893   (interactive)
 894   (let ((pattern (concat "^\\(~?/.*\\)/\\([1-9][0-9]*\\)\\("
 895                          mew-nmz-imap-localfile-suffix
 896                          " \\| \\).*$"))
 897         fld msg)
 898     (beginning-of-line)
 899     (if (not (re-search-forward pattern nil t))
 900         (namazu-view)
 901       (setq fld (mew-match 1))
 902       (setq msg (mew-match 2))
 903       (setq fld (mew-nmz-url-to-folder fld))
 904       (beginning-of-line)
 905       (mew-nmz-goto-folder-msg fld msg))))
 906
 907 (defun mew-nmz-namazu-return-mew ()
 908   (interactive)
 909   (if mew-nmz-namazu-last-folder
 910       (mew-summary-goto-folder nil mew-nmz-namazu-last-folder)))
 911
 912 (defun mew-nmz-namazu-goto-namazu ()
 913   (if (not (and (boundp 'namazu-buffer)
 914                 namazu-buffer
 915                 (get-buffer namazu-buffer)
 916                 (buffer-name (get-buffer namazu-buffer))
 917                 (pop-to-buffer namazu-buffer)))
 918       nil
 919     (if mew-nmz-namazu-full-window (delete-other-windows))
 920     t))
 921
 922 (defun mew-nmz-namazu-view-at-mouse (event)
 923   "Namazu's mouse interface for Mew."
 924   (interactive "e")
 925   (set-buffer (event-buffer event))
 926   (goto-char (event-point event))
 927   (let ((pos (point))
 928         (mew-mail-pattern
 929          (concat "^\\("
 930                  (if (not mew-nmz-use-backslash)
 931                      (expand-file-name mew-mail-path)
 932                    (concat "/"
 933                            (substring (expand-file-name mew-mail-path) 0 1)
 934                            "|"
 935                            (substring (expand-file-name mew-mail-path) 2)))
 936                  "\\|~/Mail\\)/.*/[1-9][0-9]*\\("
 937                  mew-nmz-imap-localfile-suffix
 938                  "\\)?"))
 939         (mew-news-pattern
 940          (concat "^\\("
 941                  (if (not mew-nmz-use-backslash)
 942                      (expand-file-name mew-news-path)
 943                    (concat "/"
 944                            (substring (expand-file-name mew-news-path) 0 1)
 945                            "|"
 946                            (substring (expand-file-name mew-news-path) 2)))
 947                  "\\|~/News\\)/.*/[1-9][0-9]*\\("
 948                  mew-nmz-imap-localfile-suffix
 949                  "\\)?"))
 950         pos-title pos-url)
 951     (end-of-line)
 952     (and (re-search-backward namazu-output-title-pattern nil t)
 953          (setq pos-title (point))
 954          (goto-char pos)
 955          (re-search-forward namazu-output-title-pattern nil t)
 956          (re-search-backward namazu-output-url-pattern nil t)
 957          (> (point) pos-title)
 958          (setq pos-url (point))
 959          (setq pos (point)))
 960     (goto-char pos)
 961     (beginning-of-line)
 962     (and (not pos-url)
 963          (re-search-forward namazu-output-url-pattern nil t)
 964          (setq pos-url (point)))
 965     (goto-char pos)
 966     (cond
 967      ((and pos-title pos-url
 968            (or (looking-at mew-mail-pattern)
 969                (looking-at mew-news-pattern)))
 970       (mew-nmz-namazu-goto-mew))
 971      ((and pos-title pos-url)
 972       (namazu-view))
 973      ((and pos-url (> namazu-current-page 0))
 974       (namazu-prev-page))
 975      ((and pos-title (< namazu-current-page namazu-max-page))
 976       (namazu-next-page))
 977      (t (message "nothing to do.")))))
 978
 979 ;;
 980 ;; Input "Namazu pattern" functions.
 981 (defun mew-nmz-input-pick-pattern ()
 982   "Input mew-nmz pick pattern."
 983   (mew-input-clear)
 984   (let ((mew-nmz-gather-header-list (mew-nmz-pick-pattern-gather-header)))
 985     (setq mew-input-complete-function (function mew-nmz-pick-pattern))
 986     (let ((keymap (copy-keymap mew-input-map)) ret)
 987       (define-key keymap " " nil)
 988       (setq ret (read-from-minibuffer "Namazu pick pattern : "
 989                                       mew-nmz-pick-default-field
 990                                       keymap
 991                                       nil
 992                                       'mew-nmz-pick-pattern-hist))
 993       (mew-decode-syntax-delete)
 994       ret)))
 995
 996 (defun mew-nmz-pick-pattern-gather-header ()
 997   (if mew-nmz-pick-gather-field-list
 998       (save-excursion
 999         (let ((buf (mew-cache-hit
1000                     (cons (buffer-name) (mew-summary-message-number))))
1001               (gather-list mew-nmz-pick-gather-field-list)
1002               ret-list gather header duplchk)
1003           (if (not (and buf
1004                         (get-buffer buf)
1005                         (buffer-name (get-buffer buf))))
1006               ()
1007             (set-buffer buf)
1008             (while gather-list
1009               (setq gather (car gather-list))
1010               (setq header (mew-header-get-value (car gather)))
1011               (if (and header (car (cdr gather)))
1012                   (cond
1013                    ((eq (car (cdr gather)) 'msgid)
1014                     (while (and header (string-match "<[^>]+>" header))
1015                       (let ((mid (mew-match 0 header)))
1016                         (setq header (substring header (match-end 0)))
1017                         (if (not (member mid duplchk))
1018                             (let ((prefix (nthcdr 2 gather)))
1019                               (setq duplchk (cons mid duplchk))
1020                               (while prefix
1021                                 (setq ret-list (cons (concat (car prefix) mid) ret-list))
1022                                 (setq prefix (cdr prefix))))))))
1023                    ((eq (car (cdr gather)) 'address)
1024                     (let ((addrs (mew-addrstr-parse-address-list header)))
1025                       (mapcar
1026                        '(lambda (addr)
1027                           (if (not (member addr duplchk))
1028                               (let ((prefix (nthcdr 2 gather)))
1029                                 (setq duplchk (cons addr duplchk))
1030                                 (while prefix
1031                                   (setq ret-list (cons (concat (car prefix) addr) ret-list))
1032                                   (setq prefix (cdr prefix))))))
1033                        addrs)))))
1034               (setq gather-list (cdr gather-list)))
1035             (if ret-list
1036                 (setq ret-list (append ret-list (list (concat " " (make-string 70 ?-))))))
1037             (nreverse ret-list))))))
1038
1039 (defun mew-nmz-pick-pattern ()
1040   (let* ((pat (mew-delete-pattern))
1041          (clist (append mew-nmz-pick-field-list
1042                         mew-nmz-gather-header-list)))
1043     (if (null pat)
1044         (mew-complete-window-show clist)
1045       (mew-complete
1046        pat
1047        (mapcar (function list) clist)
1048        "Namazu pick pattern "
1049        nil))))
1050
1051 ;;
1052 ;; "Namazu search engine" functions.
1053 (defun mew-nmz-pick (folder pattern &optional first last)
1054   "Get message numbers with only one folder."
1055   (let ((namazu-dir (mew-nmz-expand-folder folder))
1056         (suffix (if (mew-folder-imapp folder)
1057                     mew-nmz-imap-localfile-suffix ""))
1058         msgs-int prog-args)
1059     (if (or (mew-folder-newsp folder)
1060             (mew-folder-virtualp folder))
1061         (progn
1062           (message "Can't namazu search in %s." folder)
1063           (sit-for 1)
1064           nil)
1065       (if (or (null namazu-dir)
1066               (not (file-directory-p namazu-dir))
1067               (not (file-exists-p (expand-file-name "NMZ.i" namazu-dir))))
1068           (progn
1069             (message "Please make namazu index in %s, first." folder)
1070             (sit-for 1)
1071             nil)
1072         (save-excursion
1073           (if first (setq first (string-to-int first)))
1074           (if last (setq last (string-to-int last)))
1075           (mew-set-buffer-tmp)
1076           (buffer-disable-undo (current-buffer))
1077           (setq prog-args (append (if (eq mew-nmz-namazu-version 'v1)
1078                                       (list "-aeS")
1079                                     (list "--all" "--list" "--early"))
1080                                   (list pattern)
1081                                   (list namazu-dir)))
1082           (mew-pioalet
1083            mew-cs-autoconv mew-cs-pick mew-cs-pick
1084            (apply (function call-process)
1085                   mew-nmz-prog nil t nil prog-args))
1086           (goto-char (point-min))
1087           (while (not (eobp))
1088             (if (looking-at (concat "^.*"
1089                                     (regexp-quote mew-path-separator)
1090                                     "+\\([1-9][0-9]*\\)"
1091                                     suffix "$"))
1092                 (let ((msgnum (string-to-int (mew-match 1))))
1093                   (if (and (or (not first)
1094                                (>= msgnum first))
1095                            (or (not last)
1096                                (<= msgnum last)))
1097                       (setq msgs-int (cons msgnum msgs-int)))))
1098             (forward-line))
1099           (setq msgs-int (sort msgs-int '<))
1100           (mapcar 'int-to-string msgs-int))))))
1101
1102 (defun mew-nmz-multi-pick (namazu-dirs pattern &optional catch)
1103   "Get message numbers with many folders."
1104   (let ((tmpdirs namazu-dirs)
1105         (beg 0)
1106         (end mew-nmz-db-max)
1107         prog-args intmsgs retmsgs sortfld cell nmzdirs)
1108     (while tmpdirs
1109       (setq nmzdirs (cons (delete nil (mew-sublist namazu-dirs beg end)) nmzdirs))
1110       (setq tmpdirs (nthcdr mew-nmz-db-max tmpdirs))
1111       (setq beg (+ beg mew-nmz-db-max))
1112       (setq end (+ end mew-nmz-db-max)))
1113     (save-excursion
1114       (while (and nmzdirs
1115                   (or (not catch)
1116                       (and catch (null intmsgs))))
1117         (mew-set-buffer-tmp)
1118         (buffer-disable-undo (current-buffer))
1119         (setq prog-args (append (if (eq mew-nmz-namazu-version 'v1)
1120                                     (list "-aS")
1121                                   (list "--all" "--list"))
1122                                 (list pattern)
1123                                 (car nmzdirs)))
1124         (mew-pioalet
1125          mew-cs-autoconv mew-cs-pick mew-cs-pick
1126          (apply (function call-process)
1127                 mew-nmz-prog nil t nil prog-args))
1128         (goto-char (point-min))
1129         (let ((msgregex (concat "^\\(.*\\)"
1130                                 (regexp-quote mew-path-separator)
1131                                 "\\([1-9][0-9]*\\)")) ;; ???
1132               dir msgnum)
1133           (while (not (eobp))
1134             (if (not (looking-at msgregex))
1135                 ()
1136               (setq dir (mew-buffer-substring (match-beginning 1) (match-end 1)))
1137               (setq msgnum (string-to-int
1138                             (mew-buffer-substring (match-beginning 2) (match-end 2))))
1139               (if (not (setq cell (assoc dir intmsgs)))
1140                   (setq intmsgs (cons (list dir (list msgnum)) intmsgs))
1141                 (setq intmsgs (delete cell intmsgs))
1142                 (setq cell (cons (car cell) (list (cons msgnum (car (cdr cell))))))
1143                 (setq intmsgs (cons cell intmsgs))))
1144             (forward-line))
1145           (setq nmzdirs (cdr nmzdirs))))
1146       (if (null intmsgs)
1147           nil
1148         (setq retmsgs intmsgs)
1149         (while retmsgs
1150           (setq sortfld (cons (car (car retmsgs)) sortfld))
1151           (setq retmsgs (cdr retmsgs)))
1152         (setq sortfld (sort sortfld 'string<))
1153         (while sortfld
1154           (setq cell (assoc (car sortfld) intmsgs))
1155           (setq retmsgs
1156                 (cons
1157                  (list (mew-nmz-url-to-folder (car cell))
1158                        (mapcar 'int-to-string
1159                                (sort (car (cdr cell)) '<)))
1160                  retmsgs))
1161           (setq sortfld (cdr sortfld)))
1162         ;; '((folder (msg ...)) (folder (msg ...)) ...)
1163         (nreverse retmsgs)))))
1164
1165 ;;
1166 ;; miscellaneous functions
1167 (defun mew-nmz-dir-to-folder-imap (str)
1168   (if (string-match "^@[^#]+#[^/]+/\\(.*\\)$" str)
1169       (concat "%" (substring str (match-beginning 1) (match-end 1)))))
1170
1171 (defun mew-nmz-goto-folder-msg (fld msg)
1172   (if (and (mew-folder-imapp fld)
1173            (and (get-buffer fld)
1174                 (buffer-name (get-buffer fld))))
1175       (pop-to-buffer fld)
1176     (mew-summary-goto-folder nil fld)
1177     (while (processp mew-summary-buffer-process)
1178       (sit-for 1)
1179       (discard-input)))
1180   (mew-summary-jump-message msg)
1181   (mew-summary-display 'force))
1182
1183 (defun mew-nmz-make-temp-name (prefix)
1184   (let ((time (current-time)))
1185     (setq time (mapconcat '(lambda (x)
1186                              (format "%d" x))
1187                           time ""))
1188     (concat prefix time)))
1189
1190 (defun mew-nmz-slash-to-backslash (dir)
1191   "Convert '/' to '\'."
1192   (if (string-match "\\\\" mew-path-separator)
1193       dir
1194     (let ((backslash "\\")
1195           (pos 0))
1196       (while (string-match (regexp-quote mew-path-separator) dir pos)
1197         (setq dir (concat (substring dir 0 (match-beginning 0))
1198                           backslash
1199                           (substring dir (match-end 0))))
1200         (setq pos (1+ (match-end 0))))
1201       dir)))
1202
1203 (defun mew-nmz-url-to-folder (url)
1204   "Convert namazu's output url to folder."
1205   (and mew-nmz-use-backslash
1206        (string-match "^/\\([a-zA-Z]\\)|\\(/.*\\)" url)
1207        (setq url (concat
1208                   (substring url (match-beginning 1) (match-end 1))
1209                   ":"
1210                   (substring url (match-beginning 2) (match-end 2)))))
1211   (setq url (expand-file-name url))
1212   (cond
1213    ((string-match (concat
1214                    "^"
1215                    (regexp-quote
1216                     (concat (expand-file-name mew-mail-path) mew-path-separator))
1217                    "\\(@.*\\)$")
1218                   url)
1219     (mew-nmz-dir-to-folder-imap (substring url (match-beginning 1) (match-end 1))))
1220    ((string-match (concat
1221                    "^"
1222                    (regexp-quote
1223                     (concat (expand-file-name mew-mail-path) mew-path-separator))
1224                    "\\(.*\\)$")
1225                   url)
1226     (concat "+" (substring url (match-beginning 1) (match-end 1))))
1227    ((string-match (concat
1228                    "^"
1229                    (regexp-quote
1230                     (concat (expand-file-name mew-news-path) mew-path-separator))
1231                    "\\(.*\\)$")
1232                   url)
1233     (concat "=" (substring url (match-beginning 1) (match-end 1))))
1234
1235    (t (message "Ignore url(%s) in %s." url
1236                (if (eq mew-nmz-namazu-version 'v1) "NMZ.field.url" "NMZ.field.uri")))))
1237
1238 (defun mew-nmz-expand-folder-regexp (folder)
1239   "Convert folder to namazu-index-dir with '*' expand."
1240   (if (null mew-nmz-indexed-folders)
1241       (mew-nmz-gather-indexed-folder))
1242   (let ((nmz-fld-list mew-nmz-indexed-folders)
1243         namazu-dir-list fld)
1244     (if (not (string-match "^\\([^*]+\\)\\*?$" folder))
1245         (if mew-use-imap
1246             (setq folder "^[+=%]")
1247           (setq folder "^[+=]"))
1248       (setq folder (mew-match 1 folder))
1249       (if (string-match "^\\(.*\\)/$" folder)
1250           (setq folder (concat "^" (regexp-quote (mew-match 1 folder))))
1251         (setq folder (concat "^" (regexp-quote folder)))))
1252     (while (setq fld (car nmz-fld-list))
1253       (and (string-match folder fld)
1254            (setq namazu-dir-list
1255                  (cons (mew-nmz-expand-folder fld) namazu-dir-list)))
1256       (setq nmz-fld-list (cdr nmz-fld-list)))
1257     (nreverse namazu-dir-list)))
1258
1259 (defun mew-nmz-gather-indexed-folder ()
1260   "Gather indexed folder."
1261   (interactive)
1262   (let ((folder-list mew-folder-list)
1263         nmzdir namazu-folder-list)
1264     (mapcar '(lambda (fld)
1265                (and (setq nmzdir (mew-nmz-expand-folder fld))
1266                     (file-directory-p nmzdir)
1267                     (file-exists-p (expand-file-name "NMZ.i" nmzdir))
1268                     (setq namazu-folder-list
1269                           (cons (directory-file-name fld) namazu-folder-list))))
1270             folder-list)
1271     (setq mew-nmz-indexed-folders (nreverse namazu-folder-list))
1272     (and (interactive-p) (message "Gather indexed folder...done."))))
1273
1274 (defun mew-nmz-index-delete (namazu-dir)
1275   "Delete namazu index files."
1276   (let ((nmz-list (file-name-all-completions "NMZ\." namazu-dir)))
1277     (mapcar '(lambda (file)
1278                (and (file-writable-p (expand-file-name file namazu-dir))
1279                     (delete-file (expand-file-name file namazu-dir))))
1280             nmz-list)))
1281
1282 (defun mew-nmz-skip-folder (fld)
1283   (let ((fls mew-nmz-mknmz-skip-folders))
1284     (catch 'match
1285       (while fls
1286         (if (string-match (concat "^" (car fls)) fld)
1287             (throw 'match t))
1288         (setq fls (cdr fls)))
1289       nil)))
1290
1291 (defun mew-nmz-folder-dir-newp (namazu-dir)
1292   (let* ((folder (mew-nmz-dir-to-folder namazu-dir))
1293          (buf (get-buffer folder)))
1294     (if (not buf)
1295         (let* ((dir (file-chase-links (mew-expand-folder folder)))
1296                (tdir (if (and mew-touch-folder-p (boundp 'mew-summary-touch-file))
1297                          (nth 5 (file-attributes
1298                                  (expand-file-name mew-summary-touch-file
1299                                                    (mew-expand-folder dir))))
1300                        (nth 5 (file-attributes dir))))
1301                (da (car tdir))
1302                (db (car (cdr tdir)))
1303                (cache (expand-file-name mew-summary-cache-file dir))
1304                (tcache (nth 5 (file-attributes cache)))
1305                (fa (car tcache))
1306                (fb (car (cdr tcache))))
1307           (cond
1308            ((null tdir) nil)
1309            ((null tcache) t)  ;; no cache, do update!
1310            ((> da fa) t)
1311            ((= da fa) (if (> db fb) t nil)) ;; nil if same
1312            (t nil)))
1313       (set-buffer buf)
1314       (if (and (not (mew-summary-folder-dir-newp))
1315                (mew-summary-exclusive-p))
1316           nil t))))
1317
1318 (provide 'mew-nmz)
1319
1320 ;; end here.