cgit.sxemacs.org Git - packages/blob - mule-packages/mule-base/kana-keyboard.el

   1 ;;; kana-keyboard.el --- Japanese Kana Keyboard support
   2
   3 ;; Copyright (C) 1999 by Free Software Foundation, Inc.
   4
   5 ;; Author: SL Baur <steve@xemacs.org>
   6 ;; Keywords: mule, hardware
   7
   8 ;; This file is part of XEmacs.
   9
  10 ;; XEmacs is free software; you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; XEmacs is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23 ;; 02111-1307, USA.
  24
  25 ;;; Synched up with: Not in FSF
  26
  27 ;;; Commentary:
  28
  29 ;; This file contains keybindings to make a Kana keyboard useful.  It requires
  30 ;; X11 keysym support on the X server and (of course) a keyboard that can
  31 ;; directly generate kana symbols.
  32
  33 ;;; Code:
  34
  35 (eval-when-compile
  36   (require 'cl))
  37
  38 (defconst kana-keyboard-data
  39   '(
  40     (kana_A ?\e$B$"\e(B ?\e$B%"\e(B)
  41     (kana_a ?\e$B$!\e(B ?\e$B%!\e(B)
  42     (kana_I ?\e$B$$\e(B ?\e$B%$\e(B)
  43     (kana_i ?\e$B$#\e(B ?\e$B%#\e(B)
  44     (kana_U ?\e$B$&\e(B ?\e$B%&\e(B)
  45     (kana_u ?\e$B$%\e(B ?\e$B%%\e(B)
  46     (kana_E ?\e$B$(\e(B ?\e$B%(\e(B)
  47     (kana_e ?\e$B$'\e(B ?\e$B%'\e(B)
  48     (kana_O ?\e$B$*\e(B ?\e$B%*\e(B)
  49     (kana_o ?\e$B$)\e(B ?\e$B%)\e(B)
  50
  51     (kana_KA ?\e$B$+\e(B ?\e$B%+\e(B)
  52     (kana_KI ?\e$B$-\e(B ?\e$B%-\e(B)
  53     (kana_KU ?\e$B$/\e(B ?\e$B%/\e(B)
  54     (kana_KE ?\e$B$1\e(B ?\e$B%1\e(B)
  55     (kana_KO ?\e$B$3\e(B ?\e$B%3\e(B)
  56
  57     (kana_SA ?\e$B$5\e(B ?\e$B%5\e(B)
  58     (kana_SHI ?\e$B$7\e(B ?\e$B%7\e(B)
  59     (kana_SU ?\e$B$9\e(B ?\e$B%9\e(B)
  60     (kana_SE ?\e$B$;\e(B ?\e$B%;\e(B)
  61     (kana_SO ?\e$B$=\e(B ?\e$B%=\e(B)
  62
  63     (kana_TA ?\e$B$?\e(B ?\e$B%?\e(B)
  64     (kana_CHI ?\e$B$A\e(B ?\e$B%A\e(B)
  65     (kana_TSU ?\e$B$D\e(B ?\e$B%D\e(B)
  66     (kana_tsu ?\e$B$C\e(B ?\e$B%C\e(B)
  67     (kana_TE ?\e$B$F\e(B ?\e$B%F\e(B)
  68     (kana_TO ?\e$B$H\e(B ?\e$B%H\e(B)
  69
  70     (kana_MA ?\e$B$^\e(B ?\e$B%^\e(B)
  71     (kana_MI ?\e$B$_\e(B ?\e$B%_\e(B)
  72     (kana_MU ?\e$B$`\e(B ?\e$B%`\e(B)
  73     (kana_ME ?\e$B$a\e(B ?\e$B%a\e(B)
  74     (kana_MO ?\e$B$b\e(B ?\e$B%b\e(B)
  75
  76     (kana_HA ?\e$B$O\e(B ?\e$B%O\e(B)
  77     (kana_HI ?\e$B$R\e(B ?\e$B%R\e(B)
  78     (kana_FU ?\e$B$U\e(B ?\e$B%U\e(B)
  79     (kana_HE ?\e$B$X\e(B ?\e$B%X\e(B)
  80     (kana_HO ?\e$B$[\e(B ?\e$B%[\e(B)
  81
  82     (kana_NA ?\e$B$J\e(B ?\e$B%J\e(B)
  83     (kana_NI ?\e$B$K\e(B ?\e$B%K\e(B)
  84     (kana_NU ?\e$B$L\e(B ?\e$B%L\e(B)
  85     (kana_NE ?\e$B$M\e(B ?\e$B%M\e(B)
  86     (kana_NO ?\e$B$N\e(B ?\e$B%N\e(B)
  87
  88     (kana_YA ?\e$B$d\e(B ?\e$B%d\e(B)
  89     (kana_ya ?\e$B$c\e(B ?\e$B%c\e(B)
  90     (kana_YU ?\e$B$f\e(B ?\e$B%f\e(B)
  91     (kana_yu ?\e$B$e\e(B ?\e$B%e\e(B)
  92     (kana_YO ?\e$B$h\e(B ?\e$B%h\e(B)
  93     (kana_yo ?\e$B$g\e(B ?\e$B%g\e(B)
  94
  95     (kana_RA ?\e$B$i\e(B ?\e$B%i\e(B)
  96     (kana_RI ?\e$B$j\e(B ?\e$B%j\e(B)
  97     (kana_RU ?\e$B$k\e(B ?\e$B%k\e(B)
  98     (kana_RE ?\e$B$l\e(B ?\e$B%l\e(B)
  99     (kana_RO ?\e$B$m\e(B ?\e$B%m\e(B)
 100
 101     (kana_WA ?\e$B$o\e(B ?\e$B%o\e(B)
 102     (kana_WO ?\e$B$r\e(B ?\e$B%r\e(B)
 103
 104     (kana_N ?\e$B$s\e(B ?\e$B%s\e(B)
 105
 106     (prolongedsound ?\e$B!<\e(B ?\e$B!<\e(B)
 107     ;; (voicedsound ? ?)
 108     ;; (semivoicedsound ? ?)
 109     (kana_openingbracket ?\\e$B!V\e(B ?\\e$B!V\e(B)
 110     (kana_closingbracket ?\\e$B!W\e(B ?\\e$B!W\e(B)
 111     (kana_fullstop ?\e$B!#\e(B ?\e$B!#\e(B)
 112     (kana_comma ?\e$B!"\e(B ?\e$B!"\e(B)
 113     (kana_conjunctive ?\e$B!&\e(B ?\e$B!&\e(B)))
 114
 115 ;;; Postfixed voiced sound support from MORIOKA Tomohiko
 116 (defun kana-keyboard-postfix-voicedsound (arg)
 117   (interactive "P")
 118   (let ((ret (assq (char-before)
 119                    '((?\e$B$+\e(B . ?\e$B$,\e(B)
 120                      (?\e$B$-\e(B . ?\e$B$.\e(B)
 121                      (?\e$B$/\e(B . ?\e$B$0\e(B)
 122                      (?\e$B$1\e(B . ?\e$B$2\e(B)
 123                      (?\e$B$3\e(B . ?\e$B$4\e(B)
 124                      (?\e$B$5\e(B . ?\e$B$6\e(B)
 125                      (?\e$B$7\e(B . ?\e$B$8\e(B)
 126                      (?\e$B$9\e(B . ?\e$B$:\e(B)
 127                      (?\e$B$;\e(B . ?\e$B$<\e(B)
 128                      (?\e$B$=\e(B . ?\e$B$>\e(B)
 129                      (?\e$B$?\e(B . ?\e$B$@\e(B)
 130                      (?\e$B$A\e(B . ?\e$B$B\e(B)
 131                      (?\e$B$D\e(B . ?\e$B$E\e(B)
 132                      (?\e$B$F\e(B . ?\e$B$G\e(B)
 133                      (?\e$B$H\e(B . ?\e$B$I\e(B)
 134                      (?\e$B$O\e(B . ?\e$B$P\e(B)
 135                      (?\e$B$R\e(B . ?\e$B$S\e(B)
 136                      (?\e$B$U\e(B . ?\e$B$V\e(B)
 137                      (?\e$B$X\e(B . ?\e$B$Y\e(B)
 138                      (?\e$B$[\e(B . ?\e$B$\\e(B)
 139                      (?\e$B%&\e(B . ?\e$B%t\e(B)
 140                      (?\e$B%+\e(B . ?\e$B%,\e(B)
 141                      (?\e$B%-\e(B . ?\e$B%.\e(B)
 142                      (?\e$B%/\e(B . ?\e$B%0\e(B)
 143                      (?\e$B%1\e(B . ?\e$B%2\e(B)
 144                      (?\e$B%3\e(B . ?\e$B%4\e(B)
 145                      (?\e$B%5\e(B . ?\e$B%6\e(B)
 146                      (?\e$B%7\e(B . ?\e$B%8\e(B)
 147                      (?\e$B%9\e(B . ?\e$B%:\e(B)
 148                      (?\e$B%;\e(B . ?\e$B%<\e(B)
 149                      (?\e$B%=\e(B . ?\e$B%>\e(B)
 150                      (?\e$B%?\e(B . ?\e$B%@\e(B)
 151                      (?\e$B%A\e(B . ?\e$B%B\e(B)
 152                      (?\e$B%D\e(B . ?\e$B%E\e(B)
 153                      (?\e$B%F\e(B . ?\e$B%G\e(B)
 154                      (?\e$B%H\e(B . ?\e$B%I\e(B)
 155                      (?\e$B%O\e(B . ?\e$B%P\e(B)
 156                      (?\e$B%R\e(B . ?\e$B%S\e(B)
 157                      (?\e$B%U\e(B . ?\e$B%V\e(B)
 158                      (?\e$B%X\e(B . ?\e$B%Y\e(B)
 159                      (?\e$B%[\e(B . ?\e$B%\\e(B)
 160                      ))))
 161     (self-insert-internal
 162      (if ret
 163          (progn
 164            (delete-backward-char 1 nil)
 165            (cdr ret))
 166        ?\e$B!+\e(B))))
 167
 168 (defun kana-keyboard-postfix-semivoicedsound (arg)
 169   (interactive "P")
 170   (let ((ret (assq (char-before)
 171                    '((?\e$B$O\e(B . ?\e$B$Q\e(B)
 172                      (?\e$B$R\e(B . ?\e$B$T\e(B)
 173                      (?\e$B$U\e(B . ?\e$B$W\e(B)
 174                      (?\e$B$X\e(B . ?\e$B$Z\e(B)
 175                      (?\e$B$[\e(B . ?\e$B$]\e(B)
 176                      (?\e$B%O\e(B . ?\e$B%Q\e(B)
 177                      (?\e$B%R\e(B . ?\e$B%T\e(B)
 178                      (?\e$B%U\e(B . ?\e$B%W\e(B)
 179                      (?\e$B%X\e(B . ?\e$B$Z\e(B)
 180                      (?\e$B%[\e(B . ?\e$B%]\e(B)
 181                      ))))
 182     (self-insert-internal
 183      (if ret
 184          (progn
 185            (delete-backward-char 1 nil)
 186            (cdr ret))
 187        ?\e$B!+\e(B))))
 188
 189
 190 (defvar kana-keyboard-hiragana-flag t
 191   "Non nil if kana keys generate hiragana by default.")
 192
 193 (defun kana-keyboard-hiragana (arg)
 194   "Make kana keys generate hiragana."
 195   (interactive "P")
 196   (setq kana-keyboard-hiragana-flag t))
 197
 198 (defun kana-keyboard-katakana (arg)
 199   "Make kana keys generate katakana."
 200   (interactive "P")
 201   (setq kana-keyboard-hiragana-flag nil))
 202
 203 (defmacro kana-keyboard-self-insert (hira kata)
 204   `(lambda (arg)
 205      (interactive "P")
 206      (if kana-keyboard-hiragana-flag
 207          (self-insert-internal ,hira)
 208        (self-insert-internal ,kata))))
 209
 210 ;; The following doesn't work bytecompiled
 211 ;(defmacro kana-keyboard-self-insert (hira kata)
 212 ;  `(lambda (arg)
 213 ;     (interactive "P")
 214 ;     (if kana-keyboard-hiragana-flag
 215 ;        (self-insert-internal ,(eval hira))
 216 ;       (self-insert-internal ,(eval kata)))))
 217
 218 ;(defun kana-keyboard-define-keys ()
 219 ;  (define-key global-map [(voicedsound)] 'kana-keyboard-postfix-voicedsound)
 220 ;  (define-key global-map
 221 ;    [(semivoicedsound)]
 222 ;    'kana-keyboard-postfix-semivoicedsound)
 223 ;  (define-key global-map [(hiragana)] 'kana-keyboard-hiragana)
 224 ;  (define-key global-map [(katakana)] 'kana-keyboard-katakana)
 225 ;  (let (keydef
 226 ;       (keys kana-keyboard-data))
 227 ;    (while (setq keydef (pop keys))
 228 ;      (define-key global-map
 229 ;       (vector (list (car keydef)))
 230 ;       (kana-keyboard-self-insert (cadr keydef) (caddr keydef))))))
 231
 232 ;;;###autoload
 233 (defun kana-keyboard-define-keys ()
 234   (define-key global-map [(voicedsound)] 'kana-keyboard-postfix-voicedsound)
 235   (define-key global-map
 236     [(semivoicedsound)]
 237     'kana-keyboard-postfix-semivoicedsound)
 238   (define-key global-map [(hiragana)] 'kana-keyboard-hiragana)
 239   (define-key global-map [(katakana)] 'kana-keyboard-katakana)
 240   (let (keydef
 241         (keys kana-keyboard-data))
 242     (while (setq keydef (pop keys))
 243       (define-key global-map
 244         (vector (list (car keydef)))
 245         `(lambda (arg)
 246            (interactive "P")
 247            (if kana-keyboard-hiragana-flag
 248                (self-insert-internal ,(cadr keydef))
 249              (self-insert-internal ,(caddr keydef))))))))
 250
 251 (provide 'kana-keyboard)
 252
 253 ;;; kana-keyboard.el ends here