;; -*- Emacs-Lisp -*-
;;; migemo.el - Japanese incremental search trough dynamic pattern expansion

;; $Id: migemo.el,v 1.1.1.1 2002/12/19 09:59:34 akihisa Exp $
;; Copyright (C) Satoru Takabayashi

;; Author: Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>
;; Keywords: 

;; This file 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 file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 

;;; Code:

(defvar migemo-ruby "ruby"
  "*Name or full path of the ruby executable.")

(defvar migemo-directory "/usr/local/share/migemo"
  "*Directory where migemo files are placed")

(defvar migemo-isearch-enable-p t
  "*Enable the migemo feature on isearch or not.")

;; -t emacs for specifying the type of regular expression.
;; -i "\\s *" is the pattern inserted into each 2 byte characters.
(defvar migemo-options (list "-t" "emacs")
  "*Options for migemo command")

(defvar migemo-dictionary
  (expand-file-name "migemo-dict" migemo-directory)
  "*Path of migemo dictionary.")

(defvar migemo-user-dictionary
  (expand-file-name "user-dict" migemo-directory)
  "*Path of migemo user dictionary.")

(defvar migemo-regex-dictionary
  (expand-file-name "regex-dict" migemo-directory)
  "*Path of migemo regex dictionary.")

(defvar migemo-coding-system
  (if (>= emacs-major-version 20)
      (if (featurep 'mule)
	  (if (string-match "XEmacs" emacs-version)
	      (cond
	       ((memq 'euc-japan-unix (coding-system-list)) 'euc-japan-unix)
	       ((memq 'euc-jp-unix (coding-system-list)) 'euc-jp-unix))
	    'euc-japan-unix))
    (and (boundp 'MULE) *euc-japan*unix))
  "*Default coding system for migemo.el")

(defvar migemo-use-pattern-alist t
  "*If non-nil, use a stored regex in Emacs.")

(defvar migemo-pattern-alist-length 512
  "*Maximal length of migemo-pattern-alist.")

(defvar migemo-pattern-alist-file "~/.migemo"
  "*Path of migemo alist file. If nil, don't save and restore the file.")

(defconst migemo-mw32-input-method (and (featurep 'meadow) "MW32-IME")
  "Support \"MW32-IME\" for Meadow.")

;; internal variables
(defvar migemo-process nil)
(defvar migemo-buffer nil)
(defvar migemo-current-input-method nil)
(defvar migemo-search-pattern nil)
(defvar migemo-pattern-alist nil "Alist of pattern vs regex.")

(defun migemo-toggle-isearch-enable ()
  (interactive)
  (setq migemo-isearch-enable-p (not migemo-isearch-enable-p))
  (message (if migemo-isearch-enable-p
	       "t"
	     "nil")))

(defun migemo-start-process (name buffer program args) 
  (let ((proc (apply 'start-process name buffer program args)))
    (if (fboundp 'set-process-coding-system)
	(set-process-coding-system proc 
				   migemo-coding-system 
				   migemo-coding-system)
      (set-process-input-coding-system  proc migemo-coding-system)
      (set-process-output-coding-system proc migemo-coding-system))
    proc))

(defun migemo-init ()
  (let ((proc migemo-process))
    (or (and proc (eq (process-status proc) 'run))
	(let ((options
	       (append migemo-options
		       (if (file-exists-p migemo-user-dictionary)
			   (list "-u" migemo-user-dictionary)
			 '())
		       (if (file-exists-p migemo-regex-dictionary)
			   (list "-r" migemo-regex-dictionary)
			 '())
		       (list migemo-dictionary))))
;	  (message (format "migemo %s" options))
	  (setq migemo-buffer (get-buffer-create " *migemo*"))
	  (setq migemo-process (migemo-start-process 
		 "migemo" migemo-buffer "migemo" options))
	  (process-kill-without-query migemo-process)
	  t))))

;; Must be worked with Emacs 19.28
(defun migemo-get-pattern (word)
  (when (and migemo-use-pattern-alist
	     migemo-pattern-alist-file
	     (null migemo-pattern-alist))
    (migemo-pattern-alist-load))
  (set-text-properties 0 (length word) nil word)
  (let* ((pattern (if isearch-case-fold-search (downcase word) word))
	 (alst (and migemo-use-pattern-alist
		    (assoc pattern migemo-pattern-alist)))
	 regex)
    (if alst
	(progn
	  (setq migemo-pattern-alist (cons alst (delq alst migemo-pattern-alist)))
	  (cdr alst))
  (migemo-init)
    (save-excursion
      (set-buffer (process-buffer migemo-process))
      (delete-region (point-min) (point-max))
      (process-send-string migemo-process (concat word "\n"))
      (while (not (and (> (point-max) 1)
		       (eq (char-after (1- (point-max))) ?\n)))
        (accept-process-output migemo-process 0 5))
	(prog1
	    (setq regex (buffer-substring (point-min) (1- (point-max))))
	  (when migemo-use-pattern-alist
	    (setq migemo-pattern-alist
		  (cons (cons pattern regex) migemo-pattern-alist))
	    (when (and migemo-pattern-alist-length
		       (> (length migemo-pattern-alist)
			  (* migemo-pattern-alist-length 2)))
	      (setcdr (nthcdr (1- (* migemo-pattern-alist-length 2))
			      migemo-pattern-alist) nil))))))))

(defun migemo-pattern-alist-load ()
  "Load migemo alist file."
  (when (and migemo-use-pattern-alist migemo-pattern-alist-file)
    (let ((file (expand-file-name migemo-pattern-alist-file))
	  (coding-system-for-read migemo-coding-system)
	  (file-coding-system-for-read migemo-coding-system))
      (when (and (file-readable-p file) (not (file-directory-p file)))
	(setq migemo-pattern-alist
	      (with-temp-buffer
		(insert-file-contents file)
		(goto-char (point-min))
		(condition-case err
		    (read (current-buffer))
		  (error
		   (message "Error while reading %s; %s"
			    (file-name-nondirectory file)
			    (error-message-string err))
		   nil))))))))

(defun migemo-pattern-alist-save ()
  "Save migemo alist file."
  (interactive)
  (when (and migemo-use-pattern-alist
	     migemo-pattern-alist-file
	     migemo-pattern-alist)
    (let ((file (expand-file-name migemo-pattern-alist-file))
	  (coding-system-for-write migemo-coding-system)
	  (file-coding-system  migemo-coding-system))
      (when (file-writable-p file)
	(when (and migemo-pattern-alist-length
		   (> (length migemo-pattern-alist) migemo-pattern-alist-length))
	  (setcdr (nthcdr (1- migemo-pattern-alist-length)
			  migemo-pattern-alist) nil))
	(with-temp-buffer
	  (if (fboundp 'pp)
	      (pp migemo-pattern-alist (current-buffer))
	    (prin1 migemo-pattern-alist (current-buffer)))
	  (write-region (point-min) (point-max) file nil 'nomsg))
	(setq migemo-pattern-alist nil)))))

(add-hook 'kill-emacs-hook 'migemo-pattern-alist-save)

(defun migemo-expand-pattern () "\
Expand the Romaji sequences on the left side of the cursor
into the migemo's regexp pattern."
  (interactive)
  (let ((pos (point)))
    (goto-char (- pos 1))
    (if (re-search-backward "[^-a-zA-Z]" (line-beginning-position) t)
	(forward-char 1)
      (beginning-of-line))
    (let* ((str (buffer-substring (point) pos))
	   (jrpat (migemo-get-pattern str)))
      (delete-region (point) pos)
      (insert jrpat))))

(defun migemo-forward (word &optional bound noerror count)
  (interactive "sSearch: \nP\nP")
  (if (delq 'ascii (find-charset-string word))
      (setq migemo-search-pattern word)
    (setq migemo-search-pattern (migemo-get-pattern word)))
  (search-forward-regexp migemo-search-pattern bound noerror count))

(defun migemo-backward (word &optional bound noerror count)
  (interactive "sSearch backward: \nP\nP")
  (if (delq 'ascii (find-charset-string word))
      (setq migemo-search-pattern word)
    (setq migemo-search-pattern (migemo-get-pattern word)))
  (search-backward-regexp migemo-search-pattern bound noerror count))

;; experimental
;; (define-key global-map "\M-;" 'migemo-dabbrev-expand)
(defun migemo-dabbrev-expand ()
  (interactive)
  (let ((end-pos (point)))
    (goto-char (- end-pos 1))
    (if (re-search-backward "[^a-z-]" (line-beginning-position) t)
	(forward-char 1)
      (beginning-of-line))
    (let* ((begin-pos (point))
	   (pattern (buffer-substring (point) end-pos)))
      (if (migemo-backward pattern 1 t)
	  (let ((found-pos (point)))
	    (delete-region begin-pos end-pos)
	    (forward-char 1)
	    (if (not (re-search-forward "\\>" (line-end-position) t))
		(end-of-line))
	    (let ((matched-string (buffer-substring found-pos (point))))
	      (goto-char begin-pos)
	      (insert matched-string)))
	(goto-char end-pos)
	(message (format "No dynamic expansion for `%s' found" pattern))))))

;; Use migemo-{forward,backward} instead of search-{forward,backward}.
(defadvice isearch-search (around migemo-search-ad activate)
  (let ((orig-search-forward  (make-symbol "orig-search-forward"))
	(orig-search-backward (make-symbol "orig-search-backward")))
    (if migemo-isearch-enable-p
	(progn
	  (fset orig-search-forward  (symbol-function 'search-forward))
	  (fset orig-search-backward (symbol-function 'search-backward))
	  (fset 'search-forward  (symbol-function 'migemo-forward))
	  (fset 'search-backward (symbol-function 'migemo-backward))))
    (unwind-protect
	ad-do-it
      (if migemo-isearch-enable-p
	  (progn
	    (fset 'search-forward  (symbol-function orig-search-forward))
	    (fset 'search-backward (symbol-function orig-search-backward)))))))

;; Turn off input-method automatically when C-s or C-r are typed.
(defadvice isearch-mode (before migemo-search-ad activate)
  (setq migemo-search-pattern nil)
  (when (and migemo-isearch-enable-p
	     (boundp 'current-input-method))
    (setq migemo-current-input-method current-input-method)
    (when (and migemo-mw32-input-method
	       (stringp migemo-current-input-method)
	       (string= migemo-current-input-method migemo-mw32-input-method))
      (set-input-method nil))
    (setq current-input-method nil)))

(defadvice isearch-done (after migemo-search-ad activate)
  (setq migemo-search-pattern nil)
  (when (and migemo-isearch-enable-p
	     (boundp 'current-input-method))
    (when (and migemo-mw32-input-method
	       (stringp migemo-current-input-method)
	       (string= migemo-current-input-method migemo-mw32-input-method))
      (set-input-method migemo-current-input-method))
    (setq current-input-method migemo-current-input-method)))

;;;; for isearch-lazy-highlight (Emacs 21)
;; Avoid byte compile warningsfor other emacsen
(defvar isearch-lazy-highlight-wrapped)
(defvar isearch-lazy-highlight-start)
(defvar isearch-lazy-highlight-end)

(defun migemo-isearch-lazy-highlight-search ()
  "Search ahead for the next or previous match, for lazy highlighting.
Attempt to do the search exactly the way the pending isearch would.
This function used with Megemo feature."
  (let ((case-fold-search isearch-case-fold-search)
        (choices (cond (isearch-word
                        '(word-search-forward . word-search-backward))
                       ((or isearch-regexp migemo-search-pattern)  ;; mod.
                        '(re-search-forward . re-search-backward))
                       (t
                        '(search-forward . search-backward)))))
    (funcall (if isearch-forward
                 (car choices)
               (cdr choices))
	     (or migemo-search-pattern isearch-string) ;; mod.
             (if isearch-forward
                 (if isearch-lazy-highlight-wrapped
                     isearch-lazy-highlight-start
                   (window-end))
               (if isearch-lazy-highlight-wrapped
                   isearch-lazy-highlight-end
                 (window-start)))
             t)))

(if (fboundp 'isearch-lazy-highlight-search)
    (defalias 'isearch-lazy-highlight-search 'migemo-isearch-lazy-highlight-search))

;;;; for isearch-highlightify-region (XEmacs 21)
;; Avoid byte compile warningsfor other emacsen
(defvar isearch-highlightify-region)

(if (fboundp 'isearch-highlightify-region)
    (defadvice isearch-highlightify-region (around migemo-highlightify-region
						   activate)
      (let ((isearch-string (migemo-get-pattern isearch-string))
	    (isearch-regexp t))
	ad-do-it)))

(provide 'migemo)

;; sample
;; 0123 abcd ABCD ひらがな カタカナ 漢字 !"[#\$]%^&_':`(;)<*=+>,?-@./{|}~