;;; skk-kcode.el --- 漢字コードを使った変換のためのプログラム ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, ;; 1999 ;; Masahiko Sato ;; Author: Masahiko Sato ;; Maintainer: Mikio Nakajima ;; Version: $Id: skk-kcode.el,v 1.2 2000-07-10 04:34:00 yoshiki Exp $ ;; Keywords: japanese ;; Last Modified: $Date: 2000-07-10 04:34:00 $ ;; This file is part of SKK. ;; SKK 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 versions 2, or (at your option) ;; any later version. ;; SKK 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 SKK, 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: (eval-when-compile (require 'skk)) (require 'skk-foreword) ;;;###autoload (defgroup skk-kcode nil "SKK Kanji Code related customization." :prefix "skk-" :group 'skk ) (defcustom skk-input-by-code-menu-keys1 '(?a ?s ?d ?f ?g ?h ?q ?w ?e ?r ?t ?y) "*メニュー形式で JIS 文字を入力するときに使用する選択キーのリスト。 第 1 段階のメニューで使用する。 12 個のキー (char type) を含む必要がある。" :type '(repeat character) :group 'skk-kcode ) (defcustom skk-input-by-code-menu-keys2 '(?a ?s ?d ?f ?g ?h ?j ?k ?l ?q ?w ?e ?r ?t ?y ?u) "*メニュー形式で JIS 文字を入力するときに使用する選択キーのリスト。 第 2 段階のメニューで使用する。 16 個のキー (char type) を含む必要がある。" :type '(repeat character) :group 'skk-kcode ) (defcustom skk-kcode-charset (if (memq skk-emacs-type '(xemacs mule4 mule3)) 'japanese-jisx0208 lc-jp ) "*skk-input-by-code-or-menu で使われる文字セット。" :type 'symbol :group 'skk-kcode ) (defcustom skk-kcode-load-hook nil "*skk-kcode.el をロードした後にコールされるフック。" :type 'hook :group 'skk-kcode ) ;; internal constants and variables. (defconst skk-code-n1-min 161) (defconst skk-code-n1-max 244) (defconst skk-code-n2-min 161) (defconst skk-code-n2-max 254) (defconst skk-code-null 128) (defconst skk-kcode-charset-list (if (memq skk-emacs-type '(xemacs mule4 mule3)) (mapcar '(lambda (x) (list (symbol-name x))) (charset-list)) )) (defvar skk-input-by-code-or-menu-jump-default skk-code-n1-min) ;;;###autoload (defun skk-input-by-code-or-menu (&optional arg) "7bit もしくは 8bit もしくは 区点コードに対応する 2byte 文字を挿入する。" (interactive "*P") (if arg (let ((charset (intern (completing-read (format "CHARSET(%s): " skk-kcode-charset) skk-kcode-charset-list nil t )))) (cond ((eq charset (intern ""))) ((not (skk-charsetp charset)) (skk-error "無効なキャラクターセットです" "Invalid charset")) (t (setq skk-kcode-charset charset)) ))) (let ((str (read-string (format "7/8 bits or KUTEN code for %s (00nn or CR for Jump Menu): " skk-kcode-charset ))) (enable-recursive-minibuffer t) n1 n2 ) (if (string-match "\\(.+\\)-\\(.+\\)" str) (setq n1 (+ (string-to-number (match-string 1 str)) 32 128) n2 (+ (string-to-number (match-string 2 str)) 32 128) ) (setq n1 (if (string= str "") 128 (+ (* 16 (skk-char-to-hex (aref str 0) 'jis)) (skk-char-to-hex (aref str 1)) )) n2 (if (string= str "") 128 (+ (* 16 (skk-char-to-hex (aref str 2) 'jis)) (skk-char-to-hex (aref str 3)) )))) (if (or (> n1 256) (> n2 256)) (skk-error "無効なコードです" "Invalid code") ) (insert (if (> n1 160) (skk-make-string n1 n2) (skk-input-by-code-or-menu-0 n1 n2) )) (if skk-henkan-active (skk-kakutei)) )) (defun skk-char-to-hex (char &optional jischar) (cond ((and (<= char 102) (> char 96)) (- char 87)) ; a-f ((and (<= char 70) (> char 64)) (- char 55)) ; A-F ((and (<= char 57) (> char 47)) ; 0-9 (cond (jischar (- char 40)) (t (- char 48)) )) (t (skk-error "%c を 16 進数に変換できません" "Cannot convert %c to hexadecimal number" char)))) (defun skk-make-string (n1 n2) (char-to-string (skk-make-char skk-kcode-charset n1 n2)) ) (defun skk-next-n2-code (n) (if (<= (setq n (1+ n)) skk-code-n2-max) n skk-code-n2-min)) (defun skk-previous-n2-code (n) (if (<= skk-code-n2-min (setq n (1- n))) n skk-code-n2-max)) (defun skk-next-n1-code (n) (if (<= (setq n (1+ n)) skk-code-n1-max) n skk-code-n1-min)) (defun skk-previous-n1-code (n) (if (<= skk-code-n1-min (setq n (1- n))) n skk-code-n1-max)) (defun skk-input-by-code-or-menu-0 (n1 n2) (if (= n1 skk-code-null) (skk-input-by-code-or-menu-jump n2) (skk-input-by-code-or-menu-1 n1 n2))) (defun skk-input-by-code-or-menu-jump (n) (let ((menu-keys1 ; 表示用のキーリストを組み立てる。 (mapcar (function (lambda (char) (char-to-string (upcase char)))) skk-input-by-code-menu-keys1 )) kanji-char ) (if (< n skk-code-n1-min) (setq n skk-input-by-code-or-menu-jump-default)) (while (not kanji-char) (let ((n-org n) (chars (list (list (skk-make-string n skk-code-n1-min) n skk-code-n1-min) (list (skk-make-string n 177) n 177) (list (skk-make-string n 193) n 193) (list (skk-make-string n 209) n 209) (list (skk-make-string n 225) n 225) (list (skk-make-string n 241) n 241) (progn (setq n (skk-next-n1-code n)) (list (skk-make-string n skk-code-n1-min) n skk-code-n1-min )) (list (skk-make-string n 177) n 177) (list (skk-make-string n 193) n 193) (list (skk-make-string n 209) n 209) (list (skk-make-string n 225) n 225) (list (skk-make-string n 241) n 241)))) (skk-save-point (let ((i 0) message-log-max str ) (while (< i 12) (setq str (concat str (nth i menu-keys1) ":" (car (nth i chars)) " " )) (setq i (1+ i)) ) (message str) ) (let ((char (event-to-character (skk-read-event))) rest ch ) (if (not (characterp char)) (progn (skk-message "\"%s\" は有効なキーではありません！" "\"%s\" is not valid here!" (prin1 char) ) (sit-for 1) (message "") (setq n n-org) ) (setq rest (or (memq char skk-input-by-code-menu-keys1) (if (skk-lower-case-p char) (memq (upcase char) skk-input-by-code-menu-keys1) (memq (downcase char) skk-input-by-code-menu-keys1) )) ch (if rest ;; 12 == (length skk-input-by-code-menu-keys1) (nth (- 12 (length rest)) chars) nil ) kanji-char (cond (ch) ((eq char ?x) (if (< (setq n (- n-org 2)) skk-code-n1-min) (setq n skk-code-n1-max)) nil) ((eq char ?\040) (setq n (skk-next-n1-code n)) nil) ((eq char ?\?) (skk-message (concat "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) " "[何かキーを押してください]" ) (concat "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) " "[Hit any key to continue]" ) (car (car chars)) n-org skk-code-n1-min n-org skk-code-n1-min (- n-org 128) (- skk-code-n1-min 128) (- n-org 128) (- skk-code-n1-min 128) ) (skk-read-event) (setq n n-org) nil) (t (skk-message "\"%c\" は有効なキーではありません！" "\"%c\" is not valid here!" char ) (sit-for 1) (message "") (setq n n-org) nil )))))))) (setq skk-input-by-code-or-menu-jump-default (car (cdr kanji-char))) (skk-input-by-code-or-menu-1 (car (cdr kanji-char)) (car (cdr (cdr kanji-char))) ))) (defun skk-input-by-code-or-menu-1 (n1 n2) (let ((menu-keys2 ; 表示用のキーリストを組み立てる。 (mapcar (function (lambda (char) (char-to-string (upcase char)))) skk-input-by-code-menu-keys2 )) kanji-char ) (while (not kanji-char) (let ((n1-org n1) (n2-org n2) (i 0) (chars (list (skk-make-string n1 n2)))) ;; 16 == (length skk-input-by-code-menu-keys2) (while (< i 16) (nconc chars (list (progn (setq n2 (skk-next-n2-code n2)) (if (= n2 skk-code-n2-min) (setq n1 (skk-next-n1-code n1))) (skk-make-string n1 n2)))) (setq i (1+ i))) (skk-save-point (let ((i 0) message-log-max str ) (while (< i 16) (setq str (concat str (nth i menu-keys2) ":" (nth i chars) " ")) (setq i (1+ i)) ) (message str) ) (let ((char (event-to-character (skk-read-event))) rest ch ) (if (not (characterp char)) (progn (skk-message "\"%s\" は有効なキーではありません！" "\"%s\" is not valid here!" (prin1 char) ) (sit-for 1) (message "") (setq n1 n1-org n2 n2-org) ) (setq rest (or (memq char skk-input-by-code-menu-keys2) (if (skk-lower-case-p char) (memq (upcase char) skk-input-by-code-menu-keys2) (memq (downcase char) skk-input-by-code-menu-keys2) )) ch (if rest ;; 16 == (length skk-input-by-code-menu-keys2) (nth (- 16 (length rest)) chars) ) kanji-char (cond (ch) ((eq char ?x) (if (< (setq n2 (- n2 31)) skk-code-n2-min) (setq n2 (+ n2 94) n1 (skk-previous-n1-code n1))) nil ) ((eq char ?\040) ; space (if (= (setq n2 (skk-next-n2-code n2)) skk-code-n2-min) (setq n1 (skk-next-n1-code n1))) nil ) ((eq char ?\?) (skk-message (concat "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) " "[何かキーを押してください]" ) (concat "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) " "[Hit any key to continue]" ) (car chars) n1-org n2-org n1-org n2-org (- n1-org 128) (- n2-org 128) (- n1-org 128) (- n2-org 128) ) (skk-read-event) (setq n1 n1-org n2 n2-org) nil ) ((eq char ?>) (if (= (setq n2 (skk-next-n2-code n2-org)) skk-code-n2-min) (setq n1 (skk-next-n1-code n1-org)) (setq n1 n1-org)) nil ) ((eq char ?<) (if (= (setq n2 (skk-previous-n2-code n2-org)) skk-code-n2-max) (setq n1 (skk-previous-n1-code n1-org)) (setq n1 n1-org)) nil ) (t (skk-message "\"%c\" は有効なキーではありません！" "\"%c\" is not valid here!" char ) (sit-for 1) (message "") (setq n1 n1-org n2 n2-org) nil )))))))) kanji-char )) ;;;###autoload (defun skk-display-code-for-char-at-point (&optional arg) "ポイントにある文字の EUC コードと JIS コードを表示する。" (interactive "P") (if (eobp) (skk-error "カーソルがバッファの終端にあります" "Cursor is at the end of the buffer" ) (skk-display-code (buffer-substring-no-properties (point) (skk-save-point (forward-char 1) (point)) )) ;; エコーした文字列をカレントバッファに挿入しないように。 t )) (defun skk-display-code (str) (static-cond ((memq skk-emacs-type '(xemacs mule4 mule3)) (let* ((char (string-to-char str)) (charset (char-charset char))) (cond ((memq charset '(japanese-jisx0208 japanese-jisx0208-1978)) (let* ((char1-j (skk-char-octet char 0)) (char1-k (- char1-j 32)) (char1-e (+ char1-j 128)) (char2-j (skk-char-octet char 1)) (char2-k (- char2-j 32)) (char2-e (+ char2-j 128))) (message "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d), KUTEN: (%2d, %2d)" str char1-e char2-e char1-e char2-e char1-j char2-j char1-j char2-j char1-k char2-k))) ((memq charset '(ascii latin-jisx0201)) (message "\"%s\" %2x (%3d)" str (skk-char-octet char 0) (skk-char-octet char 0))) (t (skk-error "判別できない文字です" "Cannot understand this character" ))))) ;; 'mule2 (t (let (;; 文字列を char に分解。 ;; (mapcar '+ str) == (append str nil) (char-list (mapcar (function +) str))) (cond ((and (= (length char-list) 3) (memq (car char-list) (list lc-jp lc-jpold))) (let* ((char1-e (car (cdr char-list))) (char1-j (- char1-e 128)) (char1-k (- char1-j 32)) (char2-e (car (cdr (cdr char-list)))) (char2-j (- char2-e 128)) (char2-k (- char2-j 32))) (message "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d), KUTEN: (%2d, %2d)" str char1-e char2-e char1-e char2-e char1-j char2-j char1-j char2-j char1-k char2-k))) ((or (= (length char-list) 1) ; ascii character (memq (car char-list) (list lc-ascii lc-roman))) (let ((char (car char-list))) (message "\"%c\" %2x (%3d)" char char char) )) (t (skk-error "判別できない文字です" "Cannot understand this character" ))))))) (run-hooks 'skk-kcode-load-hook) (provide 'skk-kcode) ;;; skk-kcode.el ends here