sekka 0.8.2 → 0.8.3

data/emacs/sekka.el

@@ -2,7 +2,7 @@
 ;;
 ;; "sekka.el" is a client for Sekka server
 ;;
-;;   Copyright (C) 2010 Kiyoka Nishiyama
+;;   Copyright (C) 2010,2011 Kiyoka Nishiyama
 ;;   This program was derived from sumibi.el and yc.el-4.0.13(auther: knak)
 ;;
 ;;
@@ -25,6 +25,7 @@
 ;;; Code:
 (require 'cl)
 (require 'http-get)
+(require 'popup)
 
 ;;; 
 ;;;
@@ -55,6 +56,11 @@
   :type  'string
   :group 'sekka)
 
+(defcustom sekka-no-proxy-hosts ""
+  "http proxyを使わないホスト名を指定する。複数指定する場合は、コンマで区切る。"
+  :type  'string
+  :group 'sekka)
+
 (defcustom sekka-realtime-guide-running-seconds 30
   "リアルタイムガイド表示の継続時間(秒数)・ゼロでガイド表示機能が無効になる"
   :type  'integer
@@ -67,7 +73,7 @@
 
 (defcustom sekka-realtime-guide-interval  0.2
   "リアルタイムガイド表示を更新する時間間隔"
-  :type  'integer
+  :type  'float
   :group 'sekka)
 
 (defcustom sekka-roman-method "normal"
@@ -87,6 +93,17 @@
 		 (const :tag "english(us)-keyboard" "en"))
   :group 'sekka)
 
+(defcustom sekka-jisyo-filename "~/.sekka-jisyo"
+  "sekka-jisyoのファイル名を指定する"
+  :type  'string
+  :group 'sekka)
+
+(defcustom sekka-use-googleime t
+  "変換結果に、漢字のエントリ type=j が含まれていなかったら、自動的にGoogleIMEを APIを使って変換候補を取得する。
+non-nil で明示的に呼びだすまでGoogleIMEは起動しない。"
+  :type  'boolean
+  :group 'sekka)
+
 
 (defface sekka-guide-face
   '((((class color) (background light)) (:background "#E0E0E0" :foreground "#F03030")))
@@ -125,6 +142,8 @@
 
 (defconst sekka-login-name   (user-login-name))
 
+(defconst sekka-tango-index  0)
+(defconst sekka-annotation-index  1)
 (defconst sekka-kind-index   3)
 (defconst sekka-id-index     4)
 
@@ -164,6 +183,8 @@
 (defvar sekka-cand-cur-backup 0)        ; カレント候補番号(UNDO用に退避する変数)
 (defvar sekka-cand-len nil)             ; 候補数
 (defvar sekka-last-fix "")              ; 最後に確定した文字列
+(defvar sekka-last-roman "")            ; 最後にsekka-serverにリクエストしたローマ字文字列
+(defvar sekka-select-operation-times 0) ; 選択操作回数
 (defvar sekka-henkan-kouho-list nil)    ; 変換結果リスト(サーバから帰ってきたデータそのもの)
 
 
@@ -271,13 +292,26 @@
 ;;    )
 (defun sekka-rest-request (func-name arg-alist)
   (if sekka-psudo-server
-      ;; クライアント単体で仮想的にサーバーに接続しているようにしてテストするモード
-      "((\"変換\" nil \"へんかん\" j 0) (\"変化\" nil \"へんか\" j 1) (\"ヘンカン\" nil \"へんかん\" k 2) (\"へんかん\" nil \"へんかん\" h 3))"
-      ;;"((\"変換\" nil \"へんかん\" j 0) (\"変化\" nil \"へんか\" j 1))"
+      (cond
+       ((string-equal func-name "henkan")
+	;; クライアント単体で仮想的にサーバーに接続しているようにしてテストするモード
+	;; result of /henkan
+	;;"((\"変換\" nil \"へんかん\" j 0) (\"変化\" nil \"へんか\" j 1) (\"ヘンカン\" nil \"へんかん\" k 2) (\"へんかん\" nil \"へんかん\" h 3))")
+	"((\"ヨンモジジュクゴ\" nil \"よんもじじゅくご\" k 0) (\"よんもじじゅくご\" nil \"よんもじじゅくご\" h 1))")
+       ((string-equal func-name "googleime")
+	;; result of /google_ime
+	;;  1) よんもじじゅくご
+	"(\"四文字熟語\" \"４文字熟語\" \"4文字熟語\" \"よんもじじゅくご\" \"ヨンモジジュクゴ\")"
+	;;  2) しょかいきどう
+	;;    "(\"初回起動\", \"諸快気堂\", \"諸開基堂\", \"しょかいきどう\", \"ショカイキドウ\")"
+	))
     ;; 実際のサーバに接続する
     (let ((command
 	   (concat
 	    sekka-curl " --silent --show-error "
+	    (if (< 0 (length sekka-no-proxy-hosts))
+		(concat " --noproxy " sekka-no-proxy-hosts)
+	      "")
 	    (format " --max-time %d " sekka-server-timeout)
 	    " --insecure "
 	    " --header 'Content-Type: application/x-www-form-urlencoded' "
@@ -351,6 +385,28 @@
     (message result)
     t))
 
+
+;;
+;; GoogleImeAPIリクエストをサーバーに送る
+;;
+(defun sekka-googleime-request (yomi)
+  (sekka-debug-print (format "googleime yomi=[%s]\n" yomi))
+  
+  ;;(message "Requesting to sekka server...")
+  
+  (let ((result (sekka-rest-request "googleime" `(
+						  (yomi  . ,yomi)))))
+    (sekka-debug-print (format "googleime-result:%S\n" result))
+    (progn
+      (message nil)
+      (condition-case err
+	  (read result)
+	(end-of-file
+	 (progn
+	   (message "Parse error for parsing result of Sekka Server.")
+	   '()))))))
+
+
 ;;
 ;; ユーザー語彙をサーバーに再度登録する。
 ;;
@@ -362,9 +418,9 @@
   
 ;;
 ;; ユーザー語彙をサーバーに登録する。
-;;
-(defun sekka-register-userdict-internal ()
-  (let* ((str      (sekka-get-jisyo-str "~/.sekka-jisyo"))
+;;   only-first が t の時は、1ブロック目だけを登録する
+(defun sekka-register-userdict-internal (&optional only-first)
+  (let* ((str      (sekka-get-jisyo-str sekka-jisyo-filename))
 	 (str-lst  (sekka-divide-into-few-line str)))
     (mapcar
      (lambda (x)
@@ -373,7 +429,9 @@
        (let ((result (sekka-rest-request "register" `((dict . ,x)))))
 	 (sekka-debug-print (format "register-result:%S\n" result))
 	 (message result)))
-     str-lst)
+     (if only-first
+	 (list (car str-lst))
+       str-lst))
     t))
 
 
@@ -427,25 +485,54 @@
 	(reverse result))
     '()))
 
+
+(defun sekka-file-existp (file)
+  "FILE が存在するかどうかをチェックする。 t か nil で結果を返す"
+  (let* ((file (or (car-safe file)
+		   file))
+	 (file (expand-file-name file)))
+    (file-exists-p file)))
+
+
 (defun sekka-get-jisyo-str (file &optional nomsg)
   "FILE を開いて Sekka辞書バッファを作り、バッファ1行1文字列のリストで返す"
-  (when file
-    (let* ((file (or (car-safe file)
-		     file))
-	   (file (expand-file-name file)))
-      (if (not (file-exists-p file))
-	  (progn
-	    (message (format "Sekka辞書 %s が存在しません..." file))
-	    nil)
-	(let ((str "")
-	      (buf-name (file-name-nondirectory file)))
-	  (save-excursion
-	    (find-file-read-only file)
-	    (setq str (with-current-buffer (get-buffer buf-name)
-			(buffer-substring-no-properties (point-min) (point-max))))
-	    (message (format "Sekka辞書 %s を開いています...完了！" (file-name-nondirectory file)))
-	    (kill-buffer-if-not-modified (get-buffer buf-name)))
-	  str)))))
+  (if (sekka-file-existp file)
+      (let ((str "")
+	    (buf-name (file-name-nondirectory file)))
+	(save-excursion
+	  (find-file-read-only file)
+	  (setq str (with-current-buffer (get-buffer buf-name)
+		      (buffer-substring-no-properties (point-min) (point-max))))
+	  (message (format "Sekka辞書 %s を開いています...完了！" (file-name-nondirectory file)))
+	  (kill-buffer-if-not-modified (get-buffer buf-name)))
+	str)
+    (message (format "Sekka辞書 %s が存在しません..." file))))
+
+
+(defun sekka-add-new-word-to-jisyo (file yomi tango)
+  "FILE Sekka辞書ファイルと見做し、ファイルの先頭に「読み」と「単語」のペアを書き込む
+登録が成功したかどうかを t or nil で返す"
+  (if (sekka-file-existp file)
+      (let ((buf-name (file-name-nondirectory file))
+	    (added nil))
+	(save-excursion
+	  (find-file file)
+	  (with-current-buffer (get-buffer buf-name)
+	    (goto-char (point-min))
+	    (let ((newstr (format "%s /%s/" yomi tango)))
+	      (when (not (search-forward newstr nil t))
+		(insert newstr)
+		(insert "\n")
+		(save-buffer)
+		(setq added t)
+		)))
+	  (kill-buffer-if-not-modified (get-buffer buf-name)))
+	added)
+    (progn
+      (message (format "Sekka辞書 %s が存在しません..." file))
+      nil)))
+    
+	     
 
 
 ;; ポータブル文字列置換( EmacsとXEmacsの両方で動く )
@@ -612,8 +699,57 @@
 (define-key sekka-select-mode-map "\C-k"                   'sekka-select-katakana)
 (define-key sekka-select-mode-map "\C-l"                   'sekka-select-hankaku)
 (define-key sekka-select-mode-map "\C-e"                   'sekka-select-zenkaku)
+(define-key sekka-select-mode-map "\C-r"                   'sekka-add-new-word)
+
+
+(defvar sekka-popup-menu-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\r"        'popup-select)
+    (define-key map "\C-f"      'popup-open)
+    (define-key map [right]     'popup-open)
+    (define-key map "\C-b"      'popup-close)
+    (define-key map [left]      'popup-close)
+
+    (define-key map "\C-n"      'popup-next)
+    (define-key map "\C-j"      'popup-next)
+    (define-key map [down]      'popup-next)
+    (define-key map "\C-p"      'popup-previous)
+    (define-key map [up]        'popup-previous)
+
+    (define-key map [f1]        'popup-help)
+    (define-key map (kbd "\C-?") 'popup-help)
+
+    (define-key map "\C-s"      'popup-isearch)
+    (define-key map "\C-g"      'popup-close)
+    map))
+
+;; 選択操作回数のインクリメント
+(defun sekka-select-operation-inc ()
+  (incf sekka-select-operation-times)
+  (when (< 3 sekka-select-operation-times)
+    (sekka-select-operation-reset)
+    (let* ((lst 
+	    (mapcar
+	     (lambda (x)
+	       (concat 
+		(nth sekka-tango-index x)
+		"   ; "
+		(nth sekka-annotation-index x)))
+	     sekka-henkan-kouho-list))
+	   (map (make-sparse-keymap))
+	   (result 
+	    (popup-menu* lst
+			 :scroll-bar t
+			 :margin t
+			 :keymap sekka-popup-menu-keymap)))
+      (let ((selected-word (car (split-string result " "))))
+	(setq sekka-cand-cur (sekka-find-by-tango selected-word))
+	(sekka-select-kakutei)))))
+      
 
-
+;; 選択操作回数のリセット
+(defun sekka-select-operation-reset ()
+  (setq sekka-select-operation-times 0))
 
 ;; 変換を確定し入力されたキーを再入力する関数
 (defun sekka-kakutei-and-self-insert (arg)
@@ -647,6 +783,7 @@
       (sekka-kakutei-request key tango)))
   (setq sekka-select-mode nil)
   (run-hooks 'sekka-select-mode-end-hook)
+  (sekka-select-operation-reset)
   (sekka-select-update-display)
   (sekka-history-push))
 
@@ -671,6 +808,7 @@
   (decf sekka-cand-cur)
   (when (> 0 sekka-cand-cur)
     (setq sekka-cand-cur (- sekka-cand-len 1)))
+  (sekka-select-operation-inc)
   (sekka-select-update-display))
 
 ;; 次の候補に進める
@@ -682,8 +820,21 @@
 	(if (< sekka-cand-cur (- sekka-cand-len 1))
 	    (+ sekka-cand-cur 1)
 	  0))
+  (sekka-select-operation-inc)
   (sekka-select-update-display))
 
+;; 指定された tango のindex番号を返す
+(defun sekka-find-by-tango ( tango )
+  (let ((result-index nil))
+    (mapcar
+     (lambda (x)
+       (let ((_tango (nth sekka-tango-index x)))
+	 (when (string-equal _tango tango)
+	   (setq result-index (nth sekka-id-index x)))))
+     sekka-henkan-kouho-list)
+    (sekka-debug-print (format "sekka-find-by-tango: tango=%s result=%S \n" tango result-index))
+    result-index))
+
 ;; 指定された type の候補を抜き出す
 (defun sekka-select-by-type-filter ( _type )
   (let ((lst '()))
@@ -693,27 +844,35 @@
 	 (when (eq sym _type)
 	   (push x lst))))
      sekka-henkan-kouho-list)
-    (sekka-debug-print (format "filterd-lst = %S" (reverse lst)))
+    (sekka-debug-print (format "filterd-lst = %S\n" (reverse lst)))
     (car (reverse lst))))
     
+;; 指定された type の候補が存在するか調べる
+(defun sekka-include-typep ( _type )
+  (not (null (sekka-select-by-type-filter _type))))
+
 ;; 指定された type の候補に強制的に切りかえる
+;; 切りかえが成功したかどうかを t or nil で返す。
 (defun sekka-select-by-type ( _type )
   (let ((kouho (sekka-select-by-type-filter _type)))
     (if (null kouho)
-	(cond
-	 ((eq _type 'j)
-	  (message "Sekka: 漢字の候補はありません。"))
-	 ((eq _type 'h)
-	  (message "Sekka: ひらがなの候補はありません。"))
-	 ((eq _type 'k)
-	  (message "Sekka: カタカナの候補はありません。"))
-	 ((eq _type 'l)
-	  (message "Sekka: 半角の候補はありません。"))
-	 ((eq _type 'z)
-	  (message "Sekka: 全角の候補はありません。")))
+	(begin
+	 (cond
+	  ((eq _type 'j)
+	   (message "Sekka: 漢字の候補はありません。"))
+	  ((eq _type 'h)
+	   (message "Sekka: ひらがなの候補はありません。"))
+	  ((eq _type 'k)
+	   (message "Sekka: カタカナの候補はありません。"))
+	  ((eq _type 'l)
+	   (message "Sekka: 半角の候補はありません。"))
+	  ((eq _type 'z)
+	   (message "Sekka: 全角の候補はありません。"))
+	  nil))
       (let ((num   (nth sekka-id-index kouho)))
 	(setq sekka-cand-cur num)
-	(sekka-select-update-display)))))
+	(sekka-select-update-display)
+	t))))
 
 (defun sekka-select-kanji ()
   "漢字候補に強制的に切りかえる"
@@ -741,6 +900,65 @@
   (sekka-select-by-type 'z))
 
 
+(defun sekka-replace-kakutei-word (b e insert-word)
+  ;; UNDO抑制開始
+  (sekka-disable-undo)
+    
+  (delete-region b e)
+  
+  (insert insert-word)
+  (message (format "replaced by new word [%s]" insert-word))
+  ;; UNDO再開
+  (sekka-enable-undo))
+
+
+;; 登録語リストからユーザーに該当単語を選択してもらう
+(defun sekka-add-new-word-sub (yomi lst)
+  (let* ((etc "(自分で入力する)")
+	 (lst (if (stringp lst) 
+		  (progn
+		    (message lst) ;; サーバーから返ってきたエラーメッセージを表示
+		    '())
+		lst))
+	 (result (popup-menu*
+		  (append lst `(,etc))
+		  :margin t
+		  :keymap sekka-popup-menu-keymap))
+	 (b (copy-marker sekka-fence-start))
+	 (e (copy-marker sekka-fence-end)))
+    (let ((tango
+	   (if (string-equal result etc)
+	       (save-current-buffer
+		 (read-string (format "%sに対応する単語:" yomi)))
+	     result)))
+      ;; 新しい単語で確定する
+      (sekka-replace-kakutei-word (marker-position b)
+				  (marker-position e)
+				  tango)
+      ;; .sekka-jisyoとサーバーの両方に新しい単語を登録する
+      (let ((added (sekka-add-new-word-to-jisyo sekka-jisyo-filename yomi tango)))
+	(if added
+	    (progn
+	      (sekka-register-userdict-internal t)
+	      (message (format "Sekka辞書 %s に単語(%s /%s/)を保存しました！" sekka-jisyo-filename yomi tango)))
+	  (message (format "Sekka辞書 %s に 単語(%s /%s/)を追加しませんでした(登録済)" sekka-jisyo-filename yomi tango)))))))
+
+
+(defun sekka-add-new-word ()
+  "変換候補のよみ(平仮名)に対応する新しい単語を追加する"
+  (interactive)
+  (setq case-fold-search nil)
+  (when (sekka-select-by-type 'h)
+    (let* ((kouho      (nth sekka-cand-cur sekka-henkan-kouho-list))
+	   (hiragana   (car kouho)))
+      (sekka-debug-print (format "sekka-register-new-word: sekka-last-roman=[%s] hiragana=%s result=%S\n" sekka-last-roman hiragana (string-match-p "^[A-Z][^A-Z]+$" sekka-last-roman)))
+      (when (string-match-p "^[A-Z][^A-Z]+$" sekka-last-roman)
+	(sekka-select-kakutei)
+	(sekka-add-new-word-sub
+	 hiragana
+	 (sekka-googleime-request hiragana))))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 変換履歴操作関数
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -895,14 +1113,17 @@
 	    (when (sekka-henkan-region b e)
 	      (if (eq (char-before b) ?/)
 		  (setq b (- b 1)))
+	      (setq sekka-last-roman (buffer-substring-no-properties b e))
 	      (delete-region b e)
 	      (goto-char b)
 	      (insert (sekka-get-display-string))
 	      (setq e (point))
 	      (sekka-display-function b e nil)
 	      (sekka-select-kakutei)
+	      (when sekka-use-googleime
+		(when (not (sekka-include-typep 'j))
+		  (sekka-add-new-word)))
 	      )))))
-
      
      ((sekka-kanji (preceding-char))
     
@@ -1198,7 +1419,7 @@ point から行頭方向に同種の文字列が続く間を漢字変換しま
 (setq default-input-method "japanese-sekka")
 
 (defconst sekka-version
-  "0.8.2" ;;SEKKA-VERSION
+  "0.8.3" ;;SEKKA-VERSION
   )
 (defun sekka-version (&optional arg)
   "入力モード変更"