;;; skk-exsearch.el --- 外部検索プログラム共用 interface -*- coding: iso-2022-jp -*-

;; Copyright (C) 2000 NAKAJIMA Mikio <minakaji@osaka.email.ne.jp>

;; Author: NAKAJIMA Mikio <minakaji@osaka.email.ne.jp>
;; Maintainer: SKK Development Team <skk@ring.gr.jp>
;; Keywords: japanese

;; This file is part of Daredevil SKK.

;; 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 3 of
;; the License, 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.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file needs eieio package (which provides CLOS like OO
;; programming) that can be found at;

;;   ftp://ftp.ultranet.com/pub/zappo

;; This program may be (or may not be) a core engine of external
;; searching program of Daredevil (or some other new branch) SKK.

;;; Code:

(eval-when-compile
  (require 'skk-macs)
  (require 'skk-vars))
(require 'path-util) ; for exec-installed-p.
(require 'eieio)

(defvar skk-grep-dic
  "/usr/local/share/skk/SKK-JISYO.L"
  "*grep search dictionary.")

(defclass search-engine ()
  ((program :initarg :program
            :initform nil
            :documentation "Program file.")
   ;;(argument :initarg :argument :initform nil :documentation "")
   (dictionary :initarg :dictionary
               :initform nil
               :documentation "Dictionary file to be searched."))
  "External search engine superclass.")

(defclass synchronous-search-engine (search-engine)
  ((infile :initarg :infile
           :initform nil
           :documentation
           "This is where the program's input comes from. (nil means `/dev/null').")
   (stderr :initarg :stderr
           :initform t
           :documentation "What to do with standard error in the child.\
nil (discard standard error output), t (mix it with ordinary output),\
or a file name string.")
   (success-exit-code :initarg :success-exit-code
                      :initform 0
                      :documentation "Numeric exit status of success.")
   (error-exit-code :initarg :error-exit-code
                    :initform 2
                    :documentation "Numeric exit status of error."))
  "External synchronous search engine class.")

(defclass regular-engine (synchronous-search-engine)
  ((coding-system :initarg :coding-system
                  :initform (lambda () (skk-find-coding-system skk-jisyo-code))))
  "Regular search engine type.
Call program synchronously in separate process.
Output of this type is a line that contains candidates delimited by slash.")


(defclass grep-engine (synchronous-search-engine)
  ((coding-system :initarg :coding-system
                  :initform (lambda () (skk-find-coding-system skk-jisyo-code))))
  "Regular search engine type for grep search.
Call program synchronously in separate process.
Output of this type is a line that contains candidates delimited by slash.")


(defclass look-engine (synchronous-search-engine)
  (())
  "look type.
Call program synchronously in separate process.
This type inserts multiple lines to the buffer.  Each line contains a candidate.")

(defmethod setup-synchronous-engine ((engine synchronous-search-engine))
  (and (slot-exists-p engine 'coding-system)
       ;; return nil if cdbget executable binary does not installed.
       (slot-value engine 'program)
       (with-slots ((code coding-system)) engine
         (if (and code (fboundp 'modify-coding-system-alist))
             (modify-coding-system-alist
              'process (oref engine program) (cons code code))))))

(defvar cdbget (make-instance regular-engine
                              :program (exec-installed-p "cdbget")
                              :infile "/usr/local/share/skk/SKK-JISYO.L.cdb")
  "*cdbget search engine object.")
(setup-synchronous-engine cdbget)

(defvar grep (make-instance grep-engine :program
                            (exec-installed-p "grep")
                            :infile skk-grep-dic)
  "*grep search engine object.")

(setup-synchronous-engine grep)

(defvar look (make-instance look-engine :program
                            (exec-installed-p "look"))
  "*look search engine object.")


(defmethod core-engine ((engine synchronous-search-engine) argument)
  ;; core search engine
  (save-excursion
    (let ((exit-code (apply 'call-process (oref engine program)
                            (oref engine infile)
                            (list t     ;output to current buffer.
                                  (oref engine stderr))
                            nil
                            argument))
          error)
      (cond ((and (= (oref engine success-exit-code) exit-code)
                  (> (buffer-size) 0)))
            ((>= exit-code (oref engine error-exit-code))
             (error (buffer-substring-no-properties (point-min) (point-max))))))))

(defmethod search-engine ((engine regular-engine) &rest argument)
  (let ((okurigana (or skk-henkan-okurigana skk-okuri-char))
        l)
    (with-temp-buffer
      (if (core-engine engine argument)
          (progn
            (forward-char 1)
            (and (setq l (skk-compute-henkan-lists okurigana))
                 (cond ((and okurigana skk-henkan-okuri-strictly)
                        (nth 2 l))
                       ((and okurigana skk-henkan-strict-okuri-precedence)
                        (skk-nunion (nth 2 l) (car l)))
                       (t (car l)))))))))

(defmethod search-engine ((engine grep-engine) &rest argument)
  (let ((okurigana (or skk-henkan-okurigana skk-okuri-char))
        (tmparg argument)
        l)
    (with-temp-buffer
      (setq argument (cons (concat "^" (car tmparg) " ") nil))
      (if (core-engine engine argument)
          (progn
            (while (not (eq (char-after) ?/))
              (forward-char 1))
            (forward-char 1)
            (and (setq l (skk-compute-henkan-lists okurigana))
                 (cond ((and okurigana skk-henkan-okuri-strictly)
                        (nth 2 l))
                       ((and okurigana skk-henkan-strict-okuri-precedence)
                        (skk-nunion (nth 2 l) (car l)))
                       (t (car l)))))))))



(defmethod search-engine ((engine look-engine) &rest argument)
  (with-temp-buffer
    (let ((word argument)
          opt)
      (and (oref engine dictionary)
           (nconc argument (list (oref engine dictionary))))
      (and skk-look-dictionary-order (setq opt "d"))
      (and skk-look-ignore-case (setq opt (concat "f" opt)))
      (and skk-look-use-alternate-dictionary
           (setq opt (concat "a" opt)))
      (and opt (setq argument (cons (concat "-" opt) argument)))
      (and skk-look-termination-character
           (setq argument
                 (cons (list "-t" skk-look-termination-character) argument)))
      (and (core-engine engine argument)
           (delete word (split-string (buffer-substring-no-properties
                                       (point-min) (1- (point-max)))
                                      "\n"))))))

;;;###autoload
(defun skk-cdbget-search ()
  (search-engine cdbget (if skk-use-numeric-conversion
                            (skk-num-compute-henkan-key skk-henkan-key)
                          skk-henkan-key)))

;;;###autoload
(defun skk-grep-search ()
  (search-engine grep (if skk-use-numeric-conversion
                          (skk-num-compute-henkan-key skk-henkan-key)
                        skk-henkan-key)))

;;;###autoload
(defun skk-look-search ()
  (and skk-abbrev-mode
       (eq (aref skk-henkan-key (1- (length skk-henkan-key))) ?*)
       (let ((args (substring skk-henkan-key 0 (1- (length skk-henkan-key))))
             v)
         (if (not skk-look-use-ispell)
             (setq v (search-engine look args))
           (setq v (skk-look-ispell args)))
         (if (not skk-look-recursive-search)
             v
           (let (skk-henkan-key v2 v3)
             (while v
               (let ((skk-current-search-prog-list (copy-sequence skk-search-prog-list)))
                 (setq skk-current-search-prog-list
                       (delete '(skk-look) skk-current-search-prog-list))
                 (setq skk-current-search-prog-list
                       (delete '(skk-look-search) skk-current-search-prog-list))
                 (setq skk-henkan-key (car v))
                 (while skk-current-search-prog-list
                   (setq v3 (skk-search)
                         v2 (if (not skk-look-expanded-word-only)
                                (skk-nunion v2 (cons (car v) v3))
                              (if v3
                                  (skk-nunion v2 (cons (car v) v3))
                                v2)))))
               (setq v (cdr v)))
             v2)))))

(provide 'skk-exsearch)

;; Local Variables:
;; indent-tabs-mode: nil
;; End:

;;; skk-exsearch.el ends here
