- (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))))
-
-(defsubst gnus-namazu/group-prefixed-name (group method)
- "Return the whole name from GROUP and METHOD."
- (if gnus-namazu-case-sensitive-filesystem
- (gnus-group-prefixed-name group method)
- (let* ((orig (gnus-group-prefixed-name group method))
- (name (downcase orig)))
- (catch 'found-group
- (mapatoms (lambda (sym)
- (when (string= name (downcase (symbol-name sym)))
- (throw 'found-group (symbol-name sym))))
- gnus-newsrc-hashtb)
- orig))))
-
-(defun gnus-namazu/real-group-name (cond str)
- "Generate the real group name from the partial path, STR."
- (if cond
- str
- (catch 'found-group
- (dolist (group (gnus-namazu/possible-real-groups
- (nnheader-replace-chars-in-string str ?/ ?.)))
- (when (gnus-gethash group gnus-newsrc-hashtb)
- (throw 'found-group group))))))
-
-(defun gnus-namazu/possible-real-groups (str)
- "Regard the string STR as the partial path of the cached article and
-generate possible group names from it."
- (if (string-match "_\\(_\\(_\\)?\\)?" str)
- (let ((prefix (substring str 0 (match-beginning 0)))
- (suffix (substring str (match-end 0))))
- (cond
- ((match-beginning 2) ;; The number of discoverd underscores = 3
- (nconc
- (gnus-namazu/possible-real-groups (concat prefix "/__" suffix))
- (gnus-namazu/possible-real-groups (concat prefix ".._" suffix))))
- ((match-beginning 1) ;; The number of discoverd underscores = 2
- (nconc
- (gnus-namazu/possible-real-groups (concat prefix "//" suffix))
- (gnus-namazu/possible-real-groups (concat prefix ".." suffix))))
- (t ;; The number of discoverd underscores = 1
- (gnus-namazu/possible-real-groups (concat prefix "/" suffix)))))
- (if (string-match "\\." str)
- ;; Handle the first occurence of period.
- (list (concat (substring str 0 (match-beginning 0))
- ":"
- (substring str (match-end 0)))
- str)
- (list str))))
+ (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 (if gnus-namazu-command-prefix
+ (concat "'" query "'")
+ 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)
+ (interactive (list t))
+ (unless (and (not force)
+ gnus-namazu/directory-table
+ (eq gnus-namazu-case-sensitive-filesystem
+ (car gnus-namazu/directory-table)))
+ (let ((table (make-vector (length gnus-newsrc-hashtb) 0))
+ cache agent alist dir method)
+ (mapatoms
+ (lambda (group)
+ (unless (gnus-ephemeral-group-p (setq group (symbol-name group)))
+ (when (file-directory-p
+ (setq dir (file-name-as-directory
+ (gnus-cache-file-name group ""))))
+ (push (cons dir group) cache))
+ (when (file-directory-p
+ (setq dir (gnus-agent-group-pathname group)))
+ (push (cons dir group) agent))
+ (when (memq (car (setq method (gnus-find-method-for-group group)))
+ '(nnml nnmh))
+ (when (file-directory-p
+ (setq dir (nnmail-group-pathname
+ (gnus-group-short-name group)
+ (gnus-namazu/server-directory method))))
+ (push (cons dir group) alist)))
+ (dolist (pair gnus-namazu-remote-groups)
+ (when (setq dir
+ (or (and (eq t (car pair))
+ (gnus-method-equal method gnus-select-method)
+ group)
+ (and (stringp (car pair))
+ (string-match (car pair) group)
+ (substring group (match-end 0)))))
+ (setq dir (nnmail-group-pathname dir "/"))
+ (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
+ (car pair)
+ (downcase (car pair)))
+ table)
+ (cdr pair)))
+ (setq gnus-namazu/directory-table
+ (cons gnus-namazu-case-sensitive-filesystem table)))))