From: akr Date: Sat, 27 Jan 2001 18:55:20 +0000 (+0000) Subject: tamago-current.diff.gz in [tamago:00423] is applied. X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=918ba29ce6f7a775f27fe20929d8a9869fe0bde2;p=elisp%2Ftamago.git tamago-current.diff.gz in [tamago:00423] is applied. --- diff --git a/ChangeLog b/ChangeLog index 6ac9d2d..699623f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,129 @@ +2000-06-02 KATAYAMA Yoshio + + * egg/wnn.el (wnn): Fix docstring. + (wnn-backend-plist): Include egg-special-candidate. + (wnn-special-candidate): New function. + (wnn-pinyin-zhuyin-bunsetsu, wnn-pinyin-zhuyin-string): New + functions. + (egg-activate-wnn): Fix docstring. + + * egg/sj3.el (sj3, egg-activate-sj3): Fix docstring. + + * egg/canna.el (egg-activate-canna): Fix docstring. + + * menudiag.el: Mostly rewritten. + + * leim-list.el: Docstrings for autoload fixed. + + * its.el (its): Fix docstring. + (its-mode-map): Fix bindings. + (its-fence-mode, egg-sub-mode-map-alist): New variables. + (its-enter/leave-fence): New function. + (its-put-cursor): Add text properties point-entered, point-left, + modification-hooks. + (its-in-fence-p): Check also read-only property. + (its-hiragana, its-katakana): Just call its-convert. + (its-hankaku, its-japanese-hankaku): These functions deleted. + (its-full-half-table, its-half-full-table): New variables. + Initialize them. + (its-half-width, its-full-width): New functions. + (its-convert): Args changed. + + * its-keydef.el (its-make-select-func): Add check by + (egg-conversion-fence-p). + + * egg.el (egg): Fix docstring. + (egg-current-keymap): This variable deleted. + (egg-mode-map-alist, egg-sub-mode-map-alist): New variables. + (define-egg-mode-map): New macro. + (modefull, modeless): New egg mode maps. + (egg-enter/leave-fence-hook): New variable. + (egg-enter/leave-fence): New function. + (egg-activated): New variable. + (egg-activate-keymap): New variable. + (egg-modify-fence, egg-post-command-func): New functions. + (egg-change-major-mode-buffer): New variable. + (egg-activate-keymap-after-command, egg-change-major-mode-func): + New functions. + (egg-mode): Initialize egg-modefull-mode, egg-modeless-mode. + (egg-modefull-map, egg-modeless-map): These functions deleted. + (egg-set-face): Preserve the current modification-hooks property. + + * egg-com.el (ccl-decode-egg-binary): Fix BUFFER-MAGNIFICATION. + (ccl-encode-egg-binary): Likewise. + + * egg-cnv.el (egg-conv): Fix docstring. + (egg-conversion-auto-candidate-menu): Fix docstring. + (egg-conversion-auto-candidate-menu-show-all): New variable. + (egg-conversion-sort-by-converted-string): New variable. + (egg-conversion-fence-p): New function. + (egg-define-backend-functions): Include egg-special-candidate. + (egg-conversion-map): Define up, down, etc. + (egg-conversion-mode): New variable. Register it in + egg-sub-mode-map-alist. + (egg-conversion-enter/leave-fence): New function. Register it in + egg-enter/leave-fence-hook. + (egg-exit-conversion-unread-char): Use single setq. + (egg-make-bunsetsu): Add text properties point-entered and + point-left. + (egg-set-menu-mode-in-use, egg-unset-menu-mode-in-use) + (egg-set-candsel-info): Args changed. + (egg-get-candsel-target-major): Code changed. + (egg-get-candsel-target-minor): Code changed. + (egg-insert-new-bunsetsu): Args changed. + (egg-candidate-select-counter): Make it buffer local. + (egg-next-candidate-internal): Args changed. + (egg-sort-item): New functions. + (egg-select-candidate-major): New arg SORT. + (egg-select-candidate-minor, egg-select-candidate-list-all-major) + (egg-select-candidate-list-all-minor) + (egg-select-candidate-internal): Likewise. + (egg-hiragana): New function. + (egg-katakana, egg-pinyin, egg-zhuyin, egg-hangul): Aliases of + egg-hiragana. + (egg-special-convert): New function. + (egg-enlarge-bunsetsu-internal): Code changed. + (egg-reconvert-bunsetsu-internal, egg-decide-before-point) + (egg-decide-first-char, egg-exit-conversion) + (egg-abort-conversion): Likewise. + +2000-02-01 Takanori Saneto + + * egg/sj3rpc.el (sj3rpc-tanbunsetsu-conversion): should use + let* instead of let. + +2000-01-20 Katsumi Yamaoka + + * egg/sj3.el (sj3-word-registration): New function. + (sj3-hinshi-select): New function. + (sj3-dictionary-select): New function. + (sj3-conversion-backend): Add `sj3-word-registration'. + (sj3-hinshi-name): New function. + (sj3-hinshi-menu): New variable. + (sj3-register-2, sj3-register-1): Add messages. + (sj3-server-coding-system-list): Remove. + (sj3-server-version): Move to egg/sj3rpc.el. + (sj3-server-port, sj3-hostname): Strip "*" from the doc string. + + * egg/sj3rpc.el (sj3rpc-add-word): New function. + (sj3rpc-kugiri-stdy, sj3rpc-get-bunsetsu-candidates): Use + `sj3-server-coding-system' insted of `sj3rpc-server-coding-system'. + (sj3rpc-tanbunsetsu-conversion, sj3rpc-get-bunsetsu-candidates-sub, + sj3rpc-begin): Use `sj3-server-coding-system' insted of + `sj3rpc-server-coding-system'; don't specify an argument of + `sj3rpc-unpack-mb-string'. + (sj3rpc-unpack-mb-string): Don't allow the argument; use + `sj3rpc-server-coding-system'. + (sj3rpc-server-coding-system): Remove macro. + (sj3-const): Switch on the return value of `sj3-sjis-p' instead of + `sj3-server-version'. + (sj3-sjis-p): New macro. + (sj3-server-coding-system): New variable; default to `shift_jis'. + (sj3-server-version): Move from egg/sj3.el; use `defvar' insted of + `defcustom'. + + * eggrc: Remove SJ3 stuff. + 2000-01-17 TOMURA Satoru * Version 4.0.6 released diff --git a/Makefile.in b/Makefile.in index 87793ce..9ace87d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -31,7 +31,7 @@ INSTALL_INFO = install-info # ;; install files into the emacs site-lisp directory # ;; ex. /usr/local/share/emacs/site-lisp/egg -DEPS = -l ./docomp.el +DEPS = -l ./docomp.el -l ./jisx0213.el BATCHFLAGS = -batch -q -no-site-file -no-init-file ETCS = Makefile docomp.el \ @@ -62,6 +62,7 @@ EGGSRCS = \ # ITSSRCS = \ its/ascii.el \ + its/aynu.el \ its/bixing.el \ its/erpin.el \ its/hankata.el \ @@ -138,8 +139,8 @@ uninstall-site: egg/sj3rpc.elc: egg-com.elc egg/sj3.elc egg/wnnrpc.elc: egg-com.elc egg/wnn.elc -egg.elc its/ascii.elc its/erpin.elc its/hankata.elc \ -its/hira.elc its/jeonkak.elc its/pinyin.elc \ +egg.elc its/ascii.elc its/aynu.elc its/erpin.elc \ +its/hankata.elc its/hira.elc its/jeonkak.elc its/pinyin.elc \ its/hangul.elc its/kata.elc its/quanjiao.elc \ its/zenkaku.elc its/zhuyin.elc: its-keydef.elc diff --git a/egg-cnv.el b/egg-cnv.el index 3995da5..7eaa318 100644 --- a/egg-cnv.el +++ b/egg-cnv.el @@ -34,19 +34,29 @@ (require 'egg-edep) (defgroup egg-conv nil - "Conversion backend Interface of Tamagotchy" + "Conversion Backend Interface of Tamago 4." :group 'egg) -(defcustom egg-conversion-wrap-select nil +(defcustom egg-conversion-wrap-select t "*Candidate selection wraps around to first candidate, if non-NIL. Otherwise stop at the last candidate." :group 'egg-conv :type 'boolean) (defcustom egg-conversion-auto-candidate-menu 0 - "*Automatically enter the candidate selectionmenu mode at N times + "*Automatically enter the candidate selection mode at N times next/previous-candidate, if positive number N." :group 'egg-conv :type 'integer) +(defcustom egg-conversion-auto-candidate-menu-show-all nil + "*Enter show all candiate mode when automatic candidate selection +mode, if non-NIL." + :group 'egg-conv :type 'boolean) + +(defcustom egg-conversion-sort-by-converted-string nil + "*Sort candidate list by converted string on candidate selection +mode, if non-NIL." + :group 'egg-conv :type 'boolean) + (defcustom egg-conversion-fence-invisible nil "*Make fence marks invisible, if non-NIL." :group 'egg-conv :type 'boolean) @@ -207,6 +217,10 @@ next/previous-candidate, if positive number N." (defsubst egg-bunsetsu-set-info (bunsetsu info) (setcdr bunsetsu info)) +(defun egg-conversion-fence-p () + (and (egg-get-backend (point)) + (get-text-property (point) 'read-only))) + (defvar egg-finalize-backend-list nil) (defun egg-set-finalize-backend (func-list) @@ -243,6 +257,7 @@ next/previous-candidate, if positive number N." (egg-major-bunsetsu-continue-p (bunsetsu)) (egg-list-candidates (bunsetsu-list prev-b next-b major)) (egg-decide-candidate (bunsetsu-list candidate-pos prev-b next-b)) + (egg-special-candidate (bunsetsu-list prev-b next-b major type)) (egg-change-bunsetsu-length (bunsetsu-list prev-b next-b length major)) (egg-bunsetsu-combinable-p (bunsetsu next-b)) (egg-end-conversion (bunsetsu-list abort)) @@ -263,7 +278,7 @@ next/previous-candidate, if positive number N." (defun egg-start-conversion-noconv (backend yomi-string context) (let ((string (copy-sequence yomi-string)) (language (egg-get-language 0 yomi-string))) - (set-text-properties 0 (length string) nil string) + (egg-remove-all-text-properties 0 (length string) string) (list (egg-bunsetsu-create backend (vector string language))))) (defun egg-get-bunsetsu-source-noconv (bunsetsu) @@ -429,7 +444,8 @@ next/previous-candidate, if positive number N." (setq last-chinese lang)) (setq j i i (egg-next-single-property-change i 'egg-lang str len)) - (set-text-properties j i (list 'egg-lang lang) str)))) + (egg-remove-all-text-properties j i str) + (put-text-property j i 'egg-lang lang str)))) ;;; Should think again the interface to language-info-alist (defun egg-charset-to-language (charset) @@ -478,7 +494,8 @@ next/previous-candidate, if positive number N." s (substring source i j) lang (egg-get-language 0 s) backend (egg-get-conversion-backend lang n t)) - (set-text-properties 0 (- j i) (list 'egg-lang lang) s) + (egg-remove-all-text-properties 0 (- j i) s) + (put-text-property 0 (- j i) 'egg-lang lang s) (setq retval (nconc retval (list (list backend (list lang) s))) i j)) (prog1 @@ -536,53 +553,72 @@ next/previous-candidate, if positive number N." (while (< i 127) (define-key map (vector i) 'egg-exit-conversion-unread-char) (setq i (1+ i))) - (define-key map "\C-@" 'egg-decide-first-char) - (define-key map [?\C-\ ] 'egg-decide-first-char) - (define-key map "\C-a" 'egg-beginning-of-conversion-buffer) - (define-key map "\C-b" 'egg-backward-bunsetsu) - (define-key map "\C-c" 'egg-abort-conversion) - (define-key map "\C-e" 'egg-end-of-conversion-buffer) - (define-key map "\C-f" 'egg-forward-bunsetsu) - (define-key map "\C-h" 'egg-help-command) - (define-key map "\C-i" 'egg-shrink-bunsetsu-major) - (define-key map "\C-k" 'egg-decide-before-point) -;; (define-key map "\C-l" 'egg-exit-conversion) ; Don't override C-L - (define-key map "\C-m" 'egg-exit-conversion) - (define-key map "\C-n" 'egg-next-candidate-major) - (define-key map "\C-o" 'egg-enlarge-bunsetsu-major) - (define-key map "\C-p" 'egg-previous-candidate-major) - (define-key map "\C-r" 'egg-reconvert-bunsetsu) - (define-key map "\C-t" 'egg-toroku-bunsetsu) - (define-key map "\C-v" 'egg-inspect-bunsetsu) - (define-key map "\M-i" 'egg-shrink-bunsetsu-minor) - (define-key map "\M-n" 'egg-next-candidate-minor) - (define-key map "\M-o" 'egg-enlarge-bunsetsu-minor) - (define-key map "\M-p" 'egg-previous-candidate-minor) - (define-key map "\M-r" 'egg-reconvert-bunsetsu-from-source) - (define-key map "\M-s" 'egg-select-candidate-major) - (define-key map "\M-v" 'egg-toggle-inspect-mode) - (define-key map "\M-z" 'egg-select-candidate-minor) - (define-key map "\e\C-s" 'egg-select-candidate-list-all-major) - (define-key map "\e\C-z" 'egg-select-candidate-list-all-minor) - (define-key map [return] 'egg-exit-conversion) - (define-key map [right] 'egg-forward-bunsetsu) - (define-key map [left] 'egg-backward-bunsetsu) - (define-key map " " 'egg-next-candidate) - (define-key map "/" 'egg-exit-conversion) - ;;;(define-key map "\M-h" 'egg-hiragana) - ;;;(define-key map "\M-k" 'egg-katakana) - ;;;(define-key map "\M-<" 'egg-hankaku) - ;;;(define-key map "\M->" 'egg-zenkaku) + (define-key map "\C-@" 'egg-decide-first-char) + (define-key map [?\C-\ ] 'egg-decide-first-char) + (define-key map "\C-a" 'egg-beginning-of-conversion-buffer) + (define-key map "\C-b" 'egg-backward-bunsetsu) + (define-key map "\C-c" 'egg-abort-conversion) + (define-key map "\C-e" 'egg-end-of-conversion-buffer) + (define-key map "\C-f" 'egg-forward-bunsetsu) + (define-key map "\C-h" 'egg-help-command) + (define-key map "\C-i" 'egg-shrink-bunsetsu-major) + (define-key map "\C-k" 'egg-decide-before-point) +;; (define-key map "\C-l" 'egg-exit-conversion) ; Don't override C-L + (define-key map "\C-m" 'egg-exit-conversion) + (define-key map "\C-n" 'egg-next-candidate-major) + (define-key map "\C-o" 'egg-enlarge-bunsetsu-major) + (define-key map "\C-p" 'egg-previous-candidate-major) + (define-key map "\C-r" 'egg-reconvert-bunsetsu) + (define-key map "\C-t" 'egg-toroku-bunsetsu) + (define-key map "\C-v" 'egg-inspect-bunsetsu) + (define-key map "\M-i" 'egg-shrink-bunsetsu-minor) + (define-key map "\M-n" 'egg-next-candidate-minor) + (define-key map "\M-o" 'egg-enlarge-bunsetsu-minor) + (define-key map "\M-p" 'egg-previous-candidate-minor) + (define-key map "\M-r" 'egg-reconvert-bunsetsu-from-source) + (define-key map "\M-s" 'egg-select-candidate-major) + (define-key map "\M-v" 'egg-toggle-inspect-mode) + (define-key map "\M-z" 'egg-select-candidate-minor) + (define-key map "\e\C-s" 'egg-select-candidate-list-all-major) + (define-key map "\e\C-z" 'egg-select-candidate-list-all-minor) + (define-key map [return] 'egg-exit-conversion) + (define-key map [right] 'egg-forward-bunsetsu) + (define-key map [left] 'egg-backward-bunsetsu) + (define-key map [up] 'egg-previous-candidate) + (define-key map [down] 'egg-next-candidate) + (define-key map [backspace] 'egg-abort-conversion) + (define-key map [clear] 'egg-abort-conversion) + (define-key map [delete] 'egg-abort-conversion) + (define-key map " " 'egg-next-candidate) + (define-key map "/" 'egg-exit-conversion) + (define-key map "\M-h" 'egg-hiragana) + (define-key map "\M-k" 'egg-katakana) + (define-key map "\M-P" 'egg-pinyin) + (define-key map "\M-Z" 'egg-zhuyin) + (define-key map "\M-H" 'egg-hangul) map) "Keymap for EGG Conversion mode.") - (fset 'egg-conversion-map egg-conversion-map) +(defvar egg-conversion-mode nil) +(make-variable-buffer-local 'egg-conversion-mode) +(put 'egg-conversion-mode 'permanent-local t) + +(or (assq 'egg-conversion-mode egg-sub-mode-map-alist) + (setq egg-sub-mode-map-alist (cons + '(egg-conversion-mode . egg-conversion-map) + egg-sub-mode-map-alist))) + +(defun egg-conversion-enter/leave-fence (&optional old new) + (setq egg-conversion-mode (egg-conversion-fence-p))) + +(add-hook 'egg-enter/leave-fence-hook 'egg-conversion-enter/leave-fence) + (defun egg-exit-conversion-unread-char () (interactive) - (setq unread-command-events (list last-command-event) - this-command 'egg-use-context) - (setq egg-context (egg-exit-conversion))) + (setq egg-context (egg-exit-conversion) + unread-command-events (list last-command-event) + this-command 'egg-use-context)) (defun egg-make-bunsetsu (backend bunsetsu last) (let* ((converted (copy-sequence (egg-get-bunsetsu-converted bunsetsu))) @@ -597,27 +633,30 @@ next/previous-candidate, if positive number N." egg-conversion-minor-separator egg-conversion-major-separator)))) (setq len (length converted)) - (set-text-properties 0 len + (egg-remove-all-text-properties 0 len converted) + (add-text-properties 0 len (list 'read-only t (egg-bunsetsu-info) bunsetsu 'egg-backend backend 'egg-lang language 'egg-bunsetsu-last last 'egg-major-continue continue - 'local-map 'egg-conversion-map) + 'point-entered 'egg-enter/leave-fence + 'point-left 'egg-enter/leave-fence + 'modification-hooks '(egg-modify-fence)) converted) (if face (egg-set-face 0 len1 face converted)) converted)) -(defun egg-insert-bunsetsu-list (backend bunsetsu-list &optional last) +(defun egg-insert-bunsetsu-list (backend bunsetsu-list &optional last before) (let ((len (length bunsetsu-list))) - (insert - (mapconcat - (lambda (b) - (setq len (1- len)) - (egg-make-bunsetsu backend b (and (= len 0) last))) - bunsetsu-list "")))) + (funcall (if before 'insert-before-markers 'insert) + (mapconcat + (lambda (b) + (setq len (1- len)) + (egg-make-bunsetsu backend b (and (= len 0) last))) + bunsetsu-list nil)))) (defun egg-beginning-of-conversion-buffer (n) (interactive "p") @@ -677,8 +716,7 @@ next/previous-candidate, if positive number N." (egg-get-bunsetsu-info (1- p)))) (defun egg-get-previous-major-bunsetsu (p) - (let ((p (point)) - (prev (egg-get-previous-bunsetsu p)) + (let ((prev (egg-get-previous-bunsetsu p)) bunsetsu) (while prev (setq bunsetsu (cons prev bunsetsu) @@ -702,7 +740,10 @@ next/previous-candidate, if positive number N." (nreverse bunsetsu))) (defsubst egg-get-major-bunsetsu-source (list) - (mapconcat (lambda (b) (egg-get-bunsetsu-source b)) list "")) + (mapconcat 'egg-get-bunsetsu-source list nil)) + +(defsubst egg-get-major-bunsetsu-converted (list) + (mapconcat 'egg-get-bunsetsu-converted list nil)) (defvar egg-inspect-mode nil "*Display clause information on candidate selection, if non-NIL.") @@ -724,8 +765,8 @@ next/previous-candidate, if positive number N." (defvar egg-candidate-selection-major t) (make-variable-buffer-local 'egg-candidate-selection-major) -(defsubst egg-set-candsel-info (b prev-b next-b major) - (setq egg-candidate-selection-info (list b prev-b next-b major))) +(defsubst egg-set-candsel-info (b major) + (setq egg-candidate-selection-info (list (car b) (cadr b) (caddr b) major))) (defsubst egg-candsel-last-bunsetsu () (car egg-candidate-selection-info)) (defsubst egg-candsel-last-prev-b () (nth 1 egg-candidate-selection-info)) @@ -744,9 +785,8 @@ next/previous-candidate, if positive number N." (defun egg-get-candsel-target-major () (let ((bunsetsu (egg-get-major-bunsetsu (point))) - next-b prev-b next) - (setq prev-b (egg-get-previous-major-bunsetsu (point)) - next (egg-next-bunsetsu-point (point) (length bunsetsu))) + (prev-b (egg-get-previous-major-bunsetsu (point))) + next-b) (cond ((and (egg-candsel-last-major) (egg-major-bunsetsu-tail-p (egg-candsel-last-prev-b) prev-b) @@ -755,31 +795,63 @@ next/previous-candidate, if positive number N." bunsetsu)) (setq bunsetsu (egg-candsel-last-bunsetsu) prev-b (egg-candsel-last-prev-b) - next-b (egg-candsel-last-next-b)) - (setq next (egg-next-bunsetsu-point (point) (length bunsetsu)))) - ((null (egg-get-bunsetsu-last (1- next))) - (setq next-b (egg-get-major-bunsetsu next)))) + next-b (egg-candsel-last-next-b))) + ((null (egg-get-bunsetsu-last + (egg-next-bunsetsu-point (point) (1- (length bunsetsu))))) + (setq next-b (egg-get-major-bunsetsu + (egg-next-bunsetsu-point (point) (length bunsetsu)))))) (setq egg-candidate-selection-major t) - (list bunsetsu prev-b next-b next t))) + (list bunsetsu prev-b next-b t))) (defun egg-get-candsel-target-minor () (let* ((bunsetsu (list (egg-get-bunsetsu-info (point)))) (prev-b (egg-get-previous-bunsetsu (point))) (next-b (egg-get-next-bunsetsu (point)))) - (and prev-b (setq prev-b (list prev-b))) - (and next-b (setq next-b (list next-b))) (setq egg-candidate-selection-major nil) - (list bunsetsu prev-b next-b (egg-next-bunsetsu-point (point)) nil))) - -(defun egg-insert-new-bunsetsu (b prev-b next-b next end) - (let ((backend (egg-get-backend (point))) - start last) - (setq start (egg-previous-bunsetsu-point (point) (length prev-b))) - (setq end (or end (egg-next-bunsetsu-point next (length next-b)))) - (setq last (egg-get-bunsetsu-last (1- end))) - (delete-region start end) - (egg-insert-bunsetsu-list backend (append prev-b (append b next-b)) last) - (goto-char (egg-next-bunsetsu-point start (length prev-b))) + (list bunsetsu (and prev-b (list prev-b)) (and next-b (list next-b)) nil))) + +(defun egg-check-candsel-target (b prev-b next-b major) + (if major + (and (egg-major-bunsetsu-tail-p + prev-b (egg-get-previous-major-bunsetsu (point))) + (let* ((cur-b (egg-get-major-bunsetsu (point))) + (next-p (egg-next-bunsetsu-point (point) (length cur-b)))) + (egg-major-bunsetsu-head-p + (append b next-b) + (append cur-b (and (null (egg-get-bunsetsu-last (1- next-p))) + (egg-get-major-bunsetsu next-p)))))) + (and (eq (egg-get-bunsetsu-info (point)) (car b)) + (eq (egg-get-previous-bunsetsu (point)) (car prev-b)) + (eq (egg-get-next-bunsetsu (point)) (car next-b))))) + +(defun egg-insert-new-bunsetsu (b tail new-b) + (let* ((backend (egg-get-backend (point))) + (start (egg-previous-bunsetsu-point (point) (length (cadr new-b)))) + (end (egg-next-bunsetsu-point (point) (+ (length b) (length tail)))) + (last (egg-get-bunsetsu-last (1- end))) + (insert-before (buffer-has-markers-at end))) + (cond + ((buffer-has-markers-at end) + (delete-region start end) + (egg-insert-bunsetsu-list backend + (append (cadr new-b) (car new-b) (caddr new-b)) + last t)) + ((buffer-has-markers-at (egg-next-bunsetsu-point (point) (length b))) + (delete-region start end) + (egg-insert-bunsetsu-list backend (append (cadr new-b) (car new-b)) + nil t) + (egg-insert-bunsetsu-list backend (caddr new-b) last)) + ((buffer-has-markers-at (point)) + (delete-region start end) + (egg-insert-bunsetsu-list backend (cadr new-b) nil t) + (egg-insert-bunsetsu-list backend (append (car new-b) (caddr new-b)) + last)) + (t + (delete-region start end) + (egg-insert-bunsetsu-list backend + (append (cadr new-b) (car new-b) (caddr new-b)) + last))) + (goto-char (egg-next-bunsetsu-point start (length (cadr new-b)))) (if egg-inspect-mode (egg-inspect-bunsetsu t)))) @@ -812,16 +884,19 @@ next/previous-candidate, if positive number N." (apply 'egg-next-candidate-internal (- n) (egg-get-candsel-target-minor))) (defvar egg-candidate-select-counter 1) +(make-variable-buffer-local 'egg-candidate-select-counter) -(defun egg-next-candidate-internal (n b prev-b next-b next major) +(defun egg-next-candidate-internal (n b prev-b next-b major) (if (eq last-command (if major 'egg-candidate-major 'egg-candidate-minor)) (setq egg-candidate-select-counter (1+ egg-candidate-select-counter)) (setq egg-candidate-select-counter 1)) (if (= egg-candidate-select-counter egg-conversion-auto-candidate-menu) - (egg-select-candidate-internal nil b prev-b next-b next major) + (egg-select-candidate-internal + nil egg-conversion-auto-candidate-menu-show-all + b prev-b next-b major) (setq this-command (if major 'egg-candidate-major 'egg-candidate-minor)) (let ((inhibit-read-only t) - candidates nitem i beep) + new-b candidates nitem i beep) (setq candidates (egg-list-candidates b prev-b next-b major)) (if (null candidates) (setq beep t) @@ -829,21 +904,18 @@ next/previous-candidate, if positive number N." nitem (length (cdr candidates))) (cond ((< i 0) ; go backward as if it is ring - (while (< i 0) - (setq i (+ i nitem)))) + (setq i (% i nitem)) + (if (< i 0) + (setq i (+ i nitem)))) ((< i nitem)) ; OK (egg-conversion-wrap-select ; go backward as if it is ring - (while (>= i nitem) - (setq i (- i nitem)))) + (setq i (% i nitem))) (t ; don't go forward (setq i (1- nitem) beep t))) - (setq b (egg-decide-candidate b i prev-b next-b) - prev-b (nth 1 b) - next-b (nth 2 b) - b (car b)) - (egg-set-candsel-info b prev-b next-b major) - (egg-insert-new-bunsetsu b prev-b next-b next nil)) + (setq new-b (egg-decide-candidate b i prev-b next-b)) + (egg-set-candsel-info new-b major) + (egg-insert-new-bunsetsu b (caddr new-b) new-b)) (if beep (ding))))) @@ -851,39 +923,65 @@ next/previous-candidate, if positive number N." (let ((n -1)) (mapcar (lambda (item) (cons item (setq n (1+ n)))) list))) -(defun egg-select-candidate-major () - (interactive) - (apply 'egg-select-candidate-internal nil (egg-get-candsel-target-major))) +(defun egg-sort-item (list sort) + (if (eq (null sort) (null egg-conversion-sort-by-converted-string)) + list + (sort list (lambda (a b) (string< (car a) (car b)))))) -(defun egg-select-candidate-minor () - (interactive) - (apply 'egg-select-candidate-internal nil (egg-get-candsel-target-minor))) +(defun egg-select-candidate-major (sort) + (interactive "P") + (apply 'egg-select-candidate-internal sort nil (egg-get-candsel-target-major))) -(defun egg-select-candidate-list-all-major () - (interactive) - (apply 'egg-select-candidate-internal t (egg-get-candsel-target-major))) +(defun egg-select-candidate-minor (sort) + (interactive "P") + (apply 'egg-select-candidate-internal sort nil (egg-get-candsel-target-minor))) -(defun egg-select-candidate-list-all-minor () - (interactive) - (apply 'egg-select-candidate-internal t (egg-get-candsel-target-minor))) +(defun egg-select-candidate-list-all-major (sort) + (interactive "P") + (apply 'egg-select-candidate-internal sort t (egg-get-candsel-target-major))) -(defun egg-select-candidate-internal (all b prev-b next-b next major) - (let ((inhibit-read-only t) - (prompt (egg-get-message 'candidate)) - candidates item-list new i) +(defun egg-select-candidate-list-all-minor (sort) + (interactive "P") + (apply 'egg-select-candidate-internal sort t (egg-get-candsel-target-minor))) + +(defun egg-select-candidate-internal (sort all b prev-b next-b major) + (let ((prompt (egg-get-message 'candidate)) + new-b candidates pos clist item-list i) (setq candidates (egg-list-candidates b prev-b next-b major)) (if (null candidates) (ding) - (setq all (and all '(menudiag-list-all)) - item-list (egg-numbering-item (cdr candidates)) + (setq pos (car candidates) + clist (cdr candidates) + item-list (egg-sort-item (egg-numbering-item clist) sort) i (menudiag-select (list 'menu prompt item-list) - (cons (nth (car candidates) item-list) all)) - new (egg-decide-candidate b i prev-b next-b) - prev-b (nth 1 new) - next-b (nth 2 new) - new (car new)) - (egg-set-candsel-info new prev-b next-b major) - (egg-insert-new-bunsetsu new prev-b next-b next nil)))) + all + (list (assq (nth pos clist) item-list)))) + (if (or (null (egg-conversion-fence-p)) + (null (egg-check-candsel-target b prev-b next-b major))) + (error "Fence was already modified") + (let ((inhibit-read-only t)) + (setq new-b (egg-decide-candidate b i prev-b next-b)) + (egg-set-candsel-info new-b major) + (egg-insert-new-bunsetsu b (caddr new-b) new-b)))))) + +(defun egg-hiragana (&optional minor) + (interactive "P") + (if (null minor) + (apply 'egg-special-convert this-command (egg-get-candsel-target-major)) + (apply 'egg-special-convert this-command (egg-get-candsel-target-minor)))) + +(defalias 'egg-katakana 'egg-hiragana) +(defalias 'egg-pinyin 'egg-hiragana) +(defalias 'egg-zhuyin 'egg-hiragana) +(defalias 'egg-hangul 'egg-hiragana) + +(defun egg-special-convert (type b prev-b next-b major) + (let ((inhibit-read-only t) + (new-b (egg-special-candidate b prev-b next-b major type))) + (if (null new-b) + (ding) + (egg-set-candsel-info new-b major) + (egg-insert-new-bunsetsu b (caddr new-b) new-b)))) (defun egg-separate-characters (str) (let* ((v (egg-string-to-vector str)) @@ -915,7 +1013,7 @@ next/previous-candidate, if positive number N." (defun egg-enlarge-bunsetsu-internal (n major) (let ((inhibit-read-only t) - b prev-b next-b s1 s1len s2 s2len nchar i last next end beep) + b prev-b next-b new-b s1 s1len s2 s2len nchar i last end beep) (if major (setq b (egg-get-major-bunsetsu (point)) prev-b (egg-get-previous-major-bunsetsu (point))) @@ -938,28 +1036,23 @@ next/previous-candidate, if positive number N." ((<= n 0) (setq beep t nchar (and (/= s1len 1) (egg-get-char-size 0 s1)))) ((> n s2len) - (setq beep t nchar (and (/= s2len 0) (length s2)))) + (setq beep t nchar (and (/= s2len s1len) (length s2)))) (t (setq nchar 0) (while (> n 0) (setq nchar (+ nchar (egg-get-char-size nchar s2)) n (1- n))))) - (if nchar - (progn - (setq next-b (nconc b next-b) - i (length (egg-get-bunsetsu-source (car next-b)))) - (while (< i nchar) - (setq next-b (cdr next-b) - i (+ i (length (egg-get-bunsetsu-source (car next-b)))))) - (setq next-b (prog1 (cdr next-b) (setcdr next-b nil)) - next (egg-next-bunsetsu-point (point) (length b)) - b (egg-change-bunsetsu-length b prev-b next-b nchar major)) - (if (null b) - (setq beep t) - (setq prev-b (nth 1 b) - next-b (nth 2 b) - b (car b)) - (egg-insert-new-bunsetsu b prev-b next-b next (and next-b end))))) + (when nchar + (setq next-b (nconc b next-b) + i (length (egg-get-bunsetsu-source (car next-b)))) + (while (< i nchar) + (setq next-b (cdr next-b) + i (+ i (length (egg-get-bunsetsu-source (car next-b)))))) + (setq next-b (prog1 (cdr next-b) (setcdr next-b nil)) + new-b (egg-change-bunsetsu-length b prev-b next-b nchar major)) + (if (null new-b) + (setq beep t) + (egg-insert-new-bunsetsu b (and (caddr new-b) next-b) new-b))) (if beep (ding)))) @@ -1028,9 +1121,7 @@ next/previous-candidate, if positive number N." (if (or (= i len) (egg-get-bunsetsu-last (1- i) decided)) (progn - (apply 'insert (mapcar - (lambda (b) (egg-get-bunsetsu-converted b)) - bunsetsu)) + (insert (mapconcat 'egg-get-bunsetsu-converted bunsetsu nil)) (setq context (cons (cons (egg-bunsetsu-get-backend (car bunsetsu)) (egg-end-conversion bunsetsu nil)) context) @@ -1071,7 +1162,7 @@ next/previous-candidate, if positive number N." (defun egg-exit-conversion () (interactive) - (if (egg-get-bunsetsu-info (point)) + (if (egg-conversion-fence-p) (progn (goto-char (next-single-property-change (point) 'egg-end)) (egg-decide-before-point)))) diff --git a/egg-com.el b/egg-com.el index d36e5f6..6aaa58b 100644 --- a/egg-com.el +++ b/egg-com.el @@ -136,6 +136,7 @@ (cons ccl-decode-fixed-euc-kr ccl-encode-fixed-euc-kr)) ;; Chinese + (defconst egg-pinyin-shengmu '(("" . 0) ("B" . 1) ("C" . 2) ("Ch" . 3) ("D" . 4) ("F" . 5) ("G" . 6) ("H" . 7) ("J" . 8) ("K" . 9) @@ -521,53 +522,60 @@ (defun decode-fixed-euc-china-region (beg end type zhuyin) "Decode EUC-CN/TW encoded text in the region. Return the length of resulting text." - (prog1 - (let ((str (string-as-unibyte (buffer-substring beg end))) - (i 0) - l c0 c1 s y ss) - (delete-region beg end) - (setq l (1- (length str))) - (while (< i l) - (setq c0 (aref str i) - c1 (aref str (1+ i)) - i (+ i 2)) - (cond - ((eq c0 0) - (if (> c1 ?\xa0) - (insert leading-code-private-11 - (charset-id 'chinese-sisheng) - c1) - (insert c1))) - ((>= c0 ?\x80) - (cond - ((eq type 'cn) - (insert (charset-id 'chinese-gb2312) c0 (logior c1 ?\x80))) - ((>= c1 ?\x80) - (insert (charset-id 'chinese-cns11643-1) c0 c1)) - (t - (insert (charset-id 'chinese-cns11643-2) c0 (+ c1 ?\x80))))) - (t - (setq c1 (logand c1 ?\x7f)) - (setq s (- (lsh c1 -2) 7);;(+ (lsh (- c1 32) -2) 1) - y (- (lsh c0 -1) 16);;(lsh (- c0 32) -1) - ss (+ (logand c0 1) (logand c1 3))) - (if (and (eq s 20) - (eq (aref egg-pinyin-table (+ (* 39 20) y)) 0)) - (setq s 0)) - (if (null zhuyin) - (setq s (car (nth s egg-pinyin-shengmu)) - y (car (nth (+ (* 5 y) ss) egg-pinyin-yunmu))) - (setq c0 (aref egg-zhuyin-table (+ (* 41 s) y))) - (if (eq (logand c0 ?\x8080) ?\x80) - (setq s (lsh c0 -8) - y (logand c0 ?\x7f))) - (setq s (car (nth s egg-zhuyin-shengmu)) - y (car (nth (+ (* 5 y) ss) egg-zhuyin-yunmu)))) - (if enable-multibyte-characters - (insert s y) - (insert (string-as-unibyte s) (string-as-unibyte y)))))) - (- (point) beg)) - (if (looking-at "\0\0") (forward-char 2)))) + (let ((str (string-as-unibyte (buffer-substring beg end))) + (i 0) + (char (make-string 3 0)) + l c0 c1 s y ss) + (delete-region beg end) + (setq l (1- (length str))) + (while (< i l) + (setq c0 (aref str i) + c1 (aref str (1+ i)) + i (+ i 2)) + (cond + ((eq c0 0) + (if (<= c1 ?\xa0) + (insert c1) + (aset char 0 leading-code-private-11) + (aset char 1 (charset-id 'chinese-sisheng)) + (aset char 2 c1) + (insert (string-as-multibyte char)))) + ((>= c0 ?\x80) + (cond + ((eq type 'cn) + (aset char 0 (charset-id 'chinese-gb2312)) + (aset char 1 c0) + (aset char 2 (logior c1 ?\x80))) + ((>= c1 ?\x80) + (aset char 0 (charset-id 'chinese-cns11643-1)) + (aset char 1 c0) + (aset char 2 c1)) + (t + (aset char 0 (charset-id 'chinese-cns11643-2)) + (aset char 1 c0) + (aset char 2 (+ c1 ?\x80)))) + (insert (string-as-multibyte char))) + (t + (setq c1 (logand c1 ?\x7f)) + (setq s (- (lsh c1 -2) 7);;(+ (lsh (- c1 32) -2) 1) + y (- (lsh c0 -1) 16);;(lsh (- c0 32) -1) + ss (+ (logand c0 1) (logand c1 3))) + (if (and (eq s 20) + (eq (aref egg-pinyin-table (+ (* 39 20) y)) 0)) + (setq s 0)) + (if (null zhuyin) + (setq s (car (nth s egg-pinyin-shengmu)) + y (car (nth (+ (* 5 y) ss) egg-pinyin-yunmu))) + (setq c0 (aref egg-zhuyin-table (+ (* 41 s) y))) + (if (eq (logand c0 ?\x8080) ?\x80) + (setq s (lsh c0 -8) + y (logand c0 ?\x7f))) + (setq s (car (nth s egg-zhuyin-shengmu)) + y (car (nth (+ (* 5 y) ss) egg-zhuyin-yunmu)))) + (if enable-multibyte-characters + (insert s y) + (insert (string-as-unibyte s) (string-as-unibyte y)))))) + (- (point) beg))) (defun post-read-decode-fixed-euc-china (len type zhuyin) (let ((pos (point)) @@ -620,7 +628,7 @@ Return the length of resulting text." (eval-and-compile (define-ccl-program ccl-decode-egg-binary - `(2 + `(1 ((read r0) (loop (if (r0 == ?\xff) @@ -628,7 +636,7 @@ Return the length of resulting text." (write-read-repeat r0))))) (define-ccl-program ccl-encode-egg-binary - `(1 + `(2 ((read r0) (loop (if (r0 == ?\xff) @@ -705,6 +713,7 @@ U: 32-bit integer. The argument is 2 element 16-bit unsigned integer list. u: 32-bit integer. The argument is treat as unsigned integer. (Note: Elisp's integer may be less than 32 bits) i: 32-bit integer. + (Note: Elisp's integer may be greater than 32 bits) w: 16-bit integer. b: 8-bit integer. S: 16-bit wide-character EUC string (0x0000 terminated). @@ -776,6 +785,14 @@ V: Fixed length string (0x00 terminated). This takes 2 args (data length)." (+ (lsh (comm-following+forward-char) 8) (comm-following+forward-char))))) +(defun comm-unpack-i32 () + (progn + (comm-require-process-output 4) + (+ (lsh (- (logxor (comm-following+forward-char) 128) 128) 24) + (lsh (comm-following+forward-char) 16) + (lsh (comm-following+forward-char) 8) + (comm-following+forward-char)))) + (defun comm-unpack-u32 () (progn (comm-require-process-output 4) @@ -852,7 +869,7 @@ See `comm-format' for FORMAT." (list (cond ((eq f 'U) `(setq ,arg (comm-unpack-u32c))) ((eq f 'u) `(setq ,arg (comm-unpack-u32))) - ((eq f 'i) `(setq ,arg (comm-unpack-u32))) + ((eq f 'i) `(setq ,arg (comm-unpack-i32))) ((eq f 'w) `(setq ,arg (comm-unpack-u16))) ((eq f 'b) `(setq ,arg (comm-unpack-u8))) ((eq f 'S) `(setq ,arg (comm-unpack-u16-string))) diff --git a/egg-sim-old.el b/egg-sim-old.el deleted file mode 100644 index 150ecaa..0000000 --- a/egg-sim-old.el +++ /dev/null @@ -1,514 +0,0 @@ -;;; egg-sim.el --- EGG Simple Input Method - -;; Copyright (C) 2000 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 2000 TOMURA Satoru - - -;; Author: TOMURA Satoru - -;; Maintainer: TOMURA Satoru - -;; Keywords: mule, multilingual, input method - -;; This file is part of EGG. - -;; EGG 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 2, or (at your option) -;; any later version. - -;; EGG 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -;;; This code is based on egg-jsymbol.el of Egg V3. - -;;; 92.10.18 modified for Mule Ver.0.9.6 by K.Handa -;;; Moved from egg.el -;;; 92.12.26 modified for Mule Ver.0.9.7 by T.Shingu -;;; JIS Hojo Kanji support. - -(require 'menudiag) - -(provide 'egg-sim) - -(defun make-char-list (charset &optional from to) - (let ((result nil) - (chars (charset-chars charset)) - min max) - (setq min (if (= chars 96) 32 33) - max (if (= chars 96) 127 126)) - (setq from (if from (+ min (1- from)) min) - to (if to (+ min (1- to)) max)) - (and (<= min from) - (<= to max) - (cond ((= (charset-dimension charset) 1) - (while (<= from to) - (setq result (cons (char-to-string - (make-char charset to)) - result) - to (1- to))) - result) - ((= (charset-dimension charset) 2) - (while (<= from to) - (let ((code max)) - (while (<= min code) - (setq result (cons (char-to-string - (make-char charset to code)) - result) - code (1- code)))) - (setq to (1- to))) - result))))) - -(defvar egg-sim-ascii-menu - '(menu "ASCII:" ,(make-char-list 'ascii))) - -(defvar egg-sim-latin-1-menu - `(menu "ISO 8859-1:" ,(make-char-list 'latin-iso8859-1))) - -(defvar egg-sim-latin-2-menu - `(menu "ISO 8859-2:" ,(make-char-list 'latin-iso8859-2))) - -(defvar egg-sim-latin-3-menu - `(menu "ISO 8859-3:" ,(make-char-list 'latin-iso8859-3))) - -(defvar egg-sim-latin-4-menu - `(menu "ISO 8859-4:" ,(make-char-list 'latin-iso8859-4))) - -(defvar egg-sim-latin-5-menu - `(menu "ISO 8859-9:" ,(make-char-list 'latin-iso8859-9))) - -(defvar egg-sim-cyrillic-menu - `(menu "ISO 8859-5:" ,(make-char-list 'cyrillic-iso8859-5))) - -(defvar egg-sim-arabic-menu - `(menu "ISO 8859-6:" ,(make-char-list 'arabic-iso8859-6))) - -(defvar egg-sim-greek-menu - `(menu "ISO 8859-7:" ,(make-char-list 'greek-iso8859-7))) - -(defvar egg-sim-hebrew-menu - `(menu "ISO 8859-8:" ,(make-char-list 'hebrew-iso8859-8))) - -(defvar egg-sim-thai-menu - `(menu "TIS620.2529:" ,(make-char-list 'thai-tis620))) - -(defvar egg-sim-lao-menu - `(menu "lao:" ,(make-char-list 'lao))) - -(defvar egg-sim-vietnamese-menu - `(menu "Vietnamese:" - (("VISCII1.1(lower-case)" . - (menu "VISCII1.1 lower-case:" - ,(make-char-list 'vietnamese-viscii-lower))) - ("VISCII1.1(upper-case)" . - (menu "VISCII1.1 upper-case:" - ,(make-char-list 'vietnamese-viscii-upper)))))) - -(defvar egg-sim-chinese-big5-menu - `(menu "Big5:" - (("Level1" . - (menu "Big 5 Level1:" , (make-char-list 'chinese-big5-1))) - ("Level2" . - (menu "Big 5 Level2:" , (make-char-list 'chinese-big5-2)))))) - -(defvar egg-sim-chinese-cns-menu - `(menu "CNS 11643:" - (("Plane-1" . - (menu "CNS 11643-1:" ,(make-char-list 'chinese-cns11643-1))) - ("Plane- 2" . - (menu "CNS 11643-2:" ,(make-char-list 'chinese-cns11643-2))) - ("Plane-3" . - (menu "CNS 11643-3:" ,(make-char-list 'chinese-cns11643-3))) - ("Plane-4" . - (menu "CNS 11643-4:" ,(make-char-list 'chinese-cns11643-4))) - ("Plane-5" . - (menu "CNS 11643-5:" ,(make-char-list 'chinese-cns11643-5))) - ("Plane-6" . - (menu "CNS 11643-6:" ,(make-char-list 'chinese-cns11643-6))) - ("Plane-7" . - (menu "CNS 11643-7:" ,(make-char-list 'chinese-cns11643-7)))))) - -(defvar egg-sim-chinese-gb-menu - `(menu "GB 2312:" - (("All" . - (menu "GB 2312:" ,(make-char-list 'chinese-gb2312))) - ("Symbols" . - (menu "GB2312/1:" ,(make-char-list 'chinese-gb2312 1 1))) - ("Numbers" . - (menu "GB2312/2:" ,(make-char-list 'chinese-gb2312 2 2))) - ("Fullwidth ASCII" . - (menu "GB2312/3:" ,(make-char-list 'chinese-gb2312 3 3))) - ("Hiragana" . - (menu "GB2312/4:" ,(make-char-list 'chinese-gb2312 4 4))) - ("Katanaka" . - (menu "GB2312/5:" ,(make-char-list 'chinese-gb2312 5 5))) - ("Greek" . - (menu "GB2312/6:" ,(make-char-list 'chinese-gb2312 6 6))) - ("Cyrillic" . - (menu "GB2312/7:" ,(make-char-list 'chinese-gb2312 7 7))) - ("Pinyin/Bopomofo" . - (menu "GB2312/8:" ,(make-char-list 'chinese-gb2312 8 8))) - ("Box Drawings" . - (menu "GB2312/9:" ,(make-char-list 'chinese-gb2312 9 9))) - ))) - -(defvar egg-sim-chinese-menu - `(menu "Chinese:" - (("GB2312" . , egg-sim-chinese-gb-menu) - ("CNS11643" . , egg-sim-chinese-cns-menu) - ("Big5" . , egg-sim-chinese-big5-menu)))) - -(defvar egg-sim-korean-menu - `(menu "Korean:" - (("KSC5601" . - (menu "KSC 5601:" ,(make-char-list 'korean-ksc5601))) - ("Symbol" . - (menu "KSC 5601/1-2:" ,(make-char-list 'korean-ksc5601 1 2))) - ("Fullwidth ASCII" . - (menu "KSC 5601/3:" , (make-char-list 'korean-ksc5601 3 3))) - ("Jamo" . - (menu "KSC 5601/4:" , (make-char-list 'korean-ksc5601 4 4))) - ("Roman Number/Greek" . - (menu "KSC 5601/5:" , (make-char-list 'korean-ksc5601 5 5))) - ("Box Drawings" . - (menu "KSC 5601/6:" , (make-char-list 'korean-ksc5601 6 6))) - ("Unit" . - (menu "KSC 5601/7:" , (make-char-list 'korean-ksc5601 7 7))) - ("Misc." . - (menu "KSC 5601/8-9:" , (make-char-list 'korean-ksc5601 8 9))) - ("Hiragana" . - (menu "KSC 5601/10:" , (make-char-list 'korean-ksc5601 10 10))) - ("Katakana" . - (menu "KSC 5601/11:" , (make-char-list 'korean-ksc5601 11 11))) - ("Cyrillic" . - (menu "KSC 5601/12:" , (make-char-list 'korean-ksc5601 12 12))) - ("Hangul" . - (menu "KSC 5601/16-40:" , (make-char-list 'korean-ksc5601 16 40))) - ("Hanja" . - (menu "KSC 5601/42-93:" , (make-char-list 'korean-ksc5601 42 93)))))) - -(defvar egg-sim-japanese-menu - `(menu "Japanese:" - (("JISX0201" . - ,(append (make-char-list 'latin-jisx0201) - (make-char-list 'katakana-jisx0201))) - ("JISX0208" . - (menu "JIS X 0208:" ,(make-char-list 'japanese-jisx0208))) - ("JISX0212" . - (menu "JIS X 0212:" ,(make-char-list 'japanese-jisx0212))) - ("JISX0208/0212" . - (menu "$B5-9fF~NO(B:" - (("JIS$BF~NO(B" . japanese-jisx0208) - ("$B5-9f(B" . - (menu "$B5-9f(B:" , (make-char-list 'japanese-jisx0208 1 2))) - ("$B1Q?t;z(B" . - (menu "$B1Q?t;z(B:" , (make-char-list 'japanese-jisx0208 3 3))) - ("$B$R$i$,$J(B" . - (menu "$B$R$i$,$J(B:" , (make-char-list 'japanese-jisx0208 4 4))) - ("$B%+%?%+%J(B" . - (menu "$B%+%?%+%J(B:" , (make-char-list 'japanese-jisx0208 5 5))) - ("$B%.%j%7%cJ8;z(B" . - (menu "$B%.%j%7%cJ8;z(B:" , (make-char-list 'japanese-jisx0208 6 6))) - ("$B%-%j%kJ8;z(B" . - (menu "$B%-%j%kJ8;z(B:" , (make-char-list 'japanese-jisx0208 7 7))) - ("$B7S@~(B" . - (menu "$B7S@~(B:" , (make-char-list 'japanese-jisx0208 8 8))) - ;;;"$BIt(B" ",1%(B" ",15(B" ",2e(B" ",1U(B" ",1e(B" ",1u(B" -6| ",2g(B" "&" "6" "F" "V" "f" "v" ",2&(B" ",26(B" ",1&(B" ",16(B" ",1F(B" ",1V(B" ",1f(B" ",1v(B" -7| "'" "7" "G" "W" "g" "w" ",2'(B" ",27(B" ",1'(B" ",17(B" ",1G(B" ",1W(B" ",1g(B" ",1w(B" -8| "(" "8" "H" "X" "h" "x" ",2((B" ",28(B" ",1((B" ",18(B" ",2h(B" ",1X(B" ",1h(B" ",1x(B" -9| ",2[(B" ")" "9" "I" "Y" "i" "y" ",2)(B" ",2v(B" ",1)(B" ",2q(B" ",2i(B" ",2y(B" ",1i(B" ",1y(B" -A| "*" ":" "J" "Z" "j" "z" ",2*(B" ",2w(B" ",1*(B" ",2Q(B" ",2j(B" ",2z(B" ",1j(B" ",1z(B" -B| "+" ";" "K" "[" "k" "{" ",2+(B" ",2o(B" ",1+(B" ",2W(B" ",2k(B" ",1[(B" ",1k(B" ",1{(B" -C| "," "<" "L" "\" "l" "|" ",2,(B" ",2|(B" ",1,(B" ",2X(B" ",2l(B" ",1\(B" ",1l(B" ",1|(B" -D| "-" "=" "M" "]" "m" "}" ",2-(B" ",2{(B" ",1-(B" ",1=(B" ",2m(B" ",2}(B" ",1m(B" ",1}(B" -E| ",2\(B" "." ">" "N" "^" "n" "~" ",2.(B" ",2x(B" ",1.(B" ",1>(B" ",2n(B" ",1^(B" ",1n(B" ",1~(B" -F| "/" "?" "O" "_" "o" ",2/(B" ",2O(B" ",1/(B" ",2_(B" ",1O(B" ",1_(B" ",1o(B" ",2f(B" - -"a" ",1`(B" ",1d(B" ",1c(B" ",1a(B" ",1U(B" -",1e(B" ",1"(B" ",1F(B" ",1G(B" ",1!(B" ",1#(B" -",1b(B" ",1%(B" ",1&(B" ",1g(B" ",1$(B" ",1'(B" -"e" ",1i(B" ",1k(B" ",1((B" ",1h(B" ",1)(B" -",1j(B" ",1*(B" ",1,(B" ",1-(B" ",1+(B" ",1.(B" -"i" ",1m(B" ",1o(B" ",1n(B" ",1l(B" ",18(B" -"o" ",1s(B" ",1v(B" ",1u(B" ",1r(B" ",1w(B" -",1t(B" ",1/(B" ",11(B" ",12(B" ",10(B" ",15(B" -",1=(B" ",1>(B" ",17(B" ",1^(B" ",16(B" ",1~(B" -"u" ",1z(B" ",1|(B" ",1{(B" ",1y(B" ",1x(B" -",1_(B" ",1Q(B" ",1X(B" ",1f(B" ",1W(B" ",1q(B" -"y" ",1}(B" ",1V(B" ",1[(B" ",1O(B" ",1\(B" - -"A" ",2`(B" ",2d(B" ",2c(B" ",2a(B" ",2U(B" -",2e(B" ",2"(B" ",2F(B" ",2G(B" ",2!(B" ",2#(B" -",2b(B" ",2%(B" ",2&(B" ",2g(B" ",2$(B" ",2'(B" -"E" ",2h(B" ",2k(B" ",2((B" ",2i(B" ",2)(B" -",2j(B" ",2+(B" ",2,(B" ",2-(B" ",2*(B" ",2.(B" -"I" ",2l(B" ",2o(B" ",2n(B" ",2m(B" ",28(B" -"O" ",2r(B" ",2v(B" ",2u(B" ",2s(B" ",2w(B" -",2t(B" ",20(B" ",21(B" ",22(B" ",2/(B" ",25(B" -",2=(B" ",26(B" ",27(B" ",2^(B" ",2>(B" ",2~(B" -"U" ",2y(B" ",2|(B" ",2{(B" ",2z(B" ",2x(B" -",2_(B" ",2W(B" ",2X(B" ",2f(B" ",2Q(B" ",2q(B" -"Y" ",2O(B" ",2V(B" ",2[(B" ",2}(B" ",2\(B" - -",2p(B" ",1p(B" \ No newline at end of file diff --git a/egg.el b/egg.el index 4ab1823..69f4503 100644 --- a/egg.el +++ b/egg.el @@ -33,10 +33,11 @@ (require 'cl) (require 'egg-edep) -(autoload 'egg-simple-input-method "egg-sim") +(autoload 'egg-simple-input-method "egg-sim" + "simple input method for Tamago 4." t) (defgroup egg nil - "Tamago Version 4") + "Tamago Version 4.") (defcustom egg-mode-preference t "*Make Egg as modefull input method, if non-NIL." @@ -48,9 +49,84 @@ (make-variable-buffer-local 'egg-last-method-name) (put 'egg-last-method-name 'permanent-local t) -(defvar egg-current-keymap nil) -(make-variable-buffer-local 'egg-current-keymap) -(put 'egg-current-keymap 'permanent-local t) +(defvar egg-mode-map-alist nil) +(defvar egg-sub-mode-map-alist nil) + +(defmacro define-egg-mode-map (mode &rest initializer) + (let ((map (intern (concat "egg-" (symbol-name mode) "-map"))) + (var (intern (concat "egg-" (symbol-name mode) "-mode"))) + (comment (concat (symbol-name mode) " keymap for EGG mode."))) + `(progn + (defvar ,map (let ((map (make-sparse-keymap))) + ,@initializer + map) + ,comment) + (fset ',map ,map) + (defvar ,var nil) + (make-variable-buffer-local ',var) + (put ',var 'permanent-local t) + (or (assq ',var egg-mode-map-alist) + (setq egg-mode-map-alist (append egg-mode-map-alist + '((,var . ,map)))))))) + +(define-egg-mode-map modefull + (define-key map "\C-^" 'egg-simple-input-method) + (let ((i 33)) + (while (< i 127) + (define-key map (vector i) 'egg-self-insert-char) + (setq i (1+ i))))) + +(define-egg-mode-map modeless + (define-key map " " 'mlh-space-bar-backward-henkan) + (define-key map "\C-^" 'egg-simple-input-method)) + +(defvar egg-enter/leave-fence-hook nil) + +(defun egg-enter/leave-fence (&optional old new) + (run-hooks 'egg-enter/leave-fence-hook)) + +(defvar egg-activated nil) +(make-variable-buffer-local 'egg-activated) +(put 'egg-activated 'permanent-local t) + +(defun egg-activate-keymap () + (when (and egg-activated + (null (eq (car egg-sub-mode-map-alist) + (car minor-mode-overriding-map-alist)))) + (let ((alist (append egg-sub-mode-map-alist egg-mode-map-alist)) + (overriding (copy-sequence minor-mode-overriding-map-alist))) + (while alist + (setq overriding (delq (assq (caar alist) overriding) overriding) + alist (cdr alist))) + (setq minor-mode-overriding-map-alist (append egg-sub-mode-map-alist + overriding + egg-mode-map-alist))))) + +(add-hook 'egg-enter/leave-fence-hook 'egg-activate-keymap t) + +(defun egg-modify-fence (&rest arg) + (add-hook 'post-command-hook 'egg-post-command-func)) + +(defun egg-post-command-func () + (run-hooks 'egg-enter/leave-fence-hook) + (remove-hook 'post-command-hook 'egg-post-command-func)) + +(defvar egg-change-major-mode-buffer nil) + +(defun egg-activate-keymap-after-command () + (while egg-change-major-mode-buffer + (save-excursion + (set-buffer (car egg-change-major-mode-buffer)) + (egg-activate-keymap) + (setq egg-change-major-mode-buffer (cdr egg-change-major-mode-buffer)))) + (remove-hook 'post-command-hook 'egg-activate-keymap-after-command)) + +(defun egg-change-major-mode-func () + (setq egg-change-major-mode-buffer (cons (current-buffer) + egg-change-major-mode-buffer)) + (add-hook 'post-command-hook 'egg-activate-keymap-after-command)) + +(add-hook 'change-major-mode-hook 'egg-change-major-mode-func) ;;;###autoload (defun egg-mode (&rest arg) @@ -64,9 +140,9 @@ (progn (its-exit-mode) (egg-exit-conversion)) - (setq describe-current-input-method-function nil) - (if (eq (current-local-map) egg-current-keymap) - (use-local-map (keymap-parent (current-local-map)))) + (setq describe-current-input-method-function nil + egg-modefull-mode nil + egg-modeless-mode nil) (remove-hook 'input-method-activate-hook 'its-set-mode-line-title t) (force-mode-line-update)) ;; Turn on @@ -77,11 +153,14 @@ (egg-set-conversion-backend (nthcdr 2 arg)) (egg-set-conversion-backend (list (assq its-current-language (nthcdr 2 arg))) t) - (setq egg-last-method-name (car arg)) - (setq egg-current-keymap (if egg-mode-preference - (egg-modefull-map) - (egg-modeless-map))) - (use-local-map egg-current-keymap) + (setq egg-last-method-name (car arg) + egg-activated t) + (egg-activate-keymap) + (if egg-mode-preference + (progn + (setq egg-modefull-mode t) + (its-define-select-keys egg-modefull-map)) + (setq egg-modeless-mode t)) (setq inactivate-current-input-method-function 'egg-mode) (setq describe-current-input-method-function 'egg-help) (make-local-hook 'input-method-activate-hook) @@ -95,43 +174,37 @@ (if (<= (minibuffer-depth) 1) (remove-hook 'minibuffer-exit-hook 'egg-exit-from-minibuffer))) -(defun egg-modefull-map () - "Generate modefull keymap for EGG mode." - (let ((map (make-sparse-keymap)) - (i 33)) - (define-key map "\C-^" 'egg-simple-input-method) - (while (< i 127) - (define-key map (vector i) 'egg-self-insert-char) - (setq i (1+ i))) - (its-define-select-keys map) - (set-keymap-parent map (current-local-map)) - map)) - -(defun egg-modeless-map () - "Generate modeless keymap for EGG mode." - (let ((map (make-sparse-keymap))) - (define-key map " " 'mlh-space-bar-backward-henkan) - (define-key map "\C-^" 'egg-simple-input-method) - (set-keymap-parent map (current-local-map)) - map)) - (defvar egg-context nil) (defun egg-self-insert-char () (interactive) (its-start last-command-char (and (eq last-command 'egg-use-context) egg-context))) + +(defun egg-remove-all-text-properties (from to &optional object) + (let ((p from) + props prop) + (while (< p to) + (setq prop (text-properties-at p object)) + (while prop + (unless (eq (car prop) 'composition) + (setq props (plist-put props (car prop) nil))) + (setq prop (cddr prop))) + (setq p (next-property-change p object to))) + (remove-text-properties from to props object))) (defvar egg-mark-list nil) (defvar egg-suppress-marking nil) (defun egg-set-face (beg eng face &optional object) - (put face 'face face) - (add-text-properties beg eng - (list 'category face - 'egg-face t - 'modification-hooks '(egg-mark-modification)) - object)) + (let ((hook (get-text-property beg 'modification-hooks object))) + (put face 'face face) + (add-text-properties beg eng + (list 'category face + 'egg-face t + 'modification-hooks (cons 'egg-mark-modification + hook)) + object))) (defun egg-mark-modification (beg end) (if (and (null egg-suppress-marking) diff --git a/egg/canna.el b/egg/canna.el index 78ded66..d6ab041 100644 --- a/egg/canna.el +++ b/egg/canna.el @@ -30,257 +30,861 @@ ;;; Code: - +(require 'egg) (require 'egg-edep) -(eval-when-compile - (defmacro CANNA-const (c) - (cond ((eq c 'FileNotExist) xxxxxxxxxxxxxx) - ))) - -(defconst canna-conversion-backend - [ canna-init - - canna-start-conversion - canna-get-bunsetsu-converted - canna-get-bunsetsu-source - canna-list-candidates - canna-get-number-of-candidates - canna-get-current-candidate-number - canna-get-all-candidates - canna-decide-candidate - canna-change-bunsetsu-length - canna-end-conversion - nil - - canna-fini - ]) - -(defconst canna-server-port 5680 "Port number of Canna server") -(defvar canna-hostname "localhost" - "Hostname of Canna server") - -(defun canna-open (hostname) - "Establish the connection to CANNA server. Return environment object." - (let* ((buf (generate-new-buffer " *CANNA*")) - (proc (open-network-stream "CANNA" buf hostname canna-server-port)) - result) - (process-kill-without-query proc) - (set-process-coding-system proc 'no-conversion 'no-conversion) - (set-marker-insertion-type (process-mark proc) t) - (save-excursion - (set-buffer buf) - (erase-buffer) - (buffer-disable-undo) - (set-buffer-multibyte nil)) - (setq result (cannarpc-open proc (user-login-name))) - (if (< result 0) - (let ((msg (cannarpc-get-error-message (- result)))) - (delete-process proc) - (kill-buffer buf) - (error "Can't open CANNA session (%s): %s" hostname msg))) - (vector proc result))) - -;; XXX: Should support multiple outstanding context -;; ::= [ ] -(defvar canna-environment nil +(defgroup canna nil + "CANNA interface for Tamago 4." + :group 'egg) + +(defcustom canna-hostname "localhost" + "Hostname of CANNA server" + :group 'canna :type 'string) + +(defcustom canna-server-port 5680 + "Port number of CANNA server" + :group 'canna :type 'integer) + +(defcustom canna-user-name nil + "User Name on CANNA server" + :group 'canna :type 'string) + +(defcustom canna-group-name nil + "Group Name on CANNA server" + :group 'canna :type 'string) + +; (eval-when-compile +; (defmacro CANNA-const (c) +; (cond ((eq c 'FileNotExist) xxxxxxxxxxxxxx) +; ))) + +(egg-add-message + '((Japanese + (canna-connect-error "$B%5!<%P$H@\B3$G$-$^$;$s$G$7$?(B") + (canna-fail-make-env "$B4D6-$r:n$k$3$H$O$G$-$^$;$s$G$7$?(B") + (canna-dict-missing-1 "$B<-=q%U%!%$%k(B %s $B$,$"$j$^$;$s!#(B") + (canna-dict-missing-2 "$B<-=q%U%!%$%k(B %s $B$,$"$j$^$;$s!#:n$j$^$9$+(B? ") + (canna-dict-created "$B<-=q%U%!%$%k(B %s $B$r:n$j$^$7$?(B") + (canna-dict-saving "%s $B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9(B") + (canna-dict-saved "%s $B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?(B") + (canna-register-1 "$BEPO?<-=qL>(B:") + (canna-register-2 "$BIJ;lL>(B")))) + +(defvar canna-hinshi-alist + '(("$B?ML>(B" . "#JN") ("$BCOL>(B" . "#CN") ("$B8GM-L>;l(B" . "#KK") + ("$B0lHLL>;l(B" . "#T35") ("$BL>;l(B($BNc(B)$B6/NO$J(B" . "#T15") + ("$B%5JQL>;l(B" . "#T30") ("$B%5JQL>;l(B($BNc(B)$B0B?4$J(B" . "#T10") ("$BC14A;z(B" . "#KJ") + ("$BF0;l%+9TJQ3J3hMQ(B" . "#KX") ("$BF0;l%s%69TJQ3J3hMQ(B" . "#NZX") + ("$BF0;l%69TJQ3J3hMQ(B" . "#ZX") ("$BF0;l%59TJQ3J3hMQ(B" . "#SX") + ("$BF0;l%+9T8^CJ3hMQ(B" . "#K5") ("$BF0;l%,9T8^CJ3hMQ(B" . "#G5") + ("$BF0;l%59T8^CJ3hMQ(B" . "#S5") ("$BF0;l%?9T8^CJ3hMQ(B" . "#T5") + ("$BF0;l%J9T8^CJ3hMQ(B" . "#N5") ("$BF0;l%P9T8^CJ3hMQ(B" . "#B5") + ("$BF0;l%^9T8^CJ3hMQ(B" . "#M5") ("$BF0;l%i9T8^CJ3hMQ(B" . "#R5") + ("$BF0;l%o9T8^CJ3hMQ(B" . "#W5") ("$BF0;l>e2<0lCJ3hMQ(B" . "#KS") + ("$BF0;l%+9T8^CJO"MQL>;l(B" . "#K5r") ("$BF0;l%,9T8^CJO"MQL>;l(B" . "#G5r") + ("$BF0;l%59T8^CJO"MQL>;l(B" . "#S5r") ("$BF0;l%?9T8^CJO"MQL>;l(B" . "#T5r") + ("$BF0;l%J9T8^CJO"MQL>;l(B" . "#N5r") ("$BF0;l%P9T8^CJO"MQL>;l(B" . "#B5r") + ("$BF0;l%^9T8^CJO"MQL>;l(B" . "#M5r") ("$BF0;l%i9T8^CJO"MQL>;l(B" . "#R5r") + ("$BF0;l%o9T8^CJO"MQL>;l(B" . "#W5r") ("$BF0;l>e2<0lCJ8l44L>;l(B" . "#KSr") + ("$B7AMF;l(B" . "#KY") ("$B7AMF;l(B($BNc(B)$B$-$$$m$$(B" . "#KYT") + ("$B7AMFF0;l(B" . "#T05") + ("$B7AMFF0;l(B($BNc(B)$B4X?4$@(B" . "#T10") ("$B7AMFF0;l(B($BNc(B)$BB?92$F$@(B" . "#T13") + ("$B7AMFF0;l(B($BNc(B)$B0U30$@(B" . "#T15") ("$B7AMFF0;l(B($BNc(B)$BJXMx$@(B" . "#T18") + ("$BI{;l(B" . "#F14") ("$BI{;l(B($BNc(B)$B$U$C$/$i(B" . "#F04") + ("$BI{;l(B($BNc(B)$B$=$C$H(B" . "#F12") ("$BI{;l(B($BNc(B)$BFMA3(B" . "#F06") + ("$B?t;l(B" . "#NN") ("$B@\B3;l!&46F0;l(B" . "#CJ") ("$BO"BN;l(B" . "#RT"))) + +(defvar canna-hinshi-menu + '("$B?ML>(B" "$BCOL>(B" ("$BCDBN!&2q(B" . "$B8GM-L>;l(B") ("$BL>;l(B" . MEISHI) + ("$B%5JQL>;l(B" . SAHEN-MEISHI) "$BC14A;z(B" ("$BF0;l(B" . DOUSHI) + ("$B7AMF;l(B" . KEIYOUSHI) ("$B7AMFF0;l(B" . KEIYOUDOUSHI) ("$BI{;l(B" . FUKUSHI) + "$B?t;l(B" "$B@\B3;l!&46F0;l(B" "$BO"BN;l(B" ("$B$=$NB>$N8GM-L>;l(B" . "$B8GM-L>;l(B")) + "Menu data for a hinshi (a part of speech) selection.") + +(defun canna-hinshi-name (id &optional reverse) + (if reverse + (cdr (assoc id canna-hinshi-alist)) + (car (rassoc id canna-hinshi-alist)))) + +(defmacro canna-backend-plist () + ''(egg-start-conversion canna-start-conversion + egg-get-bunsetsu-source canna-get-bunsetsu-source + egg-get-bunsetsu-converted canna-get-bunsetsu-converted + egg-get-source-language canna-get-source-language + egg-get-converted-language canna-get-converted-language + egg-list-candidates canna-list-candidates + egg-decide-candidate canna-decide-candidate + egg-special-candidate canna-special-candidate + egg-change-bunsetsu-length canna-change-bunsetsu-length + egg-end-conversion canna-end-conversion + egg-word-registration canna-word-registration)) + +(defconst canna-backend-language-alist nil) + +(defvar canna-backend-alist nil) + +(defun canna-backend-func-name (name lang &optional env) + (intern (concat name "-" (symbol-name lang) + (and env "-") (and env (symbol-name env))))) + +(defun canna-make-backend (lang env &optional source-lang converted-lang) + (let ((finalize (canna-backend-func-name "canna-finalize-backend" lang)) + (backend (canna-backend-func-name "canna-backend" lang env))) + (if (null (fboundp finalize)) + (progn + (fset finalize (function (lambda () (canna-finalize-backend)))) + (egg-set-finalize-backend (list finalize)))) + (if (null (get backend 'egg-start-conversion)) + (setplist backend (apply 'list + 'language lang + 'source-language (or source-lang lang) + 'converted-language (or converted-lang lang) + (canna-backend-plist)))) + backend)) + +(defun canna-define-backend (lang env-name-list) + (mapcar (lambda (env) + (if (consp env) + (canna-define-backend lang env) + (canna-make-backend lang env))) + env-name-list)) + +(defun canna-define-backend-alist (deflist) + (setq canna-backend-alist + (mapcar (lambda (slot) + (let* ((lang (car slot)) + (alt (cdr (assq lang canna-backend-language-alist)))) + (cons lang (canna-define-backend (or alt lang) (cdr slot))))) + deflist))) + +(defcustom canna-backend-define-list + '((Japanese ((nil nil nil)) + ((Bushu Bushu Bushu)))) + "Alist of Japanese language and lists of the Canna backend suffixes." + :group 'canna + :set (lambda (sym value) + (set-default sym value) + (canna-define-backend-alist value)) + :type '(repeat + (cons + :tag "Language - Backend" + (choice :tag "Language" + (const Japanese) + (symbol :tag "Other")) + (repeat + (cons + :tag "Backend Sequece" + (cons :tag "First Conversion Stage" + (symbol :tag "Backend for Start Conversion") + (repeat :tag "Backends for Reconvert" + (symbol :tag "Backend"))) + (repeat + :tag "Following Conversion Stages" + (cons + :tag "N-th Stage" + (symbol :tag "Backend for This Stage") + (repeat :tag "Backends for Reconvert" + (symbol :tag "Backend"))))))))) + +(defsubst canna-backend-get-language (backend) + (get backend 'language)) + +(defsubst canna-backend-get-source-language (backend) + (get backend 'source-language)) + +(defsubst canna-backend-get-converted-language (backend) + (get backend 'converted-language)) + +(defvar canna-envspec-list nil) +(defvar canna-current-envspec nil) + +;; Should support multiple outstanding context +;; ::= [ ] +(defvar canna-environments nil "Environment for CANNA kana-kanji conversion") -(defsubst cannaenv-get-proc (env) - (aref env 0)) -(defsubst cannaenv-get-context (env) - (aref env 1)) - -;; ::= -;; [ -;; ] -(defsubst canna-make-bunsetsu (env converted bunsetsu-pos) - (vector env converted bunsetsu-pos nil nil nil)) - -(defsubst cannabunsetsu-get-env (b) - (aref b 0)) -(defsubst cannabunsetsu-get-converted (b) - (aref b 1)) -(defsubst cannabunsetsu-get-bunsetsu-pos (b) - (aref b 2)) -(defsubst cannabunsetsu-get-source (b) - (aref b 3)) -(defsubst cannabunsetsu-set-source (b s) - (aset b 3 s)) -(defsubst cannabunsetsu-get-zenkouho-pos (b) - (aref b 4)) -(defsubst cannabunsetsu-set-zenkouho-pos (b p) - (aset b 4 p)) -(defsubst cannabunsetsu-get-zenkouho (b) - (aref b 5)) -(defsubst cannabunsetsu-set-zenkouho (b z) - (aset b 5 z)) +(defun cannaenv-create (proc context &optional backend mode nostudy) + (vector proc context backend mode nostudy (list nil))) + +(defsubst cannaenv-get-proc (env) (aref env 0)) +(defsubst cannaenv-get-context (env) (aref env 1)) +(defsubst cannaenv-get-backend (env) (aref env 2)) +(defsubst cannaenv-get-mode (env) (aref env 3)) +(defsubst cannaenv-get-nostudy (env) (aref env 4)) +(defsubst cannaenv-get-dic-list (env) (cdr (aref env 5))) + +(defsubst cannaenv-add-dic-list (env &rest dic) + (nconc (aref env 5) (list (apply 'vector dic)))) + +;; ::= +;; [ +;; ] +(defsubst canna-make-bunsetsu (env converted bunsetsu-pos source) + (egg-bunsetsu-create + (cannaenv-get-backend env) + (vector env converted bunsetsu-pos source nil nil nil))) + +(defsubst canna-bunsetsu-get-env (b) + (aref (egg-bunsetsu-get-info b) 0)) +(defsubst canna-bunsetsu-get-converted (b) + (aref (egg-bunsetsu-get-info b) 1)) +(defsubst canna-bunsetsu-get-bunsetsu-pos (b) + (aref (egg-bunsetsu-get-info b) 2)) +(defsubst canna-bunsetsu-get-source (b) + (aref (egg-bunsetsu-get-info b) 3)) +(defsubst canna-bunsetsu-set-source (b s) + (aset (egg-bunsetsu-get-info b) 3 s)) +(defsubst canna-bunsetsu-get-zenkouho-pos (b) + (aref (egg-bunsetsu-get-info b) 4)) +(defsubst canna-bunsetsu-set-zenkouho-pos (b p) + (aset (egg-bunsetsu-get-info b) 4 p)) +(defsubst canna-bunsetsu-get-zenkouho (b) + (aref (egg-bunsetsu-get-info b) 5)) +(defsubst canna-bunsetsu-set-zenkouho (b z) + (aset (egg-bunsetsu-get-info b) 5 z)) +(defsubst canna-bunsetsu-get-zenkouho-converted (b) + (aref (egg-bunsetsu-get-info b) 6)) +(defsubst canna-bunsetsu-set-zenkouho-converted (b zc) + (aset (egg-bunsetsu-get-info b) 6 zc)) (defun canna-get-bunsetsu-source (b) - (let ((s (cannabunsetsu-get-source b))) + (let ((s (canna-bunsetsu-get-source b))) (or s - (let* ((env (cannabunsetsu-get-env b)) - (bp (cannabunsetsu-get-bunsetsu-pos b)) + (let* ((env (canna-bunsetsu-get-env b)) + (bp (canna-bunsetsu-get-bunsetsu-pos b)) (s (cannarpc-get-bunsetsu-source env bp))) - (cannabunsetsu-set-source b s))))) - -(defun canna-get-bunsetsu-converted (b) - (cannabunsetsu-get-converted b)) - -(defconst canna-dictionary-specification - '("iroha" - "fuzokugo" - "hojomwd" - "hojoswd" - "bushu" - "user" - ) - "Dictionary specification of CANNA.") + (canna-bunsetsu-set-source b s))))) +(defun canna-get-bunsetsu-converted (b) (canna-bunsetsu-get-converted b)) +(defun canna-get-source-language (b) 'Japanese) +(defun canna-get-converted-language (b) 'Japanese) + +(defun canna-envspec-create (env-name convert-mode nostudy) + (vector (and env-name (setq env-name (intern env-name))) + (canna-make-backend egg-language env-name) + convert-mode nostudy (list nil))) + +(defsubst canna-envspec-env-type (spec) (aref spec 0)) +(defsubst canna-envspec-backend (spec) (aref spec 1)) +(defsubst canna-envspec-mode (spec) (aref spec 2)) +(defsubst canna-envspec-nostudy (spec) (aref spec 3)) +(defsubst canna-envspec-dic-list (spec) (cdr (aref spec 4))) + +(defsubst canna-envspec-add-dic-list (spec &rest dic) + (nconc (aref spec 4) (list (apply 'vector dic)))) + +(defmacro canna-arg-type-error (func) + `(egg-error ,(format "%s: Wrong type argument" func))) + +(defun canna-define-environment (&optional env-name convert-mode nostudy) + "Define a Canna environment. ENV-NAME specifies suffix of the Canna +environment name. CONVERT-MODE specifies including hiragana or +katakana to candidates list. NOSTUDY specifies not study." + (if (and env-name (null (stringp env-name))) + (canna-arg-type-error canna-define-environment)) + (setq canna-current-envspec (canna-envspec-create env-name + convert-mode nostudy) + canna-envspec-list (nconc canna-envspec-list + (list canna-current-envspec)))) + +(defun canna-add-dict (dict dict-rw) + (canna-envspec-add-dic-list canna-current-envspec dict dict-rw)) + +(defun canna-comm-sentinel (proc reason) ; assume it is close + (let ((inhibit-quit t)) + (kill-buffer (process-buffer proc)) + ;; delete env from the list. + (setq canna-environments + (delq nil (mapcar (lambda (env) + (if (null (eq (cannaenv-get-proc env) proc)) + env)) + canna-environments))))) + +(defun canna-open (hostname-list) + "Establish the connection to CANNA server. Return environment object." + (let* ((save-inhibit-quit inhibit-quit) + (inhibit-quit t) + (proc-name "CANNA") + (msg-form "Canna: connecting to %S at %s...") + (user-name (or canna-user-name (user-login-name))) + (id (shell-command-to-string "id")) + (group (or canna-group-name + (if (string-match "gid=[0-9]+(\\([^)]+\\))" id) + (match-string 1 id) + "user"))) + buf hostname port proc result msg) + (unwind-protect + (progn + (setq buf (generate-new-buffer " *CANNA*")) + (save-excursion + (set-buffer buf) + (erase-buffer) + (buffer-disable-undo) + (set-buffer-multibyte nil) + (setq egg-fixed-euc 'fixed-euc-jp)) + (or (consp hostname-list) + (setq hostname-list (list hostname-list))) + (while (and hostname-list (null proc)) + (setq hostname (or (car hostname-list) "") + hostname-list (cdr hostname-list)) + (if (null (string-match ":" hostname)) + (setq port canna-server-port) + (setq port (string-to-int (substring hostname (match-end 0))) + hostname (substring hostname 0 (match-beginning 0)))) + (and (equal hostname "") + (setq hostname (or (getenv "CANNAHOST") "localhost"))) + (let ((inhibit-quit save-inhibit-quit)) + (if (and msg + (null (y-or-n-p (format "%s failed. Try to %s? " + msg hostname)))) + (egg-error "abort connect"))) + (setq msg (format "Canna: connecting to %s..." hostname)) + (message "%s" msg) + (let ((inhibit-quit save-inhibit-quit)) + (condition-case nil + (setq proc (open-network-stream proc-name buf hostname port)) + ((error quit)))) + (when proc + (process-kill-without-query proc) + (set-process-coding-system proc 'no-conversion 'no-conversion) + (set-process-sentinel proc 'canna-comm-sentinel) + (set-marker-insertion-type (process-mark proc) t) + (setq result (cannarpc-open proc user-name)) ;; result is context + (if (= result -1) + (progn + (delete-process proc) + (setq proc nil)) + (cannarpc-notice-group-name proc result group) + (cannarpc-set-app-name proc result "EGG4")))) + (cons proc result)) + (if proc + (message (concat msg "done")) + (if buf (kill-buffer buf)) + (egg-error 'canna-connect-error))))) (defun canna-filename (p) "" (cond ((consp p) (concat (car p) "/" (user-login-name))) (t p))) -(defun canna-get-environment () +(defun canna-search-environment (backend) + (let ((env-list canna-environments) + env) + (while (and (null env) env-list) + (setq env (and (eq (cannaenv-get-backend (car env-list)) backend) + (car env-list)) + env-list (cdr env-list))) + env)) + +(defun canna-get-environment (backend) "Return the backend of CANNA environment." - (if canna-environment - canna-environment - (let* ((env (canna-open canna-hostname)) - (l canna-dictionary-specification) - dict-list) - (while l - (let ((dic (car l)) - result) - (setq result - (canna-open-dictionary env (canna-filename dic))) - (if (= result 255) - (error "Damedamedame") ; XXX - (setq l (cdr l))))) - (setq canna-environment env)))) - -(defun canna-open-dictionary (env name) + (let ((env (canna-search-environment backend)) + proc context error) + (or env + (unwind-protect + (let* ((language (canna-backend-get-language backend)) + specs) + (setq proc (canna-open canna-hostname) + context (cdr proc) + proc (car proc) + canna-envspec-list nil) + (condition-case err + (egg-load-startup-file 'canna language) + (egg-error + (setq error err) + (signal (car error) (cdr error)))) + (setq specs canna-envspec-list) + (while specs + (canna-create-environment proc context (car specs)) + (setq context nil) + (setq specs (cdr specs))) + (setq env (canna-search-environment backend))) + (when (and proc (null env)) + (cannarpc-close proc) + (if error + (signal (car error) (cdr error)) + (egg-error 'canna-fail-make-env))) + )))) + +(defun canna-create-environment (proc context spec) + (let* ((save-inhibit-quit inhibit-quit) + (inhibit-quit t) + (backend (canna-envspec-backend spec)) + (convert-mode (canna-envspec-mode spec)) + (nostudy (canna-envspec-nostudy spec)) + (dic-list (canna-envspec-dic-list spec)) + env) + (condition-case err + (progn + (if (not context) + (setq context (cannarpc-create-context proc))) + (if (< context 0) + (egg-error "%s" (cannarpc-get-error-message (- context)))) + (setq env (cannaenv-create proc context backend convert-mode nostudy)) + (let ((inhibit-quit save-inhibit-quit)) + (while dic-list + (canna-set-dictionary env (car dic-list)) + (setq dic-list (cdr dic-list)))) + (setq canna-environments (nconc canna-environments (list env)))) + ((egg-error quit) + (if (eq (car err) 'egg-error) + (message "%s" (nth 1 err))) + (if env + (progn + (cannarpc-close-context env) + (setq canna-environments (delq env canna-environments)))) + (if (eq (car err) 'quit) + (signal 'quit (cdr err))))))) + +(defun canna-set-dictionary (env dic-spec) + (let ((dname (aref dic-spec 0)) + (drw (aref dic-spec 1)) + did result) + (if (= 0 (canna-open-dictionary env dname drw)) + (cannaenv-add-dic-list env dname drw)))) + +(defun canna-open-dictionary (env name rw) (let ((trying t) ret) (while trying (setq ret (cannarpc-open-dictionary env name 0)) ; XXX MODE=0 (if (= ret 0) (setq trying nil) - (message "$B<-=q%U%!%$%k(B(%s)$B$,$"$j$^$;$s(B" name) - (setq ret (- ret)) ; Get error code. + (message (egg-get-message 'canna-dict-missing-1) name) + (if rw (if (and (y-or-n-p - (format "$B<-=q%U%!%$%k(B(%s)$B$,$"$j$^$;$s!#:n$j$^$9$+(B? " - name)) + (format (egg-get-message 'canna-dict-missing-2) name)) (= (cannarpc-make-dictionary env name) 0)) - (message "$B<-=q%U%!%$%k(B(%s)$B$r:n$j$^$7$?(B" name) - (error "Fatal")))) + (message (egg-get-message 'canna-dict-created) name) + (message "%s" (cannarpc-get-error-message (- ret)))) + (setq trying nil)))) ret)) +(defun canna-save-dictionaries (env) + (let ((dic-list (canna-list-writable-dictionaries-byname env)) + dic) + (while dic-list + (setq dic (car dic-list) + dic-list (cdr dic-list)) + (cannarpc-save-dictionary env dic)))) + (defun canna-init () ) -(defun canna-start-conversion (yomi lang) +(defun canna-start-conversion (backend yomi &optional context) "Convert YOMI string to kanji, and enter conversion mode. Return the list of bunsetsu." - (if (eq lang 'Japanese) - (let ((env (canna-get-environment))) - (cannarpc-begin-conversion env yomi)) - (signal 'lang-not-supported))) + (let* ((env (canna-get-environment backend)) + (bunsetsu-list (cannarpc-begin-conversion env yomi))) + (if (numberp bunsetsu-list) ; XXX error $B$N=hM}E,Ev(B + (progn + (if (= -1 (cannarpc-cancel-conversion env)) + (progn + (setq env (canna-get-environment backend)) + (canna-finalize-backend))) + (setq bunsetsu-list (cannarpc-begin-conversion env yomi)))) + bunsetsu-list)) (defun canna-end-conversion (bunsetsu-list abort) - (let* ((env (cannabunsetsu-get-env (car bunsetsu-list))) + (let* ((env (canna-bunsetsu-get-env (car bunsetsu-list))) (l bunsetsu-list) (len (length bunsetsu-list)) (zenkouho-pos-vector (make-vector (* 2 len) 0)) (i 0) - (mode 1) ;XXX MODE=1 attru? + (mode (if (cannaenv-get-nostudy env) 0 1)) ; MODE=1 $B3X=,(B 0 $B$7$J$$(B bunsetsu zenkouho-pos) (if abort (setq mode 0)) (while l (setq bunsetsu (car l)) (setq l (cdr l)) - (setq zenkouho-pos (cannabunsetsu-get-zenkouho-pos bunsetsu)) + (setq zenkouho-pos (canna-bunsetsu-get-zenkouho-pos bunsetsu)) (if (null zenkouho-pos) () ; XXX: NIL--> 0 atteru??? (aset zenkouho-pos-vector i 0) ; XXX Don't support >=256 (aset zenkouho-pos-vector (1+ i) zenkouho-pos)) (setq i (+ i 2))) - (cannarpc-end-conversion env len zenkouho-pos-vector 0))) - -(defun canna-list-candidates (bunsetsu prev-bunsetsu) - (let* ((env (cannabunsetsu-get-env bunsetsu)) - (bunsetsu-pos (cannabunsetsu-get-bunsetsu-pos bunsetsu)) - (z (cannarpc-get-bunsetsu-candidates env bunsetsu-pos))) - (cannabunsetsu-set-zenkouho bunsetsu z) - (cannabunsetsu-set-zenkouho-pos bunsetsu 0) - 0)) - + (cannarpc-end-conversion env len zenkouho-pos-vector mode))) + +(defun canna-list-candidates (bunsetsu prev-b next-b major) + (setq bunsetsu (car bunsetsu)) + (if (canna-bunsetsu-get-zenkouho bunsetsu) + (cons (canna-bunsetsu-get-zenkouho-pos bunsetsu) + (canna-bunsetsu-get-zenkouho-converted bunsetsu)) + (let* ((env (canna-bunsetsu-get-env bunsetsu)) + (yomi (canna-get-bunsetsu-source bunsetsu)) + (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu)) + (z (cannarpc-get-bunsetsu-candidates env bunsetsu-pos yomi))) + (canna-bunsetsu-set-zenkouho bunsetsu z) + (cons (canna-bunsetsu-set-zenkouho-pos bunsetsu 0) + (canna-bunsetsu-set-zenkouho-converted + bunsetsu + (mapcar 'canna-bunsetsu-get-converted z)))))) + +;;; XXX not use ? (defun canna-get-number-of-candidates (bunsetsu) - (let ((l (cannabunsetsu-get-zenkouho bunsetsu))) + (let ((l (canna-bunsetsu-get-zenkouho bunsetsu))) (if l (length l) nil))) -(defun canna-decide-candidate (bunsetsu candidate-pos) - (let* ((candidate-list (cannabunsetsu-get-zenkouho bunsetsu)) - (candidate (nth candidate-pos candidate-list))) - (cannabunsetsu-set-zenkouho candidate candidate-list) - (cannabunsetsu-set-zenkouho-pos candidate candidate-pos) - candidate)) - +(defun canna-decide-candidate (bunsetsu pos prev-b next-b) + (let* ((head (car bunsetsu)) + (candidate-list (canna-bunsetsu-get-zenkouho head)) + (candidate (nth pos candidate-list))) + (canna-bunsetsu-set-zenkouho candidate candidate-list) + (canna-bunsetsu-set-zenkouho-pos candidate pos) + (canna-bunsetsu-set-zenkouho-converted + candidate (canna-bunsetsu-get-zenkouho-converted head)) + (list (list candidate)))) + +(defun canna-special-candidate (bunsetsu prev-b next-b major type) + (let* ((head (car bunsetsu)) + (env (canna-bunsetsu-get-env head)) + (backend (egg-bunsetsu-get-backend head)) + (lang (get backend 'language)) + source converted zenkouho-list kouho-list pos) + (when (and (eq lang (get backend 'source-language)) + (eq lang (get backend 'converted-language))) + (cond ((eq lang 'Japanese) + (setq source (canna-get-bunsetsu-source head)) + (cond ((eq type 'egg-hiragana) + (setq converted source)) + ((eq type 'egg-katakana) + (setq converted (japanese-katakana source)))) + (setq zenkouho-list + (cdr (canna-list-candidates bunsetsu prev-b next-b major))) + (setq pos + (when (setq kouho-list (member converted zenkouho-list)) + (- (length zenkouho-list) (length kouho-list)))))) + (when pos + (canna-decide-candidate bunsetsu pos prev-b next-b))))) + +;;; XXX not used ? (defun canna-get-current-candidate-number (bunsetsu) - (cannabunsetsu-get-zenkouho-pos bunsetsu)) + (canna-bunsetsu-get-zenkouho-pos bunsetsu)) +;;; XXX not used ? (defun canna-get-all-candidates (bunsetsu) - (let* ((l (cannabunsetsu-get-zenkouho bunsetsu)) + (let* ((l (canna-bunsetsu-get-zenkouho bunsetsu)) (result (cons nil nil)) (r result)) (catch 'break (while t (let ((candidate (car l))) - (setcar r (cannabunsetsu-get-converted candidate)) + (setcar r (canna-bunsetsu-get-converted candidate)) (if (null (setq l (cdr l))) (throw 'break nil) (setq r (setcdr r (cons nil nil))))))) result)) -;;;;;;;;;;;;;;;;;;;;;;; MADAMADA zenzendame, just copy from SJ3 -(defun canna-change-bunsetsu-length (b0 b1 b2 len) - (let ((yomi (concat - (cannabunsetsu-get-source b1) - (if b2 (cannabunsetsu-get-source b2)))) - (env (cannabunsetsu-get-env b1)) - yomi1 yomi2 - bunsetsu1 bunsetsu2) - (setq yomi1 (substring yomi 0 len) - yomi2 (substring yomi len)) - (setq bunsetsu1 - (cannarpc-tanbunsetsu-conversion env yomi1)) - ;; Only set once (memory original length of the bunsetsu). - (cannabunsetsu-set-kugiri-changed bunsetsu1 - (or (cannabunsetsu-get-kugiri-changed b1) - (length (cannabunsetsu-get-source b1)))) - (if (< 0 (length yomi2)) - (setq bunsetsu2 (cannarpc-tanbunsetsu-conversion env yomi2)) - (setq bunsetsu2 nil)) - (if bunsetsu2 - (list bunsetsu1 bunsetsu2) - (list bunsetsu1)))) - -;;;;;;;;;;;;;; MADAMADA -(defun canna-fini () -) +(defun canna-change-bunsetsu-length (bunsetsu prev-b next-b len major) + (let* ((env (canna-bunsetsu-get-env (car bunsetsu))) + (yomi (canna-get-bunsetsu-source (car bunsetsu))) + (yomi-length (cond ((< (length yomi) len) -1) + ((> (length yomi) len) -2) + (t nil))) + (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos (car bunsetsu))) + new) + (if yomi-length + (setq new (cannarpc-set-kugiri-changed env yomi-length bunsetsu-pos)) + (setq new bunsetsu)) + (list (list (car new)) prev-b (cdr new)))) + +(defun canna-finalize-backend (&optional action) + (let* ((save-inhibit-quit inhibit-quit) + (inhibit-quit t) + (env-list canna-environments) + env proc-list saved) + (while env-list + (setq env (car env-list) + env-list (cdr env-list)) + (condition-case err + (progn + (unless (memq (cannaenv-get-proc env) proc-list) + (setq proc-list (cons (cannaenv-get-proc env) proc-list))) + (unless (eq action 'disconnect-only) + (unless saved + (setq saved t) + (message (egg-get-message 'canna-dict-saving) "Canna")) + (let ((inhibit-quit save-inhibit-quit)) + (canna-save-dictionaries env))) + (unless (eq action 'save-only) + (cannarpc-close-context env))) + ((error quit) + (message "signal %S occured when dictionary saving" err)))) + (if saved + (message (egg-get-message 'canna-dict-saved) "Canna")) + (unless (eq action 'save-only) + (while proc-list + (if (and (car proc-list) + (eq (process-status (car proc-list)) 'open)) + (cannarpc-close (car proc-list))) + (setq proc-list (cdr proc-list))))) + (setq canna-environments nil)) + +;;; word registration + +(defun canna-list-writable-dictionaries-byname (env) + (let ((dic-list (cannaenv-get-dic-list env))) + (delq nil + (mapcar (lambda (dic) + (let ((dname (aref dic 0)) + (drw (aref dic 1))) + (and drw dname))) + dic-list)))) + +(defun canna-dictionary-select (env) + (let ((dic-list (canna-list-writable-dictionaries-byname env))) + (if (= 1 (length dic-list)) + (car dic-list) + (menudiag-select (list 'menu + (egg-get-message 'canna-register-1) + dic-list))))) + +(defun canna-hinshi-MEISHI (kanji yomi) + (if (y-or-n-p (concat "$B!V(B" kanji "$B$J!W$O@5$7$$$G$9$+!#(B")) "#T15" "#T35")) + +(defun canna-hinshi-SAHEN-MEISHI (kanji yomi) + (if (y-or-n-p (concat "$B!V(B" kanji "$B$J!W$O@5$7$$$G$9$+!#(B") "#T10" "#T30"))) + +(defmacro canna-hinshi-DOUSHI-check-gobi () + '(progn + (setq i 0) + (while (> 9 i) + (if (string-match (concat (substring gobi i (1+ i)) "$") kanji) + (progn + (setq renyou (substring re-gobi i (1+ i))) + (setq mizen (substring mi-gobi i (1+ i))) + (setq kanji-gobi (substring kanji (match-beginning 0))) + (setq kanji-gokan (substring kanji 0 (match-beginning 0))) + (setq ret (nth i hinshi)) + (setq i 9))) + (setq i (1+ i))) + (setq i 0) + (while (> 9 i) + (if (string-match (concat (substring gobi i (1+ i)) "$") yomi) + (progn + (setq yomi-gobi (substring yomi (match-beginning 0))) + (setq yomi-gokan (substring yomi 0 (match-beginning 0))) + (setq i 9))) + (setq i (1+ i))))) + +(defun canna-hinshi-DOUSHI (kanji yomi) + (let ((gobi "$B$/$0$9$D$L$V$`$k$&(B") + (re-gobi "$B$-$.$7$A$K$S$_$j$$(B") + (mi-gobi "$B$+$,$5$?$J$P$^$i$o(B") + (hinshi (list "#K5" "#G5" "#S5" "#T5" "#N5" "#B5" "#M5" "#R5" "#W5")) + kanji-gokan yomi-gokan kanji-gobi yomi-gobi mizen renyou + i ret1 ret2 ret) + (canna-hinshi-DOUSHI-check-gobi) + (if (not (and (> (length kanji) 1) (> (length yomi) 1) + (and kanji-gobi yomi-gobi (equal kanji-gobi yomi-gobi)))) + (if (and kanji-gobi yomi-gobi) + (egg-error "$BFI$_$H8uJd$N3hMQ$,0c$$$^$9!#F~NO$7$J$*$7$F$/$@$5$$!#(B") + (egg-error "$BFI$_$H8uJd$r=*;_7A$GF~NO$7$F$/$@$5$$!#(B"))) + (cond ((and (> (length kanji) 2) (> (length yomi) 2) + (string-match "$B$/$k(B$" kanji) (string-match "$B$/$k(B$" yomi)) + (setq ret "#KX") + (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) + (setq yomi-gokan (substring yomi 0 (- (length yomi) 2)))) + ((and (> (length kanji) 3) (> (length yomi) 3) + (string-match "$B$s$:$k(B$" kanji) (string-match "$B$s$:$k(B$" yomi)) + (setq ret "#NZX") + (setq kanji-gokan (substring kanji 0 (- (length kanji) 3))) + (setq yomi-gokan (substring yomi 0 (- (length yomi) 3)))) + ((and (> (length kanji) 2) (> (length yomi) 2) + (string-match "$B$:$k(B$" kanji) (string-match "$B$:$k(B$" yomi)) + (setq ret "#ZX") + (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) + (setq yomi-gokan (substring yomi 0 (- (length yomi) 2)))) + ((and (> (length kanji) 2) (> (length yomi) 2) + (string-match "$B$9$k(B$" kanji) (string-match "$B$9$k(B$" yomi)) + (setq ret "#SX") + (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) + (setq yomi-gokan (substring yomi 0 (- (length yomi) 2))))) + (if (not (string-match "5$" ret)) + (if (y-or-n-p (concat "$B!X(B" kanji "$B!Y$r(B (" (canna-hinshi-name ret) + ") $B$H$7$FEPO?$7$^$9$+(B? ")) + (setq ret (list kanji-gokan yomi-gokan ret)) + (setq ret "#R5") + (setq kanji-gokan (substring kanji 0 (- (length kanji) 1))) + (setq yomi-gokan (substring yomi 0 (- (length yomi) 1))))) + (if (listp ret) + ret + (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N 9 i) + (if (string-match (concat (substring re-gobi i (1+ i)) "$") + kanji-gokan) + (progn (setq renyou nil) + (setq i 9))) + (setq i (1+ i)))) + (setq ret2 (y-or-n-p (concat "$B!V(B" kanji-gokan renyou + "$B$,$$$$!W$O@5$7$$$G$9$+!#(B"))) + (setq ret (if ret1 (if ret2 (concat ret "r") ret) + (if ret2 "#KSr" "#KS"))))) + (list kanji-gokan yomi-gokan ret)))) + +(defun canna-hinshi-KEIYOUSHI (kanji yomi) + (let (ret) + (if (not (and (> (length kanji) 1) (> (length yomi) 1) + (string-match "$B$$(B$" yomi) (string-match "$B$$(B$" kanji))) + (egg-error "$BFI$_$H8uJd$r(B $B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc(B) $BAa$$(B")) + (setq kanji (substring kanji 0 (1- (length kanji)))) + (setq yomi (substring yomi 0 (1- (length yomi)))) + (setq ret + (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N (length kanji) 1) (> (length yomi) 1) + (string-match "$B$@(B$" yomi) (string-match "$B$@(B$" kanji))) + (egg-error "$BFI$_$H8uJd$r(B $B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc(B) $B@E$+$@(B")) + (setq kanji (substring kanji 0 (1- (length kanji)))) + (setq yomi (substring yomi 0 (1- (length yomi)))) + (setq ret + (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N= result 0) + (progn + (cannarpc-save-dictionary env dic) + (list (canna-hinshi-name hinshi-id) dic)) + (egg-error (cannarpc-get-error-message (- result))))))) + +;;; word delete registration + +(defun canna-word-delete-regist (backend yomi) + "Delete a word KANJI from dictionary." + (let* ((env (canna-get-environment backend)) + (dic (canna-dictionary-select env)) + proc context envd bunsetsu bunsetsu-pos z zpos kouho-list hinshi i + kanji lex result) + (setq proc (cannaenv-get-proc env)) + (setq context (cannarpc-create-context proc)) + (setq envd (cannaenv-create proc context + 'canna-backend-Japanese-tmp-delete-regist + 1 t)) + (canna-set-dictionary envd (vector dic t)) + (canna-set-dictionary envd (vector "fuzokugo" nil)) + (setq bunsetsu (car (cannarpc-begin-conversion envd yomi))) + (setq bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu)) + (setq z (cannarpc-get-bunsetsu-candidates envd bunsetsu-pos yomi)) + (canna-bunsetsu-set-zenkouho bunsetsu z) + (canna-bunsetsu-set-zenkouho-pos bunsetsu 0) + (setq kouho-list + (canna-bunsetsu-set-zenkouho-converted + bunsetsu + (mapcar 'canna-bunsetsu-get-converted z))) + (setq yomi (car (last kouho-list))) + (setq kouho-list (cdr (reverse kouho-list))) + (setq kouho-list (reverse kouho-list)) + (setq i 0) + (setq kouho-list (mapcar '(lambda (k) + (prog1 + (cons k i) + (setq i (1+ i)))) + kouho-list)) + (let ((hiragana (assoc yomi kouho-list)) + hinshi) + (if hiragana + (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos (cdr hiragana)))) + (if (stringp hinshi) + (if (equal "#T35" hinshi) + (setq kouho-list (delete hiragana kouho-list))) + (setq kouho-list (delete hiragana kouho-list)))) + (cond + ((null kouho-list) + (cannarpc-close-context envd) + (egg-error "$BEPO?$5$l$F$$$^$;$s!#(B")) + ((eq 1 (length kouho-list)) + (setq zpos 0) + (setq kanji (car (car kouho-list)))) + (t + (setq kanji (menudiag-select (list 'menu "$B:o=|(B:" kouho-list) nil nil t)) + (setq zpos (cdr (car kanji))) + (setq kanji (car (car kanji))))) + (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos zpos)) + (setq lex (cannarpc-get-lex envd bunsetsu-pos zpos)) + (cannarpc-cancel-conversion envd) + (if (string-match "#[^#]+" hinshi) + (setq hinshi (substring hinshi 0 (match-end 0))) + (egg-error "$BIJ;l>pJs$,= result 0) + (progn + (cannarpc-save-dictionary envd dic) + (cannarpc-close-context envd) + (list kanji yomi (canna-hinshi-name hinshi) dic)) + (cannarpc-close-context envd) + (egg-error (cannarpc-get-error-message (- result)))) + )) ;;; setup -(require 'egg) +(load "egg/cannarpc") +(run-hooks 'canna-load-hook) ;;;###autoload (defun egg-activate-canna (&rest arg) - "Activate CANNA backend of Tamagotchy." - (setq egg-conversion-backend canna-conversion-backend) - (if (not (fboundp 'cannarpc-open)) - (load-library "egg/canna")) - (apply 'egg-mode arg)) + "Activate CANNA backend of Tamago 4." + (apply 'egg-mode (append arg canna-backend-alist))) ;;; egg/canna.el ends here. diff --git a/egg/cannarpc.el b/egg/cannarpc.el index 8cd2aa0..41fa7c0 100644 --- a/egg/cannarpc.el +++ b/egg/cannarpc.el @@ -45,17 +45,31 @@ ((eq c 'GetDirectoryList) 7) ((eq c 'MountDictionary) 8) ((eq c 'UnmountDictionary) 9) + ((eq c 'GetMountDictionaryList) 11) + ((eq c 'DefineWord) 13) + ((eq c 'DeleteWord) 14) ((eq c 'BeginConvert) 15) ((eq c 'EndConvert) 16) ((eq c 'GetCandidacyList) 17) ((eq c 'GetYomi) 18) ((eq c 'ResizePause) 26) + ((eq c 'GetHinshi) 27) + ((eq c 'GetLex) 28) + ((eq c 'SetApplicationName) 33) + ((eq c 'NoticeGroupName) 34) ((eq c 'CreateDictionary) 3) + ((eq c 'Sync) 8) (t (error "No such constant"))))) +;; XXX +(defconst cannarpc-error-message (vector )) + (defun cannarpc-get-error-message (errno) - (or (aref cannarpc-error-message errno) (format "#%d" errno))) + (or (and (>= errno 0) + (< errno (length cannarpc-error-message)) + (aref cannarpc-error-message errno)) + (format "#%d" errno))) (defmacro cannarpc-call-with-environment (e vlist send-expr &rest receive-exprs) (let ((v (append @@ -73,54 +87,101 @@ (goto-char (prog1 (point) (accept-process-output proc)))) receive-exprs)))) -(defconst canna-version-fmt "2.0:%s") +(defconst canna-version-fmt "3.3:%s") (defun cannarpc-open (proc username) "Open the session. Return 0 on success, error code on failure." (let ((verusr (format canna-version-fmt username))) - (comm-call-with-proc proc (result) - (comm-format (u u v) (canna-const Initialize) (length verusr) verusr) - (comm-unpack (u) result) - result))) + (comm-call-with-proc proc (minor context) + (comm-format (u u s) (canna-const Initialize) (+ (length verusr) 1) + verusr) + (comm-unpack (w w) minor context) + (cond ((and (= minor 65535) (= context 65535)) + -1) ; failure + ((and (= minor 65535) (= context 65534)) + -1) ; version miss match + (t context))))) (defun cannarpc-close (proc) (comm-call-with-proc proc (dummy result) (comm-format (b b w) (canna-const Finalize) 0 0) - (comm-unpack (b b w b) dummy dummy dummy result) - result)) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 ; failure + result))) (defun cannarpc-create-context (proc) (comm-call-with-proc proc (dummy result) (comm-format (b b w) (canna-const CreateContext) 0 0) - (comm-unpack (b b w w) dummy dummy dummy result) - result)) + (comm-unpack (u w) dummy result) + (if (= result 65535) + -1 ; failure + result))) -(defun cannarpc-close-context (proc context) - (comm-call-with-proc proc (dummy result) +(defun cannarpc-close-context (env) + (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w) (canna-const CloseContext) 0 2 context) - (comm-unpack (b b w b) dummy dummy dummy result) - result)) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 ; failure + result))) -;; XXX: Not implemented fully (defun cannarpc-get-dictionary-list (env) - (cannarpc-call-with-environment env (dymmy result) + (let ((i 0) + dic dl dic-list) + (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w w) (canna-const GetDictionaryList) 0 4 context 1024) (comm-unpack (u w) dummy result) ;; follow list of dictionaries - result)) + (if (= result 65535) + -1 ; failure + (while (< i result) + (comm-unpack (s) dic) + (if dl + (setq dl (setcdr dl (cons dic nil))) + (setq dic-list (setq dl (cons dic nil)))) + (setq i (1+ i))) + dic-list)))) -;; XXX: Not implemented fully (defun cannarpc-get-directory-list (env) - (cannarpc-call-with-environment env (dymmy result) + (let ((i 0) + dir dl dir-list) + (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w w) (canna-const GetDirectoryList) 0 4 context 1024) (comm-unpack (u w) dummy result) ;; follow list of directories - result)) + (if (= result 65535) + -1 ; failure + (while (< i result) + (comm-unpack (s) dir) + (if dl + (setq dl (setcdr dl (cons dir nil))) + (setq dir-list (setq dl (cons dir nil)))) + (setq i (1+ i))) + dir-list)))) + +(defun cannarpc-get-mount-dictionary-list (env) + (let ((i 0) + dic dl dic-list) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w w) (canna-const GetMountDictionaryList) 0 4 + context 1024) + (comm-unpack (u w) dummy result) + ;; follow list of dictionaries + (if (= result 65535) + -1 ; failure + (while (< i result) + (comm-unpack (s) dic) + (if dl + (setq dl (setcdr dl (cons dic nil))) + (setq dic-list (setq dl (cons dic nil)))) + (setq i (1+ i))) + dic-list)))) (defun cannarpc-open-dictionary (env dict-file-name mode) - (cannarpc-call-with-environment env (dymmy result) + (cannarpc-call-with-environment env (dummy result) (comm-format (b b w u w s) (canna-const MountDictionary) 0 (+ (length dict-file-name) 7) mode context dict-file-name) @@ -128,27 +189,28 @@ result)) (defun cannarpc-close-dictionary (env dict-file-name mode) - (cannarpc-call-with-environment env (dymmy result) + (cannarpc-call-with-environment env (dummy result) (comm-format (b b w u w s) (canna-const UnmountDictionary) 0 - (+ (length dict-file-name) 6) + (+ (length dict-file-name) 7) mode context dict-file-name) (comm-unpack (u b) dummy result) result)) (defun cannarpc-begin-conversion (env yomi) "Begin conversion." - (let ((yomi-ext (encode-coding-string yomi 'euc-japan)) + (let ((yomi-ext (encode-coding-string yomi 'fixed-euc-jp)) + (mode (or (cannaenv-get-mode env) 19)) ; 19 kana hiragana (i 0) converted bunsetsu-list bl) (cannarpc-call-with-environment env (dummy result) - (comm-format (b b w u w S) (canna-const BeginConvert) 0 - (+ (length yomi-ext) 8) 0 context yomi) + (comm-format (b b w i w S) (canna-const BeginConvert) 0 + (+ (length yomi-ext) 8) mode context yomi) (comm-unpack (u w) dummy result) (if (= result 65535) -1 ; failure (while (< i result) (comm-unpack (S) converted) - (let ((bl1 (cons (canna-make-bunsetsu env converted i) + (let ((bl1 (cons (canna-make-bunsetsu env converted i nil) nil))) (if bl (setq bl (setcdr bl bl1)) @@ -156,11 +218,21 @@ (setq i (1+ i))) bunsetsu-list)))) +(defun cannarpc-cancel-conversion (env) + "Cancel conversion." + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w w u) (canna-const EndConvert) 0 8 context 0 0) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 ; failure + result))) + (defun cannarpc-end-conversion (env len zenkouho-pos-vector mode) "End conversion." (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w w u v) (canna-const EndConvert) 0 - (+ (* len 2) 8) context len mode zenkouho-pos-vector) + (+ (* len 2) 8) context len mode zenkouho-pos-vector + (length zenkouho-pos-vector)) (comm-unpack (u b) dummy result) (if (= result 255) -1 ; failure @@ -173,6 +245,24 @@ (comm-unpack (u b) dummy result) result)) +(defun cannarpc-save-dictionary (env dict-name) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w u w s) (canna-const Sync) 1 + (+ (length dict-name) 7) 0 context dict-name) + (comm-unpack (u b) dummy result) + result)) + +;;; XXX not used +(defun cannarpc-get-dictionary-data (env dir dic) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w s s w) 6 1 + (+ (length dir) (length dic) 6) context dir dic 4096) + (comm-unpack (u w) dummy result) + (if (= result 65535) + -1 +;; (comm-unpack (S) result) + result))) + (defun cannarpc-get-bunsetsu-source (env bunsetsu-pos) (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w w w) (canna-const GetYomi) 0 6 context @@ -183,18 +273,19 @@ (comm-unpack (S) result) result))) -(defun cannarpc-get-bunsetsu-candidates (env bunsetsu-pos) +(defun cannarpc-get-bunsetsu-candidates (env bunsetsu-pos yomi) (let ((i 0) converted bunsetsu-list bl) (cannarpc-call-with-environment env (dummy result) (comm-format (b b w w w w) (canna-const GetCandidacyList) 0 6 context bunsetsu-pos 1024) - (comm-unpack (u w) dymmy result) + (comm-unpack (u w) dummy result) (if (= result 65535) -1 ; failure (while (< i result) (comm-unpack (S) converted) - (let ((bl1 (cons (canna-make-bunsetsu env converted bunsetsu-pos) + (let ((bl1 (cons (canna-make-bunsetsu env converted + bunsetsu-pos yomi) nil))) (if bl (setq bl (setcdr bl bl1)) @@ -202,4 +293,103 @@ (setq i (1+ i))) bunsetsu-list)))) +(defun cannarpc-set-kugiri-changed (env yomi-length bunsetsu-pos) + ;; yomi-length -2$B!DJ8@a=L$a(B -1$B!DJ8@a?-$P$7(B + (let* ((i bunsetsu-pos) + converted bunsetsu-list bl) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w w w) (canna-const ResizePause) 0 6 context + bunsetsu-pos yomi-length) + (comm-unpack (u w) dummy result) + (if (= result 65535) + -1 ; failure + (while (< i result) + (comm-unpack (S) converted) + (let ((bl1 (cons (canna-make-bunsetsu env converted i nil) nil))) + (if bl + (setq bl (setcdr bl bl1)) + (setq bunsetsu-list (setq bl bl1)))) + (setq i (1+ i))) + bunsetsu-list)))) + +(defun cannarpc-get-hinshi (env bunsetsu-pos kouho-pos) + (let (b hinshi) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w w w w) (canna-const GetHinshi) 0 8 context + bunsetsu-pos kouho-pos 1024) + (comm-unpack (u w) dummy result) + (if (= result 65535) + -1 + (while (> result 0) + (comm-unpack (w) b) + (setq hinshi (concat hinshi (char-to-string b))) + (setq result (1- result))) + hinshi)))) + +(defun cannarpc-get-lex (env bunsetsu-pos kouho-pos) + (let ((i 0) + ylen klen rownum coldnum dicnum lex-list ll) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w w w w) (canna-const GetLex) 0 8 context + bunsetsu-pos kouho-pos 1024) + (comm-unpack (u w) dummy result) + (if (= result 65535) + -1 + (while (< i result) + (comm-unpack (i i i i i) ylen klen rownum coldnum dicnum) + (let ((ll1 (cons (list ylen klen rownum coldnum dicnum) nil))) + (if ll + (setq ll (setcdr ll ll1)) + (setq lex-list (setq ll ll1)))) + (setq i (1+ i))) + lex-list)))) + +(defun cannarpc-add-word (env dictionary yomi kanji hinshi) + "Register a word KANJI into DICTIONARY with a pronunciation YOMI and +a part of speech HINSHI. Where DICTIONARY should be an integer." + (let* ((word-info (concat yomi " " hinshi " " kanji)) + (word-info-ext (encode-coding-string word-info 'fixed-euc-jp)) + (length (+ (length word-info-ext) (length dictionary) 5))) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w S s) (canna-const DefineWord) 0 length context + word-info dictionary) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 ; failure + result)))) + +(defun cannarpc-delete-word (env dictionary yomi kanji hinshi) + "Delete the registered word KANJI from DICTIONARY with a +pronunciation YOMI and a part of speech HINSHI. Where DICTIONARY +should be an integer." + (let* ((word-info (concat yomi " " hinshi " " kanji)) + (word-info-ext (encode-coding-string word-info 'fixed-euc-jp)) + (length (+ (length word-info-ext) (length dictionary) 5))) + (cannarpc-call-with-environment env (dummy result) + (comm-format (b b w w S s) (canna-const DeleteWord) 0 length context + word-info dictionary) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 ; failure + result)))) + +(defun cannarpc-notice-group-name (proc context group) + (comm-call-with-proc proc (dummy result) + (comm-format (b b w u w s) (canna-const NoticeGroupName) 0 + (+ (length group) 7) 0 ;; mode = 0 + context group) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 + result))) + +(defun cannarpc-set-app-name (proc context name) + (comm-call-with-proc proc (dummy result) + (comm-format (b b w u w s) (canna-const SetApplicationName) 0 + (+ (length name) 7) 0 context name) + (comm-unpack (u b) dummy result) + (if (= result 255) + -1 + result))) + ;;; egg/cannarpc.el ends here. diff --git a/egg/sj3.el b/egg/sj3.el index 37b5a42..61d7249 100644 --- a/egg/sj3.el +++ b/egg/sj3.el @@ -35,33 +35,89 @@ (require 'egg-edep) (defgroup sj3 nil - "SJ3 interface for Tamago 4" + "SJ3 interface for Tamago 4." :group 'egg) -(defcustom sj3-hostname "localhost" - "*Hostname of SJ3 server" +(defcustom sj3-hostname "localhost" + "Hostname of SJ3 server" :group 'sj3 :type 'string) -(defcustom sj3-server-port 3086 - "*Port number of SJ3 server" +(defcustom sj3-server-port 3086 + "Port number of SJ3 server" :group 'sj3 :type 'integer) -(defcustom sj3-server-version 2 - "Major version number of SJ3 server." - :group 'sj3 - :type '(choice (const 1) (const 2))) - -(defcustom sj3-server-coding-system-list '(shift_jis euc-japan) - "List of coding systems for SJ3 server v1 and v2." - :group 'sj3 - :type '(list (symbol :tag "v1") (symbol :tag "v2"))) - (eval-when-compile (defmacro SJ3-const (c) (cond ((eq c 'FileNotExist) 35) ))) +(egg-add-message + '((Japanese + (sj3-register-1 "$BEPO?<-=qL>(B:") + (sj3-register-2 "$BIJ;lL>(B")))) + +(defvar sj3-hinshi-menu + '(("$BL>;l(B" . + (menu "$BIJ;l(B:$BL>;l(B:" + (("$BL>;l(B" . 1) + ("$BL>;l(B($B$*!D(B)" . 2) + ("$BL>;l(B($B$4!D(B)" . 3) + ("$BL>;l(B($B!DE*(B/$B2=(B)" . 4) + ("$BL>;l(B($B$*!D$9$k(B)" . 5) + ("$BL>;l(B($B!D$9$k(B)" . 6) + ("$BL>;l(B($B$4!D$9$k(B)" . 7) + ("$BL>;l(B($B!D$J(B/$B$K(B)" . 8) + ("$BL>;l(B($B$*!D$J(B/$B$K(B)" . 9) + ("$BL>;l(B($B$4!D$J(B/$B$K(B)" . 10) + ("$BL>;l(B($BI{;l(B)" . 11)))) + ("$BBeL>;l(B" . 12) + ("$BID;z(B" . 21) + ("$BL>A0(B" . 22) + ("$BCOL>(B" . 24) + ("$B8)(B/$B6hL>(B" . 25) + ("$BF0;l(B" . + (menu "$BIJ;l(B:$BF0;l(B:" + (("$B%5JQ8l44(B" . 80) + ("$B%6JQ8l44(B" . 81) + ("$B0lCJITJQ2=It(B" . 90) + ("$B%+9T8^CJ8l44(B" . 91) + ("$B%,9T8^CJ8l44(B" . 92) + ("$B%59T8^CJ8l44(B" . 93) + ("$B%?9T8^CJ8l44(B" . 94) + ("$B%J9T8^CJ8l44(B" . 95) + ("$B%P9T8^CJ8l44(B" . 96) + ("$B%^9T8^CJ8l44(B" . 97) + ("$B%i9T8^CJ8l44(B" . 98) + ("$B%o9T8^CJ8l44(B" . 99)))) + ("$BO"BN;l(B" . 26) + ("$B@\B3;l(B" . 27) + ("$B=u?t;l(B" . 29) + ("$B?t;l(B" . 30) + ("$B@\F,8l(B" . 31) + ("$B@\Hx8l(B" . 36) + ("$BI{;l(B" . 45) + ("$BI{;l(B2" . 46) + ("$B7AMF;l8l44(B" . 60) + ("$B7AMFF0;l8l44(B" . 71) + ("$BC14A;z(B" . 189)) + "Menu data for a hinshi (a part of speech) selection.") + +(defun sj3-hinshi-name (id &optional menu alist) + "Return a hinshi (a part of speech) name corresponding to ID. +If ID is nil, return a flattened alist from `sj3-hinshi-menu'. +Don't specify the optional arguments in normal use." + (let ((menu (or menu sj3-hinshi-menu))) + (if (consp menu) + (if (consp (cdr menu)) + (mapcar (lambda (elem) + (setq alist (sj3-hinshi-name nil elem alist))) + menu) + (setq alist (nconc alist (list (cons (cdr menu) (car menu))))))) + (if id + (cdr (assq id alist)) + alist))) + (setplist 'sj3-conversion-backend '(egg-start-conversion sj3-start-conversion egg-get-bunsetsu-source sj3-get-bunsetsu-source @@ -71,7 +127,8 @@ egg-list-candidates sj3-list-candidates egg-decide-candidate sj3-decide-candidate egg-change-bunsetsu-length sj3-change-bunsetsu-length - egg-end-conversion sj3-end-conversion)) + egg-end-conversion sj3-end-conversion + egg-word-registration sj3-word-registration)) (defconst sj3-backend-alist '((Japanese ((sj3-conversion-backend))))) @@ -353,7 +410,7 @@ Return the list of bunsetsu." (list (list candidate)))) (defun sj3-change-bunsetsu-length (bunsetsu prev-b next-b len major) - (let ((yomi (apply 'concat (mapcar 'sj3bunsetsu-get-source bunsetsu))) + (let ((yomi (mapconcat 'sj3bunsetsu-get-source bunsetsu nil)) (env (sj3bunsetsu-get-env (car bunsetsu))) (old (car bunsetsu)) new yomi1 yomi2) @@ -361,7 +418,7 @@ Return the list of bunsetsu." yomi2 (substring yomi len)) (setq new (sj3rpc-tanbunsetsu-conversion env yomi1)) ;; Only set once (memory original length of the bunsetsu). - (sj3bunsetsu-set-kugiri-changed new + (sj3bunsetsu-set-kugiri-changed new (or (sj3bunsetsu-get-kugiri-changed old) (length (sj3bunsetsu-get-source old)))) (if (> (length yomi2) 0) @@ -381,6 +438,37 @@ Return the list of bunsetsu." (sj3rpc-close proc) (setq sj3-environment nil)))) +;;; word registration + +(defun sj3-dictionary-select () + (menudiag-select (list 'menu + (egg-get-message 'sj3-register-1) + (aref (nth 2 sj3-dictionary-specification) 0)))) + +(defun sj3-hinshi-select () + (menudiag-select (list 'menu + (egg-get-message 'sj3-register-2) + sj3-hinshi-menu))) + +(defun sj3-word-registration (backend kanji yomi) + "Register a word KANJI with a pronunciation YOMI." + (if (or (null (eq (egg-get-language 0 kanji) + (sj3-get-converted-language backend))) + (next-single-property-change 0 'egg-lang kanji) + (null (eq (egg-get-language 0 yomi) + (sj3-get-source-language backend))) + (next-single-property-change 0 'egg-lang yomi)) + (egg-error "word registration: invalid character") + (let* ((env (sj3-get-environment)) + (dic (sj3-dictionary-select)) + (hinshi-id (sj3-hinshi-select)) + (result (sj3rpc-add-word env + (car (aref env 1)) + yomi kanji hinshi-id))) + (if (>= result 0) + (list (sj3-hinshi-name hinshi-id) dic) + (egg-error (sj3rpc-get-error-message (- result))))))) + ;;; setup (load "egg/sj3rpc") @@ -388,7 +476,7 @@ Return the list of bunsetsu." ;;;###autoload (defun egg-activate-sj3 (&rest arg) - "Activate SJ3 backend of Tamagotchy." + "Activate SJ3 backend of Tamago 4." (apply 'egg-mode (append arg sj3-backend-alist))) ;;; egg/sj3.el ends here. diff --git a/egg/sj3rpc.el b/egg/sj3rpc.el index fc356eb..fa6b403 100644 --- a/egg/sj3rpc.el +++ b/egg/sj3rpc.el @@ -31,9 +31,18 @@ ;;; Code: +(defvar sj3-server-version 2 + "*Major version number of SJ3 server.") + +(defvar sj3-server-coding-system 'shift_jis + "*Coding system used when decoding and encoding of I/O operation with +SJ3 server. Valid coding systems are depend on the server spec.") + (eval-when-compile (require 'egg-com) -;; (load-library "egg/sj3") + (defmacro sj3-sjis-p () + '(eq 'coding-category-sjis (coding-system-category + sj3-server-coding-system))) (defmacro sj3-const (c) (cond ((eq c 'OPEN) 1) ((eq c 'CLOSE) 2) @@ -44,20 +53,20 @@ ((eq c 'STDYSIZE) 23) ((eq c 'LOCK) 31) ((eq c 'UNLOCK) 32) - ((eq c 'BEGIN) '(if (eq 1 sj3-server-version) 41 111)) - ((eq c 'TANCONV) '(if (eq 1 sj3-server-version) 51 112)) - ((eq c 'KOUHO) '(if (eq 1 sj3-server-version) 54 115)) - ((eq c 'KOUHOSU) '(if (eq 1 sj3-server-version) 55 116)) + ((eq c 'BEGIN) '(if (sj3-sjis-p) 41 111)) + ((eq c 'TANCONV) '(if (sj3-sjis-p) 51 112)) + ((eq c 'KOUHO) '(if (sj3-sjis-p) 54 115)) + ((eq c 'KOUHOSU) '(if (sj3-sjis-p) 55 116)) ((eq c 'STDY) 61) - ((eq c 'CLSTDY) '(if (eq 1 sj3-server-version) 62 117)) - ((eq c 'WREG) '(if (eq 1 sj3-server-version) 71 118)) - ((eq c 'WDEL) '(if (eq 1 sj3-server-version) 72 119)) + ((eq c 'CLSTDY) '(if (sj3-sjis-p) 62 117)) + ((eq c 'WREG) '(if (sj3-sjis-p) 71 118)) + ((eq c 'WDEL) '(if (sj3-sjis-p) 72 119)) ((eq c 'MKDIC) 81) ((eq c 'MKSTDY) 82) ((eq c 'MKDIR) 83) ((eq c 'ACCESS) 84) - ((eq c 'WSCH) '(if (eq 1 sj3-server-version) 91 120)) - ((eq c 'WNSCH) '(if (eq 1 sj3-server-version) 92 121)) + ((eq c 'WSCH) '(if (sj3-sjis-p) 91 120)) + ((eq c 'WNSCH) '(if (sj3-sjis-p) 92 121)) ((eq c 'VERSION) 103) (t (error "No such constant"))))) @@ -85,15 +94,12 @@ (goto-char (prog1 (point) (accept-process-output proc)))) receive-exprs)))) -(defmacro sj3rpc-server-coding-system () - '(nth (1- sj3-server-version) sj3-server-coding-system-list)) - -(defmacro sj3rpc-unpack-mb-string (coding-system) - `(let ((start (point))) +(defmacro sj3rpc-unpack-mb-string () + '(let ((start (point))) (while (not (search-forward "\0" nil t)) (comm-accept-process-output)) (decode-coding-string (buffer-substring start (1- (point))) - ,coding-system))) + sj3-server-coding-system))) (defun sj3rpc-open (proc myhostname username) "Open the session. Return 0 on success, error code on failure." @@ -102,7 +108,7 @@ myhostname username ;; program name (format "%d.emacs-egg" (emacs-pid))) - (comm-unpack (u) result) + (comm-unpack (i) result) (if (= result -2) 0 result))) @@ -110,7 +116,7 @@ (defun sj3rpc-close (proc) (comm-call-with-proc proc (result) (comm-format (u) (sj3-const CLOSE)) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-get-stdy-size (proc) @@ -134,10 +140,9 @@ (defun sj3rpc-begin (env yomi) "Begin conversion." - (let* ((codesys (sj3rpc-server-coding-system)) - (yomi-ext (encode-coding-string yomi codesys)) - (p 0) - len source converted stdy bunsetsu-list bl) + (let ((yomi-ext (encode-coding-string yomi sj3-server-coding-system)) + (p 0) + len source converted stdy bunsetsu-list bl) (sj3rpc-call-with-environment env (result) (comm-format (u s) (sj3-const BEGIN) yomi-ext) (comm-unpack (u) result) @@ -148,9 +153,9 @@ (comm-unpack (b) len) (> len 0)) (setq stdy (sj3rpc-get-stdy proc)) - (setq converted (sj3rpc-unpack-mb-string codesys)) + (setq converted (sj3rpc-unpack-mb-string)) (setq source (decode-coding-string (substring yomi-ext p (+ p len)) - codesys) + sj3-server-coding-system) p (+ p len)) (let ((bl1 (cons (sj3-make-bunsetsu env source converted nil stdy) nil))) @@ -171,7 +176,7 @@ (defun sj3rpc-close-dictionary (proc dict-no) (comm-call-with-proc proc (result) (comm-format (u u) (sj3-const DICDEL) dict-no) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-make-dictionary (proc dict-name) @@ -181,19 +186,19 @@ 2048 ; Length 256 ; Number ) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-open-stdy (proc stdy-name) (comm-call-with-proc proc (result) (comm-format (u s s) (sj3-const OPENSTDY) stdy-name "") - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-close-stdy (proc) (comm-call-with-proc proc (result) (comm-format (u) (sj3-const CLOSESTDY)) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-make-stdy (proc stdy-name) @@ -203,18 +208,17 @@ 1 ; Step 2048 ; Length ) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-make-directory (proc name) (comm-call-with-proc proc (result) (comm-format (u s) (sj3-const MKDIR) name) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun sj3rpc-get-bunsetsu-candidates-sub (proc env yomi yomi-ext len n) - (let ((codesys (sj3rpc-server-coding-system)) - (i 0) + (let ((i 0) stdy converted bunsetsu bl bunsetsu-list cylen rest) (comm-call-with-proc-1 proc (result) (comm-format (u u s) (sj3-const KOUHO) len yomi-ext) @@ -224,9 +228,9 @@ (while (< i n) (comm-unpack (u) cylen) (setq stdy (sj3rpc-get-stdy proc)) - (setq converted (sj3rpc-unpack-mb-string codesys)) + (setq converted (sj3rpc-unpack-mb-string)) (setq rest (decode-coding-string (substring yomi-ext cylen) - codesys)) + sj3-server-coding-system)) (setq bunsetsu (sj3-make-bunsetsu env yomi converted rest stdy)) (if bl (setq bl (setcdr bl (cons bunsetsu nil))) @@ -240,7 +244,7 @@ bunsetsu-list)))) (defun sj3rpc-get-bunsetsu-candidates (env yomi) - (let* ((yomi-ext (encode-coding-string yomi (sj3rpc-server-coding-system))) + (let* ((yomi-ext (encode-coding-string yomi sj3-server-coding-system)) (len (length yomi-ext))) (sj3rpc-call-with-environment env (result) (comm-format (u u s) (sj3-const KOUHOSU) len yomi-ext) @@ -254,9 +258,8 @@ yomi yomi-ext len result)))))) (defun sj3rpc-tanbunsetsu-conversion (env yomi) - (let* ((codesys (sj3rpc-server-coding-system)) - (yomi-ext (encode-coding-string yomi codesys)) - (len (length yomi-ext)) cylen stdy converted rest) + (let* ((yomi-ext (encode-coding-string yomi sj3-server-coding-system)) + (len (length yomi-ext)) cylen stdy converted rest) (sj3rpc-call-with-environment env (result) (comm-format (u u s) (sj3-const TANCONV) len yomi-ext) (comm-unpack (u) result) @@ -264,28 +267,35 @@ (- result) (comm-unpack (u) cylen) (setq stdy (sj3rpc-get-stdy proc)) - (setq converted (sj3rpc-unpack-mb-string codesys)) - (setq rest (decode-coding-string (substring yomi-ext cylen) codesys)) + (setq converted (sj3rpc-unpack-mb-string)) + (setq rest (decode-coding-string (substring yomi-ext cylen) + sj3-server-coding-system)) (setq bunsetsu (sj3-make-bunsetsu env yomi converted rest stdy)))))) (defun sj3rpc-bunsetsu-stdy (env stdy) (sj3rpc-call-with-environment env (result) (comm-format (u v) (sj3-const STDY) stdy (length stdy)) (comm-unpack (u) result) - (if (/= result 0) - (- result) - 0))) + (- result))) (defun sj3rpc-kugiri-stdy (env yomi1 yomi2 stdy) - (let* ((codesys (sj3rpc-server-coding-system)) - (yomi1-ext (encode-coding-string yomi1 codesys)) - (yomi2-ext (encode-coding-string yomi2 codesys))) - (sj3rpc-call-with-environment env (result) - (comm-format (u s s v) (sj3-const CLSTDY) - yomi1-ext yomi2-ext stdy (length stdy)) - (comm-unpack (u) result) - (if (/= result 0) - (- result) - 0)))) + (sj3rpc-call-with-environment env (result) + (comm-format (u s s v) (sj3-const CLSTDY) + (encode-coding-string yomi1 sj3-server-coding-system) + (encode-coding-string yomi2 sj3-server-coding-system) + stdy (length stdy)) + (comm-unpack (u) result) + (- result))) + +(defun sj3rpc-add-word (env dictionary yomi kanji hinshi) + "Register a word KANJI into DICTIONARY with a pronunciation YOMI and +a part of speech HINSHI. Where DICTIONARY should be an integer." + (sj3rpc-call-with-environment env () + (comm-format (u u s s u) (sj3-const WREG) dictionary + (encode-coding-string yomi sj3-server-coding-system) + (encode-coding-string kanji sj3-server-coding-system) + hinshi) + (comm-unpack (u) result) + (- result))) ;;; egg/sj3rpc.el ends here. diff --git a/egg/wnn.el b/egg/wnn.el index c2cb2c0..18b392c 100644 --- a/egg/wnn.el +++ b/egg/wnn.el @@ -36,7 +36,7 @@ (require 'egg-edep) (defgroup wnn nil - "Wnn interface for Tamagotchy" + "Wnn interface for Tamago 4." :group 'egg) (defcustom wnn-auto-save-dictionaries 0 @@ -114,6 +114,7 @@ by ':' and digit N." egg-major-bunsetsu-continue-p wnn-major-bunsetsu-continue-p egg-list-candidates wnn-list-candidates egg-decide-candidate wnn-decide-candidate + egg-special-candidate wnn-special-candidate egg-change-bunsetsu-length wnn-change-bunsetsu-length egg-bunsetsu-combinable-p wnn-bunsetsu-combinable-p egg-end-conversion wnn-end-conversion @@ -657,20 +658,28 @@ Return the list of bunsetsu." (defun wnn-major-bunsetsu-continue-p (bunsetsu) (wnn-bunsetsu-get-dai-continue bunsetsu)) +(defmacro wnn-uniq-hash-string (uniq-level) + `(mapconcat + (lambda (b) + (concat ,@(cond ((eq uniq-level 'wnn-uniq) + '((number-to-string (wnn-bunsetsu-get-hinshi b)))) + ((eq uniq-level 'wnn-uniq-entry) + '((number-to-string (wnn-bunsetsu-get-dic-no b)) + "+" + (number-to-string (wnn-bunsetsu-get-entry b))))) + "\0" + (wnn-bunsetsu-get-converted b) + "\0" + (wnn-bunsetsu-get-fuzokugo b))) + bunsetsu "\0")) + (defun wnn-uniq-hash (bunsetsu hash-table) - (intern (mapconcat (lambda (b) - (concat (cond - ((eq wnn-uniq-level 'wnn-uniq) - (wnn-bunsetsu-get-hinshi b)) - ((eq wnn-uniq-level 'wnn-uniq-entry) - (concat (wnn-bunsetsu-get-dic-no b) - "+" - (wnn-bunsetsu-get-entry b)))) - (concat "\0" - (wnn-bunsetsu-get-converted b) - "\0" - (wnn-bunsetsu-get-fuzokugo b)))) - bunsetsu "\0") + (intern (cond ((eq wnn-uniq-level 'wnn-uniq) + (wnn-uniq-hash-string wnn-uniq)) + ((eq wnn-uniq-level 'wnn-uniq-entry) + (wnn-uniq-hash-string wnn-uniq-entry)) + (t + (wnn-uniq-hash-string nil))) hash-table)) (defun wnn-uniq-candidates (candidates) @@ -786,6 +795,68 @@ Return the list of bunsetsu." (setq next-b (list (car next-b)))) (list cand prev-b next-b))) +(defun wnn-special-candidate (bunsetsu prev-b next-b major type) + (let* ((backend (egg-bunsetsu-get-backend (car bunsetsu))) + (lang (get backend 'language)) + pos cand) + (when (and (eq lang (get backend 'source-language)) + (eq lang (get backend 'converted-language))) + (setq pos (and (eq lang (get backend 'source-language)) + (eq lang (get backend 'converted-language)) + (cond ((eq lang 'Japanese) + (cond ((eq type 'egg-hiragana) -1) + ((eq type 'egg-katakana) -2))) + ((or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS)) + (cond ((eq type 'egg-pinyin) -1) + ((eq type 'egg-zhuyin) -1))) + ((eq lang 'Korean) + (cond ((eq type 'egg-hangul) -1)))))) + (when pos + (setq cand (cdr (wnn-list-candidates bunsetsu prev-b next-b major)) + pos (+ pos (length cand))) + (when (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))) + (let ((converted (nth pos cand))) + (cond ((egg-pinyin-syllable converted) + (cond ((eq type 'egg-pinyin)) ; OK + ((eq type 'egg-zhuyin) + (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type)) + (t (setq pos nil)))) + ((egg-zhuyin-syllable converted) + (cond ((eq type 'egg-pinyin) + (wnn-pinyin-zhuyin-bunsetsu bunsetsu pos lang type)) + ((eq type 'egg-zhuyin)) ; OK + (t (setq pos nil)))) + (t (setq pos nil)))))) + (when pos + (wnn-decide-candidate bunsetsu pos prev-b next-b))))) + +(defun wnn-pinyin-zhuyin-bunsetsu (bunsetsu pos lang type) + (let ((b (nth pos (wnn-bunsetsu-get-zenkouho-list (car bunsetsu)))) + (encoding (if (eq lang 'Chinese-GB) + (if (eq type 'egg-pinyin) + 'fixed-euc-py-cn 'fixed-euc-zy-cn) + (if (eq type 'egg-pinyin) + 'fixed-euc-py-tw 'fixed-euc-zy-tw))) + (converted (wnn-bunsetsu-get-zenkouho-converted (car bunsetsu))) + str) + (setcar (nthcdr pos converted) + (wnn-pinyin-zhuyin-string (nth pos converted) encoding)) + (while b + (setq str (wnn-bunsetsu-get-converted (car b))) + (when str + (wnn-bunsetsu-set-converted + (car b) + (wnn-pinyin-zhuyin-string str encoding))) + (setq str (wnn-bunsetsu-get-fuzokugo (car b))) + (when str + (wnn-bunsetsu-set-fuzokugo + (car b) + (wnn-pinyin-zhuyin-string str encoding))) + (setq b (cdr b))))) + +(defun wnn-pinyin-zhuyin-string (str encoding) + (decode-coding-string (encode-coding-string str encoding) encoding)) + (defun wnn-change-bunsetsu-length (bunsetsu prev-b next-b len major) (let ((backend (egg-bunsetsu-get-backend (car bunsetsu))) (env (wnn-bunsetsu-get-env (car bunsetsu))) @@ -2090,7 +2161,7 @@ environment." ;;;###autoload (defun egg-activate-wnn (&rest arg) - "Activate Wnn backend of Tamagotchy." + "Activate Wnn backend of Tamago 4." (apply 'egg-mode (append arg wnn-backend-alist))) ;;; egg/wnn.el ends here. diff --git a/egg/wnnrpc.el b/egg/wnnrpc.el index f09fcdc..8fcc98d 100644 --- a/egg/wnnrpc.el +++ b/egg/wnnrpc.el @@ -693,10 +693,10 @@ (defmacro wnnrpc-get-result (&rest body) `(let (result) - (comm-unpack (u) result) + (comm-unpack (i) result) (if (< result 0) (progn - (comm-unpack (u) result) + (comm-unpack (i) result) (- result)) ,@(or body '(result))))) @@ -783,7 +783,7 @@ error code on faiulure." (comm-format (u u u) (wnn-const JS_GET_AUTOLEARNING_DIC) env-id type) (wnnrpc-get-result - (comm-unpack (u) result) + (comm-unpack (i) result) (1+ result)))) (defun wnnrpc-set-autolearning-dic (env type dic-id) @@ -798,7 +798,7 @@ Return 0 on success, negate-encoded error code on faiulure." "Return the version number of WNN server." (comm-call-with-proc proc (result) (comm-format (u) (wnn-const JS_VERSION)) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-access (env path mode) @@ -807,7 +807,7 @@ Return 0 when the remote file (dictionary/frequency) of PATH on server can be accessed in mode MODE. Return Non-zero otherwise." (wnnrpc-call-with-environment env (result) (comm-format (u u u s) (wnn-const JS_ACCESS) env-id mode path) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-mkdir (env path) @@ -904,7 +904,7 @@ Return positive if loaded, zero if not, negative on failure." hinshi status status-backward kangovect evaluation result source fuzokugo) (while (> n-bunsetsu 0) - (comm-unpack (u u u u u u u u u u u u) + (comm-unpack (i i i i i i i i i i i i) end start jiritsugo-end dic-no entry freq right-now hinshi status status-backward kangovect evaluation) @@ -929,9 +929,9 @@ Return positive if loaded, zero if not, negative on failure." n-bunstsu kanji-length dlist slist end start n-sho evaluation n retval) - (comm-unpack (u u) n-bunstsu kanji-length) + (comm-unpack (i i) n-bunstsu kanji-length) (while (> n-dai 0) - (comm-unpack (u u u u) end start n-sho evaluation) + (comm-unpack (i i i i) end start n-sho evaluation) (setq dlist (cons (cons n-sho evaluation) dlist) n-dai (1- n-dai))) (setq dlist (nreverse dlist) @@ -1010,7 +1010,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." fi-dic dic entry offset num result) (comm-unpack (i) num) (while (> num 0) - (comm-unpack (u u u u) fi-dic dic entry offset) + (comm-unpack (i i i i) fi-dic dic entry offset) (setq result (cons (vector fi-dic dic entry offset -2 -4) result) num (1- num))) (nreverse result))) @@ -1110,7 +1110,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "" (comm-call-with-proc proc (result) (comm-format (u s) (wnn-const JS_ENV_EXIST) envname) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-make-env-sticky (env) @@ -1156,14 +1156,14 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "" (wnnrpc-call-with-environment env (n-dic) (comm-format (u u) (wnn-const JS_DIC_LIST) env-id) - (comm-unpack (u) n-dic) + (comm-unpack (i) n-dic) (wnnrpc-receive-dictionary-list proc n-dic))) (defun wnnrpc-get-fi-dictionary-list-with-environment (env mask) "" (wnnrpc-call-with-environment env (n-dic) (comm-format (u u u) (wnn-const JS_FI_DIC_LIST) env-id mask) - (comm-unpack (u) n-dic) + (comm-unpack (i) n-dic) (wnnrpc-receive-dictionary-list proc n-dic))) (defun wnnrpc-receive-dictionary-list (proc n-dic) @@ -1171,7 +1171,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." rev comment dicname freqname dic-passwd freq-passwd type gosuu dic-local-flag freq-local-flag retval) (while (> n-dic 0) - (comm-unpack (u u u u u u u u S s s s s u u u u) + (comm-unpack (i i i i i i i i S s s s s i i i i) entry dic freq dic-mode freq-mode enable-flag nice rev comment dicname freqname dic-passwd freq-passwd type gosuu dic-local-flag freq-local-flag) @@ -1193,7 +1193,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (comm-format (u u i) (wnn-const JS_HINSI_DICTS) env-id -1) (wnnrpc-get-result (while (> result 0) - (comm-unpack (u) dic) + (comm-unpack (i) dic) (setq dic-list (nconc dic-list (list dic)) result (1- result))) dic-list))) @@ -1222,7 +1222,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." p10 p11 p12 p13 p14 p15) (comm-format (u u) (wnn-const JS_PARAM_GET) env-id) (wnnrpc-get-result - (comm-unpack (u u u u u u u u u u u u u u u u u) + (comm-unpack (i i i i i i i i i i i i i i i i i) n nsho p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15) (vector n nsho p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15)))) @@ -1243,7 +1243,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "" (comm-call-with-proc proc (result) (comm-format (u s) (wnn-const JS_FILE_LOADED) path) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-write-file (env fid filename) @@ -1261,9 +1261,9 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (let ((i 0) flist nfiles fid local ref-count type name) - (comm-unpack (u) nfiles) + (comm-unpack (i) nfiles) (while (> nfiles 0) - (comm-unpack (u u u u s) fid local ref-count type name) + (comm-unpack (i i i i s) fid local ref-count type name) (setq flist (nconc flist (list (vector fid local ref-count type name))) nfiles (1- nfiles))) flist)) @@ -1284,7 +1284,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "3: dictionary, 4: hindo file, 5: fuzokugo-file" (wnnrpc-call-with-environment env (result) (comm-format (u u s) (wnn-const JS_FILE_STAT) env-id path) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-get-file-info (env fid) @@ -1292,7 +1292,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (wnnrpc-call-with-environment env (name local ref-count type) (comm-format (u u u) (wnn-const JS_FILE_INFO) env-id fid) (wnnrpc-get-result - (comm-unpack (s u u u) name local ref-count type) + (comm-unpack (s i i i) name local ref-count type) (vector name local ref-count type)))) (defmacro wnnrpc-receive-vector (n) @@ -1300,7 +1300,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (i 0) j) (while (< i ,n) - (comm-unpack (u) j) + (comm-unpack (i) j) (aset v i j) (setq i (1+ i))) v)) @@ -1311,7 +1311,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (comm-format (u) (wnn-const JS_WHO)) (wnnrpc-get-result (while (> result 0) - (comm-unpack (u s s) socket username hostname) + (comm-unpack (i s s) socket username hostname) (setq who (nconc who (list (vector socket username hostname (wnnrpc-receive-vector @@ -1324,7 +1324,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (comm-format (u) (wnn-const JS_ENV_LIST)) (wnnrpc-get-result (while (> result 0) - (comm-unpack (u s u u u) id name count fuzokugo dic-max) + (comm-unpack (i s i i i) id name count fuzokugo dic-max) (setq envs (nconc envs (list (vector id name count fuzokugo dic-max (wnnrpc-receive-vector @@ -1338,7 +1338,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "" (comm-call-with-proc proc (result) (comm-format (u) (wnn-const JS_KILL)) - (comm-unpack (u) result) + (comm-unpack (i) result) result)) (defun wnnrpc-delete-dictionary (env dic) @@ -1357,7 +1357,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." "" (wnnrpc-call-with-proc proc (n-dic) (comm-format (u) (wnn-const JS_DIC_LIST_ALL)) - (comm-unpack (u) n-dic) + (comm-unpack (i) n-dic) (wnnrpc-receive-dictionary-list proc n-dic))) (defun wnnrpc-delete-word (env dic entry) @@ -1369,15 +1369,15 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (defun wnnrpc-receive-word (proc yomi) (let (dic serial hinshi hindo right-now internal-hindo internal-right-now kanji comment l l1) - (comm-unpack (u) dic) + (comm-unpack (i) dic) (while (>= dic 0) - (comm-unpack (u u u u u u) serial hinshi hindo right-now + (comm-unpack (i i i i i i) serial hinshi hindo right-now internal-hindo internal-right-now) (setq l (cons (vector dic serial hinshi hindo right-now internal-hindo internal-right-now yomi nil nil) l)) - (comm-unpack (u) dic)) + (comm-unpack (i) dic)) (setq l (nreverse l) l1 l) (while l1 @@ -1492,7 +1492,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (wnn-const WNN_FILE_STRING))) (progn (goto-char (1+ (wnn-const WNN_FILE_STRING_LEN))) - (comm-unpack (u v v v) + (comm-unpack (i v v v) type uniq1 (wnn-const WNN_UNIQ_LEN) uniq2 (wnn-const WNN_UNIQ_LEN) @@ -1534,10 +1534,18 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (defun wnnrpc-make-uniq (attributes) (wnnrpc-with-temp-buffer - (comm-format (U i u V) - (nth 6 attributes) (nth 11 attributes) (nth 10 attributes) - wnn-system-name (wnn-const WNN_HOST_LEN)) - (buffer-string))) + (let ((ctime (nth 6 attributes)) + (ino (nth 10 attributes)) + (devno (nth 11 attributes))) + (if (numberp devno) + (comm-format (U i u V) + ctime devno ino + wnn-system-name (wnn-const WNN_HOST_LEN)) + ;; Emacs 21 returns returns negative devno as 16 bits uint pair + (comm-format (U U u V) + ctime (list (car devno) (cdr devno)) ino + wnn-system-name (wnn-const WNN_HOST_LEN))) + (buffer-string)))) (defun wnnrpc-change-file-uniq (header path &optional new) (wnnrpc-with-write-file path @@ -1558,27 +1566,28 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (defun wnnrpc-check-passwd (proc passwd header) (let ((env-id -1)) (unwind-protect - (if (>= (setq env-id (wnnrpc-connect proc "")) 0) - (wnnrpc-call-with-environment (wnnenv-create proc env-id) - (file-id) - (comm-format (u u v) (wnn-const JS_FILE_SEND) - env-id - (nth 1 header) (wnn-const WNN_UNIQ_LEN)) - (comm-unpack (u) file-id) - (if (>= file-id 0) - (progn - (wnnrpc-get-result) ; ignore result code - (- (wnn-const WNN_FILE_IN_USE))) - (wnnrpc-get-result - (comm-call-with-proc-1 proc () - (comm-format (s B) - (concat wnn-system-name "!TEMPFILE") - (wnnrpc-make-dummy-dictionary header)) - (wnnrpc-get-result - (let ((egg-fixed-euc (list egg-fixed-euc egg-fixed-euc))) - (wnnrpc-set-dictionary (wnnenv-create proc env-id) - result -1 1 t t - passwd "" nil)))))))) + (if (< (setq env-id (wnnrpc-connect proc "")) 0) + -1 + (wnnrpc-call-with-environment (wnnenv-create proc env-id) + (file-id) + (comm-format (u u v) (wnn-const JS_FILE_SEND) + env-id + (nth 1 header) (wnn-const WNN_UNIQ_LEN)) + (comm-unpack (i) file-id) + (if (>= file-id 0) + (progn + (wnnrpc-get-result) ; ignore result code + (- (wnn-const WNN_FILE_IN_USE))) + (wnnrpc-get-result + (comm-call-with-proc-1 proc () + (comm-format (s B) + (concat wnn-system-name "!TEMPFILE") + (wnnrpc-make-dummy-dictionary header)) + (wnnrpc-get-result + (let ((egg-fixed-euc (list egg-fixed-euc egg-fixed-euc))) + (wnnrpc-set-dictionary (wnnenv-create proc env-id) + result -1 1 t t + passwd "" nil)))))))) (if (>= env-id 0) (wnnrpc-disconnect (wnnenv-create proc env-id)))))) @@ -1603,7 +1612,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (comm-call-with-proc proc (result) (comm-format (u v) (wnn-const JS_FILE_LOADED_LOCAL) (nth 1 header) (wnn-const WNN_UNIQ_LEN)) - (comm-unpack (u) result) + (comm-unpack (i) result) result)))) (defun wnnrpc-file-receive (env fid local-filename) @@ -1654,7 +1663,7 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (comm-format (u u v) (wnn-const JS_FILE_SEND) env-id (nth 1 header) (wnn-const WNN_UNIQ_LEN)) - (comm-unpack (u) file-id) + (comm-unpack (i) file-id) (if (>= file-id 0) (wnnrpc-get-result (wnnenv-set-client-file env filename) @@ -1718,9 +1727,9 @@ HINSHI and FUZOKUGO are information of preceding bunsetsu." (defun wnnrpc-make-temp-name (env) (let ((n 0) (temp-form "usr/temp")) - (while (= (wnnrpc-access env (concat temp-form n) 0) 0) + (while (= (wnnrpc-access env (concat temp-form (number-to-string n)) 0) 0) (setq n (1+ n))) - (concat temp-form n))) + (concat temp-form (number-to-string n)))) (defun wnnrpc-create-and-move-to-client (env dic-id filename type comment passwd hpasswd) diff --git a/eggrc b/eggrc index 965083d..bcde322 100644 --- a/eggrc +++ b/eggrc @@ -1,4 +1,4 @@ -;;; eggrc --- EGG Input Method Startup File +;;; eggrc --- EGG Input Method Startup File -*- emacs-lisp -*- ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc @@ -186,11 +186,15 @@ (wnn-add-dict '("ud") nil 2 t t) (wnn-set-param 2 5 2 45 200 80 5 1 40 0 400 -100 400 80 200 2 200)))) - ((eq egg-backend-type 'sj3) -; (sj3-set-default-sys-dic-directory "/usr/sony/dict/sj3") -; (sj3-set-default-usr-dic-directory "/usr/sony/dict/sj3/user/$USER") + ((eq egg-backend-type 'canna) - (sj3-setsysdic "sj3main.dic") + (canna-define-environment) + (canna-add-dict "iroha" nil) + (canna-add-dict "fuzokugo" nil) + (canna-add-dict "hojomwd" nil) + (canna-add-dict "hojoswd" nil) + (canna-add-dict "user" t) - (sj3-setusrdic "private.dic") - (sj3-setusrstdy "study.dat"))) + (canna-define-environment "Bushu" 0 t) + (canna-add-dict "bushu" nil)) + ) diff --git a/its-keydef.el b/its-keydef.el index 6a087f2..e436faf 100644 --- a/its-keydef.el +++ b/its-keydef.el @@ -70,7 +70,7 @@ ((its-in-fence-p) (its-input-end) (its-put-cursor t)) - ((egg-get-bunsetsu-info (point)) + ((egg-conversion-fence-p) (egg-exit-conversion))) (setq its-current-select-func func its-current-map ',map diff --git a/its.el b/its.el index 759f0d5..d651451 100644 --- a/its.el +++ b/its.el @@ -35,7 +35,7 @@ (require 'egg-edep) (defgroup its nil - "Input Translation System of Tamagotchy" + "Input Translation System of Tamago 4." :group 'egg) (defcustom its-enable-fullwidth-alphabet t @@ -194,8 +194,15 @@ (defsubst its-kst-p (kst/t) (not (or (numberp kst/t) (null kst/t)))) -(defsubst its-get-output (syl/state) - (car syl/state)) +(defun its-get-output (syl/state &optional no-eval) + (setq syl/state (car syl/state)) + (cond ((null (consp syl/state)) + syl/state) + ((and (null no-eval) (eq (car syl/state) 'eval)) + (eval (mapcar (lambda (s) (if (stringp s) (copy-sequence s) s)) + (cdr syl/state)))) + (t + (copy-sequence syl/state)))) (defsubst its-set-output (state output) (setcar state output)) @@ -274,13 +281,26 @@ (define-key map "\M-n" 'its-next-map) (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer (define-key map "\M-k" 'its-katakana) - (define-key map "\M-<" 'its-hankaku) - (define-key map "\M->" 'its-zenkaku) + (define-key map "\M-<" 'its-half-width) + (define-key map "\M->" 'its-full-width) map) "Keymap for ITS mode.") - (fset 'its-mode-map its-mode-map) +(defvar its-fence-mode nil) +(make-variable-buffer-local 'its-fence-mode) +(put 'its-fence-mode 'permanent-local t) + +(defvar egg-sub-mode-map-alist nil) +(or (assq 'its-fence-mode egg-sub-mode-map-alist) + (setq egg-sub-mode-map-alist (cons '(its-fence-mode . its-mode-map) + egg-sub-mode-map-alist))) + +(defun its-enter/leave-fence (&optional old new) + (setq its-fence-mode (its-in-fence-p))) + +(add-hook 'egg-enter/leave-fence-hook 'its-enter/leave-fence) + (defconst its-setup-fence-before-insert-SYL nil) (defun its-get-fence-face (lang) @@ -290,17 +310,19 @@ (assq t its-fence-face))))) (defun its-put-cursor (cursor) - (if (null (eq its-barf-on-invalid-keyseq 'its-keyseq-test)) - (let ((p (point)) - (str (copy-sequence "!"))) - (set-text-properties 0 1 (list 'local-map 'its-mode-map - 'read-only t - 'invisible t - 'intangible 'its-part-2 - 'its-cursor cursor) - str) - (insert str) - (goto-char p)))) + (unless (eq its-barf-on-invalid-keyseq 'its-keyseq-test) + (let ((p (point)) + (str (copy-sequence "!"))) + (set-text-properties 0 1 (list 'read-only t + 'invisible t + 'intangible 'its-part-2 + 'its-cursor cursor + 'point-entered 'egg-enter/leave-fence + 'point-left 'egg-enter/leave-fence + 'modification-hooks '(egg-modify-fence)) + str) + (insert str) + (goto-char p)))) (defun its-set-cursor-status (cursor) (delete-region (point) (1+ (point))) @@ -643,14 +665,14 @@ (add-hook hook func t) (funcall func) (run-hooks hook) - (setq hook nil)))) + (set hook nil)))) ;; Data structure for map compaction ;; ::= ( ) ; atom ;; | ( ( . )) ; cons cell ;; ;; ::= integer ; 0 or negative - usage count -;; ; psotive - generated common sub-tree +;; ; positive - generated common sub-tree ;; ;; ::= integer ; subject to compaction ;; | nil ; not subject to compaction @@ -683,9 +705,16 @@ `(1- (setq its-compaction-list (cons ,node its-compaction-list) its-compaction-counter-2 (1+ its-compaction-counter-2)))) +(defmacro its-concat (&rest args) + `(concat ,@(mapcar (lambda (arg) + (if (stringp arg) + arg + `(if (numberp ,arg) (number-to-string ,arg) ,arg))) + args))) + (defmacro its-compaction-hash (name node parent lr type) (if (null type) - `(let ((hash (intern (concat ,@name) its-compaction-hash-table))) + `(let ((hash (intern (its-concat ,@name) its-compaction-hash-table))) (if (null (boundp hash)) (car (set hash (list* (its-compaction-new-node) ,parent ,lr))) (setq hash (symbol-value hash)) @@ -696,7 +725,7 @@ (its-compaction-set-lr ,parent ,lr (cdr hash)) (car hash))) `(let ((hash ,(if (eq type 'integer) - `(intern (concat ,@name) its-compaction-hash-table) + `(intern (its-concat ,@name) its-compaction-hash-table) `(aref its-compaction-integer-table (+ ,node 10))))) (if (null ,(if (eq type 'integer) '(boundp hash) 'hash)) (setq hash (,@(if (eq type 'integer) @@ -708,18 +737,24 @@ (its-compaction-set-lr ,parent ,lr (cdr hash)) (car hash)))) -(defun its-map-compaction-internal (map parent lr) +(defun its-map-compaction-internal (map parent lr &optional force) (cond - ((consp map) (let ((candidate (or (null (stringp (car map))) (cdr map))) - (l (its-map-compaction-internal (car map) map 'car)) - (r (its-map-compaction-internal (cdr map) map 'cdr))) - (if (and candidate l r) - (its-compaction-hash (l " " r) map parent lr nil)))) - ((stringp map) (its-compaction-hash ("STR" map) map parent lr nil)) - ((integerp map) (if (and (>= map -10) (< map 128)) - (its-compaction-hash nil map parent lr small-int) - (its-compaction-hash ("INT" map) map parent lr integer))) - ((null map) 0))) + ((consp map) + (let* ((candidate (or (null (stringp (car map))) (cdr map))) + (sexp (or force (eq (car map) 'eval))) + (l (its-map-compaction-internal (car map) map 'car sexp)) + (r (its-map-compaction-internal (cdr map) map 'cdr sexp))) + (if (or sexp (and candidate l r)) + (its-compaction-hash (l " " r) map parent lr nil)))) + ((stringp map) + (its-compaction-hash ("STR" map) map parent lr nil)) + ((integerp map) + (if (and (>= map -10) (< map 128)) + (its-compaction-hash nil map parent lr small-int) + (its-compaction-hash ("INT" map) map parent lr integer))) + ((null map) 0) + ((symbolp map) + (its-compaction-hash ("SYM" (symbol-name map)) map parent lr nil)))) (defvar its-map-rebuild-subtrees) @@ -802,7 +837,7 @@ Return last state." state)) (defun its-set-interim-terminal-state (state &optional output) - (its-make-next-state state -1 (or output (its-get-output state))) + (its-make-next-state state -1 (or output (its-get-output state t))) (its-defrule-otherwise state output)) (defun its-defoutput (input display) @@ -1124,10 +1159,14 @@ Return last state." (setq i 0) (while (< i len) (setq lang (get-text-property i 'egg-lang source)) - (if (and - (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS)) - (setq l (egg-chinese-syllable source i))) - (setq j (+ i l)) + (if (or (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS)) + (setq l (egg-chinese-syllable source i))) + (and (setq l (get-text-property i 'composition source)) + (setq l (if (consp (car l)) (caar l) (cadr l))) + (eq (next-single-property-change i 'composition + source (length source)) + l))) + (setq j (+ i l)) (setq j (+ i (egg-char-bytes (egg-string-to-char-at source i))))) (setq syl (substring no-prop-source i j)) (put-text-property i j 'its-syl (cons syl syl) source) @@ -1181,7 +1220,7 @@ Return last state." ;; TODO: handle overwrite-mode, insertion-hook, fill... (defun its-exit-mode-internal (&optional proceed-to-conversion n) - (let (start end s context) + (let (start end s context str) (its-select-previous-mode t) ;; Delete CURSOR (delete-region (point) (1+ (point))) @@ -1198,9 +1237,10 @@ Return last state." (egg-convert-region start end context n) ;; Remove all properties (goto-char start) - (insert (prog1 - (buffer-substring-no-properties start end) - (delete-region start end))) + (setq str (buffer-substring start end)) + (egg-remove-all-text-properties 0 (length str) str) + (delete-region start end) + (insert str) (egg-do-auto-fill) (run-hooks 'input-method-after-insert-chunk-hook)))) @@ -1220,7 +1260,8 @@ Return last state." (its-kick-convert-region n)))) (defun its-in-fence-p () - (eq (get-text-property (point) 'intangible) 'its-part-2)) + (and (eq (get-text-property (point) 'intangible) 'its-part-2) + (get-text-property (point) 'read-only))) (defvar its-translation-result "" "") @@ -1241,7 +1282,7 @@ Return last state." (defun its-translate-region (start end) (interactive "r") (its-translate-region-internal start end) - (set-text-properties start (point) nil)) + (egg-remove-all-text-properties start (point))) (defun its-translate-region-internal (start end) (setq its-translation-result "") @@ -1300,66 +1341,198 @@ Return last state." ;;; its-hiragana : hiragana-region for input-buffer (defun its-hiragana () (interactive) - (let ((inhibit-read-only t)) - (its-input-end) - (its-set-part-1 (point) (its-search-end)) - (its-convert 'japanese-hiragana (its-search-beginning) (point)) - (its-put-cursor t))) + (its-convert (lambda (str lang) (japanese-hiragana str)))) ;;; its-katakana : katanaka-region for input-buffer (defun its-katakana () (interactive) - (let ((inhibit-read-only t)) - (its-input-end) - (its-set-part-1 (point) (its-search-end)) - (its-convert 'japanese-katakana (its-search-beginning) (point)) - (its-put-cursor t))) - -;;; its-hankaku : hankaku-region for input-buffer -(defun its-hankaku () + (its-convert (lambda (str lang) (japanese-katakana str)))) + +(defconst its-full-half-table (make-vector 100 nil)) +(defconst its-half-full-table (make-vector 100 nil)) + +(let ((table '((Japanese + (?$B!!(B . ?\ ) (?$B!$(B . ?,) (?$B!%(B . ?.) (?$B!"(B . ?,) (?$B!#(B . ?.) + (?$B!'(B . ?:) (?$B!((B . ?\;) (?$B!)(B . ??) (?$B!*(B . ?!) + (?$B!-(B . ?') (?$B!.(B . ?`) (?$B!0(B . ?^) (?$B!2(B . ?_) (?$B!1(B . ?~) + (?$B!<(B . ?-) (?$B!=(B . ?-) (?$B!>(B . ?-) + (?$B!?(B . ?/) (?$B!@(B . ?\\) (?$B!A(B . ?~) (?$B!C(B . ?|) + (?$B!F(B . ?`) (?$B!G(B . ?') (?$B!H(B . ?\") (?$B!I(B . ?\") + (?$B!J(B . ?\() (?$B!K(B . ?\)) (?$B!N(B . ?[) (?$B!O(B . ?]) + (?$B!P(B . ?{) (?$B!Q(B . ?}) (?$B!R(B . ?<) (?$B!S(B . ?>) + (?$B!\(B . ?+) (?$B!](B . ?-) (?$B!a(B . ?=) (?$B!c(B . ?<) (?$B!d(B . ?>) + (?$B!l(B . ?') (?$B!m(B . ?\") (?$B!o(B . ?\\) (?$B!p(B . ?$) (?$B!s(B . ?%) + (?$B!t(B . ?#) (?$B!u(B . ?&) (?$B!v(B . ?*) (?$B!w(B . ?@) + (?$B#0(B . ?0) (?$B#1(B . ?1) (?$B#2(B . ?2) (?$B#3(B . ?3) (?$B#4(B . ?4) + (?$B#5(B . ?5) (?$B#6(B . ?6) (?$B#7(B . ?7) (?$B#8(B . ?8) (?$B#9(B . ?9) + (?$B#A(B . ?A) (?$B#B(B . ?B) (?$B#C(B . ?C) (?$B#D(B . ?D) (?$B#E(B . ?E) + (?$B#F(B . ?F) (?$B#G(B . ?G) (?$B#H(B . ?H) (?$B#I(B . ?I) (?$B#J(B . ?J) + (?$B#K(B . ?K) (?$B#L(B . ?L) (?$B#M(B . ?M) (?$B#N(B . ?N) (?$B#O(B . ?O) + (?$B#P(B . ?P) (?$B#Q(B . ?Q) (?$B#R(B . ?R) (?$B#S(B . ?S) (?$B#T(B . ?T) + (?$B#U(B . ?U) (?$B#V(B . ?V) (?$B#W(B . ?W) (?$B#X(B . ?X) (?$B#Y(B . ?Y) + (?$B#Z(B . ?Z) + (?$B#a(B . ?a) (?$B#b(B . ?b) (?$B#c(B . ?c) (?$B#d(B . ?d) (?$B#e(B . ?e) + (?$B#f(B . ?f) (?$B#g(B . ?g) (?$B#h(B . ?h) (?$B#i(B . ?i) (?$B#j(B . ?j) + (?$B#k(B . ?k) (?$B#l(B . ?l) (?$B#m(B . ?m) (?$B#n(B . ?n) (?$B#o(B . ?o) + (?$B#p(B . ?p) (?$B#q(B . ?q) (?$B#r(B . ?r) (?$B#s(B . ?s) (?$B#t(B . ?t) + (?$B#u(B . ?u) (?$B#v(B . ?v) (?$B#w(B . ?w) (?$B#x(B . ?x) (?$B#y(B . ?y) + (?$B#z(B . ?z)) + (Chinese-GB + (?$A!!(B . ?\ ) (?$A#,(B . ?,) (?$A#.(B . ?.) (?$A!"(B . ?,) (?$A!#(B . ?.) + (?$A#:(B . ?:) (?$A#;(B . ?\;) (?$A#?(B . ??) (?$A#!(B . ?!) + (?$A#`(B . ?`) (?$A#^(B . ?^) (?$A#_(B . ?_) (?$A#~(B . ?~) + (?$A!*(B . ?-) + (?$A#/(B . ?/) (?$A#\(B . ?\\) (?$A!+(B . ?~) (?$A#|(B . ?|) + (?$A!.(B . ?`) (?$A!/(B . ?') (?$A!0(B . ?\") (?$A!1(B . ?\") + (?$A#((B . ?\() (?$A#)(B . ?\)) (?$A#[(B . ?[) ( ?$A#](B . ?]) + (?$A#{(B . ?{) (?$A#}(B . ?}) + (?$A#+(B . ?+) (?$A#-(B . ?-) (?$A#=(B . ?=) (?$A#<(B . ?<) (?$A#>(B . ?>) + (?$A#'(B . ?') (?$A#"(B . ?\") (?$A#$(B . ?$) (?$A#%(B . ?%) + (?$A##(B . ?#) (?$A#&(B . ?&) (?$A#*(B . ?*) (?$A#@(B . ?@) + (?$A#0(B . ?0) (?$A#1(B . ?1) (?$A#2(B . ?2) (?$A#3(B . ?3) (?$A#4(B . ?4) + (?$A#5(B . ?5) (?$A#6(B . ?6) (?$A#7(B . ?7) (?$A#8(B . ?8) (?$A#9(B . ?9) + (?$A#A(B . ?A) (?$A#B(B . ?B) (?$A#C(B . ?C) (?$A#D(B . ?D) (?$A#E(B . ?E) + (?$A#F(B . ?F) (?$A#G(B . ?G) (?$A#H(B . ?H) (?$A#I(B . ?I) (?$A#J(B . ?J) + (?$A#K(B . ?K) (?$A#L(B . ?L) (?$A#M(B . ?M) (?$A#N(B . ?N) (?$A#O(B . ?O) + (?$A#P(B . ?P) (?$A#Q(B . ?Q) (?$A#R(B . ?R) (?$A#S(B . ?S) (?$A#T(B . ?T) + (?$A#U(B . ?U) (?$A#V(B . ?V) (?$A#W(B . ?W) (?$A#X(B . ?X) (?$A#Y(B . ?Y) + (?$A#Z(B . ?Z) + (?$A#a(B . ?a) (?$A#b(B . ?b) (?$A#c(B . ?c) (?$A#d(B . ?d) (?$A#e(B . ?e) + (?$A#f(B . ?f) (?$A#g(B . ?g) (?$A#h(B . ?h) (?$A#i(B . ?i) (?$A#j(B . ?j) + (?$A#k(B . ?k) (?$A#l(B . ?l) (?$A#m(B . ?m) (?$A#n(B . ?n) (?$A#o(B . ?o) + (?$A#p(B . ?p) (?$A#q(B . ?q) (?$A#r(B . ?r) (?$A#s(B . ?s) (?$A#t(B . ?t) + (?$A#u(B . ?u) (?$A#v(B . ?v) (?$A#w(B . ?w) (?$A#x(B . ?x) (?$A#y(B . ?y) + (?$A#z(B . ?z)) + (Chinese-CNS + (?$(G!!(B . ?\ ) (?$(G!"(B . ?,) (?$(G!%(B . ?.) (?$(G!#(B . ?,) (?$(G!$(B . ?.) + (?$(G!((B . ?:) (?$(G!'(B . ?\;) (?$(G!)(B . ??) (?$(G!*(B . ?!) + (?$(G!k(B . ?') (?$(G!j(B . ?`) (?$(G!T(B . ?^) (?$(G"%(B . ?_) (?$(G"#(B . ?~) + (?$(G"@(B . ?-) + (?$(G"_(B . ?/) (?$(G"`(B . ?\\) (?$(G"a(B . ?/) (?$(G"b(B . ?\\) + (?$(G"D(B . ?~) (?$(G"^(B . ?|) + (?$(G!d(B . ?`) (?$(G!e(B . ?') + (?$(G!h(B . ?\") (?$(G!i(B . ?\") (?$(G!f(B . ?\") (?$(G!g(B . ?\") + (?$(G!>(B . ?\() (?$(G!?(B . ?\)) + (?$(G!F(B . ?[) (?$(G!G(B . ?]) (?$(G!b(B . ?[) (?$(G!c(B . ?]) + (?$(G!B(B . ?{) (?$(G!C(B . ?}) (?$(G!`(B . ?{) (?$(G!a(B . ?}) + (?$(G!R(B . ?<) (?$(G!S(B . ?>) + (?$(G"0(B . ?+) (?$(G"1(B . ?-) (?$(G"8(B . ?=) (?$(G"6(B . ?<) (?$(G"7(B . ?>) + (?$(G"c(B . ?$) (?$(G"h(B . ?%) + (?$(G!l(B . ?#) (?$(G!m(B . ?&) (?$(G!n(B . ?*) (?$(G"i(B . ?@) + (?$(G$!(B . ?0) (?$(G$"(B . ?1) (?$(G$#(B . ?2) (?$(G$$(B . ?3) (?$(G$%(B . ?4) + (?$(G$&(B . ?5) (?$(G$'(B . ?6) (?$(G$((B . ?7) (?$(G$)(B . ?8) (?$(G$*(B . ?9) + (?$(G$A(B . ?A) (?$(G$B(B . ?B) (?$(G$C(B . ?C) (?$(G$D(B . ?D) (?$(G$E(B . ?E) + (?$(G$F(B . ?F) (?$(G$G(B . ?G) (?$(G$H(B . ?H) (?$(G$I(B . ?I) (?$(G$J(B . ?J) + (?$(G$K(B . ?K) (?$(G$L(B . ?L) (?$(G$M(B . ?M) (?$(G$N(B . ?N) (?$(G$O(B . ?O) + (?$(G$P(B . ?P) (?$(G$Q(B . ?Q) (?$(G$R(B . ?R) (?$(G$S(B . ?S) (?$(G$T(B . ?T) + (?$(G$U(B . ?U) (?$(G$V(B . ?V) (?$(G$W(B . ?W) (?$(G$X(B . ?X) (?$(G$Y(B . ?Y) + (?$(G$Z(B . ?Z) + (?$(G$[(B . ?a) (?$(G$\(B . ?b) (?$(G$](B . ?c) (?$(G$^(B . ?d) (?$(G$_(B . ?e) + (?$(G$`(B . ?f) (?$(G$a(B . ?g) (?$(G$b(B . ?h) (?$(G$c(B . ?i) (?$(G$d(B . ?j) + (?$(G$e(B . ?k) (?$(G$f(B . ?l) (?$(G$g(B . ?m) (?$(G$h(B . ?n) (?$(G$i(B . ?o) + (?$(G$j(B . ?p) (?$(G$k(B . ?q) (?$(G$l(B . ?r) (?$(G$m(B . ?s) (?$(G$n(B . ?t) + (?$(G$o(B . ?u) (?$(G$p(B . ?v) (?$(G$q(B . ?w) (?$(G$r(B . ?x) (?$(G$s(B . ?y) + (?$(G$t(B . ?z)) + (Korean + (?$(C!!(B . ?\ ) (?$(C#,(B . ?,) (?$(C#.(B . ?.) + (?$(C#:(B . ?:) (?$(C#;(B . ?\;) (?$(C#?(B . ??) (?$(C#!(B . ?!) + (?$(C!/(B . ?') (?$(C!.(B . ?`) (?$(C#^(B . ?^) (?$(C#_(B . ?_) (?$(C#~(B . ?~) + (?$(C!*(B . ?-) (?$(C!)(B . ?-) + (?$(C#/(B . ?/) (?$(C!,(B . ?\\) (?$(C!-(B . ?~) (?$(C#|(B . ?|) + (?$(C!.(B . ?`) (?$(C!/(B . ?') (?$(C!0(B . ?\") (?$(C!1(B . ?\") + (?$(C#((B . ?\() (?$(C#)(B . ?\)) (?$(C#[(B . ?[) (?$(C#](B . ?]) + (?$(C#{(B . ?{) (?$(C#}(B . ?}) (?$(C!4(B . ?<) (?$(C!5(B . ?>) + (?$(C#+(B . ?+) (?$(C#-(B . ?-) (?$(C#=(B . ?=) (?$(C#<(B . ?<) (?$(C#>(B . ?>) + (?$(C#'(B . ?') (?$(C#"(B . ?\") (?$(C#\(B . ?\\) (?$(C#$(B . ?$) (?$(C#%(B . ?%) + (?$(C##(B . ?#) (?$(C#&(B . ?&) (?$(C#*(B . ?*) (?$(C#@(B . ?@) + (?$(C#0(B . ?0) (?$(C#1(B . ?1) (?$(C#2(B . ?2) (?$(C#3(B . ?3) (?$(C#4(B . ?4) + (?$(C#5(B . ?5) (?$(C#6(B . ?6) (?$(C#7(B . ?7) (?$(C#8(B . ?8) (?$(C#9(B . ?9) + (?$(C#A(B . ?A) (?$(C#B(B . ?B) (?$(C#C(B . ?C) (?$(C#D(B . ?D) (?$(C#E(B . ?E) + (?$(C#F(B . ?F) (?$(C#G(B . ?G) (?$(C#H(B . ?H) (?$(C#I(B . ?I) (?$(C#J(B . ?J) + (?$(C#K(B . ?K) (?$(C#L(B . ?L) (?$(C#M(B . ?M) (?$(C#N(B . ?N) (?$(C#O(B . ?O) + (?$(C#P(B . ?P) (?$(C#Q(B . ?Q) (?$(C#R(B . ?R) (?$(C#S(B . ?S) (?$(C#T(B . ?T) + (?$(C#U(B . ?U) (?$(C#V(B . ?V) (?$(C#W(B . ?W) (?$(C#X(B . ?X) (?$(C#Y(B . ?Y) + (?$(C#Z(B . ?Z) + (?$(C#a(B . ?a) (?$(C#b(B . ?b) (?$(C#c(B . ?c) (?$(C#d(B . ?d) (?$(C#e(B . ?e) + (?$(C#f(B . ?f) (?$(C#g(B . ?g) (?$(C#h(B . ?h) (?$(C#i(B . ?i) (?$(C#j(B . ?j) + (?$(C#k(B . ?k) (?$(C#l(B . ?l) (?$(C#m(B . ?m) (?$(C#n(B . ?n) (?$(C#o(B . ?o) + (?$(C#p(B . ?p) (?$(C#q(B . ?q) (?$(C#r(B . ?r) (?$(C#s(B . ?s) (?$(C#t(B . ?t) + (?$(C#u(B . ?u) (?$(C#v(B . ?v) (?$(C#w(B . ?w) (?$(C#x(B . ?x) (?$(C#y(B . ?y) + (?$(C#z(B . ?z)))) + (hash (make-vector 100 nil)) + lang pair) + (while table + (setq lang (caar table) + pair (cdar table) + table (cdr table)) + (while pair + (set (intern (char-to-string (caar pair)) its-full-half-table) + (cdar pair)) + (set (intern (concat (symbol-name lang) (char-to-string (cdar pair))) + its-half-full-table) + (caar pair)) + (setq pair (cdr pair))) + hash)) + +;;; its-half-width : half-width-region for input-buffer +(defun its-half-width () (interactive) - (let ((inhibit-read-only t)) - (its-input-end) - (its-set-part-1 (point) (its-search-end)) - (its-convert 'its-japanese-hankaku (its-search-beginning) (point)) - (its-put-cursor t))) - -(defun its-japanese-hankaku (obj) - (japanese-hankaku obj 'ascii-only)) - -;;; its-zenkaku : zenkaku-region for input-buffer -(defun its-zenkaku () + (its-convert + (lambda (str lang) + (concat (mapcar (lambda (c) + (or (symbol-value (intern-soft (char-to-string c) + its-full-half-table)) + c)) + (string-to-sequence str 'list)))))) + +;;; its-full-width : full-width-region for input-buffer +(defun its-full-width () (interactive) + (its-convert + (lambda (str lang) + (if (egg-chinese-syllable str 0) + (copy-sequence str) + (concat (mapcar (lambda (c) + (or (symbol-value + (intern-soft (concat (symbol-name lang) + (char-to-string c)) + its-half-full-table)) + c)) + (string-to-sequence str 'list))))))) + +(defun its-convert (func) (let ((inhibit-read-only t)) - (its-input-end) - (its-set-part-1 (point) (its-search-end)) - (its-convert 'japanese-zenkaku (its-search-beginning) (point)) - (its-put-cursor t))) - -(defun its-convert (func start end) - (let* ((goto-start (eq (point) start)) - (old-str (buffer-substring start end)) - (new-str "") - (len (length old-str)) - (p 0) - old new syl q) - (while (< p len) - (setq q (next-single-property-change p 'its-syl old-str len) - old (substring old-str p q) - new (copy-sequence old)) - (set-text-properties 0 (- q p) nil new) - (setq new (funcall func new)) - (if (equal new old) - (setq new-str (concat new-str old)) - (setq syl (cons (copy-sequence new) (copy-sequence new))) - (set-text-properties 0 (length new) (text-properties-at 0 old) new) - (put-text-property 0 (length new) 'its-syl syl new) - (setq new-str (concat new-str new))) - (setq p q)) - (delete-region start end) - (insert new-str) - (if goto-start - (goto-char start)))) + (unwind-protect + (progn + (its-input-end) + (let* ((start (its-search-beginning)) + (end (its-search-end)) + (old-str (buffer-substring start end)) + (len (length old-str)) + (p 0) + (new-str "")) + (put-text-property 0 len 'intangible 'its-part-1 old-str) + (while (< p len) + (let* ((prop (text-properties-at p old-str)) + (cmp (memq 'composition prop)) + (old (its-get-output (plist-get prop 'its-syl))) + (new (funcall func old (plist-get prop 'egg-lang))) + (new-len (length new)) + syl) + (unless (equal new old) + (when cmp + (if (eq prop cmp) + (setq prop (cddr prop)) + (setcdr (nthcdr (- (length prop) (length cmp) 1) prop) + (cddr cmp)))) + (setq syl (copy-sequence new)) + (plist-put prop 'its-syl (cons syl syl))) + (add-text-properties 0 new-len prop new) + (setq new-str (concat new-str new) + p (+ p (length old))))) + (delete-region start end) + (insert new-str))) + (its-put-cursor t)))) (defun its-mode () "\\{its-mode-map}" diff --git a/its/ascii.el b/its/ascii.el index b7c16ca..bdf2c85 100644 --- a/its/ascii.el +++ b/its/ascii.el @@ -26,10 +26,7 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; -;; Symbol input is desined by jiro@math.keio.ac.jp (TANAKA Jiro) -;; This file is based on the rules of its/hira.el in Mule-2.3 distribution. -;; + ;;; Code: diff --git a/its/aynu.el b/its/aynu.el new file mode 100644 index 0000000..42ac872 --- /dev/null +++ b/its/aynu.el @@ -0,0 +1,282 @@ +;;; its/aynu.el --- Aynu Katakana Input in Egg Input Method Architecture + +;; Copyright (C) 1999,2000 PFU LIMITED + +;; Author: KATAYAMA Yoshio + +;; Maintainer: TOMURA Satoru + +;; Keywords: mule, multilingual, input method + +;; This file is part of EGG. + +;; EGG 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 2, or (at your option) +;; any later version. + +;; EGG 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + + +;;; Code: + +(require 'its) + +(eval-when (compile) + (defconst its-compaction-enable t)) + +(defvar its-aynu-enable-zenkaku-alphabet + (if (boundp 'its-enable-fullwidth-alphabet) + its-enable-fullwidth-alphabet + t) + "*Enable Zenkaku alphabet") + +(defvar its-aynu-horizontal "$(O!<(B" "*-") ; "-" "$(O!=(B" +(defvar its-aynu-period "$(O!#(B " "*.") ; "." "$(O!#(B" +(defvar its-aynu-comma "$(O!$(B " "*,") ; "," "$(O!$(B" +(defvar its-aynu-open-bracket "$(O!V(B" "*[") ; "$(O!N(B" +(defvar its-aynu-close-bracket "$(O!W(B" "*]") ; "$(O!O(B" + +(defvar its-aynu-enable-double-n nil "*Enable \"nn\" input for \"$(O%s(B\"") + +(defvar its-aynu-kick-conversion-on-space nil "*Start conversion on SPACE") + +(eval-when-compile + (defun its-define-state-aynu (input i-tail output o-tail otherwise) + "Define following rules: +INPUT + I-TAIL --> OUTPUT + O-TAIL +INPUT + I-TAIL + ' --> OUTPUT + O-TAIL +INPUT + I-TAIL + vowel --> (translate INPUT) + I-tail + vowel +INPUT + I-TAIL + OTHERWISE (see `its-defrule-otherwise')." + (let ((out (concat output o-tail)) + state) + (setq state (its-defrule (concat input i-tail) out)) + (its-defrule (concat input i-tail "'") out) + (its-defrule-otherwise state nil "[aiueo]" -2) + (while otherwise + (its-defrule-otherwise state (concat output (caar otherwise)) + (nth 1 (car otherwise)) (nth 2 (car otherwise))) + (setq otherwise (cdr otherwise))) + (setq state (its-defrule (concat input i-tail "y") (concat out "$(O%#(B"))) + (its-make-next-state state -1 out -1) + (its-defrule-otherwise state out nil -2) + (its-defrule-otherwise state nil "[u]" -3) +)) + + (defconst its-aynu-tail-alist + (let ((common '(("k" "$(O&n(B" (("$(O%C(B" "[k]" -1))) + ("s" "$(O&o(B" (("$(O%C(B" "[s]" -1) (nil "[h]" -2))) + ("p" "$(O&x(B" (("$(O%C(B" "[p]" -1))) + ("m" "$(O&y(B" (("$(O%s(B" "[mp]" -1))) + ("t" "$(O%C(B") ("y" "$(O%#(B") ("w" "$(O%%(B")))) + `((?a ("h" "$(O&s(B") ("x" "$(O&s(B") ("r" "$(O&z(B") ,@common) + (?i ("h" "$(O&t(B") ("x" "$(O&t(B") ("r" "$(O&{(B") ,@common) + (?u ("h" "$(O&u(B") ("x" "$(O&u(B") ("r" "$(O&|(B") ,@common) + (?e ("h" "$(O&v(B") ("x" "$(O&v(B") ("r" "$(O&}(B") ,@common) + (?o ("h" "$(O&w(B") ("x" "$(O&w(B") ("r" "$(O&~(B") ,@common)))) + + (defun its-defrule-aynu (conso vowel output) + (let ((input (concat conso vowel)) + (tails (and vowel (cdr (assq (aref vowel 0) its-aynu-tail-alist))))) + (its-defrule input output) + (while tails + (its-define-state-aynu input (caar tails) output (nth 1 (car tails)) + (nth 2 (car tails))) + (setq tails (cdr tails))))) + + (defmacro its-define-aynu (&rest rules) + (let ((defs (list 'progn)) + conso vowels output) + (while rules + (setq vowels '(nil "a" "i" "u" "e" "o") + conso (caar rules) + output (cdar rules) + rules (cdr rules)) + (while output + (when (car output) + (setq defs (cons `(its-defrule-aynu ,conso ,(car vowels) + ,(car output)) + defs))) + (setq output (cdr output) + vowels (cdr vowels)))) + (nreverse defs))) + + (defun its-defrule-aynu-override-yu (conso) + (let ((output (its-get-output (its-goto-state conso))) + state) + (its-defrule (concat conso "yu") + (concat (its-get-output (its-goto-state (concat conso "i"))) + "$(O%e!<(B")) + (setq state (its-goto-state (concat conso "y"))) + (its-set-output state (concat output "$(O%#(B")) + (its-make-next-state state -1 output -1) + (its-defrule-otherwise state output nil -2)))) + +(define-its-state-machine its-aynu-map + "roma-aynu-kata" "$(O%"(B" Aynu + "Map for Romaji-Aynu-Katakana translation. (Japanese)" + + (defconst its-zenkaku-escape "Z") ;; Escape character to Zenkaku inputs + (defconst its-hankaku-escape "~") ;; Escape character to Hankaku inputs + + (its-defrule-select-mode-temporally "q" downcase) + (its-defrule-select-mode-temporally "Q" zenkaku-downcase) + + (dolist (small '(("a" "$(O%!(B") ("i" "$(O%#(B") ("u" "$(O%%(B") ("e" "$(O%'(B") ("o" "$(O%)(B") + ("ka" "$(O%u(B") ("ku" "$(O&n(B") ("ke" "$(O%v(B") + ("si" "$(O&o(B") ("su" "$(O&p(B") + ("tu" "$(O%C(B") ("to" "$(O&q(B") + ("nu" "$(O&r(B") + ("ha" "$(O&s(B") ("hi" "$(O&t(B") ("hu" "$(O&u(B") ("he" "$(O&v(B") ("ho" "$(O&w(B") + ("pu" "$(O&x(B") + ("mu" "$(O&y(B") + ("ya" "$(O%c(B") ("yu" "$(O%e(B") ("yo" "$(O%g(B") + ("ra" "$(O&z(B") ("ri" "$(O&{(B") ("ru" "$(O&|(B") ("re" "$(O&}(B") ("ro" "$(O&~(B") + ("wa" "$(O%n(B"))) + (its-defrule (concat "x" (car small)) (cadr small))) + + (its-define-aynu + ("" nil "$(O%"(B" "$(O%$(B" "$(O%&(B" "$(O%((B" "$(O%*(B") + ("k" "$(O&n(B" "$(O%+(B" "$(O%-(B" "$(O%/(B" "$(O%1(B" "$(O%3(B") + ("g" "$(O%0(B" "$(O%,(B" "$(O%.(B" "$(O%0(B" "$(O%2(B" "$(O%4(B") + ("s" "$(O&p(B" "$(O%5(B" "$(O%7(B" "$(O%9(B" "$(O%;(B" "$(O%=(B") + ("z" nil "$(O%6(B" "$(O%8(B" "$(O%:(B" "$(O%<(B" "$(O%>(B") + ("vs" nil nil nil nil "$(O%|(B" nil) + ("sh" "$(O%7%c(B" "$(O%7%c(B" "$(O%7(B" "$(O%7%e(B" "$(O%7%'(B" "$(O%7%g(B") + ("j" nil "$(O%8%c(B" "$(O%8(B" "$(O%8%e(B" "$(O%8%'(B" "$(O%8%g(B") + ("t" "$(O%C(B" "$(O%?(B" "$(O%A(B" "$(O%H%%(B" "$(O%F(B" "$(O%H(B") + ("vt" nil nil nil "$(O%}(B" nil "$(O%~(B") + ("d" nil "$(O%@(B" "$(O%B(B" "$(O%E(B" "$(O%G(B" "$(O%I(B") + ("c" "$(O%C(B" "$(O%A%c(B" "$(O%A(B" "$(O%A%e(B" "$(O%A%'(B" "$(O%A%g(B") + ("ch" "$(O%C(B" "$(O%A%c(B" "$(O%A(B" "$(O%A%e(B" "$(O%A%'(B" "$(O%A%g(B") + ("n" "$(O%s(B" "$(O%J(B" "$(O%K(B" "$(O%L(B" "$(O%M(B" "$(O%N(B") + ("h" "$(O&s(B" "$(O%O(B" "$(O%R(B" "$(O%U(B" "$(O%X(B" "$(O%[(B") + ("b" nil "$(O%P(B" "$(O%S(B" "$(O%V(B" "$(O%Y(B" "$(O%\(B") + ("p" "$(O&x(B" "$(O%Q(B" "$(O%T(B" "$(O%W(B" "$(O%Z(B" "$(O%](B") + ("m" "$(O&y(B" "$(O%^(B" "$(O%_(B" "$(O%`(B" "$(O%a(B" "$(O%b(B") + ("y" "$(O%#(B" "$(O%d(B" "$(O%#(B" "$(O%f(B" "$(O%$%'(B" "$(O%h(B") + ("r" "$(O&|(B" "$(O%i(B" "$(O%j(B" "$(O%k(B" "$(O%l(B" "$(O%m(B") + ("w" "$(O%%(B" "$(O%o(B" "$(O%&%#(B" "$(O%%(B" "$(O%&%'(B" "$(O%&%)(B")) + + (dolist (yu '("k" "g" "s" "z" "sh" "j" "t" "d" + "c" "ch" "n" "h" "b" "p" "m" "r")) + (its-defrule-aynu-override-yu yu)) + + (its-defrule "kk" "$(O%C(B" -1) + (its-defrule "ss" "$(O%C(B" -1) + (its-defrule "pp" "$(O%C(B" -1) + (its-defrule "vv" "$(O%C(B" -1) + +;; SYMBOL Input + (its-defrule "z1" "$(O!{(B") (its-defrule "z!" "$(O!|(B") + (its-defrule "z2" "$(O"&(B") (its-defrule "z@" "$(O"'(B") + (its-defrule "z3" "$(O"$(B") (its-defrule "z#" "$(O"%(B") + (its-defrule "z4" "$(O""(B") (its-defrule "z$" "$(O"#(B") + (its-defrule "z5" "$(O!~(B") (its-defrule "z%" "$(O"!(B") + (its-defrule "z6" "$(O!y(B") (its-defrule "z^" "$(O!z(B") + (its-defrule "z7" "$(O!}(B") (its-defrule "z&" "$(O!r(B") + (its-defrule "z8" "$(O!q(B") (its-defrule "z*" "$(O!_(B") + (its-defrule "z9" "$(O!i(B") (its-defrule "z(" "$(O!Z(B") + (its-defrule "z0" "$(O!j(B") (its-defrule "z)" "$(O![(B") + (its-defrule "z-" "$(O!A(B") (its-defrule "z_" "$(O!h(B") + (its-defrule "z=" "$(O!b(B") (its-defrule "z+" "$(O!^(B") + (its-defrule "z\\" "$(O!@(B") (its-defrule "z|" "$(O!B(B") + (its-defrule "z`" "$(O!-(B") (its-defrule "z~" "$(O!/(B") + + (its-defrule "zq" "$(O!T(B") (its-defrule "zQ" "$(O!R(B") + (its-defrule "zw" "$(O!U(B") (its-defrule "zW" "$(O!S(B") + ; e + (its-defrule "zr" "$(O!9(B") (its-defrule "zR" "$(O!8(B") + (its-defrule "zt" "$(O!:(B") (its-defrule "zT" "$(O!x(B") + ; y u i o + (its-defrule "zp" "$(O")(B") (its-defrule "zP" "$(O",(B") + (its-defrule "z[" "$(O!X(B") (its-defrule "z{" "$(O!L(B") + (its-defrule "z]" "$(O!Y(B") (its-defrule "z}" "$(O!M(B") + ; a + (its-defrule "zs" "$(O!3(B") (its-defrule "zS" "$(O!4(B") + (its-defrule "zd" "$(O!5(B") (its-defrule "zD" "$(O!6(B") + (its-defrule "zf" "$(O!7(B") (its-defrule "zF" "$(O"*(B") + (its-defrule "zg" "$(O!>(B") (its-defrule "zG" "$(O!=(B") + (its-defrule "zh" "$(O"+(B") + (its-defrule "zj" "$(O"-(B") + (its-defrule "zk" "$(O",(B") + (its-defrule "zl" "$(O"*(B") + (its-defrule "z;" "$(O!+(B") (its-defrule "z:" "$(O!,(B") + (its-defrule "z\'" "$(O!F(B") (its-defrule "z\"" "$(O!H(B") + ; z + (its-defrule "zx" ":-") (its-defrule "zX" ":-)") + (its-defrule "zc" "$(O!;(B") (its-defrule "zC" "$(O!n(B") + (its-defrule "zv" "$(O"((B") (its-defrule "zV" "$(O!`(B") + (its-defrule "zb" "$(O!k(B") (its-defrule "zB" "$(O"+(B") + (its-defrule "zn" "$(O!l(B") (its-defrule "zN" "$(O"-(B") + (its-defrule "zm" "$(O!m(B") (its-defrule "zM" "$(O".(B") + (its-defrule "z," "$(O!E(B") (its-defrule "z<" "$(O!e(B") + (its-defrule "z." "$(O!D(B") (its-defrule "z>" "$(O!f(B") + (its-defrule "z/" "$(O!&(B") (its-defrule "z?" "$(O!g(B") + ) + +(define-its-state-machine-append its-aynu-map + (if its-aynu-enable-double-n + (its-defrule "nn" "$(O%s(B")) + + (its-defrule "-" its-aynu-horizontal) + (its-defrule "." its-aynu-period) + (its-defrule "," its-aynu-comma) + (its-defrule "[" its-aynu-open-bracket) + (its-defrule "]" its-aynu-close-bracket) + + (unless its-aynu-kick-conversion-on-space + (its-defrule " " " ")) + + (if its-aynu-enable-zenkaku-alphabet + (progn + (its-defrule "1" "$(O#1(B") (its-defrule "2" "$(O#2(B") + (its-defrule "3" "$(O#3(B") (its-defrule "4" "$(O#4(B") + (its-defrule "5" "$(O#5(B") (its-defrule "6" "$(O#6(B") + (its-defrule "7" "$(O#7(B") (its-defrule "8" "$(O#8(B") + (its-defrule "9" "$(O#9(B") (its-defrule "0" "$(O#0(B") + (its-defrule "!" "$(O!*(B") (its-defrule "@" "$(O!w(B") + (its-defrule "#" "$(O!t(B") (its-defrule "$" "$(O!p(B") + (its-defrule "%" "$(O!s(B") (its-defrule "^" "$(O!0(B") + (its-defrule "&" "$(O!u(B") (its-defrule "*" "$(O!v(B") + (its-defrule "(" "$(O!J(B") (its-defrule ")" "$(O!K(B") + (its-defrule "=" "$(O!a(B") (its-defrule "`" "$(O!.(B") + (its-defrule "\\" "$(O!o(B") (its-defrule "|" "$(O!C(B") + (its-defrule "_" "$(O!2(B") (its-defrule "+" "$(O!\(B") + (its-defrule "{" "$(O!P(B") (its-defrule "}" "$(O!Q(B") + (its-defrule ":" "$(O!'(B") (its-defrule ";" "$(O!((B") + (its-defrule "\"" "$(O!I(B") (its-defrule "'" "$(O!G(B") + (its-defrule "<" "$(O!c(B") (its-defrule ">" "$(O!d(B") + (its-defrule "?" "$(O!)(B") (its-defrule "/" "$(O!?(B")) + (progn + (its-defrule "1" "1") (its-defrule "2" "2") + (its-defrule "3" "3") (its-defrule "4" "4") + (its-defrule "5" "5") (its-defrule "6" "6") + (its-defrule "7" "7") (its-defrule "8" "8") + (its-defrule "9" "9") (its-defrule "0" "0") + (its-defrule "!" "!") (its-defrule "@" "@") + (its-defrule "#" "#") (its-defrule "$" "$") + (its-defrule "%" "%") (its-defrule "^" "^") + (its-defrule "&" "&") (its-defrule "*" "*") + (its-defrule "(" "(") (its-defrule ")" ")") + (its-defrule "=" "=") (its-defrule "`" "`") + (its-defrule "\\" "\\") (its-defrule "|" "|") + (its-defrule "_" "_") (its-defrule "+" "+") + (its-defrule "{" "{") (its-defrule "}" "}") + (its-defrule ":" ":") (its-defrule ";" ";") + (its-defrule "\"" "\"") (its-defrule "'" "'") + (its-defrule "<" "<") (its-defrule ">" ">") + (its-defrule "?" "?") (its-defrule "/" "/")))) + +(provide 'its/aynu) +;;; its/aynu.el ends here. diff --git a/its/hankata.el b/its/hankata.el index 3aac351..a24d3e2 100644 --- a/its/hankata.el +++ b/its/hankata.el @@ -24,10 +24,7 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; -;; Symbol input is desined by jiro@math.keio.ac.jp (TANAKA Jiro) -;; This file is based on the rules of its/kata.el in Mule-2.3 distribution. -;; + ;;; Code: diff --git a/its/jeonkak.el b/its/jeonkak.el index 2775e3b..df9c425 100644 --- a/its/jeonkak.el +++ b/its/jeonkak.el @@ -26,10 +26,7 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; -;; Symbol input is desined by jiro@math.keio.ac.jp (TANAKA Jiro) -;; This file is based on the rules of its/hira.el in Mule-2.3 distribution. -;; + ;;; Code: diff --git a/its/pinyin.el b/its/pinyin.el index 1fb9df3..e4296c3 100644 --- a/its/pinyin.el +++ b/its/pinyin.el @@ -4,7 +4,7 @@ ;; Author: KATAYAMA Yoshio -;; Maintainer: TOMURA Satoru  +;; Maintainer: TOMURA Satoru ;; Keywords: mule, multilingual, input method diff --git a/its/quanjiao.el b/its/quanjiao.el index a127083..99cd8f0 100644 --- a/its/quanjiao.el +++ b/its/quanjiao.el @@ -26,10 +26,7 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; -;; Symbol input is desined by jiro@math.keio.ac.jp (TANAKA Jiro) -;; This file is based on the rules of its/hira.el in Mule-2.3 distribution. -;; + ;;; Code: diff --git a/its/thai.el b/its/thai.el index 1a1f6cb..91753eb 100644 --- a/its/thai.el +++ b/its/thai.el @@ -69,7 +69,7 @@ (setq next-keyseq (concat keyseq (car (car vowel))) next-output (concat output (cdr (car vowel))) vowel (cdr vowel)) - (its-defrule next-keyseq (compose-string next-output)) + (its-defrule next-keyseq `(eval compose-string ,next-output)) (its-thai-add-tone next-keyseq next-output tone)))) (defun its-thai-add-tone (keyseq output tone) @@ -78,7 +78,7 @@ (setq next-keyseq (concat keyseq (car (car tone))) next-output (concat output (cdr (car tone))) tone (cdr tone)) - (its-defrule next-keyseq (compose-string next-output)))))) + (its-defrule next-keyseq `(eval compose-string ,next-output)))))) ;; Thai Kesmanee keyboard support. @@ -93,7 +93,7 @@ ("4" ",T@(B" consonant) ("$" ",Ts(B") ("5" ",T6(B" consonant) ("%" ",Tt(B") ("6" ",TX(B" vowel) ("^" ",TY(B" vowel) - ("7" ",TV(B" vowel) ("&" "0,TQi(B1" vowel) + ("7" ",TV(B" vowel) ("&" "0,TQi1(B" vowel) ("8" ",T$(B" consonant) ("*" ",Tu(B") ("9" ",T5(B" consonant) ("(" ",Tv(B") ("0" ",T((B" consonant) (")" ",Tw(B") diff --git a/its/zenkaku.el b/its/zenkaku.el index a5ccff9..8ae9f6c 100644 --- a/its/zenkaku.el +++ b/its/zenkaku.el @@ -26,10 +26,7 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; -;; Symbol input is desined by jiro@math.keio.ac.jp (TANAKA Jiro) -;; This file is based on the rules of its/hira.el in Mule-2.3 distribution. -;; + ;;; Code: diff --git a/its/zhuyin.el b/its/zhuyin.el index 09ee3a3..5eb9531 100644 --- a/its/zhuyin.el +++ b/its/zhuyin.el @@ -142,9 +142,9 @@ (mapcar (lambda (s) (its-defoutput (car s) (nth 1 s))) (list B P M F D T N L G K H J Q X)) - (its-defrule (concat (car N) 2) (concat (nth 1 N) "(0B(B")) - (its-defrule (concat (car N) 3) (concat (nth 1 N) "(0C(B")) - (its-defrule (concat (car N) 4) (concat (nth 1 N) "(0D(B"))))) + (its-defrule (concat (car N) "2") (concat (nth 1 N) "(0B(B")) + (its-defrule (concat (car N) "3") (concat (nth 1 N) "(0C(B")) + (its-defrule (concat (car N) "4") (concat (nth 1 N) "(0D(B"))))) (define-its-state-machine its-zhuyin-cn-map "zhuyin-cn" "$AW"(BG" Chinese-GB diff --git a/jisx0213.el b/jisx0213.el new file mode 100644 index 0000000..7a17790 --- /dev/null +++ b/jisx0213.el @@ -0,0 +1,34 @@ +;;; jisx0213.el --- Charset Definition for JIS X 0213 + +;; Copyright (C) 1999,2000 PFU LIMITED + +;; Author: KATAYAMA Yoshio + +;; Maintainer: TOMURA Satoru + +;; Keywords: mule, multilingual, input method + +;; This file is part of EGG. + +;; EGG 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 2, or (at your option) +;; any later version. + +;; EGG 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + + +;;; Code: + +(define-charset nil 'japanese-jisx0213 + [2 94 2 0 ?O 0 "JIS X 0213" "JIS X 0213" "JIS X 0213"]) diff --git a/leim-list.el b/leim-list.el index 9640797..1983905 100644 --- a/leim-list.el +++ b/leim-list.el @@ -32,8 +32,10 @@ ;;; Code: (when site-run-file - (autoload 'egg-activate-wnn "egg/wnn" "Activate Wnn backend of Tamagotchy." t) - (autoload 'egg-activate-sj3 "egg/sj3" "Activate SJ3 backend of Tamagotchy." t) + (autoload 'egg-activate-wnn "egg/wnn" "Activate Wnn backend of Tamago 4." t) + (autoload 'egg-activate-sj3 "egg/sj3" "Activate SJ3 backend of Tamago 4." t) + (autoload 'egg-activate-canna "egg/canna" + "Activate CANNA backend of Tamago 4." t) (register-input-method "japanese-egg-wnn" "Japanese" 'egg-activate-wnn @@ -46,6 +48,11 @@ 'its-select-hiragana) (register-input-method + "japanese-egg-canna" "Japanese" 'egg-activate-canna + "$B$"(B.." "Romaji -> Hiragana -> Kanji&Kana" + 'its-select-hiragana) + + (register-input-method "chinese-gb-egg-wnn-py" "Chinese-GB" 'egg-activate-wnn "$AF4(BG" "Pinyin -> Simplified Hanzi" 'its-select-pinyin-cn) @@ -100,6 +107,9 @@ (defgroup sj3 nil "" :group 'egg :load "egg/sj3") +(defgroup canna nil "" + :group 'egg :load "egg/canna") + (defgroup its nil "" :group 'egg :load "its") @@ -119,4 +129,4 @@ (message "Finished loading %s \n and load others..." load-file-name) (load-leim-list-except-this) - ) \ No newline at end of file + ) diff --git a/menudiag.el b/menudiag.el index 50d50b8..0e6498c 100644 --- a/menudiag.el +++ b/menudiag.el @@ -50,7 +50,7 @@ ;; (defgroup menudiag nil - "Input Translation System of Tamagotchy" + "Input Translation System of Tamago 4." :group 'egg) (defcustom menudiag-select-without-return nil @@ -72,26 +72,34 @@ (while (<= ch ?Z) (define-key map (char-to-string ch) 'menudiag-goto-item) (setq ch (1+ ch))) - (define-key map "\C-a" 'menudiag-beginning-of-line) - (define-key map "\C-e" 'menudiag-end-of-line) - (define-key map "\M-<" 'menudiag-beginning-of-items) - (define-key map "\M->" 'menudiag-end-of-items) - (define-key map "\C-f" 'menudiag-forward-item) - (define-key map "\C-b" 'menudiag-backward-item) - (define-key map "\C-n" 'menudiag-next-line) - (define-key map "\C-p" 'menudiag-previous-line) - (define-key map "\C-]" 'menudiag-exit) - (define-key map "\C-g" 'menudiag-exit-one-level) - (define-key map "\C-l" 'menudiag-redraw) - (define-key map "\C-m" 'menudiag-select-this-item) - (define-key map "?" 'menudiag-list-other-window) + (setq ch ?\C-0) + (while (<= ch ?\C-9) + (define-key map (vector ch) 'digit-argument) + (setq ch (1+ ch))) + (define-key map [?\C--] 'negative-argument) + (define-key map [?\C-u] 'universal-argument) + (define-key map " " 'menudiag-forward-item) + (define-key map "\C-a" 'menudiag-beginning-of-line) + (define-key map "\C-e" 'menudiag-end-of-line) + (define-key map "\M-<" 'menudiag-beginning-of-items) + (define-key map "\M->" 'menudiag-end-of-items) + (define-key map "\C-f" 'menudiag-forward-item) + (define-key map "\C-b" 'menudiag-backward-item) + (define-key map "\C-n" 'menudiag-next-line) + (define-key map "\C-p" 'menudiag-previous-line) + (define-key map "\C-]" 'menudiag-exit) + (define-key map "\C-g" 'menudiag-exit-one-level) + (define-key map "\C-l" 'menudiag-redraw) + (define-key map "\C-m" 'menudiag-select-this-item) + (define-key map "\M-v" 'menudiag-list-other-window) + (define-key map "?" 'menudiag-list-other-window) (define-key map [return] 'menudiag-select-this-item) - (define-key map [left] 'menudiag-backward-item) - (define-key map [right] 'menudiag-forward-item) - (define-key map [up] 'menudiag-previous-line) - (define-key map [down] 'menudiag-next-line) - (define-key map [menudiag-continuation] 'menudiag-follow-continuation) - (define-key map [t] 'undefined) + (define-key map [left] 'menudiag-backward-item) + (define-key map [right] 'menudiag-forward-item) + (define-key map [up] 'menudiag-previous-line) + (define-key map [down] 'menudiag-next-line) + (define-key map [exit] 'menudiag-exit) + (define-key map [t] 'undefined) map) "Keymap for MENU.") @@ -111,8 +119,6 @@ (defsubst menudiag-item-width (item) (+ 4 (string-width (menudiag-item-string item)))) -(defvar menudiag-window-conf nil) - (defun menudiag-make-selection-list (item-list line-width) (let ((l nil) (line nil) @@ -135,66 +141,121 @@ (reverse (cons (reverse line) l)) (reverse l)))) +(defvar menudiag-show-all nil) +(make-variable-buffer-local 'menudiag-show-all) + +(defvar menudiag-continuation nil) +(make-variable-buffer-local 'menudiag-continuation) + +(defvar menudiag-return-contin nil) +(make-variable-buffer-local 'menudiag-return-contin) + +(defvar menudiag-value nil) +(make-variable-buffer-local 'menudiag-value) + +(defvar menudiag-done nil) +(make-variable-buffer-local 'menudiag-done) + ;; Entry function -(defun menudiag-select (menu &optional menudiag-continuation return-contin) - (let ((enable-recursive-minibuffers t) - value done) - (setq menudiag-window-conf nil) - (if menudiag-continuation - (setq unread-command-events (cons 'menudiag-continuation - unread-command-events))) - (if (not return-contin) - (setq value t)) - (menudiag-select-internal menu) - (if (eq done t) - value +(defun menudiag-select (menu &optional list-all continuation return-contin) + (let ((enable-recursive-minibuffers t)) + (setq menudiag-return-contin return-contin) + (menudiag-select-internal menu list-all continuation) + (if (eq menudiag-done t) + menudiag-value (signal 'quit "")))) -;; Entry function -(defun menudiag-get-value (continuation) - (menudiag-item-value (nth (1- (length continuation)) continuation))) +(defvar menudiag-line nil) +(make-variable-buffer-local 'menudiag-line) + +(defvar menudiag-linepos 0) +(make-variable-buffer-local 'menudiag-linepos) + +(defvar menudiag-pos-in-line 0) +(make-variable-buffer-local 'menudiag-pos-in-line) (defun menudiag-follow-continuation () + (let* ((item (car menudiag-continuation)) + (value (menudiag-item-value item)) + (pos (menudiag-search-item item))) + (unless pos + (error "no such item: %s" (menudiag-item-string item))) + (menudiag-goto-line (car pos)) + (menudiag-goto-item-internal (cdr pos)) + (when (menudiag-menu-p value) + (menudiag-select-internal value + menudiag-show-all + (cdr menudiag-continuation)) + (menudiag-redraw) + (when menudiag-done + (when menudiag-return-contin + (setq menudiag-value (cons item menudiag-value))) + (setq unread-command-events (cons 'exit unread-command-events)))))) + +(defvar menudiag-minibuffer-list nil) +(defvar menudiag-variable-alist nil) + +(defmacro menudiag-send-variables (&rest args) + `(setq menudiag-variable-alist + (list ,@(mapcar (lambda (var) `(cons ',var ,var)) args)))) + +(defmacro menudiag-send-variables-with-value (&rest args) + `(setq menudiag-variable-alist + ,(let ((alist (list 'list))) + (while args + (nconc alist `((cons ',(car args) ,(cadr args)))) + (setq args (cddr args))) + alist))) + +(defun menudiag-receive-variables () + (while menudiag-variable-alist + (set (caar menudiag-variable-alist) (cdar menudiag-variable-alist)) + (setq menudiag-variable-alist (cdr menudiag-variable-alist)))) + +(defvar menudiag-minibuf-prompt nil) +(make-variable-buffer-local 'menudiag-minibuf-prompt) + +(defvar menudiag-current-items nil) +(make-variable-buffer-local 'menudiag-current-items) + +(defvar menudiag-selection-list nil) +(make-variable-buffer-local 'menudiag-selection-list) + +(defun menudiag-minibuffer-hook () (interactive) - (let ((item (car menudiag-continuation))) - (setq menudiag-continuation (cdr menudiag-continuation)) - (if menudiag-continuation - (setq unread-command-events (cons 'menudiag-continuation - unread-command-events))) - (if (eq item 'menudiag-list-all) - (menudiag-list-other-window) - (let ((in-loop t)) - (while in-loop - (if (eq item (nth pos-in-line line)) - (setq in-loop nil) - (menudiag-forward-item) - (if (and (= linepos 0) (= pos-in-line 0)) - (error "no such item: %s" (menudiag-item-string item)))))) - (let ((v (menudiag-item-value item))) - (if (menudiag-menu-p v) - (unwind-protect - (progn - (menudiag-select-internal v) - (menudiag-redraw)) - (if (consp value) - (setq value (cons item value))) - (if done (menudiag-exit-minibuffer)))))))) - -(defun menudiag-select-internal (menu) - (let* ((minibuf-prompt (nth 1 menu)) - (current-items (nth 2 menu)) - (selection-list - (menudiag-make-selection-list current-items - (- (window-width (minibuffer-window)) - (string-width minibuf-prompt)))) - (line (car selection-list)) - (minibuf-contents - (menudiag-make-menu-formatted-string line))) - (let ((linepos 0) - (pos-in-line 0)) - (read-from-minibuffer minibuf-prompt - (cons minibuf-contents 3) - menudiag-mode-map)))) + (remove-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook) + (setq menudiag-minibuffer-list (cons (current-buffer) + menudiag-minibuffer-list)) + (buffer-disable-undo) + (menudiag-receive-variables) + (menudiag-beginning-of-items) + (when menudiag-continuation + (menudiag-follow-continuation)) + (when (and menudiag-show-all (null menudiag-done)) + (menudiag-list-other-window))) + +(defun menudiag-select-internal (menu all &optional continuation) + (menudiag-send-variables-with-value + menudiag-value menudiag-value + menudiag-continuation continuation + menudiag-return-contin menudiag-return-contin + menudiag-show-all all + menudiag-minibuf-prompt (cadr menu) + menudiag-current-items (car (cddr menu)) + menudiag-selection-list (menudiag-make-selection-list + (car (cddr menu)) + (- (window-width (minibuffer-window)) + (string-width (cadr menu))))) + (add-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook) + (unwind-protect + (progn + (read-from-minibuffer "" "" menudiag-mode-map) + (menudiag-receive-variables)) + (setq menudiag-minibuffer-list (cdr menudiag-minibuffer-list)) + (remove-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook) + ;; for egg's point-enterd/left hooks + (save-excursion + (goto-char (point-min))))) (defun menudiag-make-menu-formatted-string (item-list) (let ((i -1)) @@ -217,7 +278,7 @@ char)) ;; Character --> ITEM No -(defun menudiag-char-to-item-num (char) +(defun menudiag-char-to-item-num (ch) (let ((num)) (cond ((and (<= ?0 ch) (<= ch ?9)) (setq num (- ch ?0))) @@ -228,44 +289,52 @@ (t (setq num 1000))) num)) +(defun menudiag-check-current-menu () + (or (eq (current-buffer) (car menudiag-minibuffer-list)) + (error "menudiag: not current menu"))) + (defun menudiag-goto-item () (interactive) + (menudiag-check-current-menu) (let ((ch last-command-char) (n 0)) (setq n (menudiag-char-to-item-num ch)) - (if (>= n (length line)) + (if (>= n (length menudiag-line)) (error "No such item") (menudiag-goto-item-internal n) (if menudiag-select-without-return (menudiag-select-this-item))))) (defun menudiag-goto-item-internal (n) - (let ((old-pos-in-line pos-in-line) - (p 3) + (let ((p (+ (length menudiag-minibuf-prompt) 3)) (i 0)) - (setq pos-in-line n) - (while (< i pos-in-line) - (setq p (+ p (length (menudiag-item-string (nth i line))) 4)) + (setq menudiag-pos-in-line n) + (while (< i menudiag-pos-in-line) + (setq p (+ p (length (menudiag-item-string (nth i menudiag-line))) 4)) (setq i (1+ i))) (goto-char p))) (defun menudiag-beginning-of-items () (interactive) + (menudiag-check-current-menu) (menudiag-goto-line 0) (menudiag-beginning-of-line)) (defun menudiag-end-of-items () (interactive) - (menudiag-goto-line (1- (length selection-list))) + (menudiag-check-current-menu) + (menudiag-goto-line (1- (length menudiag-selection-list))) (menudiag-end-of-line)) (defun menudiag-beginning-of-line () (interactive) + (menudiag-check-current-menu) (menudiag-goto-item-internal 0)) (defun menudiag-end-of-line () (interactive) - (menudiag-goto-item-internal (1- (length line)))) + (menudiag-check-current-menu) + (menudiag-goto-item-internal (1- (length menudiag-line)))) ;; Should retain compatibility. Must. ;; @@ -296,127 +365,166 @@ ;; (insert (menudiag-make-menu-formatted-string line)))) ;; -(defun menudiag-forward-item () - (interactive) - (if (< pos-in-line (1- (length line))) - (menudiag-goto-item-internal (1+ pos-in-line)) - (if (>= linepos (1- (length selection-list))) - (menudiag-goto-line 0) - (menudiag-goto-line (1+ linepos))) - (menudiag-beginning-of-line))) - -(defun menudiag-backward-item () - (interactive) - (if (< 0 pos-in-line) - (menudiag-goto-item-internal (1- pos-in-line)) - (if (< linepos 1) - (menudiag-goto-line (1- (length selection-list))) - (menudiag-goto-line (1- linepos))) - (menudiag-end-of-line))) +(defun menudiag-forward-item (n) + (interactive "p") + (menudiag-forward-item-internal n)) + +(defun menudiag-backward-item (n) + (interactive "p") + (menudiag-forward-item-internal (- n))) + +(defun menudiag-forward-item-internal (n) + (menudiag-check-current-menu) + (setq n (+ n menudiag-pos-in-line)) + (while (< n 0) + (menudiag-goto-line (1- menudiag-linepos)) + (setq n (+ n (length menudiag-line)))) + (while (>= n (length menudiag-line)) + (setq n (- n (length menudiag-line))) + (menudiag-goto-line (1+ menudiag-linepos))) + (menudiag-goto-item-internal n)) (defun menudiag-goto-line (n) - (cond - ((>= n (length selection-list)) - (setq n 0)) - ((< n 0) - (setq n (1- (length selection-list))))) - (setq line (nth n selection-list) - linepos n) - (delete-region (point-min) (point-max)) - (insert (menudiag-make-menu-formatted-string line))) - -(defun menudiag-next-line () - (interactive) - (menudiag-goto-line (1+ linepos)) - (if (< pos-in-line (length line)) - (menudiag-goto-item-internal pos-in-line) - (menudiag-end-of-line))) - -(defun menudiag-previous-line () - (interactive) - (menudiag-goto-line (1- linepos)) - (if (< pos-in-line (length line)) - (menudiag-goto-item-internal pos-in-line) + (let ((len (length menudiag-selection-list))) + (when (< n 0) + (setq n (+ (% n len) len))) + (when (>= n len) + (setq n (% n len))) + (setq menudiag-line (nth n menudiag-selection-list) + menudiag-linepos n) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert menudiag-minibuf-prompt + (menudiag-make-menu-formatted-string menudiag-line)) + (set-text-properties (point-min) (point-max) '(read-only t))))) + +(defun menudiag-next-line (n) + (interactive "p") + (menudiag-next-line-internal n)) + +(defun menudiag-previous-line (n) + (interactive "p") + (menudiag-next-line-internal (- n))) + +(defun menudiag-next-line-internal (n) + (menudiag-check-current-menu) + (menudiag-goto-line (+ menudiag-linepos n)) + (if (< menudiag-pos-in-line (length menudiag-line)) + (menudiag-goto-item-internal menudiag-pos-in-line) (menudiag-end-of-line))) (defun menudiag-redraw () (interactive) - (menudiag-goto-line linepos) - (menudiag-goto-item-internal pos-in-line)) + (menudiag-check-current-menu) + (menudiag-goto-line menudiag-linepos) + (menudiag-goto-item-internal menudiag-pos-in-line)) (defun menudiag-exit-one-level () (interactive) + (menudiag-check-current-menu) (menudiag-exit-minibuffer)) (defun menudiag-exit () (interactive) - (setq done 'quit) + (menudiag-check-current-menu) + (unless menudiag-done + (setq menudiag-done 'quit)) (menudiag-exit-minibuffer)) -(defun menudiag-select-this-item () +(defun menudiag-select-this-item (&optional all) (interactive) - (let* ((item (nth pos-in-line line)) + (menudiag-check-current-menu) + (let* ((item (nth menudiag-pos-in-line menudiag-line)) (v (menudiag-item-value item))) (if (menudiag-menu-p v) - (unwind-protect - (progn - (menudiag-restore-window) - (menudiag-select-internal v) - (menudiag-redraw)) - (if (consp value) - (setq value (cons item value))) - (if done (menudiag-exit-minibuffer))) - (if (eq value t) - (setq value (menudiag-item-value item)) - (setq value (cons item nil))) - (setq done t) + (progn + (menudiag-restore-window) + (menudiag-select-internal v all) + (menudiag-redraw) + (cond (menudiag-done + (when menudiag-return-contin + (setq menudiag-value (cons item menudiag-value))) + (menudiag-exit-minibuffer)) + (all + (menudiag-list-other-window)))) + (setq menudiag-value (if menudiag-return-contin + (list item) + (menudiag-item-value item)) + menudiag-done t) (menudiag-exit-minibuffer)))) + +(defun menudiag-search-item (item) + (let ((selection-list menudiag-selection-list) + (line 0) + rest) + (while (and selection-list + (null (setq rest (memq item (car selection-list))))) + (setq selection-list (cdr selection-list) + line (1+ line))) + (and selection-list + (cons line (- (length (car selection-list)) (length rest)))))) (defconst menudiag-selection-map - (let ((map (make-sparse-keymap))) - (define-key map [right] 'next-completion) - (define-key map [left] 'previous-completion) - (define-key map "\r" 'menudiag-choose-item) - (define-key map [mouse-2] 'menudiag-mouse-choose-item) - map)) + (let ((map (make-sparse-keymap)) + (ch ?0)) + (while (<= ch ?9) + (define-key map (char-to-string ch) 'menudiag-selection-goto) + (setq ch (1+ ch))) + (define-key map "q" 'menudiag-retun-to-minibuf) + (define-key map "\C-b" 'previous-completion) + (define-key map "\M-b" 'previous-completion) + (define-key map "\C-f" 'next-completion) + (define-key map "\M-f" 'next-completion) + (define-key map " " 'next-completion) + (define-key map "\C-g" 'menudiag-selection-exit-one-level) + (define-key map "\C-m" 'menudiag-choose-item) + (define-key map "\C-]" 'menudiag-selection-exit) + (define-key map "\177" 'menudiag-selection-goto-delete) + (define-key map [delete] 'menudiag-selection-goto-delete) + (define-key map [backspace] 'menudiag-selection-goto-delete) + (define-key map [right] 'next-completion) + (define-key map [left] 'previous-completion) + (define-key map [return] 'menudiag-choose-item) + (define-key map [mouse-2] 'menudiag-mouse-choose-item) + map) + "keymap for menu selection mode") + +(defvar menudiag-window-conf nil) +(make-variable-buffer-local 'menudiag-window-conf) (defvar menudiag-selection-buffer nil) (make-variable-buffer-local 'menudiag-selection-buffer) -(put 'menudiag-selection-buffer 'permanent-local t) (defvar menudiag-selection-main-buffer nil) (make-variable-buffer-local 'menudiag-selection-main-buffer) -(put 'menudiag-selection-main-buffer 'permanent-local t) (defun menudiag-selection-mode () - (interactive) (kill-all-local-variables) (make-local-variable 'inhibit-read-only) (setq buffer-read-only t inhibit-read-only nil) + (make-local-hook 'post-command-hook) + (add-hook 'post-command-hook 'menudiag-selection-align-to-item nil t) (use-local-map menudiag-selection-map) (setq mode-name "Menudiag Selection") (setq major-mode 'menudiag-selection-mode)) -(defun menudiag-max-item-width (item-list) - (let ((max 0)) - (while item-list - (setq max (max max (menudiag-item-width (car item-list))) - item-list (cdr item-list))) - max)) +(defun menudiag-max-item-width (items) + (apply 'max (mapcar 'menudiag-item-width items))) (defun menudiag-buffer-show-function () - (let* ((items current-items) - (digits (length (concat (length items)))) - (columns (max 1 (/ (window-width (minibuffer-window)) + (menudiag-receive-variables) + (let* ((items menudiag-current-items) + (digits (length (number-to-string (length items)))) + (form (concat "%" (number-to-string digits) "d. %s")) + (columns (max 1 (/ (window-width (selected-window)) (+ digits (menudiag-max-item-width items))))) - (width (/ (window-width (minibuffer-window)) columns)) - (col 0) (n 0) str) + (width (/ (window-width (selected-window)) columns)) + (col 0) (n 0) str p) (insert " ") (while items (setq p (point) - str (format (concat "%" digits "d. %s") - n (menudiag-item-string (car items)))) + str (format form n (menudiag-item-string (car items)))) (insert str) (set-text-properties p (point) '(mouse-face highlight)) (setq col (1+ col) @@ -433,75 +541,156 @@ (defun menudiag-buffer-name (prompt) (let ((len (1- (length prompt)))) - (if (= (aref prompt len) ?:) (substring prompt 0 len) prompt))) + (generate-new-buffer-name + (if (= (aref prompt len) ?:) (substring prompt 0 len) prompt)))) (defun menudiag-list-other-window () (interactive) - (let ((temp-buffer-show-hook 'menudiag-buffer-show-function) - (main-buf (current-buffer))) - (setq menudiag-window-conf (current-window-configuration)) - (with-output-to-temp-buffer (menudiag-buffer-name minibuf-prompt) - (setq menudiag-selection-buffer standard-output)) - (set-buffer menudiag-selection-buffer) - (setq menudiag-selection-main-buffer main-buf))) + (menudiag-check-current-menu) + (let ((window (and menudiag-selection-buffer + (get-buffer-window menudiag-selection-buffer)))) + (if window + (select-window window) + (let ((temp-buffer-show-hook 'menudiag-buffer-show-function) + (main-buf (current-buffer)) + (selection-list menudiag-selection-list) + (linepos menudiag-linepos) + (n (1+ menudiag-pos-in-line))) + (setq menudiag-window-conf (current-window-configuration)) + (menudiag-send-variables menudiag-current-items) + (with-output-to-temp-buffer + (menudiag-buffer-name menudiag-minibuf-prompt) + (setq menudiag-selection-buffer standard-output)) + (switch-to-buffer-other-window menudiag-selection-buffer) + (setq menudiag-selection-main-buffer main-buf + menudiag-selection-list selection-list) + (while (> linepos 0) + (setq linepos (1- linepos) + n (+ n (length (car selection-list))) + selection-list (cdr selection-list))) + (next-completion n))))) + +(defun menudiag-check-current-menu-list () + (or (eq menudiag-selection-main-buffer (car menudiag-minibuffer-list)) + (error "menudiag: not current menu list"))) (defun menudiag-choose-item () (interactive) - (let ((org-buf menudiag-selection-main-buffer) - (sel-buf (current-buffer)) - (item-list selection-list) - (l 0) - tmp-buf n) - (with-temp-buffer - (setq tmp-buf (current-buffer)) - (set-buffer sel-buf) - (setq completion-reference-buffer tmp-buf) - (choose-completion) - (set-buffer tmp-buf) - (setq n (string-to-int (buffer-string)))) - (pop-to-buffer org-buf) - (while (and item-list (>= (- n (length (car item-list))) 0)) - (setq l (1+ l) - n (- n (length (car item-list))) - item-list (cdr item-list))) - (menudiag-goto-line l) - (menudiag-goto-item-internal n) - (menudiag-select-this-item))) + (menudiag-choose-item-internal nil)) (defun menudiag-mouse-choose-item (event) (interactive "e") - (set-buffer (window-buffer (car (nth 1 event)))) + (set-buffer (window-buffer (caadr event))) + (menudiag-choose-item-internal event)) + +(defun menudiag-choose-item-internal (event) + (menudiag-check-current-menu-list) (let ((org-buf menudiag-selection-main-buffer) (sel-buf (current-buffer)) - (item-list selection-list) + (item-list menudiag-selection-list) (l 0) tmp-buf n) (with-temp-buffer (setq tmp-buf (current-buffer)) (set-buffer sel-buf) (setq completion-reference-buffer tmp-buf) - (mouse-choose-completion event) + (if event + (mouse-choose-completion event) + (choose-completion)) (set-buffer tmp-buf) (setq n (string-to-int (buffer-string)))) (pop-to-buffer org-buf) - (while (and item-list (>= (- n (length (car item-list))) 0)) + (while (and item-list (>= n (length (car item-list)))) (setq l (1+ l) n (- n (length (car item-list))) item-list (cdr item-list))) (menudiag-goto-line l) (menudiag-goto-item-internal n) - (menudiag-select-this-item))) + (menudiag-select-this-item t))) + +(defvar menudiag-goto-number-list nil) +(make-variable-buffer-local 'menudiag-goto-number-list) + +(defvar menudiag-original-point nil) +(make-variable-buffer-local' menudiag-original-point) + +(defun menudiag-selection-goto () + (interactive) + (unless (eq last-command 'menudiag-selection-goto) + (setq menudiag-goto-number-list nil + menudiag-original-point (point))) + (setq menudiag-goto-number-list (cons (- last-command-char ?0) + menudiag-goto-number-list)) + (menudiag-selection-goto-internal)) + +(defun menudiag-selection-goto-internal () + (let* ((list menudiag-goto-number-list) + (n (menudiag-selection-item-number list)) + (len (save-excursion + (set-buffer menudiag-selection-main-buffer) + (length menudiag-current-items)))) + (setq this-command 'menudiag-selection-goto) + (if (>= n len) + (progn + (ding) + (setq menudiag-goto-number-list (cdr list))) + (goto-char (point-min)) + (next-completion (1+ n))))) + +(defun menudiag-selection-item-number (list) + (let ((n 0) + (exp 1)) + (while list + (setq n (+ (* (car list) exp) n) + exp (* 10 exp) + list (cdr list))) + n)) + +(defun menudiag-selection-goto-delete (n) + (interactive "p") + (if (null (eq last-command 'menudiag-selection-goto)) + (ding) + (setq menudiag-goto-number-list (nthcdr n menudiag-goto-number-list)) + (if (null menudiag-goto-number-list) + (goto-char menudiag-original-point) + (menudiag-selection-goto-internal)))) + +(defun menudiag-selection-align-to-item () + (cond ((bolp) + (next-completion 1)) + ((get-text-property (1- (point)) 'mouse-face) + (goto-char (previous-single-property-change (point) 'mouse-face))))) (defun menudiag-restore-window () - (if menudiag-window-conf - (progn - (set-window-configuration menudiag-window-conf) - (setq menudiag-window-conf nil) - (kill-buffer menudiag-selection-buffer)))) + (when menudiag-window-conf + (set-window-configuration menudiag-window-conf) + (kill-buffer menudiag-selection-buffer))) (defun menudiag-exit-minibuffer () - (and menudiag-window-conf (menudiag-restore-window)) + (menudiag-restore-window) + (menudiag-send-variables menudiag-done menudiag-value) + (buffer-enable-undo) (exit-minibuffer)) +(defun menudiag-retun-to-minibuf () + (interactive) + (menudiag-check-current-menu-list) + (unless (minibuffer-window-active-p (minibuffer-window)) + (set-minibuffer-window (minibuffer-window))) + (let ((window (get-buffer-window menudiag-selection-main-buffer))) + (if window + (select-window window) + (error "menudiag: cannot find minibuffer")))) + +(defun menudiag-selection-exit-one-level () + (interactive) + (set-buffer menudiag-selection-main-buffer) + (menudiag-exit-one-level)) + +(defun menudiag-selection-exit () + (interactive) + (set-buffer menudiag-selection-main-buffer) + (menudiag-exit)) + (provide 'menudiag) ;;; menudiag.el ends here.