+2000-06-02 KATAYAMA Yoshio <kate@pfu.co.jp>
+
+ * 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 <sanewo@ba2.so-net.ne.jp>
+
+ * egg/sj3rpc.el (sj3rpc-tanbunsetsu-conversion): should use
+ let* instead of let.
+
+2000-01-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <tomura@etl.go.jp>
* Version 4.0.6 released
# ;; 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 \
#
ITSSRCS = \
its/ascii.el \
+ its/aynu.el \
its/bixing.el \
its/erpin.el \
its/hankata.el \
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
(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)
(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)
(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))
(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)
(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)
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
(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)))
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")
(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)
(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.")
(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))
(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)
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))))
(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)
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)))))
(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))
(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)))
((<= 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))))
(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)
(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))))
(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)
(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))
(eval-and-compile
(define-ccl-program ccl-decode-egg-binary
- `(2
+ `(1
((read r0)
(loop
(if (r0 == ?\xff)
(write-read-repeat r0)))))
(define-ccl-program ccl-encode-egg-binary
- `(1
+ `(2
((read r0)
(loop
(if (r0 == ?\xff)
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).
(+ (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)
(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)))
+++ /dev/null
-;;; egg-sim.el --- EGG Simple Input Method
-
-;; Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000 TOMURA Satoru <tomura@etl.go.jp>
-
-
-;; Author: TOMURA Satoru <tomura@etl.go.jp>
-
-;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
-
-;; 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 <handa@etl.go.jp>
-;;; Moved from egg.el
-;;; 92.12.26 modified for Mule Ver.0.9.7 by T.Shingu <shingu@cpr.canon.co.jp>
-;;; 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 "\e$B5-9fF~NO\e(B:"
- (("JIS\e$BF~NO\e(B" . japanese-jisx0208)
- ("\e$B5-9f\e(B" .
- (menu "\e$B5-9f\e(B:" , (make-char-list 'japanese-jisx0208 1 2)))
- ("\e$B1Q?t;z\e(B" .
- (menu "\e$B1Q?t;z\e(B:" , (make-char-list 'japanese-jisx0208 3 3)))
- ("\e$B$R$i$,$J\e(B" .
- (menu "\e$B$R$i$,$J\e(B:" , (make-char-list 'japanese-jisx0208 4 4)))
- ("\e$B%+%?%+%J\e(B" .
- (menu "\e$B%+%?%+%J\e(B:" , (make-char-list 'japanese-jisx0208 5 5)))
- ("\e$B%.%j%7%cJ8;z\e(B" .
- (menu "\e$B%.%j%7%cJ8;z\e(B:" , (make-char-list 'japanese-jisx0208 6 6)))
- ("\e$B%-%j%kJ8;z\e(B" .
- (menu "\e$B%-%j%kJ8;z\e(B:" , (make-char-list 'japanese-jisx0208 7 7)))
- ("\e$B7S@~\e(B" .
- (menu "\e$B7S@~\e(B:" , (make-char-list 'japanese-jisx0208 8 8)))
- ;;;"\e$BIt<sF~NO\e(B" (bushyu-input)
- ;;; "\e$B2h?tF~NO\e(B" (kakusuu-input)
- ("\e$BBh0l?e=`\e(B" .
- (menu "\e$BBh0l?e=`\e(B:" , (make-char-list 'japanese-jisx0208 16 47)))
- ("\e$BBhFs?e=`\e(B" .
- (menu "\e$BBhFs?e=`\e(B:" , (make-char-list 'japanese-jisx0208 48 84)))
- ("\e$BJd=u4A;z\e(B" .
- (menu "\e$BJd=u4A;z\e(B:" , (make-char-list 'japanese-jisx0212 2 77)))))))))
-
-(defvar egg-sim-ipa-menu
- `(menu "IPA:" ,(make-char-list 'ipa)))
-
-(defvar egg-sisheng-menu
- `(menu "SiSheng characters" ,(make-char-list 'chinese-sisheng)))
-
-(defvar egg-sim-code-input-menu
- `(menu "Charset:"
- (("JISX0208" . japanese-jisx0208)
- ("JISX0212" . japanese-jisx0212)
- ("CNS11643-1" . chinese-cns11634-1)
- ("CNS11643-2" . chinese-cns11634-2)
- ("CNS11643-3" . chinese-cns11634-3)
- ("CNS11643-4" . chinese-cns11634-4)
- ("CNS11643-5" . chinese-cns11634-5)
- ("CNS11643-6" . chinese-cns11634-6)
- ("CNS11643-7" . chinese-cns11634-7)
- ("Big5-1" . chinese-big5-1)
- ("Big5-2" . chinese-big5-2)
- ("GB2312" . chinese-gb2312)
- ("KSC5601" . korean-ksc5601))))
-
-(defvar egg-simple-input-method-menu-item-list
- `(("Code Input" . ,egg-sim-code-input-menu)
- ("Arabic" . , egg-sim-arabic-menu)
- ("ASCII" . , egg-sim-ascii-menu)
- ("Chinese" . , egg-sim-chinese-menu)
- ("Cyrillic" . , egg-sim-cyrillic-menu)
- ("Greek" . , egg-sim-greek-menu)
- ("Hebrew" . , egg-sim-hebrew-menu)
- ("Japanese" . , egg-sim-japanese-menu)
- ("Korean" . , egg-sim-korean-menu)
- ("Latin" .
- (menu "Latin:"
- (("Latin-1" . , egg-sim-latin-1-menu)
- ("Latin-2" . , egg-sim-latin-2-menu)
- ("Latin-3" . , egg-sim-latin-3-menu)
- ("Latin-4" . , egg-sim-latin-4-menu)
- ("Latin-5" . , egg-sim-latin-5-menu))))
- ("Thai/Lao" .
- (menu "Thai/Lao:"
- (("Thai" . , egg-sim-thai-menu)
- ("Lao" . , egg-sim-lao-menu))))
- ("Vietnamese" . , egg-sim-vietnamese-menu)
- ("Phonetic code" .
- (menu "Phonetic code:"
- (("SISHENG" . , egg-sisheng-menu)
- ("IPA" . , egg-sim-ipa-menu))))
- ))
-
-(defvar egg-language-environment-alist
- `(("ASCII" . , egg-sim-ascii-menu)
- ("Chinese-BIG5" . , egg-sim-chinese-big5-menu)
- ("Chinese-CNS" . , egg-sim-chinese-cns-menu)
- ("Chinese-GB" . , egg-sim-chinese-gb-menu)
- ("Cyrillic-ISO" . , egg-sim-cyrillic-menu)
- ("Cyrillic-KOI8" . , egg-sim-cyrillic-menu)
- ("Cyrillic-ALT" . , egg-sim-cyrillic-menu)
- ("Czech" . , egg-sim-latin-2-menu)
- ("Devanagari")
- ("English" . , egg-sim-ascii-menu)
- ("Ethiopic")
- ("German" . , egg-sim-latin-1-menu)
- ("Greek" . , egg-sim-greek-menu)
- ("Hebrew" . , egg-sim-hebrew-menu)
- ("Hindi")
- ("IPA" . , egg-sim-ipa-menu)
- ("Japanese" . , egg-sim-japanese-menu)
- ("Korean" . , egg-sim-korean-menu)
- ("Lao" . , egg-sim-lao-menu)
- ("Latin-1" . , egg-sim-latin-1-menu)
- ("Latin-2" . , egg-sim-latin-2-menu)
- ("Latin-3" . , egg-sim-latin-3-menu)
- ("Latin-4" . , egg-sim-latin-4-menu)
- ("Latin-5" . , egg-sim-latin-5-menu)
- ("Romaian" . , egg-sim-latin-2-menu)
- ("Slovenian" . , egg-sim-latin-2-menu)
- ("Slovak" . , egg-sim-latin-2-menu)
- ("Thai" . , egg-sim-thai-menu)
- ("Tibetan")
- ("Turkish" . , egg-sim-latin-5-menu)
- ("Vietnamese" . , egg-sim-vietnamese-menu)))
-
-(defvar egg-simple-input-method-menu
- `(menu "Character set:" , egg-simple-input-method-menu-item-list))
-
-;;;;###autoload
-(defun egg-simple-input-method()
- (interactive)
- (let ((result (egg-simple-input-menu)))
- (cond((stringp result)
- (insert result))
- ((symbolp result)
- (egg-character-code-input result
- (format "%s/Character Code in Hexadecimal:"
- (charset-description result)))))))
-
-(defun egg-simple-input-menu ()
- (let ((menu (cdr-safe (assoc current-language-environment
- egg-language-environment-alist))))
- (if menu
- (menudiag-select
- `(menu "Character set:" ,(cons (cons current-language-environment
- menu)
- egg-simple-input-method-menu-item-list)))
- (menudiag-select egg-simple-input-method-menu))))
-
-(defun egg-character-code-input (charset prompt)
- (egg-insert-character-code-from-minibuffer charset prompt))
-
-(defun egg-insert-character-code-from-minibuffer (charset prompt)
- (let ((str (read-from-minibuffer prompt)) val)
- (while (null (setq val (egg-read-character-code-from-string str charset)))
- (beep)
- (setq str (read-from-minibuffer prompt str)))
- (insert (make-char charset (car val) (cdr val)))))
-
-(defun egg-hexadigit-value (ch)
- (cond((and (<= ?0 ch) (<= ch ?9))
- (- ch ?0))
- ((and (<= ?a ch) (<= ch ?f))
- (+ (- ch ?a) 10))
- ((and (<= ?A ch) (<= ch ?F))
- (+ (- ch ?A) 10))))
-
-(defun egg-read-character-code-from-string (str charset)
- (if (and (= (length str) 4)
- (<= 2 (egg-hexadigit-value (aref str 0)))
- (egg-hexadigit-value (aref str 1))
- (<= 2 (egg-hexadigit-value (aref str 2)))
- (egg-hexadigit-value (aref str 3)))
- (let ((code1 (+ (* 16 (egg-hexadigit-value (aref str 0)))
- (egg-hexadigit-value (aref str 1))))
- (code2 (+ (* 16 (egg-hexadigit-value (aref str 2)))
- (egg-hexadigit-value (aref str 3))))
- (min (if (= (charset-chars charset) 94)
- 33 32))
- (max (if (= (charset-chars charset) 94)
- 126 127)))
- (and (<= min code1)
- (<= code1 max)
- (<= min code2)
- (<= code2 max)
- (cons code1 code2)))))
-
-;;;
-;;;
-;;;
-
-(defun make-non-iso2022-code-table-file (name)
- (with-temp-file name
- (set-buffer-multibyte nil)
- (insert ";;; -*- coding: -*-\n\n")
- (insert " |")
-
- (let ((i 0))
- (while (< i 16)
- (insert (format " %X " i))
- (setq i (1+ i))))
- (insert "\n")
-
- (insert "-+")
- (let ((i 0))
- (while (< i 16)
- (insert (format "----" i))
- (setq i (1+ i))))
- (insert "\n")
-
- (let ((i 0))
- (while (< i 16)
- (insert (format "%X|" i))
- (let ((j 0) (c i))
- (while (< j 16)
- (insert (format " \"%c\"" c))
- (setq j (1+ j)
- c (+ c 16)))
- (insert (format "\n")))
- (setq i (1+ i))))))
-
-(defun make-iso2022-94char-code-table-file (name)
- (with-temp-file name
- (set-buffer-multibyte nil)
- (insert ";;; -*- coding: -*-\n\n")
- (insert " |")
- (let ((i 0))
- (while (< i 16)
- (insert (format " %X " i))
- (setq i (1+ i))))
- (insert "\n")
-
- (insert "-+")
- (let ((i 0))
- (while (< i 16)
- (insert (format "----" i))
- (setq i (1+ i))))
- (insert "\n")
-
- (let ((i 0))
- (while (< i 16)
- (insert (format "%X|" i))
- (let ((j 0) (c i))
- (while (< j 16)
- (if (or (<= c 31)
- (= c 127)
- (and (<= 128 c)
- (<= c 160))
- (= c 255))
- (insert " ")
- (insert (format " \"%c\"" c)))
- (setq j (1+ j)
- c (+ c 16)))
- (insert (format "\n")))
- (setq i (1+ i))))))
-
-(defun make-iso2022-96char-code-table-file (name)
- (with-temp-file name
- (set-buffer-multibyte nil)
- (insert ";;; -*- coding: -*-\n\n")
- (insert " |")
- (let ((i 0))
- (while (< i 16)
- (insert (format " %X " i))
- (setq i (1+ i))))
- (insert "\n")
-
- (insert "-+")
- (let ((i 0))
- (while (< i 16)
- (insert (format "----" i))
- (setq i (1+ i))))
- (insert "\n")
-
- (let ((i 0))
- (while (< i 16)
- (insert (format "%X|" i))
- (let ((j 0) (c i))
- (while (< j 16)
- (if (or (<= c 31)
- (= c 127)
- (and (<= 128 c)
- (< c 160)))
- (insert " ")
- (insert (format " \"%c\"" c)))
- (setq j (1+ j)
- c (+ c 16)))
- (insert (format "\n")))
- (setq i (1+ i))))))
-
-(defun make-euc-code-table-file (name)
- (with-temp-file name
- (set-buffer-multibyte nil)
- (insert ";;; -*- coding: -*-\n\n")
- (insert " |")
- (let ((i 1))
- (while (<= i 94)
- ;; "XX"
- (insert (format " %02d " i))
- (setq i (1+ i))))
- (insert "\n")
-
- (insert "-+")
- (let ((i 1))
- (while (<= i 94)
- (insert (format "-----" i))
- (setq i (1+ i))))
- (insert "\n")
-
- (let ((i 1))
- (while (<= i 94)
- (insert (format "%02d|" i))
- (let ((j 1))
- (while (<= j 94)
- (insert (format " \"%c%c\""
- (+ i 32 128)
- (+ j 32 128)))
- (setq j (1+ j)))
- (insert (format "\n")))
- (setq i (1+ i))))))
\ No newline at end of file
result)))))
(defvar egg-sim-ascii-menu
- '(menu "ASCII:" ,(make-char-list 'ascii)))
+ `(menu "ASCII:" ,(make-char-list 'ascii)))
(defvar egg-sim-latin-1-menu
`(menu "ISO 8859-1:" ,(make-char-list 'latin-iso8859-1)))
`(menu "Character set:" , egg-simple-input-method-menu-item-list))
;;;;###autoload
-(defun egg-simple-input-method()
+(defun egg-simple-input-method ()
(interactive)
(let ((result (egg-simple-input-menu)))
(cond((stringp result)
(+ j 32 128)))
(setq j (1+ j)))
(insert (format "\n")))
- (setq i (1+ i))))))
\ No newline at end of file
+ (setq i (1+ i))))))
+++ /dev/null
-
- | 0 1 2 3 4 5 6 7 8 9 A B C D E F
--+----------------------------------------------------------------
-0| " " "0" "@" "P" "`" "p" "\e,2U\e(B" "\e,20\e(B" "\e,2u\e(B" "\e,10\e(B" "\e,2`\e(B" "\e,2p\e(B" "\e,1`\e(B" "\e,1p\e(B"
-1| "!" "1" "A" "Q" "a" "q" "\e,2!\e(B" "\e,21\e(B" "\e,1!\e(B" "\e,11\e(B" "\e,2a\e(B" "\e,1Q\e(B" "\e,1a\e(B" "\e,1q\e(B"
-2| "\e,2F\e(B" """ "2" "B" "R" "b" "r" "\e,2"\e(B" "\e,22\e(B" "\e,1"\e(B" "\e,12\e(B" "\e,2b\e(B" "\e,2r\e(B" "\e,1b\e(B" "\e,1r\e(B"
-3| "#" "3" "C" "S" "c" "s" "\e,2#\e(B" "\e,25\e(B" "\e,1#\e(B" "\e,2^\e(B" "\e,2c\e(B" "\e,2s\e(B" "\e,1c\e(B" "\e,1s\e(B"
-4| "\e,2V\e(B" "$" "4" "D" "T" "d" "t" "\e,2$\e(B" "\e,2~\e(B" "\e,1$\e(B" "\e,2=\e(B" "\e,2d\e(B" "\e,2t\e(B" "\e,1d\e(B" "\e,1t\e(B"
-5| "\e,2G\e(B" "%" "5" "E" "U" "e" "u" "\e,2%\e(B" "\e,2>\e(B" "\e,1%\e(B" "\e,15\e(B" "\e,2e\e(B" "\e,1U\e(B" "\e,1e\e(B" "\e,1u\e(B"
-6| "\e,2g\e(B" "&" "6" "F" "V" "f" "v" "\e,2&\e(B" "\e,26\e(B" "\e,1&\e(B" "\e,16\e(B" "\e,1F\e(B" "\e,1V\e(B" "\e,1f\e(B" "\e,1v\e(B"
-7| "'" "7" "G" "W" "g" "w" "\e,2'\e(B" "\e,27\e(B" "\e,1'\e(B" "\e,17\e(B" "\e,1G\e(B" "\e,1W\e(B" "\e,1g\e(B" "\e,1w\e(B"
-8| "(" "8" "H" "X" "h" "x" "\e,2(\e(B" "\e,28\e(B" "\e,1(\e(B" "\e,18\e(B" "\e,2h\e(B" "\e,1X\e(B" "\e,1h\e(B" "\e,1x\e(B"
-9| "\e,2[\e(B" ")" "9" "I" "Y" "i" "y" "\e,2)\e(B" "\e,2v\e(B" "\e,1)\e(B" "\e,2q\e(B" "\e,2i\e(B" "\e,2y\e(B" "\e,1i\e(B" "\e,1y\e(B"
-A| "*" ":" "J" "Z" "j" "z" "\e,2*\e(B" "\e,2w\e(B" "\e,1*\e(B" "\e,2Q\e(B" "\e,2j\e(B" "\e,2z\e(B" "\e,1j\e(B" "\e,1z\e(B"
-B| "+" ";" "K" "[" "k" "{" "\e,2+\e(B" "\e,2o\e(B" "\e,1+\e(B" "\e,2W\e(B" "\e,2k\e(B" "\e,1[\e(B" "\e,1k\e(B" "\e,1{\e(B"
-C| "," "<" "L" "\" "l" "|" "\e,2,\e(B" "\e,2|\e(B" "\e,1,\e(B" "\e,2X\e(B" "\e,2l\e(B" "\e,1\\e(B" "\e,1l\e(B" "\e,1|\e(B"
-D| "-" "=" "M" "]" "m" "}" "\e,2-\e(B" "\e,2{\e(B" "\e,1-\e(B" "\e,1=\e(B" "\e,2m\e(B" "\e,2}\e(B" "\e,1m\e(B" "\e,1}\e(B"
-E| "\e,2\\e(B" "." ">" "N" "^" "n" "~" "\e,2.\e(B" "\e,2x\e(B" "\e,1.\e(B" "\e,1>\e(B" "\e,2n\e(B" "\e,1^\e(B" "\e,1n\e(B" "\e,1~\e(B"
-F| "/" "?" "O" "_" "o" "\e,2/\e(B" "\e,2O\e(B" "\e,1/\e(B" "\e,2_\e(B" "\e,1O\e(B" "\e,1_\e(B" "\e,1o\e(B" "\e,2f\e(B"
-
-"a" "\e,1`\e(B" "\e,1d\e(B" "\e,1c\e(B" "\e,1a\e(B" "\e,1U\e(B"
-"\e,1e\e(B" "\e,1"\e(B" "\e,1F\e(B" "\e,1G\e(B" "\e,1!\e(B" "\e,1#\e(B"
-"\e,1b\e(B" "\e,1%\e(B" "\e,1&\e(B" "\e,1g\e(B" "\e,1$\e(B" "\e,1'\e(B"
-"e" "\e,1i\e(B" "\e,1k\e(B" "\e,1(\e(B" "\e,1h\e(B" "\e,1)\e(B"
-"\e,1j\e(B" "\e,1*\e(B" "\e,1,\e(B" "\e,1-\e(B" "\e,1+\e(B" "\e,1.\e(B"
-"i" "\e,1m\e(B" "\e,1o\e(B" "\e,1n\e(B" "\e,1l\e(B" "\e,18\e(B"
-"o" "\e,1s\e(B" "\e,1v\e(B" "\e,1u\e(B" "\e,1r\e(B" "\e,1w\e(B"
-"\e,1t\e(B" "\e,1/\e(B" "\e,11\e(B" "\e,12\e(B" "\e,10\e(B" "\e,15\e(B"
-"\e,1=\e(B" "\e,1>\e(B" "\e,17\e(B" "\e,1^\e(B" "\e,16\e(B" "\e,1~\e(B"
-"u" "\e,1z\e(B" "\e,1|\e(B" "\e,1{\e(B" "\e,1y\e(B" "\e,1x\e(B"
-"\e,1_\e(B" "\e,1Q\e(B" "\e,1X\e(B" "\e,1f\e(B" "\e,1W\e(B" "\e,1q\e(B"
-"y" "\e,1}\e(B" "\e,1V\e(B" "\e,1[\e(B" "\e,1O\e(B" "\e,1\\e(B"
-
-"A" "\e,2`\e(B" "\e,2d\e(B" "\e,2c\e(B" "\e,2a\e(B" "\e,2U\e(B"
-"\e,2e\e(B" "\e,2"\e(B" "\e,2F\e(B" "\e,2G\e(B" "\e,2!\e(B" "\e,2#\e(B"
-"\e,2b\e(B" "\e,2%\e(B" "\e,2&\e(B" "\e,2g\e(B" "\e,2$\e(B" "\e,2'\e(B"
-"E" "\e,2h\e(B" "\e,2k\e(B" "\e,2(\e(B" "\e,2i\e(B" "\e,2)\e(B"
-"\e,2j\e(B" "\e,2+\e(B" "\e,2,\e(B" "\e,2-\e(B" "\e,2*\e(B" "\e,2.\e(B"
-"I" "\e,2l\e(B" "\e,2o\e(B" "\e,2n\e(B" "\e,2m\e(B" "\e,28\e(B"
-"O" "\e,2r\e(B" "\e,2v\e(B" "\e,2u\e(B" "\e,2s\e(B" "\e,2w\e(B"
-"\e,2t\e(B" "\e,20\e(B" "\e,21\e(B" "\e,22\e(B" "\e,2/\e(B" "\e,25\e(B"
-"\e,2=\e(B" "\e,26\e(B" "\e,27\e(B" "\e,2^\e(B" "\e,2>\e(B" "\e,2~\e(B"
-"U" "\e,2y\e(B" "\e,2|\e(B" "\e,2{\e(B" "\e,2z\e(B" "\e,2x\e(B"
-"\e,2_\e(B" "\e,2W\e(B" "\e,2X\e(B" "\e,2f\e(B" "\e,2Q\e(B" "\e,2q\e(B"
-"Y" "\e,2O\e(B" "\e,2V\e(B" "\e,2[\e(B" "\e,2}\e(B" "\e,2\\e(B"
-
-"\e,2p\e(B" "\e,1p\e(B"
\ No newline at end of file
(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."
(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)
(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
(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)
(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)))
\f
(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)
;;; 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
-;; <env> ::= [ <proc> <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 "\e$B%5!<%P$H@\B3$G$-$^$;$s$G$7$?\e(B")
+ (canna-fail-make-env "\e$B4D6-$r:n$k$3$H$O$G$-$^$;$s$G$7$?\e(B")
+ (canna-dict-missing-1 "\e$B<-=q%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s!#\e(B")
+ (canna-dict-missing-2 "\e$B<-=q%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? ")
+ (canna-dict-created "\e$B<-=q%U%!%$%k\e(B %s \e$B$r:n$j$^$7$?\e(B")
+ (canna-dict-saving "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9\e(B")
+ (canna-dict-saved "%s \e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?\e(B")
+ (canna-register-1 "\e$BEPO?<-=qL>\e(B:")
+ (canna-register-2 "\e$BIJ;lL>\e(B"))))
+
+(defvar canna-hinshi-alist
+ '(("\e$B?ML>\e(B" . "#JN") ("\e$BCOL>\e(B" . "#CN") ("\e$B8GM-L>;l\e(B" . "#KK")
+ ("\e$B0lHLL>;l\e(B" . "#T35") ("\e$BL>;l\e(B(\e$BNc\e(B)\e$B6/NO$J\e(B" . "#T15")
+ ("\e$B%5JQL>;l\e(B" . "#T30") ("\e$B%5JQL>;l\e(B(\e$BNc\e(B)\e$B0B?4$J\e(B" . "#T10") ("\e$BC14A;z\e(B" . "#KJ")
+ ("\e$BF0;l%+9TJQ3J3hMQ\e(B" . "#KX") ("\e$BF0;l%s%69TJQ3J3hMQ\e(B" . "#NZX")
+ ("\e$BF0;l%69TJQ3J3hMQ\e(B" . "#ZX") ("\e$BF0;l%59TJQ3J3hMQ\e(B" . "#SX")
+ ("\e$BF0;l%+9T8^CJ3hMQ\e(B" . "#K5") ("\e$BF0;l%,9T8^CJ3hMQ\e(B" . "#G5")
+ ("\e$BF0;l%59T8^CJ3hMQ\e(B" . "#S5") ("\e$BF0;l%?9T8^CJ3hMQ\e(B" . "#T5")
+ ("\e$BF0;l%J9T8^CJ3hMQ\e(B" . "#N5") ("\e$BF0;l%P9T8^CJ3hMQ\e(B" . "#B5")
+ ("\e$BF0;l%^9T8^CJ3hMQ\e(B" . "#M5") ("\e$BF0;l%i9T8^CJ3hMQ\e(B" . "#R5")
+ ("\e$BF0;l%o9T8^CJ3hMQ\e(B" . "#W5") ("\e$BF0;l>e2<0lCJ3hMQ\e(B" . "#KS")
+ ("\e$BF0;l%+9T8^CJO"MQL>;l\e(B" . "#K5r") ("\e$BF0;l%,9T8^CJO"MQL>;l\e(B" . "#G5r")
+ ("\e$BF0;l%59T8^CJO"MQL>;l\e(B" . "#S5r") ("\e$BF0;l%?9T8^CJO"MQL>;l\e(B" . "#T5r")
+ ("\e$BF0;l%J9T8^CJO"MQL>;l\e(B" . "#N5r") ("\e$BF0;l%P9T8^CJO"MQL>;l\e(B" . "#B5r")
+ ("\e$BF0;l%^9T8^CJO"MQL>;l\e(B" . "#M5r") ("\e$BF0;l%i9T8^CJO"MQL>;l\e(B" . "#R5r")
+ ("\e$BF0;l%o9T8^CJO"MQL>;l\e(B" . "#W5r") ("\e$BF0;l>e2<0lCJ8l44L>;l\e(B" . "#KSr")
+ ("\e$B7AMF;l\e(B" . "#KY") ("\e$B7AMF;l\e(B(\e$BNc\e(B)\e$B$-$$$m$$\e(B" . "#KYT")
+ ("\e$B7AMFF0;l\e(B" . "#T05")
+ ("\e$B7AMFF0;l\e(B(\e$BNc\e(B)\e$B4X?4$@\e(B" . "#T10") ("\e$B7AMFF0;l\e(B(\e$BNc\e(B)\e$BB?92$F$@\e(B" . "#T13")
+ ("\e$B7AMFF0;l\e(B(\e$BNc\e(B)\e$B0U30$@\e(B" . "#T15") ("\e$B7AMFF0;l\e(B(\e$BNc\e(B)\e$BJXMx$@\e(B" . "#T18")
+ ("\e$BI{;l\e(B" . "#F14") ("\e$BI{;l\e(B(\e$BNc\e(B)\e$B$U$C$/$i\e(B" . "#F04")
+ ("\e$BI{;l\e(B(\e$BNc\e(B)\e$B$=$C$H\e(B" . "#F12") ("\e$BI{;l\e(B(\e$BNc\e(B)\e$BFMA3\e(B" . "#F06")
+ ("\e$B?t;l\e(B" . "#NN") ("\e$B@\B3;l!&46F0;l\e(B" . "#CJ") ("\e$BO"BN;l\e(B" . "#RT")))
+
+(defvar canna-hinshi-menu
+ '("\e$B?ML>\e(B" "\e$BCOL>\e(B" ("\e$BCDBN!&2q<RL>\e(B" . "\e$B8GM-L>;l\e(B") ("\e$BL>;l\e(B" . MEISHI)
+ ("\e$B%5JQL>;l\e(B" . SAHEN-MEISHI) "\e$BC14A;z\e(B" ("\e$BF0;l\e(B" . DOUSHI)
+ ("\e$B7AMF;l\e(B" . KEIYOUSHI) ("\e$B7AMFF0;l\e(B" . KEIYOUDOUSHI) ("\e$BI{;l\e(B" . FUKUSHI)
+ "\e$B?t;l\e(B" "\e$B@\B3;l!&46F0;l\e(B" "\e$BO"BN;l\e(B" ("\e$B$=$NB>$N8GM-L>;l\e(B" . "\e$B8GM-L>;l\e(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
+;; <env> ::= [ <proc> <context> <backend> <convert-mode> <nostudy> <dic-list> ]
+(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))
-
-;; <bunsetsu> ::=
-;; [ <env> <converted> <bunsetsu-pos>
-;; <source> <zenkouho-pos> <zenkouho> ]
-(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))))
+
+;; <canna-bunsetsu> ::=
+;; [ <env> <converted> <bunsetsu-pos> <source>
+;; <zenkouho-pos> <zenkouho> <zenkouho-converted> ]
+(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 "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(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 "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
- name))
+ (format (egg-get-message 'canna-dict-missing-2) name))
(= (cannarpc-make-dictionary env name) 0))
- (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(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 \e$B$N=hM}E,Ev\e(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 \e$B3X=,\e(B 0 \e$B$7$J$$\e(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 "\e$B!V\e(B" kanji "\e$B$J!W$O@5$7$$$G$9$+!#\e(B")) "#T15" "#T35"))
+
+(defun canna-hinshi-SAHEN-MEISHI (kanji yomi)
+ (if (y-or-n-p (concat "\e$B!V\e(B" kanji "\e$B$J!W$O@5$7$$$G$9$+!#\e(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 "\e$B$/$0$9$D$L$V$`$k$&\e(B")
+ (re-gobi "\e$B$-$.$7$A$K$S$_$j$$\e(B")
+ (mi-gobi "\e$B$+$,$5$?$J$P$^$i$o\e(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 "\e$BFI$_$H8uJd$N3hMQ$,0c$$$^$9!#F~NO$7$J$*$7$F$/$@$5$$!#\e(B")
+ (egg-error "\e$BFI$_$H8uJd$r=*;_7A$GF~NO$7$F$/$@$5$$!#\e(B")))
+ (cond ((and (> (length kanji) 2) (> (length yomi) 2)
+ (string-match "\e$B$/$k\e(B$" kanji) (string-match "\e$B$/$k\e(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 "\e$B$s$:$k\e(B$" kanji) (string-match "\e$B$s$:$k\e(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 "\e$B$:$k\e(B$" kanji) (string-match "\e$B$:$k\e(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 "\e$B$9$k\e(B$" kanji) (string-match "\e$B$9$k\e(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 "\e$B!X\e(B" kanji "\e$B!Y$r\e(B (" (canna-hinshi-name ret)
+ ") \e$B$H$7$FEPO?$7$^$9$+\e(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 "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
+ (progn
+ (setq ret1 (y-or-n-p (concat "\e$B!V\e(B" kanji-gokan mizen
+ "\e$B$J$$!W$O@5$7$$$G$9$+!#\e(B")))
+ (setq i 0)
+ (if (eq "#R5" ret)
+ (while (> 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 "\e$B!V\e(B" kanji-gokan renyou
+ "\e$B$,$$$$!W$O@5$7$$$G$9$+!#\e(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 "\e$B$$\e(B$" yomi) (string-match "\e$B$$\e(B$" kanji)))
+ (egg-error "\e$BFI$_$H8uJd$r\e(B \e$B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc\e(B) \e$BAa$$\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 "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
+ (if (y-or-n-p (concat "\e$B!V\e(B" kanji "\e$B!W$O@5$7$$$G$9$+!#\e(B"))
+ "#KYT" "#KY")
+ "#KY"))
+ (list kanji yomi ret)))
+
+(defun canna-hinshi-KEIYOUDOUSHI (kanji yomi)
+ (let (ret1 ret2 ret)
+ (if (not (and (> (length kanji) 1) (> (length yomi) 1)
+ (string-match "\e$B$@\e(B$" yomi) (string-match "\e$B$@\e(B$" kanji)))
+ (egg-error "\e$BFI$_$H8uJd$r\e(B \e$B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc\e(B) \e$B@E$+$@\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 "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
+ (progn
+ (setq ret1 (y-or-n-p
+ (concat "\e$B!V\e(B" kanji "\e$B$9$k!W$O@5$7$$$G$9$+!#\e(B")))
+ (setq ret2 (y-or-n-p
+ (concat "\e$B!V\e(B" kanji "\e$B$,$"$k!W$O@5$7$$$G$9$+!#\e(B")))
+ (if ret1 (if ret2 "#T10" "#T13") (if ret2 "#T15" "#T18")))
+ "#T05"))
+ (list kanji yomi ret)))
+
+(defun canna-hinshi-FUKUSHI (kanji yomi)
+ (let (ret1 ret2)
+ (if (y-or-n-p "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
+ (progn
+ (setq ret1 (y-or-n-p (concat "\e$B!V\e(B" kanji "\e$B$9$k!W$O@5$7$$$G$9$+!#\e(B")))
+ (setq ret2 (y-or-n-p (concat "\e$B!V\e(B" kanji "\e$B$H!W$O@5$7$$$G$9$+!#\e(B")))
+ (if ret1 (if ret2 "#F04" "#F12") (if ret2 "#F06" "#F14")))
+ "#F14")))
+
+(defun canna-hinshi-select (kanji yomi)
+ (let ((key (menudiag-select (list 'menu
+ (egg-get-message 'canna-register-2)
+ canna-hinshi-menu))))
+ (cond ((symbolp key) (funcall
+ (intern (concat "canna-hinshi-" (symbol-name key)))
+ kanji yomi))
+ ((stringp key) (cdr (assoc key canna-hinshi-alist))))))
+
+(defun canna-word-registration (backend kanji yomi)
+ "Register a word KANJI with a pronunciation YOMI."
+ (if (or (null (eq (egg-get-language 0 kanji)
+ (canna-get-converted-language backend)))
+ (next-single-property-change 0 'egg-lang kanji)
+ (null (eq (egg-get-language 0 yomi)
+ (canna-get-source-language backend)))
+ (next-single-property-change 0 'egg-lang yomi))
+ (egg-error "word registration: invalid character")
+ (let* ((env (canna-get-environment backend))
+ (dic (canna-dictionary-select env))
+ (hinshi-id (canna-hinshi-select kanji yomi))
+ result)
+ (if (listp hinshi-id)
+ (progn (setq kanji (car hinshi-id))
+ (setq yomi (nth 1 hinshi-id))
+ (setq hinshi-id (nth 2 hinshi-id))))
+ (setq result (cannarpc-add-word env dic yomi kanji hinshi-id))
+ (if (>= 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 "\e$BEPO?$5$l$F$$$^$;$s!#\e(B"))
+ ((eq 1 (length kouho-list))
+ (setq zpos 0)
+ (setq kanji (car (car kouho-list))))
+ (t
+ (setq kanji (menudiag-select (list 'menu "\e$B:o=|\e(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 "\e$BIJ;l>pJs$,<hF@$G$-$^$;$s!#\e(B"))
+ (setq kanji (substring kanji 0 (nth 1 (car lex))))
+ (setq yomi (substring yomi 0 (car (car lex))))
+ (if (y-or-n-p (concat "\e$B!X\e(B" kanji "\e$B!Y\e(B(" yomi ": "
+ (canna-hinshi-name hinshi) ")\e$B$r\e(B "
+ dic " \e$B$+$i:o=|$7$^$9$+\e(B? "))
+ (setq result
+ (cannarpc-delete-word envd dic yomi kanji hinshi))
+ (setq result -1))
+ (if (>= 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.
((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
(goto-char (prog1 (point) (accept-process-output proc))))
receive-exprs))))
\f
-(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)
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))
(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
(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
(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))
(setq i (1+ i)))
bunsetsu-list))))
+(defun cannarpc-set-kugiri-changed (env yomi-length bunsetsu-pos)
+ ;; yomi-length -2\e$B!DJ8@a=L$a\e(B -1\e$B!DJ8@a?-$P$7\e(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.
(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 "\e$BEPO?<-=qL>\e(B:")
+ (sj3-register-2 "\e$BIJ;lL>\e(B"))))
+
+(defvar sj3-hinshi-menu
+ '(("\e$BL>;l\e(B" .
+ (menu "\e$BIJ;l\e(B:\e$BL>;l\e(B:"
+ (("\e$BL>;l\e(B" . 1)
+ ("\e$BL>;l\e(B(\e$B$*!D\e(B)" . 2)
+ ("\e$BL>;l\e(B(\e$B$4!D\e(B)" . 3)
+ ("\e$BL>;l\e(B(\e$B!DE*\e(B/\e$B2=\e(B)" . 4)
+ ("\e$BL>;l\e(B(\e$B$*!D$9$k\e(B)" . 5)
+ ("\e$BL>;l\e(B(\e$B!D$9$k\e(B)" . 6)
+ ("\e$BL>;l\e(B(\e$B$4!D$9$k\e(B)" . 7)
+ ("\e$BL>;l\e(B(\e$B!D$J\e(B/\e$B$K\e(B)" . 8)
+ ("\e$BL>;l\e(B(\e$B$*!D$J\e(B/\e$B$K\e(B)" . 9)
+ ("\e$BL>;l\e(B(\e$B$4!D$J\e(B/\e$B$K\e(B)" . 10)
+ ("\e$BL>;l\e(B(\e$BI{;l\e(B)" . 11))))
+ ("\e$BBeL>;l\e(B" . 12)
+ ("\e$BID;z\e(B" . 21)
+ ("\e$BL>A0\e(B" . 22)
+ ("\e$BCOL>\e(B" . 24)
+ ("\e$B8)\e(B/\e$B6hL>\e(B" . 25)
+ ("\e$BF0;l\e(B" .
+ (menu "\e$BIJ;l\e(B:\e$BF0;l\e(B:"
+ (("\e$B%5JQ8l44\e(B" . 80)
+ ("\e$B%6JQ8l44\e(B" . 81)
+ ("\e$B0lCJITJQ2=It\e(B" . 90)
+ ("\e$B%+9T8^CJ8l44\e(B" . 91)
+ ("\e$B%,9T8^CJ8l44\e(B" . 92)
+ ("\e$B%59T8^CJ8l44\e(B" . 93)
+ ("\e$B%?9T8^CJ8l44\e(B" . 94)
+ ("\e$B%J9T8^CJ8l44\e(B" . 95)
+ ("\e$B%P9T8^CJ8l44\e(B" . 96)
+ ("\e$B%^9T8^CJ8l44\e(B" . 97)
+ ("\e$B%i9T8^CJ8l44\e(B" . 98)
+ ("\e$B%o9T8^CJ8l44\e(B" . 99))))
+ ("\e$BO"BN;l\e(B" . 26)
+ ("\e$B@\B3;l\e(B" . 27)
+ ("\e$B=u?t;l\e(B" . 29)
+ ("\e$B?t;l\e(B" . 30)
+ ("\e$B@\F,8l\e(B" . 31)
+ ("\e$B@\Hx8l\e(B" . 36)
+ ("\e$BI{;l\e(B" . 45)
+ ("\e$BI{;l\e(B2" . 46)
+ ("\e$B7AMF;l8l44\e(B" . 60)
+ ("\e$B7AMFF0;l8l44\e(B" . 71)
+ ("\e$BC14A;z\e(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
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)))))
(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)
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)
(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")
;;;###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.
;;; 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)
((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")))))
(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)))
\f
(defun sj3rpc-open (proc myhostname username)
"Open the session. Return 0 on success, error code on failure."
myhostname username
;; program name
(format "%d.emacs-egg" (emacs-pid)))
- (comm-unpack (u) result)
+ (comm-unpack (i) result)
(if (= result -2)
0
result)))
(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)
(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)
(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)))
(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)
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)
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)
(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)))
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)
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)
(- 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.
(require 'egg-edep)
(defgroup wnn nil
- "Wnn interface for Tamagotchy"
+ "Wnn interface for Tamago 4."
:group 'egg)
(defcustom wnn-auto-save-dictionaries 0
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
(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)
(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)))
;;;###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.
(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)))))
\f
(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)
"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)
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)
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)
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)
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)))
""
(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)
""
(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)
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)
(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)))
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))))
""
(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)
(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))
"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)
(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)
(i 0)
j)
(while (< i ,n)
- (comm-unpack (u) j)
+ (comm-unpack (i) j)
(aset v i j)
(setq i (1+ i)))
v))
(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
(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
""
(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)
""
(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)
(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
(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)
(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
(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))))))
(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)
(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)
(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)
-;;; eggrc --- EGG Input Method Startup File
+;;; eggrc --- EGG Input Method Startup File -*- emacs-lisp -*-
;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
(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))
+ )
((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
(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
(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))
(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)
(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)))
(add-hook hook func t)
(funcall func)
(run-hooks hook)
- (setq hook nil))))
+ (set hook nil))))
;; Data structure for map compaction
;; <node> ::= (<count> <node#> <original node>) ; atom
;; | (<count> <node#> (<node> . <node>)) ; cons cell
;;
;; <count> ::= integer ; 0 or negative - usage count
-;; ; psotive - generated common sub-tree
+;; ; positive - generated common sub-tree
;;
;; <node#> ::= integer ; subject to compaction
;; | nil ; not subject to compaction
`(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))
(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)
(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)
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)
(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)
;; 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)))
(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))))
(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)))
\f
(defvar its-translation-result "" "")
(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 "")
;;; 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
+ (?\e$B!!\e(B . ?\ ) (?\e$B!$\e(B . ?,) (?\e$B!%\e(B . ?.) (?\e$B!"\e(B . ?,) (?\e$B!#\e(B . ?.)
+ (?\e$B!'\e(B . ?:) (?\e$B!(\e(B . ?\;) (?\e$B!)\e(B . ??) (?\e$B!*\e(B . ?!)
+ (?\e$B!-\e(B . ?') (?\e$B!.\e(B . ?`) (?\e$B!0\e(B . ?^) (?\e$B!2\e(B . ?_) (?\e$B!1\e(B . ?~)
+ (?\e$B!<\e(B . ?-) (?\e$B!=\e(B . ?-) (?\e$B!>\e(B . ?-)
+ (?\e$B!?\e(B . ?/) (?\e$B!@\e(B . ?\\) (?\e$B!A\e(B . ?~) (?\e$B!C\e(B . ?|)
+ (?\e$B!F\e(B . ?`) (?\e$B!G\e(B . ?') (?\e$B!H\e(B . ?\") (?\e$B!I\e(B . ?\")
+ (?\e$B!J\e(B . ?\() (?\e$B!K\e(B . ?\)) (?\e$B!N\e(B . ?[) (?\e$B!O\e(B . ?])
+ (?\e$B!P\e(B . ?{) (?\e$B!Q\e(B . ?}) (?\e$B!R\e(B . ?<) (?\e$B!S\e(B . ?>)
+ (?\e$B!\\e(B . ?+) (?\e$B!]\e(B . ?-) (?\e$B!a\e(B . ?=) (?\e$B!c\e(B . ?<) (?\e$B!d\e(B . ?>)
+ (?\e$B!l\e(B . ?') (?\e$B!m\e(B . ?\") (?\e$B!o\e(B . ?\\) (?\e$B!p\e(B . ?$) (?\e$B!s\e(B . ?%)
+ (?\e$B!t\e(B . ?#) (?\e$B!u\e(B . ?&) (?\e$B!v\e(B . ?*) (?\e$B!w\e(B . ?@)
+ (?\e$B#0\e(B . ?0) (?\e$B#1\e(B . ?1) (?\e$B#2\e(B . ?2) (?\e$B#3\e(B . ?3) (?\e$B#4\e(B . ?4)
+ (?\e$B#5\e(B . ?5) (?\e$B#6\e(B . ?6) (?\e$B#7\e(B . ?7) (?\e$B#8\e(B . ?8) (?\e$B#9\e(B . ?9)
+ (?\e$B#A\e(B . ?A) (?\e$B#B\e(B . ?B) (?\e$B#C\e(B . ?C) (?\e$B#D\e(B . ?D) (?\e$B#E\e(B . ?E)
+ (?\e$B#F\e(B . ?F) (?\e$B#G\e(B . ?G) (?\e$B#H\e(B . ?H) (?\e$B#I\e(B . ?I) (?\e$B#J\e(B . ?J)
+ (?\e$B#K\e(B . ?K) (?\e$B#L\e(B . ?L) (?\e$B#M\e(B . ?M) (?\e$B#N\e(B . ?N) (?\e$B#O\e(B . ?O)
+ (?\e$B#P\e(B . ?P) (?\e$B#Q\e(B . ?Q) (?\e$B#R\e(B . ?R) (?\e$B#S\e(B . ?S) (?\e$B#T\e(B . ?T)
+ (?\e$B#U\e(B . ?U) (?\e$B#V\e(B . ?V) (?\e$B#W\e(B . ?W) (?\e$B#X\e(B . ?X) (?\e$B#Y\e(B . ?Y)
+ (?\e$B#Z\e(B . ?Z)
+ (?\e$B#a\e(B . ?a) (?\e$B#b\e(B . ?b) (?\e$B#c\e(B . ?c) (?\e$B#d\e(B . ?d) (?\e$B#e\e(B . ?e)
+ (?\e$B#f\e(B . ?f) (?\e$B#g\e(B . ?g) (?\e$B#h\e(B . ?h) (?\e$B#i\e(B . ?i) (?\e$B#j\e(B . ?j)
+ (?\e$B#k\e(B . ?k) (?\e$B#l\e(B . ?l) (?\e$B#m\e(B . ?m) (?\e$B#n\e(B . ?n) (?\e$B#o\e(B . ?o)
+ (?\e$B#p\e(B . ?p) (?\e$B#q\e(B . ?q) (?\e$B#r\e(B . ?r) (?\e$B#s\e(B . ?s) (?\e$B#t\e(B . ?t)
+ (?\e$B#u\e(B . ?u) (?\e$B#v\e(B . ?v) (?\e$B#w\e(B . ?w) (?\e$B#x\e(B . ?x) (?\e$B#y\e(B . ?y)
+ (?\e$B#z\e(B . ?z))
+ (Chinese-GB
+ (?\e$A!!\e(B . ?\ ) (?\e$A#,\e(B . ?,) (?\e$A#.\e(B . ?.) (?\e$A!"\e(B . ?,) (?\e$A!#\e(B . ?.)
+ (?\e$A#:\e(B . ?:) (?\e$A#;\e(B . ?\;) (?\e$A#?\e(B . ??) (?\e$A#!\e(B . ?!)
+ (?\e$A#`\e(B . ?`) (?\e$A#^\e(B . ?^) (?\e$A#_\e(B . ?_) (?\e$A#~\e(B . ?~)
+ (?\e$A!*\e(B . ?-)
+ (?\e$A#/\e(B . ?/) (?\e$A#\\e(B . ?\\) (?\e$A!+\e(B . ?~) (?\e$A#|\e(B . ?|)
+ (?\e$A!.\e(B . ?`) (?\e$A!/\e(B . ?') (?\e$A!0\e(B . ?\") (?\e$A!1\e(B . ?\")
+ (?\e$A#(\e(B . ?\() (?\e$A#)\e(B . ?\)) (?\e$A#[\e(B . ?[) ( ?\e$A#]\e(B . ?])
+ (?\e$A#{\e(B . ?{) (?\e$A#}\e(B . ?})
+ (?\e$A#+\e(B . ?+) (?\e$A#-\e(B . ?-) (?\e$A#=\e(B . ?=) (?\e$A#<\e(B . ?<) (?\e$A#>\e(B . ?>)
+ (?\e$A#'\e(B . ?') (?\e$A#"\e(B . ?\") (?\e$A#$\e(B . ?$) (?\e$A#%\e(B . ?%)
+ (?\e$A##\e(B . ?#) (?\e$A#&\e(B . ?&) (?\e$A#*\e(B . ?*) (?\e$A#@\e(B . ?@)
+ (?\e$A#0\e(B . ?0) (?\e$A#1\e(B . ?1) (?\e$A#2\e(B . ?2) (?\e$A#3\e(B . ?3) (?\e$A#4\e(B . ?4)
+ (?\e$A#5\e(B . ?5) (?\e$A#6\e(B . ?6) (?\e$A#7\e(B . ?7) (?\e$A#8\e(B . ?8) (?\e$A#9\e(B . ?9)
+ (?\e$A#A\e(B . ?A) (?\e$A#B\e(B . ?B) (?\e$A#C\e(B . ?C) (?\e$A#D\e(B . ?D) (?\e$A#E\e(B . ?E)
+ (?\e$A#F\e(B . ?F) (?\e$A#G\e(B . ?G) (?\e$A#H\e(B . ?H) (?\e$A#I\e(B . ?I) (?\e$A#J\e(B . ?J)
+ (?\e$A#K\e(B . ?K) (?\e$A#L\e(B . ?L) (?\e$A#M\e(B . ?M) (?\e$A#N\e(B . ?N) (?\e$A#O\e(B . ?O)
+ (?\e$A#P\e(B . ?P) (?\e$A#Q\e(B . ?Q) (?\e$A#R\e(B . ?R) (?\e$A#S\e(B . ?S) (?\e$A#T\e(B . ?T)
+ (?\e$A#U\e(B . ?U) (?\e$A#V\e(B . ?V) (?\e$A#W\e(B . ?W) (?\e$A#X\e(B . ?X) (?\e$A#Y\e(B . ?Y)
+ (?\e$A#Z\e(B . ?Z)
+ (?\e$A#a\e(B . ?a) (?\e$A#b\e(B . ?b) (?\e$A#c\e(B . ?c) (?\e$A#d\e(B . ?d) (?\e$A#e\e(B . ?e)
+ (?\e$A#f\e(B . ?f) (?\e$A#g\e(B . ?g) (?\e$A#h\e(B . ?h) (?\e$A#i\e(B . ?i) (?\e$A#j\e(B . ?j)
+ (?\e$A#k\e(B . ?k) (?\e$A#l\e(B . ?l) (?\e$A#m\e(B . ?m) (?\e$A#n\e(B . ?n) (?\e$A#o\e(B . ?o)
+ (?\e$A#p\e(B . ?p) (?\e$A#q\e(B . ?q) (?\e$A#r\e(B . ?r) (?\e$A#s\e(B . ?s) (?\e$A#t\e(B . ?t)
+ (?\e$A#u\e(B . ?u) (?\e$A#v\e(B . ?v) (?\e$A#w\e(B . ?w) (?\e$A#x\e(B . ?x) (?\e$A#y\e(B . ?y)
+ (?\e$A#z\e(B . ?z))
+ (Chinese-CNS
+ (?\e$(G!!\e(B . ?\ ) (?\e$(G!"\e(B . ?,) (?\e$(G!%\e(B . ?.) (?\e$(G!#\e(B . ?,) (?\e$(G!$\e(B . ?.)
+ (?\e$(G!(\e(B . ?:) (?\e$(G!'\e(B . ?\;) (?\e$(G!)\e(B . ??) (?\e$(G!*\e(B . ?!)
+ (?\e$(G!k\e(B . ?') (?\e$(G!j\e(B . ?`) (?\e$(G!T\e(B . ?^) (?\e$(G"%\e(B . ?_) (?\e$(G"#\e(B . ?~)
+ (?\e$(G"@\e(B . ?-)
+ (?\e$(G"_\e(B . ?/) (?\e$(G"`\e(B . ?\\) (?\e$(G"a\e(B . ?/) (?\e$(G"b\e(B . ?\\)
+ (?\e$(G"D\e(B . ?~) (?\e$(G"^\e(B . ?|)
+ (?\e$(G!d\e(B . ?`) (?\e$(G!e\e(B . ?')
+ (?\e$(G!h\e(B . ?\") (?\e$(G!i\e(B . ?\") (?\e$(G!f\e(B . ?\") (?\e$(G!g\e(B . ?\")
+ (?\e$(G!>\e(B . ?\() (?\e$(G!?\e(B . ?\))
+ (?\e$(G!F\e(B . ?[) (?\e$(G!G\e(B . ?]) (?\e$(G!b\e(B . ?[) (?\e$(G!c\e(B . ?])
+ (?\e$(G!B\e(B . ?{) (?\e$(G!C\e(B . ?}) (?\e$(G!`\e(B . ?{) (?\e$(G!a\e(B . ?})
+ (?\e$(G!R\e(B . ?<) (?\e$(G!S\e(B . ?>)
+ (?\e$(G"0\e(B . ?+) (?\e$(G"1\e(B . ?-) (?\e$(G"8\e(B . ?=) (?\e$(G"6\e(B . ?<) (?\e$(G"7\e(B . ?>)
+ (?\e$(G"c\e(B . ?$) (?\e$(G"h\e(B . ?%)
+ (?\e$(G!l\e(B . ?#) (?\e$(G!m\e(B . ?&) (?\e$(G!n\e(B . ?*) (?\e$(G"i\e(B . ?@)
+ (?\e$(G$!\e(B . ?0) (?\e$(G$"\e(B . ?1) (?\e$(G$#\e(B . ?2) (?\e$(G$$\e(B . ?3) (?\e$(G$%\e(B . ?4)
+ (?\e$(G$&\e(B . ?5) (?\e$(G$'\e(B . ?6) (?\e$(G$(\e(B . ?7) (?\e$(G$)\e(B . ?8) (?\e$(G$*\e(B . ?9)
+ (?\e$(G$A\e(B . ?A) (?\e$(G$B\e(B . ?B) (?\e$(G$C\e(B . ?C) (?\e$(G$D\e(B . ?D) (?\e$(G$E\e(B . ?E)
+ (?\e$(G$F\e(B . ?F) (?\e$(G$G\e(B . ?G) (?\e$(G$H\e(B . ?H) (?\e$(G$I\e(B . ?I) (?\e$(G$J\e(B . ?J)
+ (?\e$(G$K\e(B . ?K) (?\e$(G$L\e(B . ?L) (?\e$(G$M\e(B . ?M) (?\e$(G$N\e(B . ?N) (?\e$(G$O\e(B . ?O)
+ (?\e$(G$P\e(B . ?P) (?\e$(G$Q\e(B . ?Q) (?\e$(G$R\e(B . ?R) (?\e$(G$S\e(B . ?S) (?\e$(G$T\e(B . ?T)
+ (?\e$(G$U\e(B . ?U) (?\e$(G$V\e(B . ?V) (?\e$(G$W\e(B . ?W) (?\e$(G$X\e(B . ?X) (?\e$(G$Y\e(B . ?Y)
+ (?\e$(G$Z\e(B . ?Z)
+ (?\e$(G$[\e(B . ?a) (?\e$(G$\\e(B . ?b) (?\e$(G$]\e(B . ?c) (?\e$(G$^\e(B . ?d) (?\e$(G$_\e(B . ?e)
+ (?\e$(G$`\e(B . ?f) (?\e$(G$a\e(B . ?g) (?\e$(G$b\e(B . ?h) (?\e$(G$c\e(B . ?i) (?\e$(G$d\e(B . ?j)
+ (?\e$(G$e\e(B . ?k) (?\e$(G$f\e(B . ?l) (?\e$(G$g\e(B . ?m) (?\e$(G$h\e(B . ?n) (?\e$(G$i\e(B . ?o)
+ (?\e$(G$j\e(B . ?p) (?\e$(G$k\e(B . ?q) (?\e$(G$l\e(B . ?r) (?\e$(G$m\e(B . ?s) (?\e$(G$n\e(B . ?t)
+ (?\e$(G$o\e(B . ?u) (?\e$(G$p\e(B . ?v) (?\e$(G$q\e(B . ?w) (?\e$(G$r\e(B . ?x) (?\e$(G$s\e(B . ?y)
+ (?\e$(G$t\e(B . ?z))
+ (Korean
+ (?\e$(C!!\e(B . ?\ ) (?\e$(C#,\e(B . ?,) (?\e$(C#.\e(B . ?.)
+ (?\e$(C#:\e(B . ?:) (?\e$(C#;\e(B . ?\;) (?\e$(C#?\e(B . ??) (?\e$(C#!\e(B . ?!)
+ (?\e$(C!/\e(B . ?') (?\e$(C!.\e(B . ?`) (?\e$(C#^\e(B . ?^) (?\e$(C#_\e(B . ?_) (?\e$(C#~\e(B . ?~)
+ (?\e$(C!*\e(B . ?-) (?\e$(C!)\e(B . ?-)
+ (?\e$(C#/\e(B . ?/) (?\e$(C!,\e(B . ?\\) (?\e$(C!-\e(B . ?~) (?\e$(C#|\e(B . ?|)
+ (?\e$(C!.\e(B . ?`) (?\e$(C!/\e(B . ?') (?\e$(C!0\e(B . ?\") (?\e$(C!1\e(B . ?\")
+ (?\e$(C#(\e(B . ?\() (?\e$(C#)\e(B . ?\)) (?\e$(C#[\e(B . ?[) (?\e$(C#]\e(B . ?])
+ (?\e$(C#{\e(B . ?{) (?\e$(C#}\e(B . ?}) (?\e$(C!4\e(B . ?<) (?\e$(C!5\e(B . ?>)
+ (?\e$(C#+\e(B . ?+) (?\e$(C#-\e(B . ?-) (?\e$(C#=\e(B . ?=) (?\e$(C#<\e(B . ?<) (?\e$(C#>\e(B . ?>)
+ (?\e$(C#'\e(B . ?') (?\e$(C#"\e(B . ?\") (?\e$(C#\\e(B . ?\\) (?\e$(C#$\e(B . ?$) (?\e$(C#%\e(B . ?%)
+ (?\e$(C##\e(B . ?#) (?\e$(C#&\e(B . ?&) (?\e$(C#*\e(B . ?*) (?\e$(C#@\e(B . ?@)
+ (?\e$(C#0\e(B . ?0) (?\e$(C#1\e(B . ?1) (?\e$(C#2\e(B . ?2) (?\e$(C#3\e(B . ?3) (?\e$(C#4\e(B . ?4)
+ (?\e$(C#5\e(B . ?5) (?\e$(C#6\e(B . ?6) (?\e$(C#7\e(B . ?7) (?\e$(C#8\e(B . ?8) (?\e$(C#9\e(B . ?9)
+ (?\e$(C#A\e(B . ?A) (?\e$(C#B\e(B . ?B) (?\e$(C#C\e(B . ?C) (?\e$(C#D\e(B . ?D) (?\e$(C#E\e(B . ?E)
+ (?\e$(C#F\e(B . ?F) (?\e$(C#G\e(B . ?G) (?\e$(C#H\e(B . ?H) (?\e$(C#I\e(B . ?I) (?\e$(C#J\e(B . ?J)
+ (?\e$(C#K\e(B . ?K) (?\e$(C#L\e(B . ?L) (?\e$(C#M\e(B . ?M) (?\e$(C#N\e(B . ?N) (?\e$(C#O\e(B . ?O)
+ (?\e$(C#P\e(B . ?P) (?\e$(C#Q\e(B . ?Q) (?\e$(C#R\e(B . ?R) (?\e$(C#S\e(B . ?S) (?\e$(C#T\e(B . ?T)
+ (?\e$(C#U\e(B . ?U) (?\e$(C#V\e(B . ?V) (?\e$(C#W\e(B . ?W) (?\e$(C#X\e(B . ?X) (?\e$(C#Y\e(B . ?Y)
+ (?\e$(C#Z\e(B . ?Z)
+ (?\e$(C#a\e(B . ?a) (?\e$(C#b\e(B . ?b) (?\e$(C#c\e(B . ?c) (?\e$(C#d\e(B . ?d) (?\e$(C#e\e(B . ?e)
+ (?\e$(C#f\e(B . ?f) (?\e$(C#g\e(B . ?g) (?\e$(C#h\e(B . ?h) (?\e$(C#i\e(B . ?i) (?\e$(C#j\e(B . ?j)
+ (?\e$(C#k\e(B . ?k) (?\e$(C#l\e(B . ?l) (?\e$(C#m\e(B . ?m) (?\e$(C#n\e(B . ?n) (?\e$(C#o\e(B . ?o)
+ (?\e$(C#p\e(B . ?p) (?\e$(C#q\e(B . ?q) (?\e$(C#r\e(B . ?r) (?\e$(C#s\e(B . ?s) (?\e$(C#t\e(B . ?t)
+ (?\e$(C#u\e(B . ?u) (?\e$(C#v\e(B . ?v) (?\e$(C#w\e(B . ?w) (?\e$(C#x\e(B . ?x) (?\e$(C#y\e(B . ?y)
+ (?\e$(C#z\e(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}"
;; 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:
--- /dev/null
+;;; its/aynu.el --- Aynu Katakana Input in Egg Input Method Architecture
+
+;; Copyright (C) 1999,2000 PFU LIMITED
+
+;; Author: KATAYAMA Yoshio <kate@pfu.co.jp>
+
+;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
+
+;; 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 "\e$(O!<\e(B" "*-") ; "-" "\e$(O!=\e(B"
+(defvar its-aynu-period "\e$(O!#\e(B " "*.") ; "." "\e$(O!#\e(B"
+(defvar its-aynu-comma "\e$(O!$\e(B " "*,") ; "," "\e$(O!$\e(B"
+(defvar its-aynu-open-bracket "\e$(O!V\e(B" "*[") ; "\e$(O!N\e(B"
+(defvar its-aynu-close-bracket "\e$(O!W\e(B" "*]") ; "\e$(O!O\e(B"
+
+(defvar its-aynu-enable-double-n nil "*Enable \"nn\" input for \"\e$(O%s\e(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 "\e$(O%#\e(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" "\e$(O&n\e(B" (("\e$(O%C\e(B" "[k]" -1)))
+ ("s" "\e$(O&o\e(B" (("\e$(O%C\e(B" "[s]" -1) (nil "[h]" -2)))
+ ("p" "\e$(O&x\e(B" (("\e$(O%C\e(B" "[p]" -1)))
+ ("m" "\e$(O&y\e(B" (("\e$(O%s\e(B" "[mp]" -1)))
+ ("t" "\e$(O%C\e(B") ("y" "\e$(O%#\e(B") ("w" "\e$(O%%\e(B"))))
+ `((?a ("h" "\e$(O&s\e(B") ("x" "\e$(O&s\e(B") ("r" "\e$(O&z\e(B") ,@common)
+ (?i ("h" "\e$(O&t\e(B") ("x" "\e$(O&t\e(B") ("r" "\e$(O&{\e(B") ,@common)
+ (?u ("h" "\e$(O&u\e(B") ("x" "\e$(O&u\e(B") ("r" "\e$(O&|\e(B") ,@common)
+ (?e ("h" "\e$(O&v\e(B") ("x" "\e$(O&v\e(B") ("r" "\e$(O&}\e(B") ,@common)
+ (?o ("h" "\e$(O&w\e(B") ("x" "\e$(O&w\e(B") ("r" "\e$(O&~\e(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")))
+ "\e$(O%e!<\e(B"))
+ (setq state (its-goto-state (concat conso "y")))
+ (its-set-output state (concat output "\e$(O%#\e(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" "\e$(O%"\e(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" "\e$(O%!\e(B") ("i" "\e$(O%#\e(B") ("u" "\e$(O%%\e(B") ("e" "\e$(O%'\e(B") ("o" "\e$(O%)\e(B")
+ ("ka" "\e$(O%u\e(B") ("ku" "\e$(O&n\e(B") ("ke" "\e$(O%v\e(B")
+ ("si" "\e$(O&o\e(B") ("su" "\e$(O&p\e(B")
+ ("tu" "\e$(O%C\e(B") ("to" "\e$(O&q\e(B")
+ ("nu" "\e$(O&r\e(B")
+ ("ha" "\e$(O&s\e(B") ("hi" "\e$(O&t\e(B") ("hu" "\e$(O&u\e(B") ("he" "\e$(O&v\e(B") ("ho" "\e$(O&w\e(B")
+ ("pu" "\e$(O&x\e(B")
+ ("mu" "\e$(O&y\e(B")
+ ("ya" "\e$(O%c\e(B") ("yu" "\e$(O%e\e(B") ("yo" "\e$(O%g\e(B")
+ ("ra" "\e$(O&z\e(B") ("ri" "\e$(O&{\e(B") ("ru" "\e$(O&|\e(B") ("re" "\e$(O&}\e(B") ("ro" "\e$(O&~\e(B")
+ ("wa" "\e$(O%n\e(B")))
+ (its-defrule (concat "x" (car small)) (cadr small)))
+
+ (its-define-aynu
+ ("" nil "\e$(O%"\e(B" "\e$(O%$\e(B" "\e$(O%&\e(B" "\e$(O%(\e(B" "\e$(O%*\e(B")
+ ("k" "\e$(O&n\e(B" "\e$(O%+\e(B" "\e$(O%-\e(B" "\e$(O%/\e(B" "\e$(O%1\e(B" "\e$(O%3\e(B")
+ ("g" "\e$(O%0\e(B" "\e$(O%,\e(B" "\e$(O%.\e(B" "\e$(O%0\e(B" "\e$(O%2\e(B" "\e$(O%4\e(B")
+ ("s" "\e$(O&p\e(B" "\e$(O%5\e(B" "\e$(O%7\e(B" "\e$(O%9\e(B" "\e$(O%;\e(B" "\e$(O%=\e(B")
+ ("z" nil "\e$(O%6\e(B" "\e$(O%8\e(B" "\e$(O%:\e(B" "\e$(O%<\e(B" "\e$(O%>\e(B")
+ ("vs" nil nil nil nil "\e$(O%|\e(B" nil)
+ ("sh" "\e$(O%7%c\e(B" "\e$(O%7%c\e(B" "\e$(O%7\e(B" "\e$(O%7%e\e(B" "\e$(O%7%'\e(B" "\e$(O%7%g\e(B")
+ ("j" nil "\e$(O%8%c\e(B" "\e$(O%8\e(B" "\e$(O%8%e\e(B" "\e$(O%8%'\e(B" "\e$(O%8%g\e(B")
+ ("t" "\e$(O%C\e(B" "\e$(O%?\e(B" "\e$(O%A\e(B" "\e$(O%H%%\e(B" "\e$(O%F\e(B" "\e$(O%H\e(B")
+ ("vt" nil nil nil "\e$(O%}\e(B" nil "\e$(O%~\e(B")
+ ("d" nil "\e$(O%@\e(B" "\e$(O%B\e(B" "\e$(O%E\e(B" "\e$(O%G\e(B" "\e$(O%I\e(B")
+ ("c" "\e$(O%C\e(B" "\e$(O%A%c\e(B" "\e$(O%A\e(B" "\e$(O%A%e\e(B" "\e$(O%A%'\e(B" "\e$(O%A%g\e(B")
+ ("ch" "\e$(O%C\e(B" "\e$(O%A%c\e(B" "\e$(O%A\e(B" "\e$(O%A%e\e(B" "\e$(O%A%'\e(B" "\e$(O%A%g\e(B")
+ ("n" "\e$(O%s\e(B" "\e$(O%J\e(B" "\e$(O%K\e(B" "\e$(O%L\e(B" "\e$(O%M\e(B" "\e$(O%N\e(B")
+ ("h" "\e$(O&s\e(B" "\e$(O%O\e(B" "\e$(O%R\e(B" "\e$(O%U\e(B" "\e$(O%X\e(B" "\e$(O%[\e(B")
+ ("b" nil "\e$(O%P\e(B" "\e$(O%S\e(B" "\e$(O%V\e(B" "\e$(O%Y\e(B" "\e$(O%\\e(B")
+ ("p" "\e$(O&x\e(B" "\e$(O%Q\e(B" "\e$(O%T\e(B" "\e$(O%W\e(B" "\e$(O%Z\e(B" "\e$(O%]\e(B")
+ ("m" "\e$(O&y\e(B" "\e$(O%^\e(B" "\e$(O%_\e(B" "\e$(O%`\e(B" "\e$(O%a\e(B" "\e$(O%b\e(B")
+ ("y" "\e$(O%#\e(B" "\e$(O%d\e(B" "\e$(O%#\e(B" "\e$(O%f\e(B" "\e$(O%$%'\e(B" "\e$(O%h\e(B")
+ ("r" "\e$(O&|\e(B" "\e$(O%i\e(B" "\e$(O%j\e(B" "\e$(O%k\e(B" "\e$(O%l\e(B" "\e$(O%m\e(B")
+ ("w" "\e$(O%%\e(B" "\e$(O%o\e(B" "\e$(O%&%#\e(B" "\e$(O%%\e(B" "\e$(O%&%'\e(B" "\e$(O%&%)\e(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" "\e$(O%C\e(B" -1)
+ (its-defrule "ss" "\e$(O%C\e(B" -1)
+ (its-defrule "pp" "\e$(O%C\e(B" -1)
+ (its-defrule "vv" "\e$(O%C\e(B" -1)
+
+;; SYMBOL Input
+ (its-defrule "z1" "\e$(O!{\e(B") (its-defrule "z!" "\e$(O!|\e(B")
+ (its-defrule "z2" "\e$(O"&\e(B") (its-defrule "z@" "\e$(O"'\e(B")
+ (its-defrule "z3" "\e$(O"$\e(B") (its-defrule "z#" "\e$(O"%\e(B")
+ (its-defrule "z4" "\e$(O""\e(B") (its-defrule "z$" "\e$(O"#\e(B")
+ (its-defrule "z5" "\e$(O!~\e(B") (its-defrule "z%" "\e$(O"!\e(B")
+ (its-defrule "z6" "\e$(O!y\e(B") (its-defrule "z^" "\e$(O!z\e(B")
+ (its-defrule "z7" "\e$(O!}\e(B") (its-defrule "z&" "\e$(O!r\e(B")
+ (its-defrule "z8" "\e$(O!q\e(B") (its-defrule "z*" "\e$(O!_\e(B")
+ (its-defrule "z9" "\e$(O!i\e(B") (its-defrule "z(" "\e$(O!Z\e(B")
+ (its-defrule "z0" "\e$(O!j\e(B") (its-defrule "z)" "\e$(O![\e(B")
+ (its-defrule "z-" "\e$(O!A\e(B") (its-defrule "z_" "\e$(O!h\e(B")
+ (its-defrule "z=" "\e$(O!b\e(B") (its-defrule "z+" "\e$(O!^\e(B")
+ (its-defrule "z\\" "\e$(O!@\e(B") (its-defrule "z|" "\e$(O!B\e(B")
+ (its-defrule "z`" "\e$(O!-\e(B") (its-defrule "z~" "\e$(O!/\e(B")
+
+ (its-defrule "zq" "\e$(O!T\e(B") (its-defrule "zQ" "\e$(O!R\e(B")
+ (its-defrule "zw" "\e$(O!U\e(B") (its-defrule "zW" "\e$(O!S\e(B")
+ ; e
+ (its-defrule "zr" "\e$(O!9\e(B") (its-defrule "zR" "\e$(O!8\e(B")
+ (its-defrule "zt" "\e$(O!:\e(B") (its-defrule "zT" "\e$(O!x\e(B")
+ ; y u i o
+ (its-defrule "zp" "\e$(O")\e(B") (its-defrule "zP" "\e$(O",\e(B")
+ (its-defrule "z[" "\e$(O!X\e(B") (its-defrule "z{" "\e$(O!L\e(B")
+ (its-defrule "z]" "\e$(O!Y\e(B") (its-defrule "z}" "\e$(O!M\e(B")
+ ; a
+ (its-defrule "zs" "\e$(O!3\e(B") (its-defrule "zS" "\e$(O!4\e(B")
+ (its-defrule "zd" "\e$(O!5\e(B") (its-defrule "zD" "\e$(O!6\e(B")
+ (its-defrule "zf" "\e$(O!7\e(B") (its-defrule "zF" "\e$(O"*\e(B")
+ (its-defrule "zg" "\e$(O!>\e(B") (its-defrule "zG" "\e$(O!=\e(B")
+ (its-defrule "zh" "\e$(O"+\e(B")
+ (its-defrule "zj" "\e$(O"-\e(B")
+ (its-defrule "zk" "\e$(O",\e(B")
+ (its-defrule "zl" "\e$(O"*\e(B")
+ (its-defrule "z;" "\e$(O!+\e(B") (its-defrule "z:" "\e$(O!,\e(B")
+ (its-defrule "z\'" "\e$(O!F\e(B") (its-defrule "z\"" "\e$(O!H\e(B")
+ ; z
+ (its-defrule "zx" ":-") (its-defrule "zX" ":-)")
+ (its-defrule "zc" "\e$(O!;\e(B") (its-defrule "zC" "\e$(O!n\e(B")
+ (its-defrule "zv" "\e$(O"(\e(B") (its-defrule "zV" "\e$(O!`\e(B")
+ (its-defrule "zb" "\e$(O!k\e(B") (its-defrule "zB" "\e$(O"+\e(B")
+ (its-defrule "zn" "\e$(O!l\e(B") (its-defrule "zN" "\e$(O"-\e(B")
+ (its-defrule "zm" "\e$(O!m\e(B") (its-defrule "zM" "\e$(O".\e(B")
+ (its-defrule "z," "\e$(O!E\e(B") (its-defrule "z<" "\e$(O!e\e(B")
+ (its-defrule "z." "\e$(O!D\e(B") (its-defrule "z>" "\e$(O!f\e(B")
+ (its-defrule "z/" "\e$(O!&\e(B") (its-defrule "z?" "\e$(O!g\e(B")
+ )
+
+(define-its-state-machine-append its-aynu-map
+ (if its-aynu-enable-double-n
+ (its-defrule "nn" "\e$(O%s\e(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" "\e$(O#1\e(B") (its-defrule "2" "\e$(O#2\e(B")
+ (its-defrule "3" "\e$(O#3\e(B") (its-defrule "4" "\e$(O#4\e(B")
+ (its-defrule "5" "\e$(O#5\e(B") (its-defrule "6" "\e$(O#6\e(B")
+ (its-defrule "7" "\e$(O#7\e(B") (its-defrule "8" "\e$(O#8\e(B")
+ (its-defrule "9" "\e$(O#9\e(B") (its-defrule "0" "\e$(O#0\e(B")
+ (its-defrule "!" "\e$(O!*\e(B") (its-defrule "@" "\e$(O!w\e(B")
+ (its-defrule "#" "\e$(O!t\e(B") (its-defrule "$" "\e$(O!p\e(B")
+ (its-defrule "%" "\e$(O!s\e(B") (its-defrule "^" "\e$(O!0\e(B")
+ (its-defrule "&" "\e$(O!u\e(B") (its-defrule "*" "\e$(O!v\e(B")
+ (its-defrule "(" "\e$(O!J\e(B") (its-defrule ")" "\e$(O!K\e(B")
+ (its-defrule "=" "\e$(O!a\e(B") (its-defrule "`" "\e$(O!.\e(B")
+ (its-defrule "\\" "\e$(O!o\e(B") (its-defrule "|" "\e$(O!C\e(B")
+ (its-defrule "_" "\e$(O!2\e(B") (its-defrule "+" "\e$(O!\\e(B")
+ (its-defrule "{" "\e$(O!P\e(B") (its-defrule "}" "\e$(O!Q\e(B")
+ (its-defrule ":" "\e$(O!'\e(B") (its-defrule ";" "\e$(O!(\e(B")
+ (its-defrule "\"" "\e$(O!I\e(B") (its-defrule "'" "\e$(O!G\e(B")
+ (its-defrule "<" "\e$(O!c\e(B") (its-defrule ">" "\e$(O!d\e(B")
+ (its-defrule "?" "\e$(O!)\e(B") (its-defrule "/" "\e$(O!?\e(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.
;; 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:
;; 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:
;; Author: KATAYAMA Yoshio <kate@pfu.co.jp>
-;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>\ 1
+;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
;; Keywords: mule, multilingual, input method
;; 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:
(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)
(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.
("4" "\e,T@\e(B" consonant) ("$" "\e,Ts\e(B")
("5" "\e,T6\e(B" consonant) ("%" "\e,Tt\e(B")
("6" "\e,TX\e(B" vowel) ("^" "\e,TY\e(B" vowel)
- ("7" "\e,TV\e(B" vowel) ("&" "\e0\e,TQi\e(B\e1" vowel)
+ ("7" "\e,TV\e(B" vowel) ("&" "\e0\e,TQi\e1\e(B" vowel)
("8" "\e,T$\e(B" consonant) ("*" "\e,Tu\e(B")
("9" "\e,T5\e(B" consonant) ("(" "\e,Tv\e(B")
("0" "\e,T(\e(B" consonant) (")" "\e,Tw\e(B")
;; 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:
(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) "\e(0B\e(B"))
- (its-defrule (concat (car N) 3) (concat (nth 1 N) "\e(0C\e(B"))
- (its-defrule (concat (car N) 4) (concat (nth 1 N) "\e(0D\e(B")))))
+ (its-defrule (concat (car N) "2") (concat (nth 1 N) "\e(0B\e(B"))
+ (its-defrule (concat (car N) "3") (concat (nth 1 N) "\e(0C\e(B"))
+ (its-defrule (concat (car N) "4") (concat (nth 1 N) "\e(0D\e(B")))))
(define-its-state-machine its-zhuyin-cn-map
"zhuyin-cn" "\e$AW"\e(BG" Chinese-GB
--- /dev/null
+;;; jisx0213.el --- Charset Definition for JIS X 0213
+
+;; Copyright (C) 1999,2000 PFU LIMITED
+
+;; Author: KATAYAMA Yoshio <kate@pfu.co.jp>
+
+;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
+
+;; 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"])
;;; 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
'its-select-hiragana)
(register-input-method
+ "japanese-egg-canna" "Japanese" 'egg-activate-canna
+ "\e$B$"\e(B.." "Romaji -> Hiragana -> Kanji&Kana"
+ 'its-select-hiragana)
+
+ (register-input-method
"chinese-gb-egg-wnn-py" "Chinese-GB" 'egg-activate-wnn
"\e$AF4\e(BG" "Pinyin -> Simplified Hanzi"
'its-select-pinyin-cn)
(defgroup sj3 nil ""
:group 'egg :load "egg/sj3")
+(defgroup canna nil ""
+ :group 'egg :load "egg/canna")
+
(defgroup its nil ""
:group 'egg :load "its")
(message "Finished loading %s \n and load others..." load-file-name)
(load-leim-list-except-this)
- )
\ No newline at end of file
+ )
;;
(defgroup menudiag nil
- "Input Translation System of Tamagotchy"
+ "Input Translation System of Tamago 4."
:group 'egg)
(defcustom menudiag-select-without-return nil
(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.")
(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)
(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))
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)))
(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.
;;
;; (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))))))
\f
(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)
(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.
OSDN Git Service
