;;; ndnmz.el --- Lookup Namazu interface
;; Copyright (C) 1998,1999 NISHIDA Keisuke <knishida@ring.aist.go.jp>

;; Author: NISHIDA Keisuke <knishida@ring.aist.go.jp>
;; Version: $Id: ndnmz.el,v 1.6 1999/01/27 18:29:27 kei Exp $

;; This file is part of Lookup.

;; Lookup 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 of the License, or
;; (at your option) any later version.

;; Lookup 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 Lookup; if not, write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;; Code:

(require 'lookup)

(defconst ndnmz-version "0.8")

;;;
;:: Customizable variables
;;;

(defgroup ndnmz nil
  "Lookup Namazu interface."
  :group 'lookup-agents)

(defcustom ndnmz-program-name "namazu"
  "*Program name of Namazu."
  :type 'string
  :group 'ndnmz)


;;;
;:: Internal variables
;;;

(defconst ndnmz-search-methods '(exact))
(defconst ndnmz-default-arrange-functions '(ndnmz-arrange-default))
(defconst ndnmz-default-adjust-functions '(lookup-adjust-goto-min))

;;;
;:: types
;;;

;; ndnmz agent:
;;
;;   (ndnmz DIRECTORY)
;;
;; DIRECTORY - index directory
;; 
;; [option]
;; type      - archive type (`auto', `plain', `mail', or `html')
;; recursive - check subdirectories as dictionary

(defalias 'ndnmz-agent-directory 'lookup-agent-location)

(defun ndnmz-agent-type (agent)
  (or (lookup-agent-option agent 'type) 'auto))

(defun ndnmz-agent-recursive-p (agent)
  (lookup-agent-option agent 'recursive))

;; ndnmz dictionary
;;
;; CODE  - same as INDEX above
;; NAME  - same as `ndnmz-program-name'
;;
;; [property]
;; ndnmz-buffer - working buffer

;; ndnmz entry:
;;
;; CODE    - found file name (or URL)
;; HEADING - found heading


;;;
;:: Interface functions
;;;

(defun ndnmz-setup (agent)
  (call-process ndnmz-program-name nil 0)	; check namazu exists
  (let* ((directory (file-name-as-directory
		     (expand-file-name (ndnmz-agent-directory agent))))
	 (indexes (if (ndnmz-agent-recursive-p agent)
		      (ndnmz-get-leaf-directories directory)
		    (list directory))))
    (mapcar (lambda (index)
	      (let ((name (if (string-match directory index)
			      (substring index (match-end 0)))))
		(if (string= name "")
		    (setq name (file-name-nondirectory index)))
		(lookup-make-dictionary agent index name)))
	    indexes)))

(defun ndnmz-exit (agent)
  (lookup-foreach (lambda (dictionary)
		    (let ((buffer (lookup-dictionary-get-property
				   dictionary 'ndnmz-buffer)))
		      (if buffer (kill-buffer buffer))))
		  (lookup-agent-dictionaries agent)))

(defun ndnmz-dictionary-search (dictionary query)
  (let* ((buffer (lookup-dictionary-get-property dictionary 'ndnmz-buffer))
	 (directory (lookup-dictionary-code dictionary))
	 (args (cons "-s" (cons lookup-search-pattern
				(if directory (list directory) nil))))
	 heading file entries)
    (with-current-buffer (or buffer (lookup-temp-buffer))
      (goto-char (point-max))
      (insert (mapconcat 'eval (cons ">" (cons ndnmz-program-name args)) " "))
      (save-excursion
	(apply 'call-process ndnmz-program-name nil t nil args))
      (while (re-search-forward "[0-9]+\\. \\(.*\\)" nil t)
	(setq heading (match-string 1))
	(re-search-forward "^[^ ]*")
	(setq file (match-string 0))
	(setq entries (cons (lookup-make-entry dictionary file heading)
			    entries)))
      (if (not buffer) (kill-buffer (current-buffer))))
    (nreverse entries)))

(defun ndnmz-dictionary-content (dictionary entry)
  (with-temp-buffer
    (insert-file-contents (lookup-entry-code entry))
    (buffer-string)))

(defun ndnmz-dictionary-open (dictionary entry)
  (if (eq (ndnmz-agent-type (lookup-dictionary-agent dictionary)) 'html)
      (browse-url (lookup-entry-code entry))))


;;;
;:: Internal functions
;;;

(defun ndnmz-get-leaf-directories (directory)
  (when (file-directory-p directory)
    (if (= (file-nlinks directory) 2)
	(list directory)
      (apply 'nconc (mapcar 'ndnmz-get-leaf-directories
			    (directory-files directory t "^[^.]"))))))


;;;
;:: Format functions
;;;

(defun ndnmz-arrange-default (entry)
  (let ((type (ndnmz-agent-type (lookup-dictionary-agent
				 (lookup-entry-dictionary entry))))
	(case-fold-search t))
    (cond
     ((eq type 'plain) (lookup-arrange-default-headings entry))
     ((eq type 'mail) (ndnmz-arrange-mail entry))
     ((eq type 'html) (ndnmz-arrange-html entry))
     ;; auto detect
     ((looking-at "<!doctype\\|<html") (ndnmz-arrange-html entry))
     ((looking-at "From \\|[a-z-]+: ") (ndnmz-arrange-mail entry))
     (t (lookup-arrange-default-headings entry)))))

(defvar ndnmz-valid-mail-headers
  '("from" "subject" "to" "date"))

(defun ndnmz-arrange-mail (entry)
  (narrow-to-region (point) (progn (re-search-forward "^$" nil t) (point)))
  (goto-char (point-min))
  (let ((case-fold-search t) start)
    (while (not (eobp))
      (setq start (point))
      (if (and (looking-at "\\([a-z-]+\\):")
	       (member (match-string 1) ndnmz-valid-mail-headers))
	  (forward-line)
	(forward-line)
	(delete-region start (progn (re-search-forward "^[a-z]" nil 0)
				    (match-beginning 0)))
	(beginning-of-line)))))

(defun ndnmz-arrange-html (entry)
  nil)


;;;
;:: Provide ndnmz
;;;

(put 'ndnmz ':setup 'ndnmz-setup)
(put 'ndnmz ':exit 'ndnmz-exit)

(put 'ndnmz ':search 'ndnmz-dictionary-search)
(put 'ndnmz ':content 'ndnmz-dictionary-content)
(put 'ndnmz ':open 'ndnmz-dictionary-open)

(put 'ndnmz 'methods ndnmz-search-methods)
(put 'ndnmz 'arranges ndnmz-default-arrange-functions)
(put 'ndnmz 'adjusts ndnmz-default-adjust-functions)

(provide 'ndnmz)

;;; ndnmz.el ends here
