;;; w3m-namazu.el --- The add-on program to search files with Namazu.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2009, 2017
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Keywords: w3m, WWW, hypermedia, namazu
;; This file is a part of emacs-w3m.
;; 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)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; w3m-namazu.el is the add-on program of emacs-w3m to search files
;; with Namazu. For more detail about emacs-w3m, see:
;;
;; http://emacs-w3m.namazu.org/
;;; History:
;; Original program was posted by
;; Takayuki Arakawa <takayu@pop02.odn.ne.jp> in [emacs-w3m:01340] at
;; Jul 31, 2001.
;; Many codes are imported from namazu.el written by
;; Yukihiro Matsumoto <matz@netlab.co.jp> et al.
;; All stuffs are rewritten by
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org> at Aug 2, 2001.
;;; Code:
(eval-when-compile
(require 'cl))
(require 'w3m)
(eval-and-compile
(autoload 'w3m-search-read-query "w3m-search"))
(defgroup w3m-namazu nil
"w3m-namazu front-end for Emacs."
:group 'w3m
:prefix "w3m-namazu-")
(defcustom w3m-namazu-command "namazu"
"*Name of the executable file of Namazu."
:group 'w3m-namazu
:type 'string)
(defcustom w3m-namazu-arguments
'("-h" ; print in HTML format.
"-H" ; print further result links.
"-n" w3m-namazu-page-max ; set number of documents shown to NUM.
"-w" whence) ; set first number of documents shown to NUM.
"*Arguments of Namazu."
:group 'w3m-namazu
:type '(repeat
(restricted-sexp :format "Argument: %v\n"
:match-alternatives
(stringp 'w3m-namazu-page-max 'whence))))
(defcustom w3m-namazu-page-max
(if (boundp 'namazu-search-num)
(symbol-value 'namazu-search-num)
30)
"*A maximum number of documents which are retrieved by one-time search."
:group 'w3m-namazu
:type 'integer)
(defconst w3m-namazu-default-index-customize-spec
'`(choice
(const :tag "No default index" nil)
,@(mapcar (lambda (x) (list 'const (car x)))
w3m-namazu-index-alist)
(directory :format "Index directory: %v\n")))
(defcustom w3m-namazu-index-alist
(when (boundp 'namazu-dir-alist)
(mapcar (lambda (pair)
(cons (car pair)
(split-string (cdr pair))))
(symbol-value 'namazu-dir-alist)))
"*Alist of alias and index directories."
:group 'w3m-namazu
:type '(repeat
(group
:indent 0 :inline t
(cons :format "%v"
(string :format "Alias: %v\n")
(repeat
:format "%v%i\n" :indent 8
(directory :format "Index directory: %v\n")))))
:set (lambda (symbol value)
(custom-set-default symbol value)
(put 'w3m-namazu-default-index 'custom-type
(eval w3m-namazu-default-index-customize-spec))))
(defcustom w3m-namazu-default-index
(unless (and (boundp 'namazu-always-query-index-directory)
(symbol-value 'namazu-always-query-index-directory))
(when (boundp 'namazu-default-dir)
(symbol-value 'namazu-default-dir)))
"*Alias or directory of the default index.
If this variable equals nil, it is required to input an index path
whenever `w3m-namazu' is called interactively without prefix
argument."
:group 'w3m-namazu
:type (eval w3m-namazu-default-index-customize-spec))
(defcustom w3m-namazu-output-coding-system
(if (boundp 'namazu-cs-write)
(symbol-value 'namazu-cs-write)
(if (memq system-type '(OS/2 emx windows-nt))
'shift_jis-dos
'euc-japan-unix))
"*Coding system for namazu process."
:group 'w3m-namazu
:type 'coding-system)
(defcustom w3m-namazu-input-coding-system
(if (boundp 'namazu-cs-read)
(symbol-value 'namazu-cs-read)
'undecided)
"*Coding system for namazu process."
:group 'w3m-namazu
:type 'coding-system)
(defun w3m-namazu-call-process (index query whence)
(setq index (if (assoc index w3m-namazu-index-alist)
(mapcar 'expand-file-name
(cdr (assoc index w3m-namazu-index-alist)))
(list (expand-file-name index))))
(let ((file-name-coding-system w3m-file-name-coding-system)
(coding-system-for-read w3m-namazu-input-coding-system)
(coding-system-for-write w3m-namazu-output-coding-system)
(default-process-coding-system
(cons w3m-namazu-input-coding-system
w3m-namazu-output-coding-system)))
(apply 'call-process w3m-namazu-command nil t nil
(let ((w3m-namazu-page-max
(number-to-string w3m-namazu-page-max)))
(nconc (mapcar 'eval w3m-namazu-arguments)
(list query)
index)))))
;;;###autoload
(defun w3m-about-namazu (url &optional no-decode no-cache &rest args)
(let (index query (whence "0"))
(when (string-match "\\`about://namazu/\\?" url)
(dolist (s (split-string (substring url (match-end 0)) "&"))
(when (string-match "\\`\\(?:index\\|\\(query\\)\\|\\(whence\\)\\)=" s)
(set (cond
((match-beginning 1) 'query)
((match-beginning 2) 'whence)
(t 'index))
(substring s (match-end 0)))))
(when (zerop (w3m-namazu-call-process (w3m-url-decode-string index)
(w3m-url-decode-string query)
whence))
(let ((case-fold-search t))
(goto-char (point-min))
(let ((max (if (re-search-forward
"<!-- HIT -->\\([0-9]+\\)<!-- HIT -->" nil t)
(string-to-number (match-string 1))
0))
(cur (string-to-number whence)))
(goto-char (point-min))
(when (search-forward "<head>" nil t)
(when (> cur 0)
(insert
(format "
<link rel=\"prev\" href=\"about://namazu/?index=%s&query=%s&whence=%d\">"
index
query
(max (- cur w3m-namazu-page-max) 0))))
(when (> max (+ cur w3m-namazu-page-max))
(insert
(format "
<link rel=\"next\" href=\"about://namazu/?index=%s&query=%s&whence=%d\">"
index
query
(+ cur w3m-namazu-page-max))))))
(goto-char (point-min))
(while (search-forward "<a href=\"/" nil t)
(forward-char -1)
(insert "file://"))
(goto-char (point-min))
(while (re-search-forward "<a href=\"\\(\\?\\)&\\(?:amp;\\)?whence="
nil t)
(goto-char (match-beginning 1))
(delete-char 1)
(insert (format "about://namazu/?index=%s&query=%s" index query))))
"text/html"))))
(defun w3m-namazu-complete-index (index predicate flag)
"Function to complete index name"
(if (eq flag 'lambda)
(and (or (and (assoc index w3m-namazu-index-alist) t)
(file-directory-p index))
(or (not predicate)
(funcall predicate index)))
(let ((alist
(mapcar
'list
(nconc
(all-completions index w3m-namazu-index-alist)
(let ((partial (file-name-nondirectory index))
(dir (file-name-as-directory
(or (file-name-directory index)
default-directory))))
(delq nil
(mapcar
(lambda (file)
(when (file-directory-p (expand-file-name file dir))
(concat dir file)))
(file-name-all-completions partial dir))))))))
(cond
((not flag) (try-completion index alist predicate))
((eq flag t) (all-completions index alist predicate))))))
(defvar w3m-namazu-index-history nil)
(defvar w3m-namazu-query-history nil)
;;;###autoload
(defun w3m-namazu (index query &optional reload)
"Search indexed files with Namazu."
(interactive
(list
(if (if w3m-namazu-default-index
current-prefix-arg
(not (and current-prefix-arg
w3m-namazu-index-history)))
(let* ((default (or (car w3m-namazu-index-history)
w3m-namazu-default-index))
(s (completing-read
(if default
(format "Namazu index (default %s): " default)
"Namazu index: ")
'w3m-namazu-complete-index nil t nil
'w3m-namazu-index-history)))
(if (string= s "") default s))
(or w3m-namazu-default-index
(car w3m-namazu-index-history)))
(w3m-search-read-query "Namazu query: " "Namazu query (default %s): "
'w3m-namazu-query-history)
current-prefix-arg))
(unless (stringp index)
(error "%s" "Index is required"))
(unless (stringp query)
(error "%s" "Query is required"))
(w3m-goto-url (format "about://namazu/?index=%s&query=%s&whence=0"
(w3m-url-encode-string index)
(w3m-url-encode-string query))
reload))
(provide 'w3m-namazu)
;;; w3m-namazu.el ends here