Created
May 30, 2011 02:27
-
-
Save kiwanami/998378 to your computer and use it in GitHub Desktop.
Modeless Japanse input method on IIIMCF for Emacs
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;;; iiimcf-yc.el --- yc emulation extension for iiimcf | |
| ;; !!! EXPERIMENTAL !!! | |
| ;; Copyright (C) 2011 SAKURAI Masashi | |
| ;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net> | |
| ;; Keywords: languages, tools | |
| ;; This program 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 3 of the License, or | |
| ;; (at your option) any later version. | |
| ;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. | |
| ;;; Commentary: | |
| ;; IIIMCF で boild-egg, YC のようなモードレス変換機能を追加します。 | |
| ;; boild-egg : http://usir.kobe-c.ac.jp/boiled-egg/ | |
| ;; YC : http://www.ceres.dti.ne.jp/~knak/yc.html | |
| ;; AYC 有効中は入力文字のローマ字変換プレビューが出ますので、 | |
| ;; すぐに打ち間違いに気づくことが出来ます。 | |
| ;; auto-complete と連携して積極的に補完できます。 | |
| ;;; Code: | |
| (eval-when-compile | |
| (require 'cl)) | |
| ;;================================================== | |
| ;; Customize | |
| (defvar ayc-splitter " \t\n\r\"" | |
| "変換の範囲を特定する区切り文字") | |
| (defgroup ayc nil | |
| "Yet Another YC preview" | |
| :group 'mule | |
| :prefix "ayc-") | |
| (defface ayc-preview-face | |
| '((t (:background "khaki1" :foreground "black"))) | |
| "プレビューのface" | |
| :group 'ayc) | |
| (defface ayc-preview-wrong-face | |
| '((t (:background "MistyRose" :foreground "DimGray"))) | |
| "非日本語のプレビューのface" | |
| :group 'ayc) | |
| (defvar ayc-auto-adjust-space 'insert | |
| "日本語と英単語のスペースの調整方法。 | |
| 'insert : 変換しない単語の後でスペースを入力した後、自動でスペースを単語の前にも入れる。 | |
| 'delete : 変換した後、一つ前の不必要なスペースを詰める。 | |
| nil : なにもしない。") | |
| (defvar ayc-cursor-color "Hotpink1" "AYC モードのカーソールの色。") | |
| (defvar ayc-romaji-kana-table | |
| '(( "a" . "あ") ( "i" . "い") ( "u" . "う") ( "e" . "え") ( "o" . "お") | |
| ("ka" . "か") ("ki" . "き") ("ku" . "く") ("ke" . "け") ("ko" . "こ") | |
| ("sa" . "さ") ("si" . "し") ("su" . "す") ("se" . "せ") ("so" . "そ") | |
| ("ta" . "た") ("ti" . "ち") ("tu" . "つ") ("te" . "て") ("to" . "と") | |
| ("na" . "な") ("ni" . "に") ("nu" . "ぬ") ("ne" . "ね") ("no" . "の") | |
| ("ha" . "は") ("hi" . "ひ") ("hu" . "ふ") ("he" . "へ") ("ho" . "ほ") | |
| ("ma" . "ま") ("mi" . "み") ("mu" . "む") ("me" . "め") ("mo" . "も") | |
| ("ya" . "や") ("yu" . "ゆ") ("yo" . "よ") | |
| ("ra" . "ら") ("ri" . "り") ("ru" . "る") ("re" . "れ") ("ro" . "ろ") | |
| ("la" . "ら") ("li" . "り") ("lu" . "る") ("le" . "れ") ("lo" . "ろ") | |
| ("wa" . "わ") ("wi" . "ゐ") ("wu" . "う") ("we" . "ゑ") ("wo" . "を") | |
| ("n'" . "ん") ( "n" . "ん") ("m'" . "ん") ( "m" . "ん") | |
| ("ga" . "が") ("gi" . "ぎ") ("gu" . "ぐ") ("ge" . "げ") ("go" . "ご") | |
| ("za" . "ざ") ("zi" . "じ") ("zu" . "ず") ("ze" . "ぜ") ("zo" . "ぞ") | |
| ("da" . "だ") ("di" . "ぢ") ("du" . "づ") ("de" . "で") ("do" . "ど") | |
| ("ba" . "ば") ("bi" . "び") ("bu" . "ぶ") ("be" . "べ") ("bo" . "ぼ") | |
| ("pa" . "ぱ") ("pi" . "ぴ") ("pu" . "ぷ") ("pe" . "ぺ") ("po" . "ぽ") | |
| ("kya" . "きゃ") ("kyu" . "きゅ") ("kye" . "きぇ") ("kyo" . "きょ") | |
| ("sya" . "しゃ") ("syu" . "しゅ") ("sye" . "しぇ") ("syo" . "しょ") | |
| ("sha" . "しゃ") ("shu" . "しゅ") ("she" . "しぇ") ("sho" . "しょ") | |
| ("cha" . "ちゃ") ("chu" . "ちゅ") ("che" . "ちぇ") ("cho" . "ちょ") | |
| ("tya" . "ちゃ") ("tyu" . "ちゅ") ("tye" . "ちぇ") ("tyo" . "ちょ") | |
| ("nya" . "にゃ") ("nyu" . "にゅ") ("nye" . "にぇ") ("nyo" . "にょ") | |
| ("hya" . "ひゃ") ("hyu" . "ひゅ") ("hye" . "ひぇ") ("hyo" . "ひょ") | |
| ("mya" . "みゃ") ("myu" . "みゅ") ("mye" . "みぇ") ("myo" . "みょ") | |
| ("rya" . "りゃ") ("ryu" . "りゅ") ("rye" . "りぇ") ("ryo" . "りょ") | |
| ("lya" . "りゃ") ("lyu" . "りゅ") ("lye" . "りぇ") ("lyo" . "りょ") | |
| ("gya" . "ぎゃ") ("gyu" . "ぎゅ") ("gye" . "ぎぇ") ("gyo" . "ぎょ") | |
| ("zya" . "じゃ") ("zyu" . "じゅ") ("zye" . "じぇ") ("zyo" . "じょ") | |
| ("jya" . "じゃ") ("jyu" . "じゅ") ("jye" . "じぇ") ("jyo" . "じょ") | |
| ( "ja" . "じゃ") ( "ju" . "じゅ") ( "je" . "じぇ") ( "jo" . "じょ") | |
| ("bya" . "びゃ") ("byu" . "びゅ") ("bye" . "びぇ") ("byo" . "びょ") | |
| ("pya" . "ぴゃ") ("pyu" . "ぴゅ") ("pye" . "ぴぇ") ("pyo" . "ぴょ") | |
| ("kwa" . "くゎ") ("kwi" . "くぃ") ("kwe" . "くぇ") ("kwo" . "くぉ") | |
| ("tsa" . "つぁ") ("tsi" . "つぃ") ("tse" . "つぇ") ("tso" . "つぉ") | |
| ( "fa" . "ふぁ") ( "fi" . "ふぃ") ( "fe" . "ふぇ") ( "fo" . "ふぉ") | |
| ("gwa" . "ぐゎ") ("gwi" . "ぐぃ") ("gwe" . "ぐぇ") ("gwo" . "ぐぉ") | |
| ("dyi" . "でぃ") ("dyu" . "どぅ") ("dye" . "でぇ") ("dyo" . "どぉ") | |
| ("dhi" . "でぃ") ("dhu" . "どぅ") ("dhe" . "でぇ") ("dho" . "どぉ") | |
| ("shi" . "し") ("tyi" . "てぃ") ("thi" . "てぃ") ("chi" . "ち") ("tsu" . "つ") ("ji" . "じ") | |
| ( "fu" . "ふ") ( "ye" . "いぇ") | |
| ("va" . "ヴぁ") ("vi" . "ヴぃ") ("vu" . "ヴ") ("ve" . "ヴぇ") ("vo" . "ヴぉ") | |
| ( "xa" . "ぁ") ( "xi" . "ぃ") ( "xu" . "ぅ") ( "xe" . "ぇ") ( "xo" . "ぉ") | |
| ("xtu" . "っ") ("xya" . "ゃ") ("xyu" . "ゅ") ("xyo" . "ょ") ("xwa" . "ゎ") | |
| ("xka" . "ヵ") ("xke" . "ヶ") | |
| ("1" . "１") ("2" . "２") ("3" . "３") ("4" . "４") ("5" . "５") | |
| ("6" . "６") ("7" . "７") ("8" . "８") ("9" . "９") ("0" . "０") | |
| ("!" . "！") ("@" . "＠") ("#" . "＃") ("$" . "＄") ("%" . "％") | |
| ("^" . "＾") ("&" . "＆") ("*" . "＊") ("(" . "（") (")" . "）") | |
| ("-" . "ー") ("=" . "＝") ("`" . "｀") ("\\" . "￥") ("|" . "｜") | |
| ("_" . "＿") ("+" . "＋") ("~" . "￣") ("[" . "「") ("]" . "」") | |
| ("{" . "｛") ("}" . "｝") (":" . "：") (";" . "；") ("\"" . "”") | |
| ("'" . "’") ("." . "。") ("," . "、") ("<" . "＜") (">" . "＞") | |
| ("?" . "？") ("/" . "／") | |
| )) | |
| ;;================================================== | |
| ;; Utilities | |
| (eval-and-compile | |
| (defvar ayc-debug nil "Debug output switch.")) ; debug | |
| (defvar ayc-debug-count 0 "[internal] Debug output counter.") ; debug | |
| ;; (setq ayc-debug t) | |
| (defun ayc-log-func (&rest args) | |
| "[internal] Debug output" | |
| (with-current-buffer (get-buffer-create "*ayc-debug*") | |
| (save-excursion | |
| (goto-char (point-max)) | |
| (insert (format "%5i %s\n" ayc-debug-count (apply 'format args))))) | |
| (incf ayc-debug-count)) | |
| (defmacro ayc-log (&rest args) | |
| "[internal] Debug macro." | |
| (when ayc-debug | |
| (let ((syms (loop for i in args collect (gensym)))) | |
| `(progn | |
| (let ( ,@(loop for s in syms | |
| for v in args | |
| collect (list s v)) ) | |
| (ayc-log-func ,@syms)))))) | |
| (defun ayc-message-mark () | |
| "[internal] Debug marker." | |
| (interactive) | |
| (ayc-log "==================== mark ==== %s" | |
| (format-time-string "%H:%M:%S" (current-time)))) | |
| (defun ayc-pop-to-log-buffer () | |
| "[internal] Display log buffer." | |
| (interactive) | |
| (let ((buf (get-buffer "*ayc-debug*"))) | |
| (when buf | |
| (pop-to-buffer buf) | |
| (set-window-point | |
| (get-buffer-window buf) | |
| (with-current-buffer buf (point-max)))))) | |
| ;; (global-set-key (kbd "M-j") 'ayc-pop-to-log-buffer) | |
| ;;================================================== | |
| ;; Romaji translation | |
| (defvar ayc-romaji-regexp | |
| (regexp-opt | |
| (nconc (mapcar 'car ayc-romaji-kana-table) | |
| (mapcar (lambda (x) | |
| (let ((romaji (car x))) | |
| (if (string-match "^\\([kgszjcftdhbpmrwv]\\)" romaji) | |
| (concat (list (elt romaji 0)) (car x))))) | |
| ayc-romaji-kana-table))) | |
| "ローマ字を拾う正規表現。 ayc-romaji-kana-table を更新したらこの変数も更新すること。") | |
| (defun ayc-romaji-to-kana (string) | |
| "ローマ字からひらがなに変換する。" | |
| (with-temp-buffer | |
| (insert string) | |
| (goto-char (point-min)) | |
| (while (re-search-forward ayc-romaji-regexp nil t) | |
| (let ((match (match-string 0))) | |
| (replace-match | |
| (concat (when (and (> (length match) 1) | |
| (equal (elt match 0) (elt match 1)) | |
| (not (equal (elt match 0) ?n))) | |
| (setq match (substring match 1)) | |
| "っ") ; | |
| (cdr (assoc match ayc-romaji-kana-table)))))) | |
| (goto-char (point-min)) | |
| (while (re-search-forward "んん" nil t) | |
| (replace-match "ん")) | |
| (buffer-string))) | |
| (defun ayc-romaji-to-kana-test () | |
| (interactive) | |
| (pop-to-buffer "*atok-romaji-to-kana-test*") | |
| (erase-buffer) | |
| (loop for (in out) in | |
| '(("kyouhaiitenkidesune" "きょうはいいてんきですね") | |
| ("kyouhane" "きょうはね") | |
| ("kyouhanne" "きょうはんね") | |
| ("mikanndesu" "みかんです") | |
| ("mikandesu" "みかんです") | |
| ("neko" "ねこ") | |
| ("nyann" "にゃん") | |
| ("nyan" "にゃん") | |
| ("sekkaku" "せっかく") | |
| ("toukyoutokkyokyokakyoku" "とうきょうとっきょきょかきょく") | |
| ("1asdfnkm" "１あsdfんkん")) | |
| for rs = (ayc-romaji-to-kana in) | |
| do | |
| (insert (format "%s : %s / %s <= %s\n" | |
| (if (equal rs out) "OK" "NG") | |
| rs out in)))) | |
| ;; (ayc-romaji-to-kana-test) | |
| (defun ayc-collect-word () | |
| "変換すべき単語開始位置を拾う。見つからない場合は現在位置が返る。" | |
| (save-excursion | |
| (let ((poss (re-search-backward | |
| (concat "\\([" ayc-splitter "]\\|[[:multibyte:]]\\)") nil t))) | |
| (if poss (incf poss) | |
| (setq poss (or (re-search-backward "^" nil t) (point-min)))) | |
| poss))) | |
| (defun ayc-input-at-point (&optional delete) | |
| "point 位置のローマ字を取得する。DELETE が指定してあれば、ローマ字を削除する。" | |
| (let ((poss (ayc-collect-word)) (pose (point)) str) | |
| (setq str (and (< poss pose) (buffer-substring-no-properties poss pose))) | |
| (when (and str delete) | |
| (cond | |
| ((ayc-preview-check (ayc-romaji-to-kana (downcase str))) | |
| ;; 変換するとき | |
| (delete-region poss pose) | |
| (ayc-auto-adjust-space-delete (point))) | |
| (t | |
| ;; 変換しないとき | |
| (ayc-auto-adjust-space-insert poss) | |
| (setq str nil)))) | |
| str)) | |
| (defun ayc-auto-adjust-space-delete (pos) | |
| "POS の位置のスペースを自動で削除する。" | |
| (when (eq ayc-auto-adjust-space 'delete) | |
| (save-excursion | |
| (goto-char pos) | |
| (when (and (not (bolp)) | |
| (eql (char-before) ?\ )) | |
| (delete-backward-char 1))))) | |
| (defun ayc-auto-adjust-space-insert (pos) | |
| "POS の位置に自動でスペースを挿入する。" | |
| (when (eq ayc-auto-adjust-space 'insert) | |
| (save-excursion | |
| (goto-char poss) | |
| (when (and (not (bolp)) | |
| (not (string-match | |
| (concat "[" ayc-splitter "]") | |
| (char-to-string (char-before))))) | |
| (insert " "))))) | |
| (defvar ayc-last-invoked-string nil | |
| "変換しようとした元の文字列。 | |
| ayc-invoke で記録されて ayc-inactive-hook, ayc-commit-hook で削除される。") | |
| (make-variable-buffer-local 'ayc-last-invoked-string) | |
| (defun ayc-invoke (&optional cmds) | |
| "ローマ字を拾って変換する。その際、変換した後で引数のキー入力を追加する。" | |
| (unless current-input-method | |
| (let ((str (ayc-input-at-point t))) | |
| (ayc-log "invoke: %S" str) | |
| (cond | |
| (str | |
| (ayc-preview-stop) | |
| (setq ayc-last-invoked-string str) | |
| (call-interactively 'toggle-input-method) | |
| (setq unread-command-events | |
| (append unread-command-events | |
| (listify-key-sequence str) cmds)) | |
| (ayc-log "invoke: unread %S" unread-command-events)) | |
| (t (ayc-fallback-command this-command))) | |
| str))) | |
| (defun ayc-fallback-command (&optional except-command) | |
| "ayc-minor-mode を off にして本来のコマンドを実行する" | |
| (let* ((ayc-minor-mode nil) | |
| (keys (this-command-keys-vector)) | |
| (command (if keys (key-binding keys)))) | |
| (when (and (commandp command) | |
| (not (eq command except-command))) | |
| (setq this-command command) | |
| (call-interactively command)))) | |
| ;;================================================== | |
| ;; Preview | |
| (defvar ayc-preview-popup nil "popup インスタンス保存用") | |
| (make-variable-buffer-local 'ayc-preview-popup) | |
| (defun ayc-preview-check (str) | |
| "アルファベットが含まれてなければ t を返す。" | |
| (> 1 (loop for i across str | |
| count (and (<= 32 i) (< i 128))))) | |
| (defun ayc-preview-spell-check (str) | |
| "スペルチェッカーが文句を言わない単語を含んでいれば t を返す。" | |
| (with-temp-buffer | |
| (erase-buffer) | |
| (call-process-shell-command (format "echo '%s' | aspell -a" str) nil t) | |
| (goto-char (point-min)) | |
| (if (re-search-forward "^\\*" nil t) t nil))) | |
| (defun ayc-pre-command-hook () | |
| "[hack] カーソールの色を元に戻すなど。" | |
| (ayc-revert-cursor-color)) | |
| (defun ayc-get-current-cursor-color () | |
| "現在のカーソールの色を取得する" | |
| (frame-parameter (selected-frame) 'cursor-color)) | |
| (defun ayc-revert-cursor-color () | |
| "カーソールの色を変える" | |
| (cond | |
| (ayc-minor-mode ; ayc ON の時 | |
| (cond | |
| ((equal ayc-cursor-color (ayc-get-current-cursor-color))) ;; 期待通り 何もしない | |
| (t ;; 期待と違うのでカーソールの色を変える | |
| (set-cursor-color ayc-cursor-color)))) ;; backup は取ってるはずなので変えるだけ | |
| (t ; ayc OFF の時 | |
| (cond | |
| ((equal ayc-cursor-color (ayc-get-current-cursor-color)) ;; この色と違うはず | |
| (set-cursor-color (or ayc-cursor-color-backup | |
| ayc-cursor-color-backup-default))) | |
| (t )));; 多分何もしなくて大丈夫のはず | |
| )) | |
| (defun ayc-post-command-hook () | |
| "[hack] ここでリアルタイムにひらがなのプレビューを表示させる。" | |
| (ayc-preview-show)) | |
| (defun ayc-preview-show () | |
| "ひらがなのプレビューを表示させる。" | |
| (ignore-errors | |
| ;; まず以前のポップアップを消す | |
| (when (and ayc-preview-popup (popup-p ayc-preview-popup)) | |
| (popup-delete ayc-preview-popup) | |
| (setq ayc-preview-popup nil)) | |
| ;; プレビューネタを取得する | |
| (let* ((data (ayc-input-at-point)) | |
| (kana (ayc-romaji-to-kana (downcase data))) | |
| (check (ayc-preview-check kana))) | |
| (unless check ;; ひらがなでなかった場合 | |
| (setq kana | |
| (if (ayc-preview-spell-check data) "" ;; 英単語が含まれる場合は無視 | |
| (concat kana "★")))) ;; ミスタイプっぽかった場合は注意マークを追加する | |
| (when (and (< 0 (length kana)) | |
| (not (and (ac-menu-live-p) ; auto-complete が出てないとき | |
| (not (popup-hidden-p ac-menu))))) | |
| ;; プレビューを表示する | |
| (let ((win-width (window-width)) | |
| (win-height (window-height)) | |
| (line-start (line-beginning-position)) | |
| (popup-width (string-width kana)) | |
| (popup-height 1) (popup-pos (- (point) (length data)))) | |
| (when (< 1 (count-screen-lines line-start (point))) | |
| ;; 複数行の時は fill-column で改行させる | |
| ;; また、行を跨ぐときには邪魔にならないところに表示させる | |
| (let ((fill-column (- win-width 4))) | |
| (setq kana | |
| (with-temp-buffer | |
| (insert kana) | |
| (fill-paragraph) | |
| (setq popup-height | |
| (count-lines (point-min) (point-max)) | |
| popup-width (- win-width 4)) | |
| (buffer-string)))) | |
| (save-excursion | |
| (cond | |
| ((< (/ (* win-height 3) 4) | |
| (count-screen-lines (window-start) (point))) | |
| ;; 上側に表示する | |
| (goto-char (line-beginning-position)) | |
| (vertical-motion (- -1 popup-height)) | |
| (setq popup-pos (point))) | |
| (t | |
| ;; 下側に表示する | |
| (goto-char (1+ (line-end-position))) | |
| (vertical-motion -1) | |
| (setq popup-pos (point)))))) | |
| (setq ayc-preview-popup | |
| (popup-create | |
| popup-pos popup-width popup-height | |
| :around t :face | |
| (if (ayc-preview-check kana) | |
| 'ayc-preview-face 'ayc-preview-wrong-face))) | |
| (popup-set-list ayc-preview-popup (append (split-string kana "\n"))) | |
| (popup-draw ayc-preview-popup)))))) | |
| (defun ayc-preview-reposition () | |
| "[hack] auto-complete の popup の状態によって再度表示し直す" | |
| (when ayc-minor-mode | |
| (ayc-log "reposition: e%S / %S" ac-menu ayc-preview-popup) | |
| (cond | |
| ((and (ac-menu-live-p) ; ac-menu が表示されていて | |
| (not (popup-hidden-p ac-menu)) | |
| ayc-preview-popup (popup-p ayc-preview-popup)) ; プレビューがでているとき | |
| ;; 消す | |
| (popup-delete ayc-preview-popup) | |
| (setq ayc-preview-popup nil)) | |
| ((and (not (and (ac-menu-live-p) ; ac-menu が表示されていなくて | |
| (not (popup-hidden-p ac-menu)))) | |
| (not (popup-live-p ayc-preview-popup))) ; ひらがなプレビューが出てないとき | |
| (ayc-preview-show))))) | |
| (defadvice ac-update-candidates (after iiimcf-ayc-ac) | |
| (ayc-preview-reposition)) | |
| (ad-activate-regexp "^iiimcf-ayc-ac$") | |
| ;;(ad-deactivate-regexp "^iiimcf-ayc-ac$") | |
| ;;(ad-unadvise 'ac-update-candidates) | |
| ;;================================================== | |
| ;; Commit Hacks | |
| (defvar ayc-last-command-event nil) | |
| (make-variable-buffer-local 'ayc-last-command-event) | |
| ;; (defadvice call-interactively (around iiimcf-ayc-preedit) | |
| ;; (ayc-log "call-interactively:(%s) %S [%S]" (current-buffer) | |
| ;; this-command (this-command-keys)) | |
| ;; ad-do-it) | |
| (defadvice iiimcf-server-control-keyforward (around iiimcf-ayc-preedit) | |
| "[hack] iiimcf は一旦 preedit モードになるとキー入力を自前で全部処理してしまうので | |
| この関数を監視してキー入力を保存しておく。" | |
| (when ayc-minor-mode | |
| (let ((ch (ignore-errors keyseq))) | |
| (setq ayc-last-command-event | |
| (if (and (stringp ch) | |
| (< 31 (aref ch 0)) | |
| (< (aref ch 0) 128)) | |
| ch nil))) | |
| (ayc-log "server-control-keyforward:(%s) %S / %S [%S]" | |
| (current-buffer) | |
| this-command last-command | |
| ayc-last-command-event)) | |
| ad-do-it) | |
| ;;(ad-activate-regexp "^iiimcf-ayc-preedit$") | |
| ;;(ad-deactivate-regexp "^iiimcf-ayc-preedit$") | |
| ;;(ad-unadvise 'iiimcf-server-control-keyforward) | |
| (defun ayc-commit-hook () | |
| "[hack] 変換確定された後で呼ばれる。ここで一旦 IM 状態を切って、連続して入力できるようにする。 | |
| 続けて文字を入力する場合は、先頭の文字が iiimcf に食べられてしまうので、 | |
| ここで iiimcf-server-control-keyforward アドバイスを使って救う。" | |
| ;; str: from `iiimcf-UI-commit-string' | |
| (ayc-log "commit-hook:(%s) %s" (current-buffer) str) | |
| (ayc-record-commit-string ayc-last-invoked-string str) | |
| (setq ayc-last-invoked-string nil) | |
| (ignore-errors | |
| (setq unread-command-events | |
| (append unread-command-events | |
| (if ayc-last-command-event | |
| (list 'backspace)) | |
| (listify-key-sequence | |
| (where-is-internal 'toggle-input-method global-map t)) | |
| (if ayc-last-command-event | |
| (listify-key-sequence ayc-last-command-event)) | |
| )) | |
| (ayc-log "commit-hook: unread %S" unread-command-events) | |
| (ayc-log "commit-hook: ayc-last-key [%S]" ayc-last-command-event))) | |
| (defun ayc-inactive-hook () | |
| "[hack] ayc-commit-hook でIM 状態が非アクティブになるので、その | |
| 後このフックが呼ばれてプレビュー状態が再開される。" | |
| (ayc-preview-start) | |
| (setq ayc-last-invoked-string nil) | |
| (ayc-log "inactive-hook:(%s) unread %S" (current-buffer) unread-command-events) | |
| (setq ayc-last-command-event nil)) | |
| ;;================================================== | |
| ;; 補完関係 | |
| ;; ○ayc-record 構造体 | |
| ;; original : 元のローマ字 | |
| ;; commmitted : 変換された単語 | |
| ;; used-num : 累積採用回数 | |
| ;; last-used-time : 前回使った時間 (float-time) | |
| (defstruct ayc-record original committed used-num last-used-time) | |
| (defvar ayc-record-history-file (expand-file-name ".ayc-history" user-emacs-directory) | |
| "補完文字列を保存する場所") | |
| (defvar ayc-record-last-saved-time nil "最後に保存した時間。これよりもファイルの方が新しければ読み直す。") | |
| (defvar ayc-record-list-num 500 "履歴保存数") | |
| (defvar ayc-record-list nil "変換履歴") | |
| (defun ayc-record-save () | |
| "変換履歴を書き込む。タイムスタンプを比較して、ファイルの方が新しければ書き込まない。" | |
| (let ((file (expand-file-name ayc-record-history-file))) | |
| (when (or (not (file-exists-p file)) | |
| (null ayc-record-last-saved-time) | |
| (time-less-p (nth 5 (file-attributes file)) | |
| ayc-record-last-saved-time)) | |
| (let* ((coding-system-for-write 'utf-8) | |
| after-save-hook before-save-hook | |
| (buf (find-file-noselect file))) | |
| (unwind-protect | |
| (with-current-buffer buf | |
| (buffer-disable-undo) | |
| (erase-buffer) | |
| (insert | |
| (prin1-to-string | |
| (loop for i in (ayc-record-sort ayc-record-list) | |
| for idx from 0 below ayc-record-list-num collect | |
| (list | |
| (ayc-record-original i) | |
| (ayc-record-committed i) | |
| (ayc-record-used-num i) | |
| (ayc-record-last-used-time i))))) | |
| (save-buffer)) | |
| (kill-buffer buf))) | |
| (setq ayc-record-last-saved-time (current-time)) | |
| (ayc-log "Saved history list (%i)" (length ayc-record-list)))) | |
| nil) | |
| (defun ayc-record-load () | |
| "変換履歴を読み込む。タイムスタンプを比較して手元のデータの方が新しければ読み込まない。" | |
| (let* ((coding-system-for-read 'utf-8) | |
| (file (expand-file-name ayc-record-history-file))) | |
| (when (and (file-exists-p file) | |
| (or (null ayc-record-last-saved-time) | |
| (time-less-p ayc-record-last-saved-time | |
| (nth 5 (file-attributes file))))) | |
| (let ((buf (find-file-noselect file)) ret) | |
| (unwind-protect | |
| (setq ret (loop for i in (read buf) | |
| collect | |
| (make-ayc-record | |
| :original (car i) | |
| :committed (nth 1 i) | |
| :used-num (nth 2 i) | |
| :last-used-time (nth 3 i)))) | |
| (kill-buffer buf)) | |
| (setq ayc-record-last-saved-time (nth 5 (file-attributes file))) | |
| (setq ayc-record-list ret) | |
| (ayc-log "Load history list (%i)" (length ret)))))) | |
| (defun ayc-record-search-exact (key) | |
| "完全一致で検索する。見つからなかったら nil を返す。" | |
| (loop for i in ayc-record-list | |
| if (equal key (ayc-record-original i)) | |
| return i)) | |
| (defun ayc-record-commit-string (original committed) | |
| "確定文字列を記録する" | |
| (let ((prev (ayc-record-search-exact original))) | |
| (cond | |
| ((and prev (equal committed (ayc-record-committed prev))) | |
| (incf (ayc-record-used-num prev)) | |
| (setf (ayc-record-last-used-time prev) (float-time)) | |
| (ayc-log "record hit: %s / %i" original (ayc-record-used-num prev))) | |
| (t (push (make-ayc-record | |
| :original original :committed committed | |
| :used-num 1 :last-used-time (float-time)) | |
| ayc-record-list) ; 既にロードされていることが前提 | |
| (ayc-log "add record: %s" original))) | |
| (setq ayc-record-last-saved-time (current-time)))) | |
| (defun ayc-record-search-prefix (key) | |
| "先頭一致で検索する。結果はソートして返す。" | |
| (loop with ret = nil | |
| with key-len = (length key) | |
| for i in ayc-record-list | |
| for org = (ayc-record-original i) | |
| if (loop with len = (min key-len (length org)) ; 正規表現とどっちが速いか... | |
| for p from 0 below len | |
| unless (eql (aref key p) (aref org p)) | |
| return nil finally return t) | |
| do (push i ret) | |
| finally return (ayc-record-sort ret))) | |
| (defun ayc-record-sort (lst) | |
| "リストをソートして返す" | |
| (sort lst | |
| (lambda (x y) ; < | |
| (let ((xu (ayc-record-used-num x)) | |
| (yu (ayc-record-used-num y))) | |
| (cond | |
| ((> xu yu) t) ; 使用回数の多い方 | |
| ((= xu yu) | |
| (> (ayc-record-last-used-time x) ; 最近の方 | |
| (ayc-record-last-used-time y))) | |
| (t nil)))))) | |
| (defvar ayc-record-candidate-org-max 16 "一覧に出す補完ローマ字の最大文字数") | |
| (defvar ayc-record-candidate-com-max 20 "一覧に出す補完変換文字列の最大幅") | |
| (defvar ayc-record-candidate-show-document nil "補完一欄内で完全な内容を表示するかどうか") | |
| (defun ayc-record-candidate-transient-item (str) | |
| "ひらがな変換用のレコード作成" | |
| (make-ayc-record | |
| :original str :committed (ayc-romaji-to-kana str) | |
| :used-num 1000000 :last-used-time (float-time))) | |
| (defun ayc-record-candidates () | |
| "auto-complete 用の関数" | |
| (condition-case err | |
| (loop with search-list = (ayc-record-search-prefix ac-prefix) | |
| with clist = (if search-list | |
| (append | |
| (list (ayc-record-candidate-transient-item | |
| (substring-no-properties ac-prefix))) | |
| search-list)) | |
| for i in clist | |
| for org = (ayc-record-original i) | |
| for com = (ayc-record-committed i) | |
| collect | |
| (cons | |
| (propertize | |
| (substring-no-properties | |
| org 0 (min (length org) ayc-record-candidate-org-max)) | |
| 'summary (truncate-string-to-width | |
| (substring com 0) ayc-record-candidate-com-max 0 nil t) | |
| (if ayc-record-candidate-show-document 'document 'x-document) | |
| (format "%s\n%s" org com)) | |
| i)) | |
| (t (ayc-log "ERROR : %S" err)))) | |
| (defun ayc-record-complete-action () | |
| "auto-complete で補完されたときに呼ばれる。" | |
| (ayc-log "COMPLETE: %S" candidate) | |
| (when (and candidate (get-text-property 0 'value candidate)) | |
| (let ((record (get-text-property 0 'value candidate))) | |
| ;; auto-complete で既に入力されているものを消す | |
| (when (re-search-backward (regexp-quote candidate)) | |
| (replace-match "")) | |
| (insert (ayc-record-committed record)) | |
| (incf (ayc-record-used-num record)) | |
| (setf (ayc-record-last-used-time record) (float-time))))) | |
| (defun ayc-record-complete-prefix () | |
| (let ((poss (ayc-collect-word)) (pose (point))) | |
| ;;(ayc-log "ac-prefix: %s" (buffer-substring-no-properties poss pose)) | |
| (and (< poss pose) poss))) | |
| (defun ayc-record-setup-auto-complete () | |
| "auto-complete 用の諸々をセットアップする。" | |
| (unless (ignore-errors (symbol-value 'ac-source-iiimcf)) | |
| (ac-define-source iiimcf | |
| '((candidates . ayc-record-candidates) | |
| (action . ayc-record-complete-action) | |
| (symbol . "d") | |
| (prefix . ayc-collect-word))) | |
| (unless (assoc-default 'ayc-collect-word ac-prefix-definitions) | |
| (ac-define-prefix 'ayc-collect-word | |
| 'ayc-record-complete-prefix)))) | |
| (defvar ayc-record-auto-complete nil "AYC で auto-complete 使うかどうか.") | |
| (defvar ayc-record-auto-complete-backup nil "auto-complete-mode のバックアップ。") | |
| (make-variable-buffer-local 'ayc-record-auto-complete-backup) | |
| (defvar ayc-record-disable-faces nil "auto-complete の補完をさせたくない face 名のリスト。") | |
| (defvar ayc-record-disable-faces-backup nil "ac-disable-faces のバックアップ。") | |
| (make-variable-buffer-local 'ayc-record-disable-faces-backup) | |
| (defvar ayc-record-ac-quick-help-delay-backup nil "ac-quick-help-delay のバックアップ。") | |
| (defvar ayc-record-ac-quick-help-delay 1.5 "ac-quick-help ( 完全な変換文字列表示用のポップアップ ) 表示までの時間。なるべく速い方が便利そうなので。") | |
| (defun ayc-record-ac-on () | |
| "minor-mode on 時の auto-complete 開始処理。" | |
| (when ayc-record-auto-complete | |
| (ayc-record-load) | |
| (ayc-record-setup-auto-complete) | |
| (setq ayc-record-disable-faces-backup ac-disable-faces ; ac-disable-faces 待避 | |
| ac-disable-faces ayc-record-disable-faces ; ac-disable-faces 入れ替え | |
| ayc-record-ac-quick-help-delay-backup ac-quick-help-delay ; ac-quick-help-delay 待避 | |
| ac-quick-help-delay ayc-record-ac-quick-help-delay ; ac-quick-help-delay 入れ替え | |
| ayc-record-auto-complete-backup auto-complete-mode) ; auto-complete-mode 待避 | |
| (unless (memq 'ac-source-iiimcf ac-sources) ; ac-sources 入れ替え | |
| (push 'ac-source-iiimcf ac-sources)) | |
| (auto-complete-mode 1))) | |
| (defun ayc-record-ac-off () | |
| "minor-mode off 時の auto-complete 終了処理。" | |
| (when ayc-record-auto-complete | |
| (when (memq 'ac-source-iiimcf ac-sources) ; ac-sources 戻す | |
| (setq ac-sources (delete 'ac-source-iiimcf ac-sources))) | |
| (setq ac-disable-faces ayc-record-disable-faces-backup) ; ac-disable-faces 戻す | |
| (ayc-record-save) | |
| (unless ayc-record-auto-complete-backup ; auto-complete-mode 戻す | |
| (auto-complete-mode -1)) | |
| (setq ayc-record-auto-complete-backup nil))) | |
| ;;================================================== | |
| ;; 辞書メンテナンス | |
| (defun ayc-record-remove (records) | |
| "辞書メンテナンス。辞書から削除する。" | |
| (dolist (i records) | |
| (ayc-log "reocrd remove: %S" i) | |
| (setq ayc-record-list (delete i ayc-record-list)))) | |
| (defun ayc-record-reset-used-count (record) | |
| "辞書メンテナンス。利用回数カウンタを 1 にもどす。" | |
| (dolist (i records) | |
| (ayc-log "reocrd reset: %S" i) | |
| (setf (ayc-record-used-num i) 1))) | |
| (defun ayc-record-anything-source () | |
| "辞書メンテナンス用の anything source を返す" | |
| '((name . "Accounts : ") | |
| (candidates | |
| . (lambda () | |
| (mapcar | |
| (lambda (record) | |
| (cons (concat | |
| "[" (number-to-string (ayc-record-used-num record)) "] " | |
| (ayc-record-committed record) | |
| " / " (ayc-record-original record) | |
| " " (format-time-string | |
| "%Y/%m/%d %H:%M:%S" | |
| (seconds-to-time (ayc-record-last-used-time record)))) | |
| record)) | |
| ayc-record-list))) | |
| (action | |
| . (("Remove" | |
| . (lambda (ignore) | |
| (when (y-or-n-p "Rmove the records? ") | |
| (ayc-record-remove (anything-marked-candidates))))) | |
| ("Reset used-count to 1" | |
| . (lambda (record) | |
| (ayc-record-reset-used-count (anything-marked-candidates)))))))) | |
| (defun ayc-record-anything () | |
| "辞書メンテナンス anything" | |
| (interactive) | |
| (anything (ayc-record-anything-source))) | |
| ;;================================================== | |
| ;; 逆変換 | |
| (defvar ayc-last-commit-point nil "最後に変換確定した場所。ここ以外での確定キャンセルは、形態素解析に回す。") | |
| (make-variable-buffer-local 'ayc-last-commit-point) | |
| (defvar ayc-reverse-delimiter-regexp | |
| (concat "[][\n\r\t " | |
| ",.?!()-=+|/&$#@~:;\"{}<>" | |
| "、。 ※・？！（）＝＋｜＆＄＃＠：；”’" | |
| "｛｝＜＞「」【】○●◎■□◇◆△▲▽▼]") | |
| "逆変換の先頭を探す目印の正規表現") | |
| (defvar ayc-reverse-through-delimiters | |
| "、。※・？！（）＝＋｜＆＄＃＠：；”’｛｝＜＞「」【】○●◎■□◇◆△▲▽▼" | |
| "直前ならやっぱり逆変換に含めたい文字列") | |
| (defun ayc-reverse-search-begin () | |
| "現在のポイント位置から前に走査して、逆変換を開始する位置を返す。 | |
| 見つからなかったら現在のポイント位置を返す。" | |
| (save-excursion | |
| (when (and ; 直前の文字が through-delimiters に含まれていれば無視する | |
| (char-before) | |
| (loop with prechar = (char-before) | |
| for i across ayc-reverse-through-delimiters | |
| if (eql i prechar) | |
| return t finally return nil)) | |
| (goto-char (1- (point)))) | |
| (or | |
| (and (re-search-backward ayc-reverse-delimiter-regexp nil t) | |
| (1+ (point))) | |
| (line-beginning-position)))) | |
| (defvar ayc-reverse-translate-driver 'ayc-reverse-translate-driver-mecab "形態素解析に何を使うか。 | |
| 今のところ 'ayc-reverse-translate-driver-mecab / 'ayc-reverse-translate-driver-chasen が使える。 | |
| ドライバーは変換済み文字列を受け取って、元の単語と読みのひらがなの alist を返す。") | |
| (defun ayc-reverse-translate-driver-mecab (kanji) | |
| "MeCab driver" | |
| (let (result) | |
| (with-temp-buffer | |
| (call-process-shell-command | |
| (format "echo '%s' | mecab " kanji) nil t) | |
| (goto-char (point-min)) | |
| (while (re-search-forward "^\\([^\t]+\\)\t\\(.*\\)$" nil t) | |
| (let* ((org (match-string 1)) | |
| (cols (match-string 2)) | |
| (yomi (nth 7 (split-string cols ",")))) | |
| (push (cons org | |
| (japanese-hiragana | |
| (if yomi yomi org))) | |
| result)))) | |
| (nreverse result))) | |
| (defun ayc-reverse-translate-driver-chasen (kanji) | |
| "ChaSen driver" | |
| (let (result) | |
| (with-temp-buffer | |
| (call-process-shell-command | |
| (format "echo '%s' | chasen " kanji) nil t) | |
| (goto-char (point-min)) | |
| (while (re-search-forward "^\\([^\t]+\\)\t\\([^\t]*\\)\t.*$" nil t) | |
| (let* ((org (match-string 1)) | |
| (yomi (match-string 2))) | |
| (push (cons org | |
| (japanese-hiragana | |
| (if (or (string-match "[0-9a-zA-Z]" org) | |
| (or (null yomi) (= 0 (length yomi)))) | |
| org yomi))) | |
| result)))) | |
| (nreverse result))) | |
| (defun ayc-reverse-translate-driver (kanji) | |
| "漢字からひらがな・単語区切りにする。実際にはドライバーに丸投げする。" | |
| (funcall ayc-reverse-translate-driver kanji)) | |
| (defun ayc-reverse-kanji-to-kana (kanji) | |
| "漢字からひらがなにする。" | |
| (let ((words (ayc-reverse-translate-driver kanji))) | |
| (when words | |
| (loop for (org . kana) in words | |
| concat kana)))) | |
| (defvar ayc-kana-regexp | |
| (regexp-opt | |
| (mapcar 'cdr (sort (copy-sequence ayc-romaji-kana-table) | |
| (lambda (i j) (> (length (cdr i)) | |
| (length (cdr j))))))) | |
| "かなを拾う正規表現。 ayc-romaji-kana-table を更新したらこの変数も更新すること。") | |
| (defun ayc-reverse-kana-to-romaji (source) | |
| "アルファベットローマ字にする。" | |
| (with-temp-buffer | |
| (insert source) | |
| (goto-char (point-min)) | |
| (while (re-search-forward ayc-kana-regexp nil t) | |
| (let ((match (match-string 0))) | |
| (replace-match | |
| (car (rassoc match ayc-romaji-kana-table))))) | |
| (buffer-string))) | |
| (defun ayc-reverse-test () | |
| "逆変換のテスト" | |
| (interactive) | |
| (pop-to-buffer "*atok-kanji-to-romaji-test*") | |
| (erase-buffer) | |
| (loop for q in '(ayc-reverse-translate-driver-mecab | |
| ayc-reverse-translate-driver-chasen) | |
| do | |
| (let ((ayc-reverse-translate-driver q)) | |
| (insert "==(" (symbol-name q) ")==========\n") | |
| (loop for (in out) in | |
| '(("太郎は花子が好きだ" "tarouhahanakogasukida") ; 普通 | |
| ("今日は良い天気ですね" "kyouhayoiten'kidesune") ; ん | |
| ("東京特許許可局" "toukyoutoxtukyokyokakyoku") ; 小さいつ | |
| ("1太郎は花子が好きだ" "1tarouhahanakogasukida") ; 数字込み | |
| ("デフォルトのカーソールの色" "deforutonoka-so-runoiro") ; 未知語 | |
| ("AはBを含む。" "AhaBwohukumu.") ; アルファベット込み | |
| ("MySQLにJSONを登録する。" "MySQLniJSONwotourokusuru.")) ; 英単語込み | |
| for kana = (ayc-reverse-kanji-to-kana in) | |
| for romaji = (ayc-reverse-kana-to-romaji kana) | |
| do | |
| (insert (format "%s : %s / %s / %s <= %s\n" | |
| (if (equal romaji out) "OK" "NG") | |
| out romaji kana in)))))) | |
| ;; (ayc-reverse-test) | |
| (defun ayc-reverse-translate () | |
| "現在のポイント位置から逆変換を試みる" | |
| (interactive) | |
| (let ((poss (if (region-active-p) | |
| (min (mark) (point)) | |
| (ayc-reverse-search-begin))) | |
| (pose (if (region-active-p) | |
| (max (mark) (point)) (point))) | |
| org romaji) | |
| (when (< poss pose) | |
| (setq org (buffer-substring poss pose) | |
| romaji (ayc-reverse-kana-to-romaji | |
| (ayc-reverse-kanji-to-kana org))) | |
| (delete-region poss pose) | |
| (ayc-preview-stop) | |
| (setq ayc-last-invoked-string romaji) | |
| (call-interactively 'toggle-input-method) | |
| (setq unread-command-events | |
| (append unread-command-events | |
| (listify-key-sequence romaji) '(?\ ))) ;; ※サーバー設定依存 | |
| (ayc-log "reverse: unread %S" unread-command-events)))) | |
| ;;================================================== | |
| ;; API / Commands | |
| (defun ayc-hiragana () | |
| "ローマ字を拾ってひらがなにして変換確定する" | |
| (interactive) | |
| (ayc-invoke '(return))) ;; ※サーバー設定依存 | |
| (defun ayc-henkan () | |
| "ローマ字を拾って変換する" | |
| (interactive) | |
| (ayc-invoke '(?\ ))) ;; ※サーバー設定依存 | |
| (defun ayc-katakana () | |
| "ローマ字を拾ってカタカナにして変換確定する" | |
| (interactive) | |
| (ayc-invoke '(f7 return))) ;; ※サーバー設定依存 | |
| (defun ayc-insert-space () | |
| (interactive) | |
| (let ((poss (ayc-collect-word))) | |
| (when (< poss (point)) | |
| (ayc-auto-adjust-space-insert poss))) | |
| (insert " ")) | |
| (defun ayc-backward-delete-char-length () | |
| "ayc-romaji-kana-table から総当たりで最長一致の場所を見つける。 | |
| (re-search-backward は最短一致でしか見つけてくれないため)" | |
| (loop with start = (point) | |
| with maxlen = 0 | |
| for (romaji . kana) in ayc-romaji-kana-table | |
| for len = | |
| (loop with len = (length romaji) | |
| for i from 0 below len | |
| unless (eql (char-before (- start i)) (aref romaji (- len i 1))) | |
| return nil finally return len) | |
| if len do (setq maxlen (max maxlen len)) (ayc-log "HIT : %s" len) | |
| finally return maxlen)) | |
| (defun ayc-backward-delete-char () | |
| "ローマ字単位で一文字バックスペースする" | |
| (interactive) | |
| (cond | |
| (ayc-minor-mode | |
| (backward-delete-char (max 1 (ayc-backward-delete-char-length)))) | |
| (t (backward-delete-char 1)))) | |
| (defun ayc-delete-char () | |
| "ローマ字単位で一文字削除削除する" | |
| (interactive) | |
| (unless | |
| (and t ;ayc-minor-mode | |
| (save-excursion | |
| (let ((start (point)) | |
| (end (re-search-forward ayc-romaji-regexp nil t))) | |
| (when (and end (= (- end start) (length (match-string 0)))) | |
| (delete-region start end) t)))) | |
| (delete-char 1))) | |
| (defun ayc-complete () | |
| "auto-complete で補完をする。 ayc-record-auto-complete が nil の時に使うと便利。" | |
| (interactive) | |
| (ayc-record-setup-auto-complete) | |
| (let ((auto-complete-mode t)) | |
| (auto-complete (list ac-source-iiimcf)))) | |
| (defun ayc-preview-start () | |
| "プレビュー表示を開始する。漢字変換中は停止する。" | |
| (ayc-log "preview-start") | |
| (add-hook 'post-command-hook 'ayc-post-command-hook nil t)) | |
| (defun ayc-preview-stop () | |
| "プレビュー表示を停止する。" | |
| (ayc-log "preview-stop") | |
| (remove-hook 'post-command-hook 'ayc-post-command-hook t) | |
| (when ayc-preview-popup | |
| (and ayc-preview-popup (popup-p ayc-preview-popup)) | |
| (popup-delete ayc-preview-popup) | |
| (setq ayc-preview-popup nil))) | |
| ;;================================================== | |
| ;; Minor Mode Definition | |
| (defun ayc-minor-mode-off-command () | |
| (interactive) | |
| (ayc-minor-mode -1)) | |
| (defun ayc-define-keymap (keymap-list) | |
| (let ((map (make-sparse-keymap))) | |
| (mapc | |
| (lambda (i) | |
| (define-key map | |
| (if (stringp (car i)) | |
| (read-kbd-macro (car i)) (car i)) | |
| (cdr i))) | |
| keymap-list) | |
| map)) | |
| (defvar ayc-minor-mode-keymap | |
| (ayc-define-keymap | |
| '( | |
| ("RET" . ayc-hiragana) | |
| ("SPC" . ayc-henkan) | |
| ("S-SPC" . ayc-insert-space) | |
| ("<backspace>" . ayc-backward-delete-char) | |
| ("C-h" . ayc-backward-delete-char) | |
| ("<delete>" . ayc-delete-char) | |
| ("C-d" . ayc-delete-char) | |
| ("C-<backspace>" . ayc-reverse-translate) | |
| ("TAB" . ayc-complete) | |
| ))) | |
| (defvar ayc-cursor-color-backup nil "前のカーソールの色を覚えておく") | |
| (make-variable-buffer-local 'ayc-cursor-color-backup) | |
| (defvar ayc-cursor-color-backup-default (ayc-get-current-cursor-color) | |
| "デフォルトのカーソールの色。 ayc-cursor-color-backup が存在しな | |
| い場合で元の色に戻したいときにこの色にする。") | |
| (defvar ayc-minor-mode-hook nil) | |
| (defvar ayc-minor-mode nil) ; dummy | |
| (defun ayc-minor-mode-move () | |
| (let ((pair (assq 'ayc-minor-mode minor-mode-map-alist))) | |
| (when pair | |
| (setq minor-mode-map-alist | |
| (cons pair (delq pair minor-mode-map-alist)))))) | |
| (define-minor-mode ayc-minor-mode | |
| "Yet Another YC mode" | |
| :init-value nil | |
| :lighter " 漢" | |
| :keymap ayc-minor-mode-keymap | |
| :group 'ayc-mode | |
| (if ayc-minor-mode | |
| (progn | |
| (ayc-minor-mode-setup) | |
| (run-hooks 'ayc-minor-mode-hook)) | |
| (ayc-minor-mode-abort))) | |
| (defun ayc-minor-mode-setup () | |
| (add-hook 'pre-command-hook 'ayc-pre-command-hook) ; global | |
| (ad-activate-regexp "^iiimcf-ayc-preedit$") | |
| (add-hook 'input-method-after-insert-chunk-hook 'ayc-commit-hook nil t) | |
| (add-hook 'input-method-inactivate-hook 'ayc-inactive-hook nil t) | |
| (add-hook 'isearch-mode-hook 'ayc-preview-stop nil t) | |
| (add-hook 'isearch-mode-end-hook 'ayc-preview-start nil t) | |
| (ayc-minor-mode-move) | |
| (setq ayc-last-command-event nil) | |
| (unless ayc-cursor-color-backup | |
| (setq ayc-cursor-color-backup | |
| (frame-parameter (selected-frame) 'cursor-color))) | |
| (set-cursor-color ayc-cursor-color) | |
| (ayc-record-ac-on) | |
| (ayc-preview-start)) | |
| (defun ayc-exist-active-buffer-p () | |
| "ayc-minor-mode が on になっているバッファがあれば t を返す。 | |
| アドバイスやフックを消すタイミングを決定するために調べる。" | |
| (loop for i in (buffer-list) | |
| if (buffer-local-value 'ayc-minor-mode i) | |
| return t)) | |
| (defun ayc-minor-mode-abort () | |
| (ayc-preview-stop) | |
| (setq ayc-last-command-event nil) | |
| (remove-hook 'input-method-after-insert-chunk-hook 'ayc-commit-hook t) | |
| (remove-hook 'input-method-inactivate-hook 'ayc-inactive-hook t) | |
| (remove-hook 'isearch-mode-hook 'ayc-preview-stop t) | |
| (remove-hook 'isearch-mode-end-hook 'ayc-preview-start t) | |
| (unless (ayc-exist-active-buffer-p) | |
| (ad-deactivate-regexp "^iiimcf-ayc-preedit$") | |
| (remove-hook 'pre-command-hook 'ayc-pre-command-hook)) | |
| (if current-input-method ;; IM も切る | |
| (inactivate-input-method)) | |
| (ayc-record-ac-off) | |
| (when ayc-cursor-color-backup | |
| (set-cursor-color ayc-cursor-color-backup) | |
| (setq ayc-cursor-color-backup nil))) | |
| (defun toggle-ayc-minor-mode () | |
| (interactive) | |
| (ayc-minor-mode | |
| (if ayc-minor-mode -1 1))) | |
| ;; (eval-current-buffer) | |
| ;; (global-set-key (kbd "C-o") 'toggle-ayc-minor-mode) | |
| ;; (set-cursor-color "black") | |
| ;; iiimcf-server-control-enable | |
| ;; (inactivate-input-method) | |
| ;; (setq iiimcf-server-control-enable nil) | |
| ;; (iiimcf-server-control-delete-ic iiimcf-server-control-ic-id) | |
| (provide 'iiimcf-yc) | |
| ;;; iiimcf-yc.el ends here |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment