git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus-namazu.el

   1 ;;; gnus-namazu.el --- Search mail with Namazu. -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   4
   5 ;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   6 ;; Keywords: mail searching namazu
   7
   8 ;; This file is a part of Semi-Gnus.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, you can either send email to this
  22 ;; program's maintainer or write to: The Free Software Foundation,
  23 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  24
  25
  26 ;;; Commentary:
  27
  28 ;; This file defines the command to search mails and persistent
  29 ;; articles with Namazu and browse its results with Gnus.  This module
  30 ;; requires the external command, Namazu.  Visit the following page
  31 ;; for more information.
  32 ;;
  33 ;;     http://namazu.org/
  34
  35
  36 ;;; Install:
  37
  38 ;; Make index of articles with Namzu before using this module.
  39 ;;
  40 ;;       % mkdir ~/News/namazu
  41 ;;       % mknmz -a -h -O ~/News/namazu ~/Mail ~/News/cache
  42 ;;
  43 ;; The first command makes the directory for index files, and the
  44 ;; second command generates index files of mails and persistent
  45 ;; articles.
  46 ;;
  47 ;; When you put index files of Namazu into the directory other than
  48 ;; the default one (~/News/namazu), it is necessary to put this
  49 ;; expression to your ~/.gnus, in order to set the path of index files
  50 ;; to `gnus-namazu-index-directories'.
  51 ;;
  52 ;;      (setq gnus-namazu-index-directories
  53 ;;            (list (expand-file-name "~/namazu")))
  54 ;;
  55 ;; If you would like to use this module in Gnus (not T-gnus), put this
  56 ;; file into the lisp/ directory in the Gnus source tree and run `make
  57 ;; install'.  And then, put the following expressions into your ~/.gnus.
  58 ;;
  59 ;;      (require 'gnus-namazu)
  60 ;;      (gnus-namazu-insinuate)
  61
  62
  63 ;;; Usage:
  64
  65 ;; In group buffer or in summary buffer, type C-c C-n query RET.
  66
  67
  68 ;;; Code:
  69
  70 (eval-when-compile (require 'cl))
  71 (require 'nnoo)
  72 (require 'nnheader)
  73 (require 'nnmail)
  74 (require 'gnus-sum)
  75
  76 ;; It is required for Mule 2.3.  See the file Mule23@1934.en.
  77 (eval-and-compile
  78   (autoload 'regexp-opt "regexp-opt"))
  79
  80 ;; To suppress byte-compile warning.
  81 (eval-when-compile
  82   (defvar nnml-directory)
  83   (defvar nnml-group-alist)
  84   (defvar nnmh-directory)
  85   (defvar nnmh-group-alist))
  86
  87
  88 (defgroup gnus-namazu nil
  89   "Search nnmh and nnml groups in Gnus with Namazu."
  90   :group 'namazu
  91   :group 'gnus
  92   :prefix "gnus-namazu-")
  93
  94 (defcustom gnus-namazu-index-directories
  95   (list
  96    (or (and (boundp 'gnus-namazu-index-directory)
  97             (symbol-value 'gnus-namazu-index-directory))
  98        (and (boundp 'nnir-namazu-index-directory)
  99             (symbol-value 'nnir-namazu-index-directory))
 100        (expand-file-name "namazu" gnus-directory)))
 101   "*Index directory of Namazu."
 102   :type '(repeat directory)
 103   :group 'gnus-namazu)
 104
 105 (defcustom gnus-namazu-command
 106   (or (and (boundp 'namazu-command)
 107            (symbol-value 'namazu-command))
 108       (and (boundp 'nnir-namazu-program)
 109            (symbol-value 'nnir-namazu-program))
 110       "namazu")
 111   "*Name of the executable file of Namazu."
 112   :group 'gnus-namazu
 113   :type 'string)
 114
 115 (defcustom gnus-namazu-additional-arguments nil
 116   "*Additional arguments of Namazu.
 117 The options `-q', `-a', and `-l' are always used, very few other
 118 options make any sense in this context."
 119   :type '(repeat string)
 120   :group 'gnus-namazu)
 121
 122 (defcustom gnus-namazu-field-keywords
 123   '("date" "from" "newsgroups" "size" "subject" "summary" "to" "uri")
 124   "*List of keywords to do field-search."
 125   :type '(repeat string)
 126   :group 'gnus-namazu)
 127
 128 (defcustom gnus-namazu-coding-system
 129   (if (memq system-type '(windows-nt OS/2 emx))
 130       (if (boundp 'MULE) '*sjis* 'shift_jis)
 131     (if (boundp 'MULE) '*euc-japan* 'euc-japan))
 132   "*Coding system for Namazu process."
 133   :type 'coding-system
 134   :group 'gnus-namazu)
 135
 136 (defcustom gnus-namazu-need-path-normalization
 137   (eq system-type 'windows-nt)
 138   "*Non-nil means that outputs of namazu may contain a not normalized path."
 139   :type 'boolean
 140   :group 'gnus-namazu)
 141
 142 (defcustom gnus-namazu-case-sensitive-filesystem
 143   (not (eq system-type 'windows-nt))
 144   "*Non-nil means that the using file system distinguishes cases of characters."
 145   :type 'boolean
 146   :group 'gnus-namazu)
 147
 148 (defcustom gnus-namazu-query-highlight t
 149   "Non-nil means that queried words is highlighted."
 150   :type 'boolean
 151   :group 'gnus-namazu)
 152
 153 (defface gnus-namazu-query-highlight-face
 154   '((((type tty pc) (class color))
 155      (:background "magenta4" :foreground "cyan1"))
 156     (((class color) (background light))
 157      (:background "magenta4" :foreground "lightskyblue1"))
 158     (((class color) (background dark))
 159      (:background "palevioletred2" :foreground "brown4"))
 160     (t (:inverse-video t)))
 161   "Face used for namazu query matching words."
 162   :group 'gnus-namazu)
 163
 164 ;;; Internal Variable:
 165 (defconst gnus-namazu/group-name-regexp "\\`nnvirtual:namazu-search\\?")
 166
 167 ;; Multibyte group name:
 168 (and
 169  (fboundp 'gnus-group-decoded-name)
 170  (let ((gnus-group-name-charset-group-alist
 171         (list (cons gnus-namazu/group-name-regexp gnus-namazu-coding-system)))
 172        (query (decode-coding-string
 173                (string 27 36 66 52 65 59 122 27 40 66)
 174                (if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-7bit))))
 175    (not (string-match query
 176                       (gnus-summary-buffer-name
 177                        (encode-coding-string
 178                         (concat "nnvirtual:namazu-search?query=" query)
 179                         gnus-namazu-coding-system)))))
 180  (let (current-load-list)
 181    (defadvice gnus-summary-buffer-name
 182      (before gnus-namazu-summary-buffer-name activate compile)
 183      "Advised by `gnus-namazu' to handle encoded group names."
 184      (ad-set-arg 0 (gnus-group-decoded-name (ad-get-arg 0))))))
 185
 186 (defmacro gnus-namazu/make-article (group number)
 187   `(cons ,group ,number))
 188 (defmacro gnus-namazu/article-group  (x) `(car ,x))
 189 (defmacro gnus-namazu/article-number (x) `(cdr ,x))
 190
 191 (defsubst gnus-namazu/indexed-servers ()
 192   "Choice appropriate servers from opened ones, and return thier list."
 193   (append
 194    (gnus-servers-using-backend 'nnml)
 195    (gnus-servers-using-backend 'nnmh)))
 196
 197 (defun gnus-namazu/setup ()
 198   (and (boundp 'gnus-group-name-charset-group-alist)
 199        (not (member (cons gnus-namazu/group-name-regexp
 200                           gnus-namazu-coding-system)
 201                     gnus-group-name-charset-group-alist))
 202        (let ((pair (assoc gnus-namazu/group-name-regexp
 203                           gnus-group-name-charset-group-alist)))
 204          (if pair
 205              (setcdr pair gnus-namazu-coding-system)
 206            (push (cons gnus-namazu/group-name-regexp
 207                        gnus-namazu-coding-system)
 208                  gnus-group-name-charset-group-alist)))))
 209
 210 (defun gnus-namazu/request-list (server)
 211   "Return groups of the server SERVER."
 212   (and (memq (car server) '(nnml nnmh))
 213        (nnoo-change-server (car server) (nth 1 server) (nthcdr 2 server))
 214        (gnus-request-list server)
 215        (mapcar (function car)
 216                (if (eq 'nnml (car server))
 217                    nnml-group-alist
 218                  nnmh-group-alist))))
 219
 220 (defun gnus-namazu/server-directory (server)
 221   "Return the top directory of the server SERVER."
 222   (and (memq (car server) '(nnml nnmh))
 223        (nnoo-change-server (car server) (nth 1 server) (nthcdr 2 server))
 224        (file-name-as-directory
 225         (expand-file-name (if (eq 'nnml (car server))
 226                               nnml-directory
 227                             nnmh-directory)))))
 228
 229 ;;; Functions to call Namazu.
 230 (defsubst gnus-namazu/normalize-results ()
 231   "Normalize file names returned by Namazu in this current buffer."
 232   (goto-char (point-min))
 233   (while (not (eobp))
 234     (when (if gnus-namazu-need-path-normalization
 235               (or (not (looking-at "/\\(.\\)|/"))
 236                   (replace-match "\\1:/"))
 237             (eq ?~ (char-after (point))))
 238       (insert (expand-file-name
 239                (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))
 240       (delete-region (point) (gnus-point-at-eol)))
 241     (forward-line 1)))
 242
 243 (defsubst gnus-namazu/call-namazu (query)
 244   (let ((coding-system-for-read gnus-namazu-coding-system)
 245         (coding-system-for-write gnus-namazu-coding-system)
 246         (default-process-coding-system
 247           (cons gnus-namazu-coding-system gnus-namazu-coding-system))
 248         (file-name-coding-system gnus-namazu-coding-system)
 249         (pathname-coding-system gnus-namazu-coding-system))
 250     (apply 'call-process
 251            `(,gnus-namazu-command
 252              nil                        ; input from /dev/null
 253              t                          ; output
 254              nil                        ; don't redisplay
 255              "-q"                       ; don't be verbose
 256              "-a"                       ; show all matches
 257              "-l"                       ; use list format
 258              ,@gnus-namazu-additional-arguments
 259              ,query
 260              ,@gnus-namazu-index-directories))))
 261
 262 (defsubst gnus-namazu/group-prefixed-name (group method)
 263   "Return the whole name from GROUP and METHOD."
 264   (if gnus-namazu-case-sensitive-filesystem
 265       (gnus-group-prefixed-name group method)
 266     (let* ((orig (gnus-group-prefixed-name group method))
 267            (name (downcase orig)))
 268       (catch 'found-group
 269         (mapatoms (lambda (sym)
 270                     (when (string= name (downcase (symbol-name sym)))
 271                       (throw 'found-group (symbol-name sym))))
 272                   gnus-newsrc-hashtb)
 273         orig))))
 274
 275 (defun gnus-namazu/check-cache-group (str)
 276   "Get the news group from the partial path STR of the cached article."
 277   (if (gnus-use-long-file-name 'not-cache)
 278       str
 279     (catch 'found-group
 280       (dolist (group (gnus-namazu/cache-group-candidates
 281                       (nnheader-replace-chars-in-string str ?/ ?.)))
 282         (when (gnus-gethash group gnus-newsrc-hashtb)
 283           (throw 'found-group group))))))
 284
 285 (defun gnus-namazu/cache-group-candidates (str)
 286   "Regard the string STR as the partial path of the cached article and
 287 generate possible group names from it."
 288   (if (string-match "_\\(_\\(_\\)?\\)?" str)
 289       (let ((prefix (substring str 0 (match-beginning 0)))
 290             (suffix (substring str (match-end 0))))
 291         (cond
 292          ((match-beginning 2) ;; The number of discoverd underscores = 3
 293           (nconc
 294            (gnus-namazu/cache-group-candidates (concat prefix "/__" suffix))
 295            (gnus-namazu/cache-group-candidates (concat prefix ".._" suffix))))
 296          ((match-beginning 1) ;; The number of discoverd underscores = 2
 297           (nconc
 298            (gnus-namazu/cache-group-candidates (concat prefix "//" suffix))
 299            (gnus-namazu/cache-group-candidates (concat prefix ".." suffix))))
 300          (t ;; The number of discoverd underscores = 1
 301           (gnus-namazu/cache-group-candidates (concat prefix "/" suffix)))))
 302     (if (string-match "\\." str)
 303         ;; Handle the first occurence of period.
 304         (list (concat (substring str 0 (match-beginning 0))
 305                       ":"
 306                       (substring str (match-end 0)))
 307               str)
 308       (list str))))
 309
 310 (defun gnus-namazu/search (groups query)
 311   (with-temp-buffer
 312     (let ((exit-status (gnus-namazu/call-namazu query)))
 313       (unless (zerop exit-status)
 314         (error "Namazu finished abnormally: %d" exit-status))
 315       (let* ((articles)
 316              (server-alist
 317               (delq nil
 318                     (let (dir)
 319                       (mapcar
 320                        (lambda (s)
 321                          (when (setq dir (gnus-namazu/server-directory s))
 322                            (cons (file-name-as-directory dir) s)))
 323                        (gnus-namazu/indexed-servers)))))
 324              (topdir-regexp (regexp-opt (mapcar 'car server-alist)))
 325              (cache-regexp (concat
 326                             (regexp-quote
 327                              (file-name-as-directory
 328                               (expand-file-name gnus-cache-directory)))
 329                             "\\(.*\\)/\\([0-9]+\\)$")))
 330         (gnus-namazu/normalize-results)
 331         (goto-char (point-min))
 332         (while (not (eobp))
 333           (let (server group file)
 334             (and (or
 335                   ;; Check the discoverd file is the persistent article.
 336                   (and (looking-at cache-regexp)
 337                        (setq file (match-string-no-properties 2)
 338                              group (gnus-namazu/check-cache-group
 339                                     (match-string-no-properties 1))))
 340                   ;; Check the discovered file is managed by Gnus servers.
 341                   (and (looking-at topdir-regexp)
 342                        (setq file (buffer-substring-no-properties
 343                                    (match-end 0) (gnus-point-at-eol))
 344                              server (cdr (assoc (match-string-no-properties 0)
 345                                                 server-alist)))
 346                        ;; Check validity of the file name.
 347                        (string-match "/\\([0-9]+\\)\\'" file)
 348                        (progn
 349                          (setq group (substring file 0 (match-beginning 0))
 350                                file (match-string 1 file))
 351                          (setq group
 352                                (gnus-namazu/group-prefixed-name
 353                                 (nnheader-replace-chars-in-string group ?/ ?.)
 354                                 server)))))
 355                  (or (not groups)
 356                      (member group groups))
 357                  (push (gnus-namazu/make-article group (string-to-number file))
 358                        articles)))
 359           (forward-line 1))
 360         (nreverse articles)))))
 361
 362
 363 ;;; User Interface:
 364 (defun gnus-namazu/get-target-groups ()
 365   (cond
 366    ((eq major-mode 'gnus-group-mode)
 367     ;; In Group buffer.
 368     (cond
 369      (current-prefix-arg
 370       (gnus-group-process-prefix current-prefix-arg))
 371      (gnus-group-marked
 372       (prog1 gnus-group-marked (gnus-group-unmark-all-groups)))))
 373    ((eq major-mode 'gnus-summary-mode)
 374     ;; In Summary buffer.
 375     (if current-prefix-arg
 376         (list (gnus-read-group "Group: "))
 377       (if (and
 378            (gnus-ephemeral-group-p gnus-newsgroup-name)
 379            (string-match gnus-namazu/group-name-regexp gnus-newsgroup-name))
 380           (cadr (assq 'gnus-namazu-target-groups
 381                       (gnus-info-method (gnus-get-info gnus-newsgroup-name))))
 382         (list gnus-newsgroup-name))))))
 383
 384 (defun gnus-namazu/get-current-query ()
 385   (and (eq major-mode 'gnus-summary-mode)
 386        (gnus-ephemeral-group-p gnus-newsgroup-name)
 387        (string-match gnus-namazu/group-name-regexp gnus-newsgroup-name)
 388        (cadr (assq 'gnus-namazu-current-query
 389                    (gnus-info-method (gnus-get-info gnus-newsgroup-name))))))
 390
 391 (defvar gnus-namazu/read-query-original-buffer nil)
 392 (defvar gnus-namazu/read-query-prompt nil)
 393 (defvar gnus-namazu/read-query-history nil)
 394
 395 (defun gnus-namazu/get-current-subject ()
 396   (and gnus-namazu/read-query-original-buffer
 397        (bufferp gnus-namazu/read-query-original-buffer)
 398        (with-current-buffer gnus-namazu/read-query-original-buffer
 399          (when (eq major-mode 'gnus-summary-mode)
 400            (let ((s (gnus-summary-article-subject)))
 401              ;; Remove typically prefixes of mailing lists.
 402              (when (string-match
 403                     "^\\(\\[[^]]*[0-9]+\\]\\|([^)]*[0-9]+)\\)\\s-*" s)
 404                (setq s (substring s (match-end 0))))
 405              (when (string-match
 406                     "^\\(Re\\(\\^?\\([0-9]+\\|\\[[0-9]+\\]\\)\\)?:\\s-*\\)+" s)
 407                (setq s (substring s (match-end 0))))
 408              (when (string-match "\\s-*(\\(re\\|was\\)\\b" s)
 409                (setq s (substring s 0 (match-beginning 0))))
 410              s)))))
 411
 412 (defun gnus-namazu/get-current-from ()
 413   (and gnus-namazu/read-query-original-buffer
 414        (bufferp gnus-namazu/read-query-original-buffer)
 415        (with-current-buffer gnus-namazu/read-query-original-buffer
 416          (when (eq major-mode 'gnus-summary-mode)
 417            (cadr (mail-extract-address-components
 418                   (mail-header-from
 419                    (gnus-summary-article-header))))))))
 420
 421 (defmacro gnus-namazu/minibuffer-prompt-end ()
 422   (if (fboundp 'minibuffer-prompt-end)
 423       '(minibuffer-prompt-end)
 424     '(point-min)))
 425
 426 (defun gnus-namazu/message (string &rest arguments)
 427   (let* ((s1 (concat
 428               gnus-namazu/read-query-prompt
 429               (buffer-substring (gnus-namazu/minibuffer-prompt-end)
 430                                 (point-max))))
 431          (s2 (apply (function format) string arguments))
 432          (w (- (window-width)
 433                (string-width s1)
 434                (string-width s2)
 435                1)))
 436     (message (if (>= w 0)
 437                  (concat s1 (make-string w ?\ ) s2)
 438                s2))
 439     (if (sit-for 0.3) (message s1))
 440     s2))
 441
 442 (defun gnus-namazu/complete-query ()
 443   (interactive)
 444   (let ((pos (point)))
 445     (cond
 446      ((and (re-search-backward "\\+\\([-a-z]*\\)" nil t)
 447            (= pos (match-end 0)))
 448       (let* ((partial (match-string 1))
 449              (completions
 450               (all-completions
 451                partial
 452                (mapcar 'list gnus-namazu-field-keywords))))
 453         (cond
 454          ((null completions)
 455           (gnus-namazu/message "No completions of %s" partial))
 456          ((= 1 (length completions))
 457           (goto-char (match-beginning 1))
 458           (delete-region (match-beginning 1) (match-end 1))
 459           (insert (car completions) ":")
 460           (setq pos (point))
 461           (gnus-namazu/message "Completed"))
 462          (t
 463           (let ((x (try-completion partial (mapcar 'list completions))))
 464             (if (string= x partial)
 465                 (if (and (eq last-command
 466                              'gnus-namazu/field-keyword-completion)
 467                          completion-auto-help)
 468                     (with-output-to-temp-buffer "*Completions*"
 469                       (display-completion-list completions))
 470                   (gnus-namazu/message "Sole completion"))
 471               (goto-char (match-beginning 1))
 472               (delete-region (match-beginning 1) (match-end 1))
 473               (insert x)
 474               (setq pos (point))))))))
 475      ((and (looking-at "\\+subject:")
 476            (= pos (match-end 0)))
 477       (let ((s (gnus-namazu/get-current-subject)))
 478         (when s
 479           (goto-char pos)
 480           (insert "\"" s "\"")
 481           (setq pos (point)))))
 482      ((and (looking-at "\\+from:")
 483            (= pos (match-end 0)))
 484       (let ((f (gnus-namazu/get-current-from)))
 485         (when f
 486           (goto-char pos)
 487           (insert "\"" f "\"")
 488           (setq pos (point))))))
 489     (goto-char pos)))
 490
 491 (defvar gnus-namazu/read-query-map
 492   (let ((keymap (copy-keymap minibuffer-local-map)))
 493     (define-key keymap "\t" 'gnus-namazu/complete-query)
 494     keymap))
 495
 496 (defun gnus-namazu/read-query (prompt &optional initial)
 497   (let ((gnus-namazu/read-query-original-buffer (current-buffer))
 498         (gnus-namazu/read-query-prompt prompt))
 499     (unless initial
 500       (when (setq initial (gnus-namazu/get-current-query))
 501         (setq initial (cons initial 0))))
 502     (read-from-minibuffer prompt initial gnus-namazu/read-query-map nil
 503                           'gnus-namazu/read-query-history)))
 504
 505 (defun gnus-namazu/highlight-words (query)
 506   (with-temp-buffer
 507     (insert " " query)
 508     ;; Remove tokens for NOT search
 509     (goto-char (point-min))
 510     (while (re-search-forward "[\e$B!!\e(B \t\r\f\n]+not[\e$B!!\e(B \t\r\f\n]+\
 511 \\([^\e$B!!\e(B \t\r\f\n\"{(/]+\\|\"[^\"]+\"\\|{[^}]+}\\|([^)]+)\\|/[^/]+/\\)+" nil t)
 512       (delete-region (match-beginning 0) (match-end 0)))
 513     ;; Remove tokens for Field search
 514     (goto-char (point-min))
 515     (while (re-search-forward "[\e$B!!\e(B \t\r\f\n]+\\+[^\e$B!!\e(B \t\r\f\n:]+:\
 516 \\([^\e$B!!\e(B \t\r\f\n\"{(/]+\\|\"[^\"]+\"\\|{[^}]+}\\|([^)]+)\\|/[^/]+/\\)+" nil t)
 517       (delete-region (match-beginning 0) (match-end 0)))
 518     ;; Remove tokens for Regexp search
 519     (goto-char (point-min))
 520     (while (re-search-forward "/[^/]+/" nil t)
 521       (delete-region (match-beginning 0) (match-end 0)))
 522     ;; Remove brackets, double quote, asterisk and operators
 523     (goto-char (point-min))
 524     (while (re-search-forward "\\([(){}\"*]\\|\\b\\(and\\|or\\)\\b\\)" nil t)
 525       (delete-region (match-beginning 0) (match-end 0)))
 526     ;; Collect all keywords
 527     (setq query nil)
 528     (goto-char (point-min))
 529     (while (re-search-forward "[^\e$B!!\e(B \t\r\f\n]+" nil t)
 530       (push (match-string 0) query))
 531     (when query
 532       (list (list (regexp-opt query)
 533                   0 0 'gnus-namazu-query-highlight-face)))))
 534
 535 (defun gnus-namazu/truncate-article-list (articles)
 536   (let ((hit (length articles)))
 537     (when (> hit gnus-large-newsgroup)
 538       (let* ((cursor-in-echo-area nil)
 539              (input
 540               (when (> hit gnus-large-newsgroup)
 541                 (read-from-minibuffer
 542                  (format
 543                   "Too many articles were retrieved.  How many articles (max %d): "
 544                   hit)
 545                  (cons (number-to-string gnus-large-newsgroup) 0)))))
 546         (unless (string-match "\\`[ \t]*\\'" input)
 547           (setcdr (nthcdr (min (1- (string-to-number input)) hit) articles)
 548                   nil))))
 549     articles))
 550
 551 ;;;###autoload
 552 (defun gnus-namazu-search (groups query)
 553   "Search QUERY through GROUPS with Namazu,
 554 and make a virtual group contains its results."
 555   (interactive
 556    (list
 557     (gnus-namazu/get-target-groups)
 558     (gnus-namazu/read-query "Enter query: ")))
 559   (gnus-namazu/setup)
 560   (let ((articles (gnus-namazu/search groups query)))
 561     (if articles
 562         (let ((real-groups groups)
 563               (vgroup
 564                (apply (function format)
 565                       "nnvirtual:namazu-search?query=%s&groups=%s&id=%d%d%d"
 566                       query
 567                       (if groups (mapconcat 'identity groups ",") "ALL")
 568                       (current-time))))
 569           (gnus-namazu/truncate-article-list articles)
 570           (unless real-groups
 571             (dolist (a articles)
 572               (add-to-list 'real-groups (gnus-namazu/article-group a))))
 573           ;; Generate virtual group which includes all results.
 574           (when (fboundp 'gnus-group-decoded-name)
 575             (setq vgroup
 576                   (encode-coding-string vgroup gnus-namazu-coding-system)))
 577           (setq vgroup
 578                 (gnus-group-read-ephemeral-group
 579                  vgroup
 580                  `(nnvirtual ,vgroup
 581                              (nnvirtual-component-groups ,real-groups)
 582                              (gnus-namazu-target-groups ,groups)
 583                              (gnus-namazu-current-query ,query))
 584                  t (cons (current-buffer) (current-window-configuration)) t))
 585           (when gnus-namazu-query-highlight
 586             (gnus-group-set-parameter vgroup 'highlight-words
 587                                       (gnus-namazu/highlight-words query)))
 588           ;; Generate new summary buffer which contains search results.
 589           (gnus-group-read-group
 590            t t vgroup
 591            (sort (delq nil ;; Ad-hoc fix, to avoid wrong-type-argument error.
 592                        (mapcar
 593                         (lambda (a)
 594                           (nnvirtual-reverse-map-article
 595                            (gnus-namazu/article-group a)
 596                            (gnus-namazu/article-number a)))
 597                         articles))
 598                  '<)))
 599       (message "No entry."))))
 600
 601 (let (current-load-list)
 602   (defadvice gnus-offer-save-summaries
 603     (before gnus-namazu-kill-summary-buffers activate compile)
 604     "Advised by `gnus-namazu'.
 605 In order to avoid annoying questions, kill summary buffers which
 606 generated by `gnus-namazu' itself before `gnus-offer-save-summaries'
 607 is called."
 608     (let ((buffers (buffer-list)))
 609       (while buffers
 610         (when (with-current-buffer (car buffers)
 611                 (and (eq major-mode 'gnus-summary-mode)
 612                      (gnus-ephemeral-group-p gnus-newsgroup-name)
 613                      (string-match gnus-namazu/group-name-regexp
 614                                    gnus-newsgroup-name)))
 615           (kill-buffer (car buffers)))
 616         (setq buffers (cdr buffers))))))
 617
 618 (defun gnus-namazu-insinuate ()
 619   (add-hook
 620    'gnus-group-mode-hook
 621    (lambda ()
 622      (define-key gnus-group-mode-map "\C-c\C-n" 'gnus-namazu-search)))
 623   (add-hook
 624    'gnus-summary-mode-hook
 625    (lambda ()
 626      (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-namazu-search))))
 627
 628 (provide 'gnus-namazu)
 629
 630 ;; gnus-namazu.el ends here.