;;;
;;;	$Date: 2002/07/06 04:35:39 $
;;;	$Revision: 1.7 $
;;;

(provide 'pobox)
(require 'romakana "romakana.el")

(defvar pobox-toggle-key "\C-j")
(defvar pobox-server "localhost")
(defvar pobox-port 1178) ; skkservと同じポート... SKKでも使える?
(defvar pobox-server-process "poboxserver")
(defvar pobox-server-process-name "poboxserver")

;;; 
;; 以下のように設定すればピリオドキーなどで直接句読点を入力可能

(defvar pobox-direct-keymap
      '((?. "。")
        (?, "、")
        (?[ "「")
        (?] "」")
        ))

;; Emacs18の場合必要
;; (defun member (e l)
;;   (if (null l) nil
;;     (if (equal e (car l)) l
;;       (member e (cdr l)))))

;; 変換モード設定
(setq pobox-predict-after-fix ;; 確定した後次の単語を予測
      (and (boundp 'pobox-predict-after-fix)
	   pobox-predict-after-fix))

(defvar pobox-original-local-map nil)
(defvar pobox-local-map nil)		; POBoxモードのキーマップ
(defvar pobox-conv-local-map nil)	; パタン入力中のキーマップ

(defun pobox-reset ()
  (setq pobox-pat "") ; 検索パタン
  (setq pobox-cands nil)
  (setq pobox-nth-cand 0) ; いくつめの候補を選択しているか
  (setq pobox-curstr-begin (point))
  (setq pobox-curstr-end (point))
  (setq pobox-curstr "")	; テンポラリに選択/表示されている文字列
  (setq pobox-cand-list-begin (point))
  (setq pobox-cand-list-end (point))
  (setq pobox-exact nil)
  )

(defun pobox-finish (arg)
  (interactive "P")
  (pobox-save-dict)
  (pobox-fix pobox-curstr)
  (pobox-erase-cand-list)
  (process-send-string pobox-server-process-name "0") ; サーバから切断
  (delete-process pobox-server-process-name)
  (use-local-map pobox-original-local-map)
  (setq mode-line-format pobox-original-mode-line-format)
  )

;; 入力位置の直前の文字列を得る
(defun pobox-context ()
  (save-excursion
    (let ((p (point)) (i 8))
      (while (and (> i 0) (> (point) 1))
	(backward-char 1)
	(setq i (1- i))
	)
      (buffer-substring (point) p)
      )))
 
;; 直前の入力文字を調べる
;;(defun pobox-last-char ()
;;  last-input-char)

(defun pobox-last-char ()
  (let (s len c)
    (setq s (recent-keys))
    (setq len (length s))
    (if (stringp s) ;; Emacs18の場合
	(aref s (- len 2))
      (setq c (aref s (- len 2)))
      (if (fboundp 'key-press-event-p) ;; Xemacsの場合
	  (setq c (event-key c)))
      (cond
       ((integerp c) c)
       ((eq c 'backspace) 8)
       ((eq c 'enter) 13)
       ((eq c 'return) 13)
       ((eq c 'escape) 27)
       ((eq c 'delete) 127)
       ((eq c 'space) 32)
       (t 0)
       ))
    ))

;; 直前の入力文字が a〜z などパタン文字かどうかチェック
(defun pobox-last-char-is-pat ()
  (let ((c (pobox-last-char)))
    (and (>= c 32) (< c 127))))

;; n番目の候補を得る。最初の候補は0番目。
(defun pobox-nth-candidate (n)
  (let (s)
    (setq s (nth n pobox-cands))
    (if (stringp s) s "")
    ))

;; 候補リスト表示を消す
(defun pobox-erase-cand-list ()
  (if (not (= pobox-cand-list-begin pobox-cand-list-end))
      (delete-region pobox-cand-list-begin pobox-cand-list-end))
  (setq pobox-cand-list-begin (point))
  (setq pobox-cand-list-end (point))
  )

;; テンポラリに表示しているパタンを消す
(defun pobox-erase-curstr ()
  (if (not (= pobox-curstr-begin pobox-curstr-end))
      (delete-region pobox-curstr-begin pobox-curstr-end))
  (setq pobox-curstr-begin (point))
  (setq pobox-curstr-end (point))
  )

;; テンポラリ表示パタンを設定して表示
(defun pobox-set-curstr (str)
  (pobox-erase-curstr)
  (setq pobox-curstr str)
  (insert "[" pobox-curstr "]")
  (setq pobox-curstr-end (point))
  )

;; 候補リストをカーソルの1行下に表示
(defun pobox-disp-cand-list ()
  (let ((i pobox-nth-cand) col)
    (save-excursion
      (goto-char pobox-curstr-begin)
      (setq col (current-column))
      (end-of-line)
      (setq pobox-cand-list-begin (point))
      (insert "\n")
      (insert (make-string col 32))
      (while (and (< i (+ pobox-nth-cand 10)) (nth i pobox-cands))
	(insert "(" (pobox-nth-candidate i) ")")
	(setq i (1+ i))
	)
      (setq pobox-cand-list-end (point))
      )))

(defun pobox-send-command-and-wait (command)
  (save-excursion
    (let ((cont t))
      (set-buffer "*pobox*")
      (erase-buffer)
      (process-send-string pobox-server-process-name command)
      (while (and cont (process-status pobox-server-process-name))
	(accept-process-output pobox-server-process)
	(if (> (buffer-size) 0)
	    (setq cont nil))
	)
      (erase-buffer)
      )))

(defun pobox-register (word pat)
  (pobox-send-command-and-wait (format "5%s %s\n" word pat)))

(defun pobox-register-region (arg)
  (interactive "i")
  (let (word pat)
    (setq word (buffer-substring (mark) (point)))
    (setq pat (read-from-minibuffer
		(concat "単語登録:「" word "」の読み(ローマ字): ")))
    (pobox-register word pat)
    ))

;;  (let ((n (- pobox-nth-cand pobox-extra-cands)))
(defun pobox-select (word)
  (let ((n pobox-nth-cand))
    (if (> n 0)
	(pobox-send-command-and-wait
;;;	 (format "8%d\n" (if pobox-exact n (1- n))))
	 (format "8%d\n" (1- n)))
;;	(pobox-send-command-and-wait (format "8%d\n" (1- n)))
;;      (pobox-register (pobox-nth-candidate (1- pobox-nth-cand)) pobox-pat)
      (pobox-register word pobox-pat)
      )))

(defun pobox-fix (cand) ; 候補をcandに確定
;;  (if (> pobox-nth-cand 0)
;;      (pobox-select))
  (pobox-select cand)

  (pobox-erase-cand-list)
  (pobox-erase-curstr)
  (insert cand)
  (pobox-reset)
  )

(defun pobox-delete-word (word)
  (pobox-send-command-and-wait (format "6%s %s\n" word pobox-pat)))

(defun pobox-ctrl-q (arg)
  (interactive "P")
  (pobox-delete-word pobox-curstr)
  (pobox-selcand)
  )

(defun pobox-ctrl-k (arg)
  (interactive "P")
  (setq pobox-cands (pobox-search pobox-pat t))
  (pobox-fix (pobox-nth-candidate 1))
;;;  (pobox-fix (roma2kana pobox-pat))
  (use-local-map pobox-local-map)
  )

(defun pobox-save-dict ()
  (pobox-send-command-and-wait "7\n"))

(defun pobox-keyin (arg)
  (interactive "P")
  (let ((d (assoc last-input-char pobox-direct-keymap)))
    (if d 
      (progn
	(pobox-fix pobox-curstr)
	(insert (nth 1 d))
	(use-local-map pobox-local-map)
	)
      (use-local-map pobox-conv-local-map)
      (setq case-fold-search nil)

      (if (> pobox-nth-cand 0) ; 候補選択後
	  (pobox-fix pobox-curstr)
	(pobox-erase-cand-list)
	(if (not (or (and (>= last-input-char ?a) (<= last-input-char ?z))
		     (= last-input-char ?-) (= last-input-char ?')))
	    (pobox-fix (pobox-nth-candidate pobox-nth-cand))
	  ))

;;      (if (not (and (>= last-input-char ?a) (<= last-input-char ?z)))
;;	  (pobox-fix (pobox-nth-candidate pobox-nth-cand))
;;	;; ローマ字に変換できない文字が入力されたときはそれまでの文字列をひらがなに確定
;;	;; (SKKのような雰囲気になる)
;;	(if (and (not (or (and (>= last-input-char ?a) (<= last-input-char ?z))
;;			  (= last-input-char ?-) (= last-input-char ?')))
;;		 (string-match "^[a-z]+$" pobox-pat))
;;	    (progn
;;	      ;;(setq last-input-char (+ last-input-char (- ?a ?A)))
;;	      (if (> pobox-nth-cand 0)
;;		  (pobox-fix pobox-curstr)
;;		(setq pobox-cands (pobox-search pobox-pat t))
;;		(pobox-fix (pobox-nth-candidate 0))
;;		)
;;;;;    	   (kata2hira (roma2kana pobox-pat))))
;;      )
;;	  (if (> pobox-nth-cand 0)  ; 候補選択後
;;	      (pobox-fix pobox-curstr)
;;	    (pobox-erase-cand-list)
;;	    )
;;	  )
;;	)


;;  ;; カーソル移動などで別のところに行ってしまったときは
;;  ;; サーバにコンテクストを知らせる。
;;  (if (not (or (pobox-last-char-is-pat) ; 新しいパタン指定開始
;;	       (= (pobox-last-char) 32)
;;	       (= (pobox-last-char) 127)
;;	       (= (pobox-last-char) ?\C-H)
;;	       (= (pobox-last-char) ?\C-M)
;;	       (= (pobox-last-char) ?\C-J)
;;	       (> (length pobox-pat) 0)
;;	       ))
;;      (let ((cont t))
;;	(pobox-erase-curstr) ; 変換中のものを消す
;;	(pobox-reset)
;;	(setq pobox-curstr-begin (point))
;;	;; コンテクストをサーバに教える
;;	(pobox-send-command-and-wait (format "4%s\n" (pobox-context)))
;;	(goto-char pobox-curstr-begin)
;;	))
      (if pobox-exact (pobox-fix pobox-curstr))
      (setq pobox-pat (concat pobox-pat (char-to-string last-input-char)))
      (setq yyy pobox-pat)
      (pobox-set-curstr pobox-pat)
      (if (or (> pobox-nth-cand 0) t)
          (progn
    	(setq pobox-cands (pobox-search pobox-pat))
    	(pobox-disp-cand-list)
       	))
    ))
  )

(defun pobox-space (arg)
  (interactive "P")
  (if (or pobox-cands (> (length pobox-pat) 0))
      (pobox-selcand))
  )

(defun pobox-selcand ()
  (let ((i pobox-nth-cand))
    (pobox-erase-cand-list)
    (pobox-set-curstr (pobox-nth-candidate pobox-nth-cand))
    (setq pobox-nth-cand (1+ pobox-nth-cand))
    (pobox-disp-cand-list)
    ))

(defun pobox-prevcand ()
  (if (> pobox-nth-cand 0)
      (progn
	(pobox-erase-cand-list)
	(setq pobox-nth-cand (1- pobox-nth-cand))
	(pobox-set-curstr
	      (if (> pobox-nth-cand 0)
		  (pobox-nth-candidate (1- pobox-nth-cand))
		pobox-pat))
	(pobox-disp-cand-list)
	)))

(defun pobox-newline (arg)
  (interactive "P")
  (if (and pobox-cands (> pobox-nth-cand 0))
      (progn
	(pobox-fix pobox-curstr)
	(if pobox-predict-after-fix
	    (progn
	      (setq pobox-cands (pobox-search pobox-pat))
	      (pobox-disp-cand-list))
	  (use-local-map pobox-local-map)
	  ))
    (if (not (string= pobox-pat ""))
	(if pobox-exact
	    (progn
	      (pobox-fix pobox-curstr)
	      (use-local-map pobox-local-map)
	      )
;;	    (let (s)
;;	      (setq s (kata2hira (roma2kana pobox-pat)))
;;	      (if (= (length s) 0)
;;		  (setq s (pobox-nth-candidate 0)))
;;	      (pobox-set-curstr s)
;;	      (pobox-fix s)
;;	      (use-local-map pobox-local-map)
;;	      )
	  ;; 完全マッチモードに移行
	  (pobox-erase-cand-list)
	  (setq pobox-exact t)
	  (setq pobox-cands (pobox-search pobox-pat t)) ; 完全マッチを検索

	  (pobox-set-curstr (pobox-nth-candidate 0))
	  (setq pobox-nth-cand (1+ pobox-nth-cand))
;;;	  (setq pobox-cands (cdr pobox-cands))

;;	  (let (s)
;;	    (setq s (kata2hira (roma2kana pobox-pat)))
;;	    (if (= (length s) 0)
;;		(setq s (pobox-nth-candidate 0)))
;;	    (pobox-set-curstr s))
;;	  ;;(pobox-set-curstr (kata2hira (roma2kana pobox-pat)))
	  (pobox-disp-cand-list)
	  )
      (if pobox-cands
	  (progn
	    (pobox-fix pobox-pat)
	    (use-local-map pobox-local-map)
	    )
	(pobox-erase-cand-list)
	(use-local-map pobox-local-map)
	(newline)
	)
      )
    ))

(defun pobox-ctrl-g-xxx (arg)
  (interactive "P")
;;  (if (or pobox-cands (> (length pobox-pat) 0))
;;      (pobox-fix pobox-curstr)
;;    (keyboard-quit)
;;    )
  (if pobox-cands
      (pobox-fix pobox-curstr)
    (keyboard-quit)
    )
  )

(defun pobox-ctrl-g (arg)
  (interactive "P")
  (pobox-erase-cand-list)
  (pobox-erase-curstr)
  (insert pobox-pat)
  (pobox-reset)
  (use-local-map pobox-local-map)
  )
  
(defun pobox-mode (arg)
  (interactive "P")
  ;; 変数初期化
  (let (status process)
    (pobox-reset)
  
    ;; モード行の設定
    (setq pobox-original-mode-line-format mode-line-format)
    (setq mode-line-format (cons "[POBox]" (cdr mode-line-format)))

    ;; サーバとの通信路/バッファの初期化
    (or (eq (process-status pobox-server-process-name) 'open)
	(save-excursion
	  (get-buffer-create "*pobox*")
	  (set-buffer "*pobox*")
	  (process-kill-without-query
	   (setq pobox-server-process 
		 (open-network-stream pobox-server-process-name "*pobox*" pobox-server pobox-port) ;; for network
		 ;;(Start-process pobox-server-process-name "*pobox*" "/masui/pbserver.exe") ;; for stdin
		 )
	   )
	  (if (fboundp 'set-current-process-coding-system) ;;; for Emacs20
	      (set-current-process-coding-system *euc-japan* *euc-japan*)
	    (set-buffer-process-coding-system 'euc-japan 'euc-japan))
	  ))
    )

  ;; キーマップの設定
  (setq pobox-original-local-map (current-local-map))
  (if (null pobox-original-local-map)
      (setq pobox-local-map (make-keymap))
    (setq pobox-local-map (copy-keymap (current-local-map)))
    )
  (define-key pobox-local-map pobox-toggle-key 'pobox-finish)
  (define-key pobox-local-map "\C-O" 'pobox-register-region)
  (define-key pobox-local-map "\C-S" 'pobox-isearch)
  
  ;; 変換中のキーマップの設定
  (setq pobox-conv-local-map (make-keymap))
  (let ((i 0))
    (while (<= i 127)
      (define-key pobox-conv-local-map (char-to-string i) 'undefined)
      (setq i (1+ i))))
  (define-key pobox-conv-local-map "\C-M" 'pobox-newline)
  (define-key pobox-conv-local-map "\C-G" 'pobox-ctrl-g)
  (define-key pobox-conv-local-map " " 'pobox-space)
  (define-key pobox-conv-local-map "\177" 'pobox-del)
  (define-key pobox-conv-local-map "\C-H" 'pobox-del)
  (define-key pobox-conv-local-map "\C-Q" 'pobox-ctrl-q)
  (define-key pobox-conv-local-map "\C-K" 'pobox-ctrl-k)
  ;; a,b,...などの文字に対し pobox-keyin を割りあてる
  (let ((i 33))
    (while (< i 127)
      (define-key pobox-local-map (char-to-string i) 'pobox-keyin)
      (define-key pobox-conv-local-map (char-to-string i) 'pobox-keyin)
      (setq i (1+ i))))

  (use-local-map pobox-local-map)
  )

(defun pobox-del (arg)
  (interactive "P")
  (let ((len (length pobox-pat)))
    (if (> len 0)
	(if (> pobox-nth-cand 0)
	    (pobox-prevcand)
	  (pobox-erase-cand-list)
	  (setq pobox-pat (substring pobox-pat 0 (1- len)))
	  (pobox-set-curstr pobox-pat)
	  (setq pobox-cands (pobox-search pobox-pat))
	  (pobox-disp-cand-list)
	  )
      (pobox-fix pobox-curstr)
      (backward-delete-char 1)
      (use-local-map pobox-local-map)
      )
    ))

(defun pobox-search (pat &optional exact)
  (pobox-search-server pat exact)
  )

(defun pobox-search-server (pat &optional exact extra)
  (let (ret sendpat res i (cont t) found origpat)
    (save-excursion
      (set-buffer "*pobox*")
      (erase-buffer)
      (setq truncate-lines t)
      (setq sendpat (format "1%s" pat))
      (if (not exact) (setq sendpat (concat sendpat " ")))
      (setq sendpat (concat sendpat "\n"))

      (process-send-string pobox-server-process-name sendpat)

      (if t
	  (while (and cont (process-status pobox-server-process-name))
	    (accept-process-output pobox-server-process)
	    (if (> (buffer-size) 0)
		(if (eq (char-after 1) ?1)
		    ;; found key successfully, so check if a whole line
		    ;; is received.
		    (if (eq (char-after (1- (point-max))) ?\n)
			(setq cont nil) )
		  (setq cont nil) )))
	)

;;; migemo
;;      (while (not (and (> (point-max) 1)
;;		       (eq (char-after (1- (point-max))) ?\n)))
;;	(accept-process-output pobox-server-process 0 5))

;;;	    maybe not required
;;      (beginning-of-buffer)
;;      (replace-string "\r" "\n")

      (beginning-of-buffer)
      (setq pobox-nth-cand 0)
      (setq ret nil)
      (setq found (eq (following-char) ?1))
      (setq pobox-extra-cands 0)
;;      (if (or exact extra (not found))
;;	  (let (k)
;;	    (setq k (roma2kana pat))
;;	    ;;(if (and nil (> (length k) 0))
;;	    (if (and t (> (length k) 0))
;;		(progn
;;		  (setq ret (nconc ret (list (kata2hira k) k)))
;;		  (setq pobox-extra-cands 2)
;;		  (setq origpat pat)
;;		  (setq ret (nconc ret (list origpat)))
;;		  (setq pobox-extra-cands (1+ pobox-extra-cands))
;;		  )
;;	      )
;;	    ))
      (if found
	  (let (s e w)
	    (forward-char 2)
	    (setq res t)
	    (while (and res (not (looking-at "\n")))
	      (setq s (point))
	      (setq res (search-forward "\t" nil t))
	      (setq e (1- (point)))
	      (setq w (buffer-substring s e))
	      (if (not (member w ret))
		  (setq ret (nconc ret (list (buffer-substring s e)))))
	      ))
	)
      )
    ret
    ))

;; ;; サーバを使わないで検索する方法
;; (defun pobox-search-new (pat &optional exact)
;;   (let (ret (havemore t) (count 0) cand)
;;     (save-excursion 
;;       (set-buffer "fugo")
;;       (beginning-of-buffer)
;;       (while (and (< count 20) havemore)
;; 	(setq havemore (re-search-forward (concat "^\\(" pat (if exact "" ".*") "\\)\t+\\(.*\\)$") (buffer-size) t))
;; 	(if havemore
;; 	    (let (s)
;; 	      (setq s (buffer-substring (match-beginning 2) (match-end 2)))
;; 	      (setq cand (nconc cand (list s)))
;; 	      (setq count (1+ count))
;; 	      ))
;; 	)
;;       )
;;     cand
;;     ))

;;;
;;;	pobox-isearch (高林氏@奈良先端の「jrsearch.el」の真似)
;;;	http://cl.aist-nara.ac.jp/~satoru-t/jrsearch/
;;;	

(defvar pobox-exit-char ?\033)
(defvar pobox-delete-char ?\177)
(defvar pobox-kill-char ?\^U)
(defvar pobox-isearch-char ?\^S)

(defun pobox-message (&optional str)
  (let ((s "POBox-Isearch: "))
    (if (stringp str)
	(setq s (concat s str)))
    (message s)
    ))

(defun pobox-join-string (list delim)
  (let (s)
    (setq s (car list))
    (setq list (cdr list))
    (while list
      (setq s (concat s delim (car list)))
      (setq list (cdr list))
      )
    s
    ))

(defun pobox-re-search (pat)
  (let (p)
    (setq p (pobox-join-string (pobox-search-server pat nil t) "\\|"))
    (re-search-forward p nil t)
    ))

(defun pobox-isearch ()
  (interactive)
  (let ((pobox-string "") (more t))
    (pobox-message)
    (setq pos (point))
    (while more
      (let ((char (read-char)))
	(cond ((eq char pobox-exit-char)
	       (goto-char pos)
	       (setq more nil)
	       )
	      ((eq char pobox-delete-char)
	       (if (> (length pobox-string) 0)
		   (setq pobox-string (substring pobox-string 0 (1- (length pobox-string)))))
	       (goto-char pos)
	       (pobox-re-search pobox-string)
	       )
	      ((eq char pobox-kill-char)
	       (setq pobox-string "")
	       (pobox-message)
	       )
	      ((eq char pobox-isearch-char)
	       (pobox-re-search pobox-string)
	       )
	      ((< char 32)
	       (setq more nil)
	       (setq unread-command-char char)
	       )
	      (t
	       (setq pobox-string (concat pobox-string (char-to-string char)))
	       (goto-char pos)
	       (pobox-re-search pobox-string)
	       )
	      )
	(pobox-message pobox-string)
	))
    ))