;;;-*-EMACS-LISP-*-

;;; Japanese->English Dictionary Lookup for NEmacs and Mule.
;;; Written by Leigh L. Klotz, Jr. May 17, 1993
;;; klotz@adoc.xerox.com
;;; This file is in the public domain.  However, if you make improvements,
;;; please try to share them.
;;;
;;;
;;; This file implements a primitive Japanese->English dictionary
;;; for NEmacs and Mule.
;;;
;;; It uses "edict," a public domain Japanese/English dictionary file,
;;; coordinated by Jim Breen.
;;;
;;; The master copy of the file 'edict' is in the pub/Nihongo directory of 
;;; monu6.cc.monash.edu.au.
;;;
;;; There are other copies at other archive sites around the world.
;;;
;;; Tested with Mule version "0.9.8 PL06".
;;; Tested with Nemacs version "3.3.2".
;;;

(defvar mulep (fboundp 'mule-version))
(defvar nemacsp (fboundp 'nemacs-version))

(defvar edict-filename "/adoc/klotz/src/@Japanese/edict/edict"
  "*Set this variable to point to the location of the 'edict' text file,
for the \\[edict-japanese-lookup] command.")

(defvar edict-japanese-lookup-inserts-english-only nil
  "*In \\[negative-argument] \\[edict-japanese-lookup]
default value nil means to insert the Japanese key, the kana
pronounciation, and English definition. 
Set this variable to T to have the command insert only 
the English definition.")


;;;
;;; Key Bindings & Setup Hook
;;;
;;; Default key binding is M-J (J for Japanese).
;;; If edict-setup-hook is non-nil, run it instead.
;;;
(defvar edict-setup-hook nil 
  "*Default key binding for \\[edict-japanese-lookup] is M-J (J for Japanese).
If edict-setup-hook is non-nil, run it instead of performing this key binding.")

(if (null edict-setup-hook)
    (global-set-key "\ej" 'edict-japanese-lookup)
  (run-hooks edict-setup-hook))



;;;
;;; The main entry point.
;;;
;;; Bugs: Gives errors too close to end of buffer.  Depends on
;;; error checking in edict-chars-buffer-n-substring.
(defun edict-japanese-lookup (n-characters)
  "Lookup string at point in a Japanese-English dictionary, and display
the definition incrementally in the message area.

A prefix argument (given by \\[universal-argument]) specifies the maximum 
number of characters to search for.  The default is 4 characters.

If arg is negative (\\[negative-argument] \\[edict-japanese-lookup]), insert results into buffer
instead of printing them in the message area.  By default,
inserts the Japanese key, the kana pronounciation, and the English
definition.  If edict-japanese-lookup-inserts-english-only is t (default
nil), then insert only the English definition."

  (interactive "p")
  (let ((insert-flag (and current-prefix-arg (< n-characters 0))))
    (if insert-flag (setq n-characters (- n-characters)))
    (let ((result 
	   (edict-japanese-lookup-string
	    (edict-chars-buffer-n-substring (point)
					    (if (null current-prefix-arg)
						4
					      n-characters)))))
      (message result)
      (if insert-flag (insert 
		       (if edict-japanese-lookup-inserts-english-only
			   (edict-definition-english-part result)
			 result))))))

(defun edict-japanese-lookup-string (s)
  "Given a string s, finds the greatest initial substring of it in
the edict dictionary buffer and returns it."
  (save-excursion
    (set-buffer (find-file-noselect edict-filename))
    (let ((pos (or (edict-japanese-lookup-string-1 s t) 
		   (edict-japanese-lookup-string-1 s nil))))
      (if pos
	  (progn 
	    (goto-char pos) (end-of-line)
	    (buffer-substring pos (point)))))))

(defun edict-japanese-lookup-string-1 (s spacep)
  "Given a string, search iteratively for initial substrings of it
in the edict buffer.  Display progress."
  (let ((found nil)
	(i 1))
    (catch 'found
      (while t
       (if (> i (chars-in-string s)) (throw 'found found))
       (goto-char (point-min))
       ;; Don't use re-search-forward with "^" because it's slow in Mule
       (if (search-forward 
	    (concat "\n"
		    (let ((it (concat (edict-chars-n-substring s 0 i)
				      (if spacep " " ""))))
		      (message it)
		      it))
	    nil
	    t)
	   (progn
	     (beginning-of-line)
	     (setq found (point))
	     (message (format "%s" found))))
       (setq i (+ i 1))))))

(defun edict-definition-english-part (s)
  (let ((i 0))
    (catch 'result
      (while t
       (if (= (aref s i) ?/) (throw 'result (substring s i (length s))))
       (setq i (+ i 1))
       (if (> i (length s)) (throw 'result ""))))))

;;;
;;; New functions for character handling to make up for missing
;;; or misunderstanding of Mule and Nemacs functionality.
;;;
;;; If anyone knows how to do this right, please let me know.
;;;
;;; Doing it right would mean we could put the "min" check
;;; in the caller of edict-chars-buffer-n-substring instead of
;;; inside it.

(if nemacsp (progn
;;; Mule has this, but Nemacs doesn't.  So, just define a function
;;; of the same name in Nemacs.
;;; Bugs: Works only for homogeneous Japanese strings.
    (defun chars-in-string (s) (/ (length s) 2))

;;; Bugs: Works only for homogeneous Japanese strings.
;;; Could iterate over string using char-width.
  (defun edict-chars-n-substring (s start len)
    (substring s start (* len 2)))

;;; Bugs: Works only for homogeneous Japanese strings.
;;; Could iterate over string using char-width.
  (defun edict-chars-buffer-n-substring (start len)
    (buffer-substring start
		      (min (- (point-max) start)
			   (+ start (* 2 len)))))
))

(if mulep (progn
;;; In Mule, there ought to be some substring function that does
;;; this right.  I must be missing something.
;;;
;;; Bugs: Works only for homogeneous Japanese strings.
;;; Could iterate over string using char-width.
  (defun edict-chars-n-substring (s start len)
    (substring s start (* len 3)))

;;; In Mule, there ought to be some buffer-substring function that does
;;; this right.  I must be missing something.
;;;
;;; Bugs: Works only for homogeneous Japanese strings.
;;; Could iterate over string using char-width.
  (defun edict-chars-buffer-n-substring (start len)
    (buffer-substring start
		      (min (- (point-max) start)
			   (+ start (* 3 len)))))
))