;;; suikyo.el --- Romaji-Hiragana conversion library for Emacs
;; $Id: suikyo.el,v 1.4 2005/01/16 13:59:53 komatsu Exp $
;;
;; Copyright (C) 2002 Hiroyuki Komatsu <komatsu@taiyaki.org>
;;     All rights reserved.
;;     This is free software with ABSOLUTELY NO WARRANTY.
;;
;; You can redistribute it and/or modify it under the terms of 
;; the GNU General Public License version 2.
;;

(load "suikyo-config")
;(defvar suikyo-table-path "/usr/local/share/suikyo/conv-table")

(defvar suikyo-buffer " *suikyo*")
(defvar suikyo-table-romaji-kana nil)
(defvar suikyo-table-kana-romaji nil)

(defun suikyo-convert-romaji-kana (string)
  (or suikyo-table-romaji-kana
      (setq suikyo-table-romaji-kana
	    (suikyo-table-loadfile (list nil) "romaji-kana"))
      )
  (suikyo-convert suikyo-table-romaji-kana (downcase string))
  )

(defun suikyo-convert-kana-romaji (string)
  (or suikyo-table-kana-romaji
      (setq suikyo-table-kana-romaji
	    (suikyo-table-loadfile (list nil) "kana-romaji"))
      )
  (suikyo-convert suikyo-table-kana-romaji (downcase string))
  )

(defun suikyo-convert-romaji-refine (string)
  (suikyo-convert-kana-romaji
   (suikyo-convert-romaji-kana string))
  )

(defun suikyo-convert (table string)
  (let ((conv-str "")
	(original-table (list nil nil table)))
    (while (> (length string) 0)
      (let ((tmp-str "")
	    (table original-table)
	    conv-data head-char)
	(while (and (nth 2 table)
		    (> (length string) 0))
	  (setq head-char (substring string 0 1))
	  (setq table (assoc head-char (nth 2 table)))
	  (and (or table (string= tmp-str ""))
	       (or (string= head-char " ")
		   (setq tmp-str (concat tmp-str head-char)))
	       (setq conv-data (nth 1 table)
		     string (substring string 1)))
	  )
	(cond 
	 ((nth 2 table)
	  (setq conv-str (concat conv-str tmp-str)))
	 ((null conv-data)
	  (setq conv-str (concat conv-str tmp-str)))
	 ((consp conv-data)
	  (setq conv-str (concat conv-str (car conv-data))
		string (concat (cdr conv-data) string)))
	 (t
	  (setq conv-str (concat conv-str conv-data)))
	 )
	))
    conv-str
    ))

(defun suikyo-table-loadfile (table filename &optional table-path)
  (or (string-match "^/" filename)
      (setq filename (expand-file-name
		      (concat (or table-path suikyo-table-path)
			      "/" filename))))
  (if (not (file-readable-p filename))
      table
    (save-excursion
      (get-buffer-create suikyo-buffer)
      (set-buffer suikyo-buffer)
      (erase-buffer)
      (insert-file filename)
      (beginning-of-buffer)

      (let ((bol (point))
	    next-bol
	    data
	    comment-flag)
	(while (not (eobp))
	  (forward-line 1)
	  (setq next-bol (point))
	  (setq line (buffer-substring bol (1- next-bol)))
	  (setq bol next-bol)
	  (and (string-match "^/\\*" line)
	       (setq comment-flag t))
	  (cond
	   ((not (or comment-flag
		     (string-match "^#\\|^[ \\t]*$" line)))
	    (setq table (apply 'suikyo-table-modify
			       table (suikyo-split-string line))))
	   ((and comment-flag
		 (string-match "\\*/" line))
	    (setq comment-flag nil))
	   )))
      table)))

(defun suikyo-table-modify (table conv-from &optional conv-to pendency)
  (if conv-to
      (suikyo-table-set table conv-from &optional conv-to pendency)
    (suikyo-table-unset table conv-from)))

(defun suikyo-table-set (table conv-from &optional conv-to pendency)
  (if (= (length conv-from) 1)
      ;; Terminal of recursive execution
      (setcar (nthcdr 1 (suikyo-table-set-internal table conv-from))
	      (if pendency (cons conv-to pendency) conv-to))

    (let ((sub-table (suikyo-table-set-internal 
		      table (substring conv-from 0 1))))
      (if (= (length sub-table) 2)
	  (nconc sub-table (list (list nil))))
      (suikyo-table-set (nth 2 sub-table)
			 (substring conv-from 1) conv-to pendency)
      ))
  table)

(defun suikyo-table-set-internal (table char)
  (or (assoc char table)
      (if (equal table '(nil))
	  (setcar table (list char nil))
	(car (last (nconc table (list (list char nil)))))
	)))

(defun suikyo-table-unset (table key)
  "Delete the conversion of the KEY from the TABLE."
  (let* ((head (substring key 0 1))
	 (rest (substring key 1))
	 (word-data (assoc head table)))
    (if (= (length rest) 0)
	(if (= (length (nth 2 word-data)) 0) ;; Checking the child tree.
	    (mell-list-delete word-data table)
	  (setcar (cdr word-data) nil))
      (let ((new-subtable (suikyo-table-unset (nth 2 word-data) rest)))
	(if new-subtable
	    (setcdr (cdr word-data) (list new-subtable))
	  (mell-list-delete word-data table))))
    table))

(defun mell-list-delete (key list)
  "This deletes the KEY from the LIST.  The original list is also modified."
  (let ((list-cdr (member key list)))
    (cond
     ((= (length list-cdr) 1)
      (setcar (nthcdr (- (length list) 1) list) nil)
      (setcdr (nthcdr (- (length list) 2) list) nil))
     (list-cdr
      (setcar list-cdr (nth 1 list-cdr))
      (setcdr list-cdr (nthcdr 2 list-cdr))))))

(defun suikyo-split-string (line)
  (mapcar 'suikyo-unescape
	  (split-string line "\t")
	  ))

(defun suikyo-unescape (string)
  "Unescape string of kpdef format (canna format)."
  (let ((unescaped-string ""))
    (while (string-match "\\\\" string)
      (let ((beg (match-beginning 0))
	    (end (match-end 0))
	    (len (length string))
	    next-char)
	(setq next-char (substring string end (min (1+ end) len)))
	(cond
	 ((string= next-char "x")
	  (setq next-char
		(char-to-string
		 (string-to-int 
		  (substring string (1+ end) (min (+ end 3) len)) 16
		  )))
	  (setq end (min (+ end 2) len))
	  )
	 ((string= next-char "0")
	  (setq next-char "")
	  ))
	(setq unescaped-string
	      (concat unescaped-string (substring string 0 beg) next-char))
	(setq string (substring string (min (1+ end) len)))
	))
    (concat unescaped-string string)
    ))

(provide 'suikyo)