X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-namazu.el;h=d09d0aba833d2ac9769f6306f0d4d233b468b54b;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=ee43a56e3fa3af6c186b3e8dcc671abf0c7cf384;hpb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-namazu.el b/lisp/gnus-namazu.el index ee43a56..d09d0ab 100644 --- a/lisp/gnus-namazu.el +++ b/lisp/gnus-namazu.el @@ -1,12 +1,11 @@ ;;; gnus-namazu.el --- Search mail with Namazu -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 2000,2001,2002,2003 TSUCHIYA Masatoshi +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 +;; TSUCHIYA Masatoshi ;; Author: TSUCHIYA Masatoshi ;; Keywords: mail searching namazu -;; This file is a part of Semi-Gnus. - ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) @@ -18,9 +17,9 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, you can either send email to this -;; program's maintainer or write to: The Free Software Foundation, -;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -36,26 +35,30 @@ ;;; Quick Start: -;; If this module has already been installed, only 3 steps are +;; If this module has already been installed, only four steps are ;; required to search articles with this module. ;; ;; (1) Install Namazu. -;; (2) Start Gnus and type M-x gnus-namazu-create-index RET to make +;; +;; (2) Put this expression into your ~/.gnus. +;; +;; (gnus-namazu-insinuate) +;; +;; (3) Start Gnus and type M-x gnus-namazu-create-index RET to make ;; index of articles. -;; (3) In group buffer or in summary buffer, type C-c C-n query RET. +;; +;; (4) In group buffer or in summary buffer, type C-c C-n query RET. ;;; Install: ;; Before installing this module, you must install Namazu. ;; -;; This file is a part of T-gnus but is not *YET* a part of Gnus. -;; When you would like to use this module in Gnus (not T-gnus), put -;; this file into the lisp/ directory in the Gnus source tree and run -;; `make install'. And then, put the following expression into your +;; When you would like to byte-compile this module in Gnus, put this +;; file into the lisp/ directory in the Gnus source tree and run `make +;; install'. And then, put the following expression into your ;; ~/.gnus. ;; -;; (require 'gnus-namazu) ;; (gnus-namazu-insinuate) ;; ;; In order to make index of articles with Namazu before using this @@ -101,10 +104,6 @@ (require 'nnmail) (require 'gnus-sum) -;; It is required for Mule 2.3. See the file Mule23@1934.en. -(eval-and-compile - (autoload 'regexp-opt "regexp-opt")) - ;; To suppress byte-compile warning. (eval-when-compile (defvar nnml-directory) @@ -142,6 +141,18 @@ :type 'string :group 'gnus-namazu) +(defcustom gnus-namazu-command-prefix nil + "*Prefix commands to execute Namazu. +If you put your index on a remote server, set this option as follows: + + (setq gnus-namazu-command-prefix + '(\"ssh\" \"-x\" \"remote-server\")) + +This makes gnus-namazu execute \"ssh -x remote-server namazu ...\" +instead of executing \"namazu\" directly." + :type '(repeat string) + :group 'gnus-namazu) + (defcustom gnus-namazu-additional-arguments nil "*Additional arguments of Namazu. The options `-q', `-a', and `-l' are always used, very few other @@ -164,10 +175,9 @@ options make any sense in this context." (defcustom gnus-namazu-make-index-arguments (nconc (list "--all" "--mailnews" "--deny=^.*[^0-9].*$") - (when (or (and (boundp 'current-language-environment) - (string= "Japanese" - (symbol-value 'current-language-environment))) - (boundp 'MULE)) + (when (and (boundp 'current-language-environment) + (string= "Japanese" + (symbol-value 'current-language-environment))) (list "--indexing-lang=ja"))) "*Arguments of the indexer of Namazu." :type '(repeat string) @@ -181,8 +191,8 @@ options make any sense in this context." (defcustom gnus-namazu-coding-system (if (memq system-type '(windows-nt OS/2 emx)) - (if (boundp 'MULE) '*sjis* 'shift_jis) - (if (boundp 'MULE) '*euc-japan* 'euc-japan)) + 'shift_jis + 'euc-japan) "*Coding system for Namazu process." :type 'coding-system :group 'gnus-namazu) @@ -215,6 +225,25 @@ options make any sense in this context." "Face used for namazu query matching words." :group 'gnus-namazu) +(defcustom gnus-namazu-remote-groups nil + "*Alist of regular expressions matching remote groups and their base paths. +If you use an IMAP server and have a special index, set this option as +follows: + + (setq gnus-namazu-remote-groups + '((\"^nnimap\\\\+server:INBOX\\\\.\" . \"~/Maildir/.\"))) + +This means that the group \"nnimap+server:INBOX.group\" is placed in +\"~/Maildir/.group\"." + :group 'gnus-namazu + :type '(repeat + (cons (regexp :tag "Regexp of group name") + (string :tag "Base path of groups"))) + :set (lambda (symbol value) + (prog1 (set-default symbol value) + (when (featurep 'gnus-namazu) + (gnus-namazu/make-directory-table t))))) + ;;; Internal Variable: (defconst gnus-namazu/group-name-regexp "\\`nnvirtual:namazu-search\\?") @@ -223,9 +252,8 @@ options make any sense in this context." (fboundp 'gnus-group-decoded-name) (let ((gnus-group-name-charset-group-alist (list (cons gnus-namazu/group-name-regexp gnus-namazu-coding-system))) - (query (decode-coding-string - (string 27 36 66 52 65 59 122 27 40 66) - (if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-7bit)))) + (query (decode-coding-string (string 27 36 66 52 65 59 122 27 40 66) + 'iso-2022-7bit))) (not (string-match query (gnus-summary-buffer-name (encode-coding-string @@ -266,7 +294,8 @@ options make any sense in this context." (push (cons gnus-namazu/group-name-regexp gnus-namazu-coding-system) gnus-group-name-charset-group-alist)))) - (gnus-namazu-update-all-indices)) + (unless gnus-namazu-command-prefix + (gnus-namazu-update-all-indices))) (defun gnus-namazu/server-directory (server) "Return the top directory of the server SERVER." @@ -289,31 +318,27 @@ options make any sense in this context." (replace-match "\\1:/")) (eq ?~ (char-after (point)))) (insert (expand-file-name - (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol)))) - (delete-region (point) (gnus-point-at-eol))) + (buffer-substring (point-at-bol) (point-at-eol)))) + (delete-region (point) (point-at-eol))) (forward-line 1))) (defsubst gnus-namazu/call-namazu (query) (let ((coding-system-for-read gnus-namazu-coding-system) (coding-system-for-write gnus-namazu-coding-system) - (input-coding-system gnus-namazu-coding-system) - (output-coding-system gnus-namazu-coding-system) (default-process-coding-system (cons gnus-namazu-coding-system gnus-namazu-coding-system)) program-coding-system-alist (file-name-coding-system gnus-namazu-coding-system) - (pathname-coding-system gnus-namazu-coding-system)) - (apply 'call-process - `(,gnus-namazu-command - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-q" ; don't be verbose - "-a" ; show all matches - "-l" ; use list format - ,@gnus-namazu-additional-arguments - ,query - ,@gnus-namazu-index-directories)))) + (commands + (append gnus-namazu-command-prefix + (list gnus-namazu-command + "-q" ; don't be verbose + "-a" ; show all matches + "-l") ; use list format + gnus-namazu-additional-arguments + (list query) + gnus-namazu-index-directories))) + (apply 'call-process (car commands) nil t nil (cdr commands)))) (defvar gnus-namazu/directory-table nil) (defun gnus-namazu/make-directory-table (&optional force) @@ -340,7 +365,19 @@ options make any sense in this context." (setq dir (nnmail-group-pathname (gnus-group-short-name group) (gnus-namazu/server-directory method)))) - (push (cons dir group) alist))))) + (push (cons dir group) alist))) + (dolist (pair gnus-namazu-remote-groups) + (when (string-match (car pair) group) + (setq dir (nnmail-group-pathname + (substring group (match-end 0)) + "/")) + (push (cons (concat (cdr pair) + ;; nnmail-group-pathname() on some + ;; systems returns pathnames which + ;; have drive letters at their top. + (substring dir (1+ (string-match "/" dir)))) + group) + alist))))) gnus-newsrc-hashtb) (dolist (pair (nconc agent cache alist)) (set (intern (if gnus-namazu-case-sensitive-filesystem @@ -381,7 +418,7 @@ options make any sense in this context." group (string-to-number (buffer-substring-no-properties (point) - (gnus-point-at-eol)))) + (point-at-eol)))) articles)) (forward-line 1)) (nreverse articles)))) @@ -797,7 +834,8 @@ than the period that is set to `gnus-namazu-index-update-interval'" (defun gnus-namazu-update-indices (&optional directories force) (when (setq directories - (delq nil (mapcar (lambda (d) (gnus-namazu/update-p d force)) + (delq nil (mapcar (lambda (d) + (gnus-namazu/update-p d force)) directories))) (setq gnus-namazu/update-directories (cons force (cdr directories))) (gnus-namazu-update-index (car directories) force)))