;;; skk-kcode.el --- 漢字コードを使った変換のためのプログラム ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 ;; Masahiko Sato ;; Author: Masahiko Sato ;; Version: 1.0 ;; Keywords: japanese ;; Last Modified: Sat Oct 26 06:51:14 1996 ;; 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 versions 2, or (at your option) ;; any later version. ;; 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. ;; 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: ;;; Change log: ;; version 1.0 released 1996.10.26 (derived from the skk.el 8.6) ;;; Code: (require 'skk) (skk-defvar skk-input-by-code-menu-keys1 '(?a ?s ?d ?f ?g ?h ?q ?w ?e ?r ?t ?y) "*メニュー形式で JIS 文字を入力するときに使用する選択キーのリスト。 第 1 段階のメニューで使用する。 12 個のキー (char type) を含む必要がある。") (skk-defvar 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) を含む必要がある。") (skk-defvar skk-kcode-load-hook nil "*skk-kcode.el をロードした後にコールされるフック。" ) ;; variables for the function skk-input-by-code-or-menu (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) (defvar skk-input-by-code-or-menu-jump-default skk-code-n1-min) ;;;###autoload (defun skk-input-by-code-or-menu () "JIS もしくは EUC コードに対応する文字を挿入する。" ;; The function skk-input-by-code-or-menu, which was used until version ;; 4.20, is now replaced by this new function. (interactive "*") (let* ((str (read-string "JIS or EUC code (00nn or CR for Jump Menu): ")) (n1 (if (string= str "") 128 (+ (* 16 (skk-jis-char-to-hex (aref str 0))) (skk-char-to-hex (aref str 1)) ))) (n2 (if (string= str "") 128 (+ (* 16 (skk-jis-char-to-hex (aref str 2))) (skk-char-to-hex (aref str 3)) ))) (enable-recursive-mini-buffer t) ) (insert (if (> n1 160) (skk-char-to-string n1 n2) (skk-input-by-code-or-menu-0 n1 n2) )) (if skk-henkan-active (skk-kakutei)) )) (defun skk-char-to-hex (char) (cond ((> char 96) (- char 87)) ; a-f ((> char 64) (- char 55)) ; A-F ((> char 47) (- char 48)) ; 0-9 (t ;; 物言わぬエラーは良くないが...。 (error "") ))) (defun skk-jis-char-to-hex (char) (cond ((> char 96) (- char 87)) ; a-f ((> char 64) (- char 55)) ; A-F ((> char 47) (- char 40)) ; 0-9 (t ;; 物言わぬエラーは良くないが...。 (error "") ))) (defun skk-char-to-string (n1 n2) (cond (skk-mule24 (char-to-string (make-char 'japanese-jisx0208 n1 n2)) ) (skk-mule (char-to-string (make-character lc-jp n1 n2)) ) (t (concat (char-to-string n1) (char-to-string 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-char-to-string n skk-code-n1-min) n skk-code-n1-min) (list (skk-char-to-string n 177) n 177) (list (skk-char-to-string n 193) n 193) (list (skk-char-to-string n 209) n 209) (list (skk-char-to-string n 225) n 225) (list (skk-char-to-string n 241) n 241) (progn (setq n (skk-next-n1-code n)) (list (skk-char-to-string n skk-code-n1-min) n skk-code-n1-min )) (list (skk-char-to-string n 177) n 177) (list (skk-char-to-string n 193) n 193) (list (skk-char-to-string n 209) n 209) (list (skk-char-to-string n 225) n 225) (list (skk-char-to-string n 241) n 241)))) (save-excursion (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 (skk-read-char)) rest ch ) (if (not (integerp 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 120) ; x (if (< (setq n (- n-org 2)) skk-code-n1-min) (setq n skk-code-n1-max)) nil) ((eq char 32) ; space (setq n (skk-next-n1-code n)) nil) ((eq char 63) ; ? (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-char) (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-char-to-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-char-to-string n1 n2)))) (setq i (1+ i))) (save-excursion (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 (skk-read-char))) (if (not (integerp 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-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 120) ; x (if (< (setq n2 (- n2 31)) skk-code-n2-min) (setq n2 (+ n2 94) n1 (skk-previous-n1-code n1))) nil ) ((eq char 32) ; space (if (= (setq n2 (skk-next-n2-code n2)) skk-code-n2-min) (setq n1 (skk-next-n1-code n1))) nil ) ((eq char 63) ; ? (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-char) (setq n1 n1-org n2 n2-org) nil ) ((eq char 62) ; > (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 60) ; < (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 () "ポイントにある文字の EUC コードと JIS コードを表示する。" (interactive) (if (eobp) (skk-error "カーソルがバッファの終端にあります" "Cursor is at the end of the buffer" ) (let* ((str (skk-buffer-substring (point) (save-excursion (forward-char 1) (point)))) ;; 文字列を char に分解。 ;; (mapcar '+ str) == (append str nil) (char-list (mapcar '+ str))) (if (= (length char-list) 1) ;; ascii character (let ((char1 (car char-list))) (message "\"%c\" %2x (%3d)" char1 char1 char1)) (if skk-mule (if (and (= (length char-list) 3) (if skk-mule24 (= (car char-list) charset-japanese-jisx0208) (= (car char-list) lc-jp) )) (let* ((char1 (car (cdr char-list))) (char1-j (- char1 128)) (char2 (car (cdr (cdr char-list)))) (char2-j (- char2 128))) (message "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d)" str char1 char2 char1 char2 char1-j char2-j char1-j char2-j )) (skk-error "判別できない文字です" "Cannot understand this character" )) (let* ((char1 (car char-list)) (char1-j (- char1 128)) (char2 (car (cdr char-list))) (char2-j (- char2 128))) (message "『%s』 EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d)" str char1 char2 char1 char2 char1-j char2-j char1-j char2-j))))))) (run-hooks 'skk-kcode-load-hook) (provide 'skk-kcode) ;;; skk-kcode.el ends here