Source

skk / skk-kcode.el

Diff from to

skk-kcode.el

 ;;; skk-kcode.el --- $B4A;z%3!<%I$r;H$C$?JQ49$N$?$a$N%W%m%0%i%`(B
-;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
+;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
+;;               1999
 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
 
 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
 ;; Keywords: japanese
 ;; Last Modified: $Date$
 
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
 
-;; This program is distributed in the hope that it will be useful
+;; 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.
 
 ;;; Commentary:
 
-;; Following people contributed modifications to skk.el (Alphabetical order):
-;;       Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-
 ;;; Code:
+(eval-when-compile (require 'skk))
 (require 'skk-foreword)
-(require 'skk-vars)
 
-(defvar skk-input-by-code-menu-keys1 '(?a ?s ?d ?f ?g ?h ?q ?w ?e ?r ?t ?y)
+;;;###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)
   "*$B%a%K%e!<7A<0$G(B JIS $BJ8;z$rF~NO$9$k$H$-$K;HMQ$9$kA*Br%-!<$N%j%9%H!#(B
 $BBh(B 1 $BCJ3,$N%a%K%e!<$G;HMQ$9$k!#(B
-12 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B")
+12 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B"
+  :type '(repeat character)
+  :group 'skk-kcode )
 
-(defvar skk-input-by-code-menu-keys2
+(defcustom skk-input-by-code-menu-keys2
   '(?a ?s ?d ?f ?g ?h ?j ?k ?l ?q ?w ?e ?r ?t ?y ?u)
   "*$B%a%K%e!<7A<0$G(B JIS $BJ8;z$rF~NO$9$k$H$-$K;HMQ$9$kA*Br%-!<$N%j%9%H!#(B
 $BBh(B 2 $BCJ3,$N%a%K%e!<$G;HMQ$9$k!#(B
-16 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B")
+16 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B"
+  :type '(repeat character)
+  :group 'skk-kcode )
 
-(defvar skk-kcode-load-hook nil
-  "*skk-kcode.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
+(defcustom skk-kcode-charset
+  (if (memq skk-emacs-type '(xemacs mule4 mule3))
+      'japanese-jisx0208
+    lc-jp )
+  "*skk-input-by-code-or-menu $B$G;H$o$l$kJ8;z%;%C%H!#(B"
+  :type 'symbol
+  :group 'skk-kcode )
 
-;; variables for the function skk-input-by-code-or-menu
+(defcustom skk-kcode-load-hook nil
+  "*skk-kcode.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B"
+  :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)
-(skk-deflocalvar skk-kcode-charset
-  (if (or skk-mule3 skk-xemacs)
-      'japanese-jisx0208
-    lc-jp)
-  "skk-input-by-code-or-menu $B$G;H$o$l$kJ8;z%;%C%H!#(B" )
-(defconst skk-kcode-definded-charsets
-  (if (or skk-mule3 skk-xemacs)
-      (mapcar '(lambda (x) (list (symbol-name x))) (charset-list))
-    nil ))
 
-;;;###skk-autoload
+;;;###autoload
 (defun skk-input-by-code-or-menu (&optional arg)
   "7bit $B$b$7$/$O(B 8bit $B$b$7$/$O(B $B6hE@%3!<%I$KBP1~$9$k(B 2byte $BJ8;z$rA^F~$9$k!#(B"
-  ;; The function skk-input-by-code-or-menu, which was used until version
-  ;; 4.20, is now replaced by this new function.
   (interactive "*P")
   (if arg
       (let ((charset
 	     (intern (completing-read (format "CHARSET(%s): " skk-kcode-charset)
-				      skk-kcode-definded-charsets nil t ))))
-	(cond ((null charset))
+				      skk-kcode-charset-list nil t ))))
+	(cond ((eq charset (intern "")))
 	      ((not (skk-charsetp charset))
-	       (error "invalid charset"))
+	       (skk-error "$BL58z$J%-%c%i%/%?!<%;%C%H$G$9(B" "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-mini-buffer t)
+	(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-jis-char-to-hex (aref str 0)))
+		 (+ (* 16 (skk-char-to-hex (aref str 0) 'jis))
 		    (skk-char-to-hex (aref str 1)) ))
 	    n2 (if (string= str "") 128
-		 (+ (* 16 (skk-jis-char-to-hex (aref str 2)))
+		 (+ (* 16 (skk-char-to-hex (aref str 2) 'jis))
 		    (skk-char-to-hex (aref str 3)) ))))
+    (if (or (> n1 256) (> n2 256))
+	(skk-error "$BL58z$J%3!<%I$G$9(B" "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)
-  (cond ((> char 96) (- char 87)) ; a-f
-        ((> char 64) (- char 55)) ; A-F
-        ((> char 47) (- char 48)) ; 0-9
-        (t
-         ;; $BJ*8@$o$L%(%i!<$ONI$/$J$$$,(B...$B!#(B
-         (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
-         ;; $BJ*8@$o$L%(%i!<$ONI$/$J$$$,(B...$B!#(B
-         (error "") )))
-
+(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 $B$r(B 16 $B?J?t$KJQ49$G$-$^$;$s(B"
+ 		      "Cannot convert %c to hexadecimal number" char))))
+  
 (defun skk-make-string (n1 n2)
   (char-to-string (skk-make-char skk-kcode-charset n1 n2)) )
 
                                 "  " ))
               (setq i (1+ i)) )
             (message str) )
-          (let ((char (skk-read-event))
+          (let ((char (event-to-character (skk-read-event)))
                 rest ch )
-            (if (not (integerp char))
+            (if (not (characterp char))
                 (progn
                   (skk-message "\"%s\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
                                "\"%s\" is not valid here!" (prin1 char) )
                     kanji-char
                     (cond
                      (ch)
-                     ((eq char 120)     ; x
+                     ((eq char ?x)
                       (if (< (setq n (- n-org 2)) skk-code-n1-min)
                           (setq n skk-code-n1-max))
                       nil)
-                     ((eq char 32)      ; space
+                     ((eq char ?\040)
                       (setq n (skk-next-n1-code n))
                       nil)
-                     ((eq char 63)      ; ?
+                     ((eq char ?\?)
                       (skk-message
                        (concat "$B!X(B%s$B!Y(B  EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d)  "
                                "[$B2?$+%-!<$r2!$7$F$/$@$5$$(B]" )
               (setq str (concat str (nth i menu-keys2) ":" (nth i chars) " "))
               (setq i (1+ i)) )
             (message str) )
-          (let ((char (skk-read-event)))
-            (if (not (integerp char))
+          (let ((char (event-to-character (skk-read-event)))
+		rest ch )
+            (if (not (characterp char))
                 (progn
                   (skk-message "\"%s\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
                                "\"%s\" is not valid here!" (prin1 char) )
                     kanji-char
                     (cond
                      (ch)
-                     ((eq char 120)     ; x
+                     ((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 32)      ; space
+                     ((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 63)      ; ?
+                     ((eq char ?\?)
                       (skk-message
                        (concat "$B!X(B%s$B!Y(B  EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d)  "
                                "[$B2?$+%-!<$r2!$7$F$/$@$5$$(B]" )
                       (skk-read-event)
                       (setq n1 n1-org n2 n2-org)
                       nil )
-                     ((eq char 62)      ; >
+                     ((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 60)      ; <
+                     ((eq char ?<)
                       (if (= (setq n2 (skk-previous-n2-code n2-org))
                              skk-code-n2-max)
                           (setq n1 (skk-previous-n1-code n1-org))
                       nil ))))))))
     kanji-char ))
 
-;;;###skk-autoload
-(defun skk-display-code-for-char-at-point ()
+;;;###autoload
+(defun skk-display-code-for-char-at-point (&optional arg)
   "$B%]%$%s%H$K$"$kJ8;z$N(B EUC $B%3!<%I$H(B JIS $B%3!<%I$rI=<($9$k!#(B"
-  (interactive)
+  (interactive "P")
   (if (eobp)
       (skk-error "$B%+!<%=%k$,%P%C%U%!$N=*C<$K$"$j$^$9(B"
                  "Cursor is at the end of the buffer" )
-    (let ((str
-           (skk-buffer-substring
-            (point)
-            (skk-save-point (forward-char 1) (point)))))
+    (skk-display-code (buffer-substring-no-properties
+		       (point) (skk-save-point (forward-char 1) (point)) ))
+    ;; $B%(%3!<$7$?J8;zNs$r%+%l%s%H%P%C%U%!$KA^F~$7$J$$$h$&$K!#(B
+    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
-       (skk-xemacs
-        (let* ((char (string-to-char str))
-               (charset (char-charset char)))
-          (cond
-           ((memq charset '(japanese-jisx0208 japanese-jisx0208-1978))
-            (let* ((char1-j (char-octet char 0))
-                   (char1-k (- char1-j 32))
-                   (char1-e (+ char1-j 128))
-                   (char2-j (char-octet char 1))
-                   (char2-k (- char2-j 32))
-                   (char2-e (+ char2-j 128)))
-              (message
-               "$B!X(B%s$B!Y(B  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 (char-octet char 0)  (char-octet char 0)))
-           (t
-            (skk-error "$BH=JL$G$-$J$$J8;z$G$9(B"
-                       "Cannot understand this character")))
-          ))
-       (skk-mule3
-        (let* ((char (string-to-char str))
-               (charset (char-charset char)))
-          (cond
-           ((memq charset '(japanese-jisx0208 japanese-jisx0208-1978))
-            (let* ((char-list (mapcar (function +) str))
-                   (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
-               "$B!X(B%s$B!Y(B  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)" char char char))
-           (t
-            (skk-error "$BH=JL$G$-$J$$J8;z$G$9(B"
-                       "Cannot understand this character")))
-          ))
-       (t ; skk-mule
-        (let (;; $BJ8;zNs$r(B char $B$KJ,2r!#(B
-              ;; (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
-               "$B!X(B%s$B!Y(B  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 "$BH=JL$G$-$J$$J8;z$G$9(B"
-                       "Cannot understand this character" ))
-           )))
-       ))))
+       ((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
+	   "$B!X(B%s$B!Y(B  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 "$BH=JL$G$-$J$$J8;z$G$9(B"
+		   "Cannot understand this character" )))))
+   ;; 'mule2
+   (t
+    (let (;; $BJ8;zNs$r(B char $B$KJ,2r!#(B
+	  ;; (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
+	   "$B!X(B%s$B!Y(B  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 "$BH=JL$G$-$J$$J8;z$G$9(B"
+		   "Cannot understand this character" )))))))
 
 (run-hooks 'skk-kcode-load-hook)