lisp/international/encoded-kb.el

   1 ;;; encoded-kb.el --- Handler to input multibyte characters encoded somehow
   2
   3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 (defvar encoded-kbd-mode nil
  24   "Non-nil if in Encoded-kbd minor mode.")
  25 (put 'encoded-kbd-mode 'permanent-local t)
  26
  27 (or (assq 'encoded-kbd-mode minor-mode-alist)
  28     (setq minor-mode-alist
  29           (cons '(encoded-kbd-mode " Encoded-kbd") minor-mode-alist)))
  30
  31 (defvar encoded-kbd-mode-map
  32   (let ((map (make-sparse-keymap))
  33         (i 128))
  34     (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix)
  35     (while (< i 256)
  36       (define-key map (vector i) 'encoded-kbd-handle-8bit)
  37       (setq i (1+ i)))
  38     map)
  39   "Keymap for Encoded-kbd minor mode.")
  40
  41 (or (assq 'encoded-kbd-mode minor-mode-map-alist)
  42     (setq minor-mode-map-alist
  43           (cons (cons 'encoded-kbd-mode encoded-kbd-mode-map)
  44                 minor-mode-map-alist)))
  45
  46 ;; Subsidiary keymaps for handling ISO2022 escape sequences.
  47
  48 (defvar encoded-kbd-iso2022-esc-map
  49   (let ((map (make-sparse-keymap)))
  50     (define-key map "$" 'encoded-kbd-iso2022-esc-dollar-prefix)
  51     (define-key map "(" 'encoded-kbd-iso2022-designation-prefix)
  52     (define-key map ")" 'encoded-kbd-iso2022-designation-prefix)
  53     (define-key map "," 'encoded-kbd-iso2022-designation-prefix)
  54     (define-key map "-" 'encoded-kbd-iso2022-designation-prefix)
  55     map)
  56   "Keymap for handling ESC code in Encoded-kbd mode.")
  57 (fset 'encoded-kbd-iso2022-esc-prefix encoded-kbd-iso2022-esc-map)
  58
  59 (defvar encoded-kbd-iso2022-esc-dollar-map
  60   (let ((map (make-sparse-keymap)))
  61     (define-key map "(" 'encoded-kbd-iso2022-designation-prefix)
  62     (define-key map ")" 'encoded-kbd-iso2022-designation-prefix)
  63     (define-key map "," 'encoded-kbd-iso2022-designation-prefix)
  64     (define-key map "-" 'encoded-kbd-iso2022-designation-prefix)
  65     (define-key map "@" 'encoded-kbd-iso2022-designation)
  66     (define-key map "A" 'encoded-kbd-iso2022-designation)
  67     (define-key map "B" 'encoded-kbd-iso2022-designation)
  68     map)
  69   "Keymap for handling ESC $ sequence in Encoded-kbd mode.")
  70 (fset 'encoded-kbd-iso2022-esc-dollar-prefix
  71       encoded-kbd-iso2022-esc-dollar-map)
  72
  73 (defvar encoded-kbd-iso2022-designation-map
  74   (let ((map (make-sparse-keymap))
  75         (l charset-list))
  76     (while l
  77       (define-key map
  78         (char-to-string (charset-iso-final-char (car l)))
  79         'encoded-kbd-iso2022-designation)
  80       (setq l (cdr l)))
  81     map)
  82   "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.")
  83 (fset 'encoded-kbd-iso2022-designation-prefix
  84       encoded-kbd-iso2022-designation-map)
  85
  86 (defvar encoded-kbd-iso2022-non-ascii-map
  87   (let ((map (make-keymap))
  88         (i 32))
  89     (while (< i 128)
  90       (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit)
  91       (setq i (1+ i)))
  92     (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix)
  93     (setq i 160)
  94     (while (< i 256)
  95       (define-key map (vector i) 'encoded-kbd-handle-8bit)
  96       (setq i (1+ i)))
  97     map)
  98   "Keymap for handling non-ASCII character set in Encoded-kbd mode.")
  99
 100 ;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to
 101 ;; denote what kind of coding-system we are now handling in
 102 ;; Encoded-kbd mode.
 103 (defvar encoded-kbd-coding nil)
 104
 105 ;; Keep information of designation state of ISO2022 encoding.  This is
 106 ;; a vector of character sets currently designated to each graphic
 107 ;; registers (0..3).
 108
 109 (defvar encoded-kbd-iso2022-designations nil)
 110 (put 'encoded-kbd-iso2022-designations 'permanent-local t)
 111
 112 ;; Keep information of invocation state of ISO2022 encoding.  This is
 113 ;; a vector of graphic register numbers currently invoked to each
 114 ;; graphic plane (0..1), the third element is a single shifted graphic
 115 ;; register number.
 116
 117 (defvar encoded-kbd-iso2022-invocations nil)
 118 (put 'encoded-kbd-iso2022-invocations 'permanent-local t)
 119
 120 (defun encoded-kbd-iso2022-designation ()
 121   "Do ISO2022 designation according to the current key in Encoded-kbd mode.
 122 The following key sequence may cause multilingual text insertion."
 123   (interactive)
 124   (let ((key-seq (this-command-keys))
 125         (prev-g0-charset (aref encoded-kbd-iso2022-designations
 126                                (aref encoded-kbd-iso2022-invocations 0)))
 127         intermediate-char final-char
 128         reg dimension chars charset)
 129     (if (= (length key-seq) 4)
 130         ;; ESC $ <intermediate-char> <final-char>
 131         (setq intermediate-char (aref key-seq 2)
 132               dimension 2
 133               chars (if (< intermediate-char ?,) 94 96)
 134               final-char (aref key-seq 3)
 135               reg (mod intermediate-char 4))
 136       (if (= (aref key-seq 1) ?$)
 137           ;; ESC $ <final-char>
 138           (setq dimension 2
 139                 chars 94
 140                 final-char (aref key-seq 2)
 141                 reg 0)
 142         ;; ESC <intermediate-char> <final-char>
 143         (setq intermediate-char (aref key-seq 1)
 144               dimension 1
 145               chars (if (< intermediate-char ?,) 94 96)
 146               final-char (aref key-seq 2)
 147               reg (mod intermediate-char 4))))
 148     (if (setq charset (iso-charset dimension chars final-char))
 149         (aset encoded-kbd-iso2022-designations reg charset)
 150       (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported"
 151              dimension chars final-char))
 152
 153     (if (memq (aref encoded-kbd-iso2022-designations
 154                     (aref encoded-kbd-iso2022-invocations 0))
 155               '(ascii latin-jisx0201))
 156         ;; Graphic plane 0 (0x20..0x7f) is for ASCII.  We don't have
 157         ;; to handle characters in this range specially.
 158         (if (not (memq prev-g0-charset '(ascii latin-jisx0201)))
 159             ;; We must exit recursive edit now.
 160             (throw 'exit nil))
 161       ;; Graphic plane 0 is for non-ASCII.
 162       (if (memq prev-g0-charset '(ascii latin-jisx0201))
 163           ;; We must handle keys specially.
 164           (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map))
 165             (recursive-edit))))))
 166
 167 (defun encoded-kbd-handle-8bit ()
 168   "Handle an 8-bit character entered in Encoded-kbd mode."
 169   (interactive)
 170   (cond ((eq encoded-kbd-coding 'iso2022-7)
 171          (error "Can't handle the character code %d" last-command-char))
 172
 173         ((eq encoded-kbd-coding 'iso2022-8)
 174          (cond ((= last-command-char ?\216)
 175                 (aset encoded-kbd-iso2022-invocations 2 2))
 176
 177                ((= last-command-char ?\217)
 178                 (aset encoded-kbd-iso2022-invocations 2 3))
 179
 180                ((>= last-command-char ?\240)
 181                 (encoded-kbd-self-insert-iso2022-8bit))
 182
 183                (t
 184                 (error "Can't handle the character code %d"
 185                        last-command-char))))
 186
 187         ((eq encoded-kbd-coding 'sjis)
 188          (encoded-kbd-self-insert-sjis))
 189
 190         (t
 191          (encoded-kbd-self-insert-big5))))
 192
 193 (defun encoded-kbd-self-insert-iso2022-7bit ()
 194   (interactive)
 195   (let* ((charset (aref encoded-kbd-iso2022-designations
 196                         (or (aref encoded-kbd-iso2022-invocations 2)
 197                             (aref encoded-kbd-iso2022-invocations 0))))
 198          (char (if (= (charset-dimension charset) 1)
 199                    (make-char charset last-command-char)
 200                  (make-char charset last-command-char (read-char-exclusive)))))
 201     (aset encoded-kbd-iso2022-invocations 2 nil)
 202     (setq unread-command-events (cons char unread-command-events))))
 203
 204 (defun encoded-kbd-self-insert-iso2022-8bit ()
 205   (interactive)
 206   (let* ((charset (aref encoded-kbd-iso2022-designations
 207                         (or (aref encoded-kbd-iso2022-invocations 2)
 208                             (aref encoded-kbd-iso2022-invocations 1))))
 209          (char (if (= (charset-dimension charset) 1)
 210                    (make-char charset last-command-char)
 211                  (make-char charset last-command-char (read-char-exclusive)))))
 212     (aset encoded-kbd-iso2022-invocations 2 nil)
 213     (setq unread-command-events (cons char unread-command-events))))
 214
 215 (defun encoded-kbd-self-insert-sjis ()
 216   (interactive)
 217   (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0))
 218                   (decode-sjis-char (+ (ash last-command-char 8)
 219                                        (read-char-exclusive)))
 220                 (make-char 'katakana-jisx0201 last-command-char))))
 221     (setq unread-command-events (cons char unread-command-events))))
 222
 223 (defun encoded-kbd-self-insert-big5 ()
 224   (interactive)
 225   (let ((char (decode-big5-char (+ (ash last-command-char 8)
 226                                    (read-char-exclusive)))))
 227     (setq unread-command-events (cons char unread-command-events))))
 228
 229 ;; Input mode at the time Encoded-kbd mode is turned on is saved here.
 230 (defvar saved-input-mode nil)
 231
 232 ;;;###autoload
 233 (defun encoded-kbd-mode (&optional arg)
 234   "Toggle Encoded-kbd minor mode.
 235 With arg, turn Encoded-kbd mode on if and only if arg is positive.
 236
 237 You should not turn this mode on manually, instead use the command
 238 \\[set-keyboard-coding-system] which turns on or off this mode
 239 automatically.
 240
 241 In Encoded-kbd mode, a text sent from keyboard is accepted
 242 as a multilingual text encoded in a coding system set by
 243 \\[set-keyboard-coding-system]."
 244   (if encoded-kbd-mode
 245       ;; We must at first reset input-mode to the original.
 246       (apply 'set-input-mode saved-input-mode))
 247   (setq encoded-kbd-mode
 248         (if (null arg) (null encoded-kbd-mode)
 249           (> (prefix-numeric-value arg) 0)))
 250   (if encoded-kbd-mode
 251       (let ((coding (keyboard-coding-system)))
 252         (setq saved-input-mode  (current-input-mode))
 253         (cond ((null coding)
 254                (setq encoded-kbd-mode nil)
 255                (error "No coding system for keyboard input is set"))
 256
 257               ((= (coding-system-type coding) 1) ; SJIS
 258                (set-input-mode
 259                 (nth 0 saved-input-mode) (nth 1 saved-input-mode)
 260                 'use-8th-bit (nth 3 saved-input-mode))
 261                (setq encoded-kbd-coding 'sjis))
 262
 263               ((= (coding-system-type coding) 2) ; ISO2022
 264                (if (aref (coding-system-flags coding) 7) ; 7-bit only
 265                    (setq encoded-kbd-coding 'iso2022-7)
 266                  (set-input-mode
 267                   (nth 0 saved-input-mode) (nth 1 saved-input-mode)
 268                   'use-8th-bit (nth 3 saved-input-mode))
 269                  (setq encoded-kbd-coding 'iso2022-8))
 270                (setq encoded-kbd-iso2022-designations (make-vector 4 nil))
 271                (let ((flags (coding-system-flags coding))
 272                      (i 0))
 273                  (while (< i 4)
 274                    (if (charsetp (aref flags i))
 275                        (aset encoded-kbd-iso2022-designations i
 276                              (aref flags i))
 277                      (if (charsetp (car-safe (aref flags i)))
 278                        (aset encoded-kbd-iso2022-designations i
 279                              (car (aref flags i)))))
 280                    (setq i (1+ i))))
 281                (setq encoded-kbd-iso2022-invocations (make-vector 3 nil))
 282                (aset encoded-kbd-iso2022-invocations 0 0)
 283                (aset encoded-kbd-iso2022-invocations 1 1))
 284
 285               ((= (coding-system-type coding) 3) ; BIG5
 286                (set-input-mode
 287                 (nth 0 saved-input-mode) (nth 1 saved-input-mode)
 288                 'use-8th-bit (nth 3 saved-input-mode))
 289                (setq encoded-kbd-coding 'big5))
 290
 291               (t
 292                (setq encoded-kbd-mode nil)
 293                (error "Coding-system `%s' is not supported in Encoded-kbd mode"
 294                       (keyboard-coding-system))))
 295         (run-hooks 'encoded-kbd-mode-hook))))
 296
 297 ;;; encoded-kb.el ends here