X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=its-keydef.el;h=5e3a8353d22964e72d2d88297762741a19bf08df;hb=5aed272165474232c184fca0eea0615d0d24eb03;hp=8c617f7cb06a5219e2ac86354fb0c767d7947375;hpb=050d3888c6f1c173ba3be512dcaf7c66f4da7eca;p=elisp%2Fegg.git diff --git a/its-keydef.el b/its-keydef.el index 8c617f7..5e3a835 100644 --- a/its-keydef.el +++ b/its-keydef.el @@ -1,67 +1,88 @@ (eval-when-compile (require 'cl)) -(defvar its-current-language "Japanese") - (defvar its-zhuyin nil) (make-variable-buffer-local 'its-zhuyin) +(put 'its-zhuyin 'permanent-local t) -(defun its-make-select-func (key name file map &optional lang zhuyin) - (setq name (intern (concat "its-select-" (symbol-name name))) - file (intern (concat "its/" (symbol-name file))) - map (intern (concat "its-" (symbol-name map) "-map")) - lang (symbol-name lang)) - (cons - `(defun ,name (&optional mode-line-unchange) - (interactive) - (cond - ((its-in-fence-p) - (its-input-end) - (its-put-cursor t)) - ((egg-get-bunsetsu-info (point)) - (egg-exit-conversion))) - ,(if lang `(egg-check-language ,lang)) - (require ',file) - (setq its-current-map ,map) - ,(if lang `(setq its-current-language ,lang)) - ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T))) - (if (null mode-line-unchange) - (egg-set-mode-line-title))) - `(define-key map ,(concat "\C-x\C-m" key) ',name))) +(eval-and-compile + (defun its-make-select-func (key1 key2 func file map &optional zhuyin) + (setq func (intern (concat "its-select-" (symbol-name func))) + file (intern (concat "its/" (symbol-name file))) + map (intern (concat "its-" (symbol-name map) "-map"))) + (cons + `(defun ,func (&optional temporally mode-line-unchange) + (interactive "P") + (if temporally + (its-select-mode-temporally ',func) + (let ((inhibit-read-only t)) + (require ',file) + (cond + ((its-in-fence-p) + (its-input-end) + (its-put-cursor t)) + ((egg-get-bunsetsu-info (point)) + (egg-exit-conversion))) + (setq its-current-select-func ',func + its-current-map ',map) + (if (its-get-language ,map) + (setq its-current-language (its-get-language ,map))) + ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T))) + (if (null mode-line-unchange) + (its-set-mode-line-title))))) + `(,func ,(concat "\C-x\C-m" key1) ,(concat "\e" key2))))) (defmacro its-do-list-make-select-func (list) - (eval-when (eval compile) - (let (funcs keydefs pair) - (while list - (setq pair (apply 'its-make-select-func (car list))) - (setq funcs (cons (car pair) funcs) - keydefs (cons (cdr pair) keydefs)) - (setq list (cdr list))) - `(progn - ,@funcs - (defun its-define-select-keys (map) - ,@keydefs))))) + (let (funcs keydefs pair) + (while list + (setq pair (apply 'its-make-select-func (car list)) + funcs (cons (car pair) funcs) + keydefs (cons (cdr pair) keydefs) + list (cdr list))) + `(progn + ,@funcs + (defvar its-define-select-key-list ',keydefs)))) + +(defmacro its-add-select-funcs (list) + (let (funcs keydefs pair) + (while list + (setq pair (apply 'its-make-select-func (car list)) + funcs (cons (car pair) funcs) + keydefs (cons (cdr pair) keydefs) + list (cdr list))) + `(progn + ,@funcs + (setq its-define-select-key-list + (append ',keydefs its-define-select-key-list))))) + +(defun its-define-select-keys (map &optional fence) + (let ((key-list its-define-select-key-list)) + (while key-list + (define-key map (nth 1 (car key-list)) (car (car key-list))) + (if fence + (define-key map (nth 2 (car key-list)) (car (car key-list)))) + (setq key-list (cdr key-list))))) (its-do-list-make-select-func - (("Q" upcase ascii up) - ("q" downcase ascii down) - ("h" hiragana hira hira Japanese) - ("K" katakana kata kata Japanese) - ("x" hankaku-katakana hankata han-kata Japanese) - ("Z" zenkaku-upcase zenkaku zenkaku-up Japanese) - ("z" zenkaku-downcase zenkaku zenkaku-down Japanese) - ("\C-e" erpin-cn erpin erpin-cn Chinese-GB NIL) - ("\C-p" pinyin-cn pinyin pinyin-cn Chinese-GB NIL) - ("\C-z" zhuyin-cn zhuyin zhuyin-cn Chinese-GB T) - ("\C-u" quanjiao-upcase-cn quanjiao quanjiao-up-cn Chinese-GB) - ("\C-d" quanjiao-downcase-cn quanjiao quanjiao-down-cn Chinese-GB) - ("E" erpin-tw erpin erpin-tw Chinese-CNS NIL) - ("P" pinyin-tw pinyin pinyin-tw Chinese-CNS NIL) - ("Z" zhuyin-tw zhuyin zhuyin-tw Chinese-CNS T) - ("U" quanjiao-upcase-tw quanjiao quanjiao-up-tw Chinese-CNS) - ("C" quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS) - ("H" hangul hangul hangul Korean) - ("J" jeonkak-upcase jeonkak jeonkak-up Korean) - ("j" jeonkak-downcase jeonkak jeonkak-down Korean))) + (("Q" "Q" upcase ascii up) + ("q" "q" downcase ascii down) + ("h" "\C-h" hiragana hira hira) + ("k" "\C-k" katakana kata kata) + ("x" "\C-x" hankaku-katakana hankata han-kata) + ("Z" "Z" zenkaku-upcase zenkaku zenkaku-up) + ("z" "z" zenkaku-downcase zenkaku zenkaku-down) + ("\C-e" "\C-e" erpin-cn erpin erpin-cn NIL) + ("\C-p" "\C-p" pinyin-cn pinyin pinyin-cn NIL) + ("\C-z" "\C-z" zhuyin-cn zhuyin zhuyin-cn T) + ("\C-u" "\C-u" quanjiao-upcase-cn quanjiao quanjiao-up-cn) + ("\C-d" "\C-d" quanjiao-downcase-cn quanjiao quanjiao-down-cn) + ("E" "E" erpin-tw erpin erpin-tw NIL) + ("P" "P" pinyin-tw pinyin pinyin-tw NIL) + ("C" "C" zhuyin-tw zhuyin zhuyin-tw T) + ("U" "U" quanjiao-upcase-tw quanjiao quanjiao-up-tw) + ("D" "D" quanjiao-downcase-tw quanjiao quanjiao-down-tw) + ("H" "H" hangul hangul hangul) + ("J" "J" jeonkak-upcase jeonkak jeonkak-up) + ("j" "j" jeonkak-downcase jeonkak jeonkak-down))) (provide 'its-keydef)