Source

mule-base / kana-keyboard.el

;;; kana-keyboard.el --- Japanese Kana Keyboard support

;; Copyright (C) 1999 by Free Software Foundation, Inc.

;; Author: SL Baur <steve@xemacs.org>
;; Keywords: mule, hardware

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; This file contains keybindings to make a Kana keyboard useful.  It requires
;; X11 keysym support on the X server and (of course) a keyboard that can
;; directly generate kana symbols.

;;; Code:

(eval-when-compile
  (require 'cl))

(defconst kana-keyboard-data
  '(
    (kana_A ?$B$"(B ?$B%"(B)
    (kana_a ?$B$!(B ?$B%!(B)
    (kana_I ?$B$$(B ?$B%$(B)
    (kana_i ?$B$#(B ?$B%#(B)
    (kana_U ?$B$&(B ?$B%&(B)
    (kana_u ?$B$%(B ?$B%%(B)
    (kana_E ?$B$((B ?$B%((B)
    (kana_e ?$B$'(B ?$B%'(B)
    (kana_O ?$B$*(B ?$B%*(B)
    (kana_o ?$B$)(B ?$B%)(B)

    (kana_KA ?$B$+(B ?$B%+(B)
    (kana_KI ?$B$-(B ?$B%-(B)
    (kana_KU ?$B$/(B ?$B%/(B)
    (kana_KE ?$B$1(B ?$B%1(B)
    (kana_KO ?$B$3(B ?$B%3(B)

    (kana_SA ?$B$5(B ?$B%5(B)
    (kana_SHI ?$B$7(B ?$B%7(B)
    (kana_SU ?$B$9(B ?$B%9(B)
    (kana_SE ?$B$;(B ?$B%;(B)
    (kana_SO ?$B$=(B ?$B%=(B)

    (kana_TA ?$B$?(B ?$B%?(B)
    (kana_CHI ?$B$A(B ?$B%A(B)
    (kana_TSU ?$B$D(B ?$B%D(B)
    (kana_tsu ?$B$C(B ?$B%C(B)
    (kana_TE ?$B$F(B ?$B%F(B)
    (kana_TO ?$B$H(B ?$B%H(B)

    (kana_MA ?$B$^(B ?$B%^(B)
    (kana_MI ?$B$_(B ?$B%_(B)
    (kana_MU ?$B$`(B ?$B%`(B)
    (kana_ME ?$B$a(B ?$B%a(B)
    (kana_MO ?$B$b(B ?$B%b(B)

    (kana_HA ?$B$O(B ?$B%O(B)
    (kana_HI ?$B$R(B ?$B%R(B)
    (kana_FU ?$B$U(B ?$B%U(B)
    (kana_HE ?$B$X(B ?$B%X(B)
    (kana_HO ?$B$[(B ?$B%[(B)

    (kana_NA ?$B$J(B ?$B%J(B)
    (kana_NI ?$B$K(B ?$B%K(B)
    (kana_NU ?$B$L(B ?$B%L(B)
    (kana_NE ?$B$M(B ?$B%M(B)
    (kana_NO ?$B$N(B ?$B%N(B)

    (kana_YA ?$B$d(B ?$B%d(B)
    (kana_ya ?$B$c(B ?$B%c(B)
    (kana_YU ?$B$f(B ?$B%f(B)
    (kana_yu ?$B$e(B ?$B%e(B)
    (kana_YO ?$B$h(B ?$B%h(B)
    (kana_yo ?$B$g(B ?$B%g(B)

    (kana_RA ?$B$i(B ?$B%i(B)
    (kana_RI ?$B$j(B ?$B%j(B)
    (kana_RU ?$B$k(B ?$B%k(B)
    (kana_RE ?$B$l(B ?$B%l(B)
    (kana_RO ?$B$m(B ?$B%m(B)

    (kana_WA ?$B$o(B ?$B%o(B)
    (kana_WO ?$B$r(B ?$B%r(B)

    (kana_N ?$B$s(B ?$B%s(B)

    (prolongedsound ?$B!<(B ?$B!<(B)
    ;; (voicedsound ? ?)
    ;; (semivoicedsound ? ?)
    (kana_openingbracket ?\$B!V(B ?\$B!V(B)
    (kana_closingbracket ?\$B!W(B ?\$B!W(B)
    (kana_fullstop ?$B!#(B ?$B!#(B)
    (kana_comma ?$B!"(B ?$B!"(B)
    (kana_conjunctive ?$B!&(B ?$B!&(B)))

;;; Postfixed voiced sound support from MORIOKA Tomohiko
(defun kana-keyboard-postfix-voicedsound (arg)
  (interactive "P")
  (let ((ret (assq (char-before)
		   '((?$B$+(B . ?$B$,(B)
		     (?$B$-(B . ?$B$.(B)
		     (?$B$/(B . ?$B$0(B)
		     (?$B$1(B . ?$B$2(B)
		     (?$B$3(B . ?$B$4(B)
		     (?$B$5(B . ?$B$6(B)
		     (?$B$7(B . ?$B$8(B)
		     (?$B$9(B . ?$B$:(B)
		     (?$B$;(B . ?$B$<(B)
		     (?$B$=(B . ?$B$>(B)
		     (?$B$?(B . ?$B$@(B)
		     (?$B$A(B . ?$B$B(B)
		     (?$B$D(B . ?$B$E(B)
		     (?$B$F(B . ?$B$G(B)
		     (?$B$H(B . ?$B$I(B)
		     (?$B$O(B . ?$B$P(B)
		     (?$B$R(B . ?$B$S(B)
		     (?$B$U(B . ?$B$V(B)
		     (?$B$X(B . ?$B$Y(B)
		     (?$B$[(B . ?$B$\(B)
		     (?$B%&(B . ?$B%t(B)
		     (?$B%+(B . ?$B%,(B)
		     (?$B%-(B . ?$B%.(B)
		     (?$B%/(B . ?$B%0(B)
		     (?$B%1(B . ?$B%2(B)
		     (?$B%3(B . ?$B%4(B)
		     (?$B%5(B . ?$B%6(B)
		     (?$B%7(B . ?$B%8(B)
		     (?$B%9(B . ?$B%:(B)
		     (?$B%;(B . ?$B%<(B)
		     (?$B%=(B . ?$B%>(B)
		     (?$B%?(B . ?$B%@(B)
		     (?$B%A(B . ?$B%B(B)
		     (?$B%D(B . ?$B%E(B)
		     (?$B%F(B . ?$B%G(B)
		     (?$B%H(B . ?$B%I(B)
		     (?$B%O(B . ?$B%P(B)
		     (?$B%R(B . ?$B%S(B)
		     (?$B%U(B . ?$B%V(B)
		     (?$B%X(B . ?$B%Y(B)
		     (?$B%[(B . ?$B%\(B)
		     ))))
    (self-insert-internal
     (if ret
	 (progn
	   (delete-backward-char 1 nil)
	   (cdr ret))
       ?$B!+(B))))

(defun kana-keyboard-postfix-semivoicedsound (arg)
  (interactive "P")
  (let ((ret (assq (char-before)
		   '((?$B$O(B . ?$B$Q(B)
		     (?$B$R(B . ?$B$T(B)
		     (?$B$U(B . ?$B$W(B)
		     (?$B$X(B . ?$B$Z(B)
		     (?$B$[(B . ?$B$](B)
		     (?$B%O(B . ?$B%Q(B)
		     (?$B%R(B . ?$B%T(B)
		     (?$B%U(B . ?$B%W(B)
		     (?$B%X(B . ?$B$Z(B)
		     (?$B%[(B . ?$B%](B)
		     ))))
    (self-insert-internal
     (if ret
	 (progn
	   (delete-backward-char 1 nil)
	   (cdr ret))
       ?$B!+(B))))


(defvar kana-keyboard-hiragana-flag t
  "Non nil if kana keys generate hiragana by default.")

(defun kana-keyboard-hiragana (arg)
  "Make kana keys generate hiragana."
  (interactive "P")
  (setq kana-keyboard-hiragana-flag t))

(defun kana-keyboard-katakana (arg)
  "Make kana keys generate katakana."
  (interactive "P")
  (setq kana-keyboard-hiragana-flag nil))

(defmacro kana-keyboard-self-insert (hira kata)
  `(lambda (arg)
     (interactive "P")
     (if kana-keyboard-hiragana-flag
	 (self-insert-internal ,hira)
       (self-insert-internal ,kata))))

;; The following doesn't work bytecompiled
;(defmacro kana-keyboard-self-insert (hira kata)
;  `(lambda (arg)
;     (interactive "P")
;     (if kana-keyboard-hiragana-flag
;	 (self-insert-internal ,(eval hira))
;       (self-insert-internal ,(eval kata)))))

;(defun kana-keyboard-define-keys ()
;  (define-key global-map [(voicedsound)] 'kana-keyboard-postfix-voicedsound)
;  (define-key global-map
;    [(semivoicedsound)]
;    'kana-keyboard-postfix-semivoicedsound)
;  (define-key global-map [(hiragana)] 'kana-keyboard-hiragana)
;  (define-key global-map [(katakana)] 'kana-keyboard-katakana)
;  (let (keydef
;	(keys kana-keyboard-data))
;    (while (setq keydef (pop keys))
;      (define-key global-map
;	(vector (list (car keydef)))
;	(kana-keyboard-self-insert (cadr keydef) (caddr keydef))))))

;;;###autoload
(defun kana-keyboard-define-keys ()
  (define-key global-map [(voicedsound)] 'kana-keyboard-postfix-voicedsound)
  (define-key global-map
    [(semivoicedsound)]
    'kana-keyboard-postfix-semivoicedsound)
  (define-key global-map [(hiragana)] 'kana-keyboard-hiragana)
  (define-key global-map [(katakana)] 'kana-keyboard-katakana)
  (let (keydef
	(keys kana-keyboard-data))
    (while (setq keydef (pop keys))
      (define-key global-map
	(vector (list (car keydef)))
	`(lambda (arg)
	   (interactive "P")
	   (if kana-keyboard-hiragana-flag
	       (self-insert-internal ,(cadr keydef))
	     (self-insert-internal ,(caddr keydef))))))))

(provide 'kana-keyboard)

;;; kana-keyboard.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.