X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=canna.el;h=c2a47fe8a98653dae039df2da2bc5a9bff9e4795;hb=c1dba5b92c20c05cbf9ad30688e834b6231fde07;hp=d9b231ab3d5ca9a8738aa82ff2a1a8edf4e066d6;hpb=ddb3d13fba665ccb23db3715e18eca584a1d12a4;p=elisp%2Femacs-canna.git diff --git a/canna.el b/canna.el index d9b231a..c2a47fe 100644 --- a/canna.el +++ b/canna.el @@ -1,38 +1,94 @@ -;; This file is a part of Canna on Nemacs/Mule. +;;; canna.el --- Interface to the Canna input method. -;; Canna on Nemacs/Mule is distributed in the forms of -;; patches to Nemacs under the terms of the GNU EMACS -;; GENERAL PUBLIC LICENSE which is distributed along with -;; GNU Emacs by the Free Software Foundation. +;; Copyright (C) 1994 Akira Kon, NEC Corporation. +;; Copyright (C) 1996,1997,1998 MORIOKA Tomohiko +;; Copyright (C) 1997 Stephen Turnbull -;; Canna on Nemacs/Mule 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 EMACS GENERAL PUBLIC -;; LICENSE for more details. +;; Author: Akira Kon +;; MORIOKA Tomohiko +;; Stephen Turnbull +;; Version: $Revision: 1.16 $ +;; Keywords: Canna, Japanese, input method, mule, multilingual -;; You should have received a copy of the GNU EMACS GENERAL -;; PUBLIC LICENSE along with Nemacs/Mule; see the file -;; COPYING. If not, write to the Free Software Foundation, -;; 675 Mass Ave, Cambridge, MA 02139, USA. +;; This file is part of Emacs-Canna. -;; Egg offered some influences to the implementation of -;; Canna on Nemacs/Mule, and this file contains a few part -;; of Egg which is written by S.Tomura, Electrotechnical -;; Lab. (tomura@etl.go.jp) +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. -;; Written by Akira Kon, NEC Corporation. -;; E-Mail: kon@d1.bs2.mt.nec.co.jp. +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. -;; -*-mode: emacs-lisp-*- +;; 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. -(defconst canna-rcs-version "Canna/mule 2.x, based on Canna 2.2/3.2. : canna.el,v x.xx 1994/11/7 00:00:00") +;;; Commentary: + +;; Egg offered some influences to the implementation of Canna on +;; Nemacs/Mule, and this file contains a few part of Egg which is +;; written by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp) + +;; This program is rewritten for Emacs/mule and XEmacs/mule by MORIOKA +;; Tomohiko. + +;;; Code: + +(require 'poem) + +(eval-and-compile + (defvar canna-dl-module + (expand-file-name "canna.so" exec-directory)) + + (defvar canna-dl-handle + (and (not (boundp 'CANNA)) + (fboundp 'dynamic-link) + (dynamic-link canna-dl-module))) + + (and canna-dl-handle + (dynamic-call "emacs_canna_init" canna-dl-handle)) + ) + +(or (boundp 'CANNA) + (featurep 'CANNA) + (error "Canna is not built into this Emacs")) + +(defvar self-insert-after-hook nil) +;; (defalias 'self-insert-internal 'self-insert-command) +;; end + +(defconst canna-rcs-version + "$Id: canna.el,v 1.16 1998-10-21 06:36:55 morioka Exp $") (defun canna-version () + "Display version of canna.el in mini-buffer." (interactive) - (message (concat (substring canna-rcs-version 0 72) " ...")) ) + (message (concat + (substring canna-rcs-version + 5 + (if (string-match "[0-9] [a-z]" canna-rcs-version) + (1+ (match-beginning 0)) + )) + " ..."))) + +(if (featurep 'xemacs) + (defun canna-self-insert-string (string) + (let ((len (length string)) + (i 0) + ;; 挿入の途中で blink が起きるとうっとおしいので、 + ;; 一時的に blink を抑止する。 + (blink-matching-paren nil)) + (while (< i len) + (self-insert-internal (aref canna-kakutei-string i)) + (setq i (1+ i)) + ))) + (defalias 'canna-self-insert-string 'insert) + ) -(provide 'canna) ;;; かんなの変数 @@ -124,19 +180,42 @@ (canna:memq-recursive a (cdr l)) ))) (defun canna:create-mode-line () - (if (not (canna:memq-recursive 'mode-line-canna-mode mode-line-format)) - (setq-default - mode-line-format - (append (list (list 'minibuffer-window-selected - (list 'display-minibuffer-mode-in-minibuffer - "-" "m") "-") - (list 'minibuffer-window-selected - (list 'display-minibuffer-mode-in-minibuffer - 'mode-line-canna-mode - 'mode-line-canna-mode-in-minibuffer) - 'mode-line-canna-mode)) - mode-line-format))) - (mode-line-canna-mode-update mode-line-canna-mode) ) + "Add string of Canna status into mode-line." + (cond ((featurep 'xemacs) + (or (canna:memq-recursive 'mode-line-canna-mode + default-modeline-format) + (setq-default default-modeline-format + (nconc '("" mode-line-canna-mode) + default-modeline-format)) + ) + (mapcar (function + (lambda (buffer) + (save-excursion + (set-buffer buffer) + (or (canna:memq-recursive 'mode-line-canna-mode + modeline-format) + (setq modeline-format + (nconc '("" mode-line-canna-mode) + modeline-format)) + ) + ))) + (buffer-list)) + ) + (t + (or (canna:memq-recursive 'mode-line-canna-mode mode-line-format) + (setq-default + mode-line-format + (append (list (list 'minibuffer-window-selected + (list 'display-minibuffer-mode-in-minibuffer + "-" "m") "-") + (list 'minibuffer-window-selected + (list 'display-minibuffer-mode-in-minibuffer + 'mode-line-canna-mode + 'mode-line-canna-mode-in-minibuffer) + 'mode-line-canna-mode)) + mode-line-format)) + ))) + (mode-line-canna-mode-update mode-line-canna-mode)) (defun canna:mode-line-display () (mode-line-canna-mode-update mode-line-canna-mode)) @@ -219,20 +298,38 @@ t の時はデフォルトの色を使用する。 (define-key canna-mode-map (make-string 1 ch) 'canna-functional-insert-command) (setq ch (1+ ch)))) -(define-key canna-mode-map [up] [?\C-p]) -(define-key canna-mode-map [S-up] [?\C-p]) -(define-key canna-mode-map [C-up] [?\C-p]) -(define-key canna-mode-map [down] [?\C-n]) -(define-key canna-mode-map [S-down] [?\C-n]) -(define-key canna-mode-map [C-down] [?\C-n]) -(define-key canna-mode-map [right] [?\C-f]) -(define-key canna-mode-map [S-right] [?\C-f]) -(define-key canna-mode-map [C-right] [?\C-f]) -(define-key canna-mode-map [left] [?\C-b]) -(define-key canna-mode-map [S-left] [?\C-b]) -(define-key canna-mode-map [C-left] [?\C-b]) -(define-key canna-mode-map [kanji] [? ]) -(define-key canna-mode-map [?\C- ] [?\C-@]) +(cond ((featurep 'xemacs) + (define-key canna-mode-map [up] "\C-p") + (define-key canna-mode-map [(shift up)] "\C-p") + (define-key canna-mode-map [(control up)] "\C-p") + (define-key canna-mode-map [down] "\C-n") + (define-key canna-mode-map [(shift down)] "\C-n") + (define-key canna-mode-map [(control down)] "\C-n") + (define-key canna-mode-map [right] "\C-f") + (define-key canna-mode-map [(shift right)] "\C-f") + (define-key canna-mode-map [(control right)] "\C-f") + (define-key canna-mode-map [left] "\C-b") + (define-key canna-mode-map [(shift left)] "\C-b") + (define-key canna-mode-map [(control left)] "\C-b") + (define-key canna-mode-map [kanji] " ") + (define-key canna-mode-map [(control space)] [(control @)]) + ) + (t + (define-key canna-mode-map [up] [?\C-p]) + (define-key canna-mode-map [S-up] [?\C-p]) + (define-key canna-mode-map [C-up] [?\C-p]) + (define-key canna-mode-map [down] [?\C-n]) + (define-key canna-mode-map [S-down] [?\C-n]) + (define-key canna-mode-map [C-down] [?\C-n]) + (define-key canna-mode-map [right] [?\C-f]) + (define-key canna-mode-map [S-right] [?\C-f]) + (define-key canna-mode-map [C-right] [?\C-f]) + (define-key canna-mode-map [left] [?\C-b]) + (define-key canna-mode-map [S-left] [?\C-b]) + (define-key canna-mode-map [C-left] [?\C-b]) + (define-key canna-mode-map [kanji] [? ]) + (define-key canna-mode-map [?\C- ] [?\C-@]) + )) ;; ミニバッファに何かを表示している時のローカルマップ (defvar canna-minibuffer-mode-map (make-sparse-keymap)) @@ -242,20 +339,38 @@ t の時はデフォルトの色を使用する。 (define-key canna-minibuffer-mode-map (make-string 1 ch) 'canna-minibuffer-insert-command) (setq ch (1+ ch)))) -(define-key canna-minibuffer-mode-map [up] [?\C-p]) -(define-key canna-minibuffer-mode-map [S-up] [?\C-p]) -(define-key canna-minibuffer-mode-map [C-up] [?\C-p]) -(define-key canna-minibuffer-mode-map [down] [?\C-n]) -(define-key canna-minibuffer-mode-map [S-down] [?\C-n]) -(define-key canna-minibuffer-mode-map [C-down] [?\C-n]) -(define-key canna-minibuffer-mode-map [right] [?\C-f]) -(define-key canna-minibuffer-mode-map [S-right] [?\C-f]) -(define-key canna-minibuffer-mode-map [C-right] [?\C-f]) -(define-key canna-minibuffer-mode-map [left] [?\C-b]) -(define-key canna-minibuffer-mode-map [S-left] [?\C-b]) -(define-key canna-minibuffer-mode-map [C-left] [?\C-b]) -(define-key canna-minibuffer-mode-map [kanji] [? ]) -(define-key canna-minibuffer-mode-map [?\C- ] [?\C-@]) +(cond ((featurep 'xemacs) + (define-key canna-minibuffer-mode-map [up] "\C-p") + (define-key canna-minibuffer-mode-map [(shift up)] "\C-p") + (define-key canna-minibuffer-mode-map [(control up)] "\C-p") + (define-key canna-minibuffer-mode-map [down] "\C-n") + (define-key canna-minibuffer-mode-map [(shift down)] "\C-n") + (define-key canna-minibuffer-mode-map [(control down)] "\C-n") + (define-key canna-minibuffer-mode-map [right] "\C-f") + (define-key canna-minibuffer-mode-map [(shift right)] "\C-f") + (define-key canna-minibuffer-mode-map [(control right)] "\C-f") + (define-key canna-minibuffer-mode-map [left] "\C-b") + (define-key canna-minibuffer-mode-map [(shift left)] "\C-b") + (define-key canna-minibuffer-mode-map [(control left)] "\C-b") + (define-key canna-minibuffer-mode-map [kanji] " ") + (define-key canna-minibuffer-mode-map [(control space)] [(control @)]) + ) + (t + (define-key canna-minibuffer-mode-map [up] [?\C-p]) + (define-key canna-minibuffer-mode-map [S-up] [?\C-p]) + (define-key canna-minibuffer-mode-map [C-up] [?\C-p]) + (define-key canna-minibuffer-mode-map [down] [?\C-n]) + (define-key canna-minibuffer-mode-map [S-down] [?\C-n]) + (define-key canna-minibuffer-mode-map [C-down] [?\C-n]) + (define-key canna-minibuffer-mode-map [right] [?\C-f]) + (define-key canna-minibuffer-mode-map [S-right] [?\C-f]) + (define-key canna-minibuffer-mode-map [C-right] [?\C-f]) + (define-key canna-minibuffer-mode-map [left] [?\C-b]) + (define-key canna-minibuffer-mode-map [S-left] [?\C-b]) + (define-key canna-minibuffer-mode-map [C-left] [?\C-b]) + (define-key canna-minibuffer-mode-map [kanji] [? ]) + (define-key canna-minibuffer-mode-map [?\C- ] [?\C-@]) + )) ;;; ;;; グローバル関数の書き替え @@ -333,7 +448,11 @@ See also document for canna:saved-exit-minibuffer." "Use input character as a key of complex translation input such as\n\ kana-to-kanji translation." (interactive "*p") - (canna:functional-insert-command2 last-command-char arg) ) + (let ((ch)) + (if (char-or-char-int-p arg) + (setq ch last-command-char) + (setq ch (event-to-character last-command-event))) + (canna:functional-insert-command2 ch arg) )) (defun canna:functional-insert-command2 (ch arg) "This function actualy isert a converted Japanese string." @@ -365,13 +484,7 @@ kana-to-kanji translation." (set-marker canna:*spos-undo-text* (point)) ;; ;; update kbnes - (let ((list (string-to-char-list canna-kakutei-string)) - ;; 挿入の途中で blink が起きるとうっとおしいので、 - ;; 一時的に blink を抑止する。 - (blink-matching-paren nil)) - (while list - (self-insert-internal (car list)) - (setq list (cdr list)))) + (canna-self-insert-string canna-kakutei-string) ;; 未確定の文字がなく、確定文字列の最後が閉じ括弧の ;; 類だったときは blink させる。 (if (and canna-empty-info @@ -399,13 +512,7 @@ kana-to-kanji translation." (t ;; ;; update kbnes - (let ((list (string-to-char-list canna-kakutei-string)) - ;; 挿入の途中で blink が起きるとうっとおしいので、 - ;; 一時的に blink を抑止する。 - (blink-matching-paren nil)) - (while list - (self-insert-internal (car list)) - (setq list (cdr list)))) + (canna-self-insert-string canna-kakutei-string) ;; 未確定の文字がなく、確定文字列の最後が閉じ括弧の ;; 類だったときは blink させる。 (if (and canna-empty-info @@ -447,34 +554,34 @@ kana-to-kanji translation." (canna:yomi-attr-on canna:*region-start* canna:*region-end*)) (setq canna:*last-kouho* canna-henkan-length) )) - - ;; 候補領域では強調したい文字列が存在するものと考えら - ;; れる。強調したい文字はEmacsではカーソルポジションにて表示 - ;; することとする。強調したい文字がないのであれば、カーソル - ;; は一番後の部分(入力が行われるポイント)に置いておく。 - - ;; カーソルを移動する。 - (if (not canna-underline) - (backward-char - (- canna:*last-kouho* - ;; カーソル位置は、反転表示部分が存在しないのであれば、 - ;; 候補文字列の最後の部分とし、反転表示部分が存在するの - ;; であれば、その部分の始めとする。 - (cond ((zerop canna-henkan-revlen) - canna:*last-kouho*) - (t canna-henkan-revpos) )) ) - (if (and (> canna-henkan-revlen 0) - (> canna-henkan-length 0)) - ; 候補の長さが0でなく、 - ; 反転表示の長さが0でなければ、 - ; その部分を変転表示する。 - (let ((start (+ canna:*region-start* - (if canna-with-fences 1 0) - canna-henkan-revpos) )) - (if canna-underline - (canna:henkan-attr-on start - (+ start canna-henkan-revlen))))) - ) ) + + ;; 候補領域では強調したい文字列が存在するものと考えら + ;; れる。強調したい文字はEmacsではカーソルポジションにて表示 + ;; することとする。強調したい文字がないのであれば、カーソル + ;; は一番後の部分(入力が行われるポイント)に置いておく。 + + ;; カーソルを移動する。 + (if (not canna-underline) + (backward-char + (- canna:*last-kouho* + ;; カーソル位置は、反転表示部分が存在しないのであれば、 + ;; 候補文字列の最後の部分とし、反転表示部分が存在するの + ;; であれば、その部分の始めとする。 + (cond ((zerop canna-henkan-revlen) + canna:*last-kouho*) + (t canna-henkan-revpos) )) ) + (if (and (> canna-henkan-revlen 0) + (> canna-henkan-length 0)) + ; 候補の長さが0でなく、 + ; 反転表示の長さが0でなければ、 + ; その部分を変転表示する。 + (let ((start (+ canna:*region-start* + (if canna-with-fences 1 0) + canna-henkan-revpos) )) + (if canna-underline + (canna:henkan-attr-on start + (+ start canna-henkan-revlen))))) + ) ) (defun canna:display-candidates (strs) (cond ((stringp strs) ; エラーが起こった場合 @@ -540,10 +647,13 @@ kana-to-kanji translation." (setq canna:*saved-minibuffer* (window-buffer (minibuffer-window))) ; (set-window-buffer (minibuffer-window) ; (get-buffer-create canna:*menu-buffer*)) - (setq canna:*saved-redirection* (frame-focus (selected-frame))) - (redirect-frame-focus (selected-frame) - (window-frame (minibuffer-window))) - + ;; modified by 守岡 知彦 , 1996/6/7 + (unless (featurep 'xemacs) + ;; とりあえず XEmacs では動かさないことにしておこう (^_^; + (setq canna:*saved-redirection* (frame-focus (selected-frame))) + (redirect-frame-focus (selected-frame) + (window-frame (minibuffer-window))) + ) ;; ミニバッファのキーマップを保存しておく。 (setq canna:*minibuffer-local-map-backup* (current-local-map)) )) @@ -583,8 +693,12 @@ kana-to-kanji translation." ;; ミニバッファウィンドウのバッファを元に戻す。 (set-window-buffer (minibuffer-window) canna:*saved-minibuffer*) ; (setq canna:*saved-minibuffer* nil) - (redirect-frame-focus (window-frame canna:*previous-window*) - canna:*saved-redirection*) + ;; modified by 守岡 知彦 , 1996/6/7 + (unless (featurep 'xemacs) + ;; とりあえず XEmacs では動かさないようにしておこう (^_^; + (redirect-frame-focus (window-frame canna:*previous-window*) + canna:*saved-redirection*) + ) ; ミニバッファで入力していたのなら以下もする。 ; (if (eq canna:*previous-window* (selected-window)) ; (progn @@ -605,7 +719,11 @@ kana-to-kanji translation, even if you are in the minibuffer." (use-local-map canna:*minibuffer-local-map-backup*) (set-window-buffer (minibuffer-window) canna:*saved-minibuffer*) (select-window canna:*previous-window*) - (canna:functional-insert-command2 last-command-char arg) ) + (let ((ch)) + (if (char-or-char-int-p arg) + (setq ch last-command-char) + (setq ch (event-to-character last-command-event))) + (canna:functional-insert-command2 ch arg) )) ;;; ;;; かんなモードの主役は、次の canna-self-insert-command である。この @@ -653,6 +771,9 @@ kana-to-kanji translation, even if you are in the minibuffer." (- (point) arg) (point))) (if (= last-command-char ? ) (canna:do-auto-fill)))))) +;; wire us into pending-delete +(put 'canna-self-insert-command 'pending-delete t) + (defun canna-toggle-japanese-mode () "Toggle canna japanese mode." (interactive) @@ -733,9 +854,11 @@ kana-to-kanji translation, even if you are in the minibuffer." 0))) (setq canna:*local-map-backup* (current-local-map)) (setq canna:*fence-mode* t) - (if (boundp 'disable-undo) - (setq disable-undo canna:*fence-mode*)) - (use-local-map canna-mode-map) ) + ;; XEmacs change: + (buffer-disable-undo (current-buffer)) + ;; (if (boundp 'disable-undo) + ;; (setq disable-undo canna:*fence-mode*)) + (use-local-map canna-mode-map)) (defun canna:enter-canna-mode-and-functional-insert () (canna:enter-canna-mode) @@ -753,8 +876,10 @@ kana-to-kanji translation, even if you are in the minibuffer." (if canna:*japanese-mode* (canna-toggle-japanese-mode) (mode-line-canna-mode-update canna:*alpha-mode-string*) ))) - (if (boundp 'disable-undo) - (setq disable-undo canna:*fence-mode*)) + ;; XEmacs change: + (buffer-enable-undo (current-buffer)) + ;; (if (boundp 'disable-undo) + ;; (setq disable-undo canna:*fence-mode*)) )) (set-marker canna:*region-start* nil) (set-marker canna:*region-end* nil) @@ -885,7 +1010,10 @@ dictionary." (eq hilit-background-mode 'dark)) (string-match "on\\|t" - (or (x-get-resource "ReverseVideo" "reverseVideo") + (or (if (featurep 'xemacs) + (x-get-resource "ReverseVideo" + "reverseVideo" 'string) + (x-get-resource "ReverseVideo" "reverseVideo")) ""))) 'reverse) ;反転しているなら 'reverse (t 'normal))) @@ -939,7 +1067,14 @@ dictionary." (define-key global-map (make-string 1 ch) 'canna-self-insert-command) (setq ch (1+ ch)) )) - (cond ((let ((keys (car init-val)) (ok nil)) + (cond + ;; #### I'm just guessing that this should come before the + ;; init-val setting + ;; if registered with LEIM, no-op + ((featurep 'canna-leim) t) + ;; check to see if an X resource or the like is available in + ;; init-val + ((let ((keys (car init-val)) (ok nil)) (while keys (cond ((< (car keys) 128) (global-set-key @@ -948,9 +1083,13 @@ dictionary." (setq ok t) )) (setq keys (cdr keys)) ) ok)) - (t ; デフォルトの設定 - (global-set-key "\C-o" 'canna-toggle-japanese-mode) )) + ;; デフォルトの設定 + ;; Since XEmacs provides canna-leim.el, we should leave this + ;; as is. + (t (global-set-key "\C-o" 'canna-toggle-japanese-mode) )) + ;; #### should these global bindings be conditional on LEIM? + ;; LEIM doesn't use kanji key yet AFAIK, so leave them. (if (not (keymapp (global-key-binding "\e["))) (global-unset-key "\e[") ) (global-set-key "\e[210z" 'canna-toggle-japanese-mode) ; XFER @@ -1236,7 +1375,7 @@ self insert otherwise." (defun canna:yomi-attr-on (start end) (if (overlayp canna:*yomi-overlay*) (move-overlay canna:*yomi-overlay* start end) - (overlay-put (setq canna:*yomi-overlay* (make-overlay start end nil t)) + (overlay-put (setq canna:*yomi-overlay* (make-overlay start end nil nil t)) 'face (if canna:color-p 'attr-yomi 'underline)) ) @@ -1251,7 +1390,8 @@ self insert otherwise." (defun canna:henkan-attr-on (start end) (if (overlayp canna:*henkan-overlay*) (move-overlay canna:*henkan-overlay* start end) - (overlay-put (setq canna:*henkan-overlay* (make-overlay start end nil t)) + (overlay-put (setq canna:*henkan-overlay* + (make-overlay start end nil nil t)) 'face (if canna:color-p 'attr-taishou 'region)) ) @@ -1266,7 +1406,8 @@ self insert otherwise." (defun canna:select-attr-on (start end) (if (overlayp canna:*select-overlay*) (move-overlay canna:*select-overlay* start end) - (overlay-put (setq canna:*select-overlay* (make-overlay start end nil t)) + (overlay-put (setq canna:*select-overlay* + (make-overlay start end nil nil t)) 'face 'attr-select)) ) @@ -1276,3 +1417,8 @@ self insert otherwise." (delete-overlay canna:*select-overlay*) ) ) + + +(provide 'canna) + +;;; canna.el ends here