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

   1 ;;; mule-keyboard.el --- Direct input of multilingual chars from keyboard.
   2
   3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   4
   5 ;; This file is part of XEmacs.
   6
   7 ;; XEmacs is free software; you can redistribute it and/or modify it
   8 ;; under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; XEmacs is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with XEmacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;;; 92.3.5   created for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp>
  23
  24 ;;;###autoload
  25 (defvar keyboard-allow-latin-input nil
  26   "If non-nil, \"ESC , Fe\" and \"ESC - Fe\" are used for inputting
  27 Latin characters.")
  28
  29 ;; common global variables of internal use
  30 (defvar _keyboard-first-byte_ nil
  31   "Character buffer for the first byte of two-byte character.")
  32 (defvar _keyboard-SS2_ nil
  33   "Flag to indicate Single Shift SS2.")
  34 (defvar _keyboard-SS3_ nil
  35   "Flag to indicate Single Shift SS3.")
  36 (defvar _keyboard-saved-local-map_ nil
  37   "Saved local keymap.")
  38 (defvar _saved-local-map-single-shift_ nil
  39   "Saved single shift local map.")
  40
  41 (defvar _current-g0_ 0)
  42 (defvar _current-g1_ nil)
  43 (defvar _current-g2_ nil)
  44 (defvar _current-g3_ nil)
  45
  46 (defconst local-map-iso nil
  47   "Local keymap used while inputing ISO2022 code directly.")
  48 (defconst local-map-shift-jis nil
  49   "Local keymap used while inputing Shift-JIS code directly.")
  50 (defconst local-map-big5 nil
  51   "Local keymap used while inputing Big5 code directly.")
  52
  53 (defconst esc-dol-map nil "Keys to designate 94n or 96n charset.")
  54 (defconst esc-openpar-map nil "Keys to designate 94 charset to GL.")
  55 (defconst esc-closepar-map nil "Keys to designate 94 charset to GR.")
  56 (defconst esc-comma-map nil "Keys to designate 96 charset to GL.")
  57 (defconst esc-minus-map nil "Keys to designate 96 charset to GR.")
  58 (defconst esc-dol-openpar-map nil "Keys to designate 94n charset to GL.")
  59 (defconst esc-dol-closepar-map nil "Keys to designate 94n charset to GR.")
  60 (defconst esc-dol-comma-map nil "Keys to designate 96n charset to GL.")
  61 (defconst esc-dol-minus-map nil "Keys to designate 96n charset to GR.")
  62
  63 ;;;###autoload
  64 (defun set-keyboard-coding-system (codesys)
  65   "Set variable keyboard-coding-system to CODESYS and modify keymap for it."
  66   (interactive "zKeyboard-coding-system: ")
  67   (let ((type (coding-system-type codesys)))
  68     (cond ((eq type 'shift-jis)
  69            (set-keyboard-coding-system-shift-jis))
  70           ((eq type 'iso2022)
  71            (set-keyboard-coding-system-iso2022 codesys))
  72           ((eq type 'big5)
  73            (set-keyboard-coding-system-big5))
  74           (t
  75            (error "Direct input of code %s is not supported." codesys)))))
  76
  77 (defsubst keyboard-define-key (map key command)
  78   (define-key map (char-to-string key) command t))
  79
  80 (defun keyboard-set-input-mode (value)
  81   (let ((mode (current-input-mode)))
  82     ;; current-input-mode returns (INTERRUPT FLOW META QUIT-CHAR)
  83     ;; set META to value.
  84     (setcar (nthcdr 2 mode) value)
  85     (apply (function set-input-mode) mode)))
  86
  87 \f
  88 (defun keyboard-select-keymap (&rest maps)
  89   (or (nth (get-code-type keyboard-coding-system) maps)
  90       (error "invalid keyboard-coding-system")))
  91
  92 (defun keyboard-self-insert-do-insert (char)
  93   (self-insert-internal char)
  94   (check-auto-fill))
  95
  96 ;; ### I think this is the right function to put this on... must check further
  97 ;; wire us into pending-delete
  98 (put 'keyboard-self-insert-do-insert 'pending-delete t)
  99
 100 (defun keyboard-use-local-map-do-insert (map)
 101   (use-local-map map))
 102
 103 (defun keyboard-current-local-map-do-insert ()
 104   (current-local-map))
 105
 106 (defun keyboard-local-map-do-insert ()
 107   (keyboard-select-keymap nil local-map-shift-jis local-map-iso local-map-big5))
 108
 109 \f
 110 (defconst keyboard-self-insert-function
 111   (function keyboard-self-insert-do-insert))
 112
 113 (defconst keyboard-use-local-map-function
 114   (function keyboard-use-local-map-do-insert))
 115
 116 (defconst keyboard-current-local-map-function
 117   (function keyboard-current-local-map-do-insert))
 118
 119 (defconst keyboard-local-map-function
 120   (function keyboard-local-map-do-insert))
 121
 122 (defun keyboard-self-insert (char)
 123   (funcall keyboard-self-insert-function char))
 124
 125 (defun keyboard-current-local-map ()
 126   (funcall keyboard-current-local-map-function))
 127
 128 (defun keyboard-use-local-map (map)
 129   (funcall keyboard-use-local-map-function map))
 130
 131 (defun keyboard-local-map ()
 132   (funcall keyboard-local-map-function))
 133
 134 \f
 135 (defun keyboard-reset-state ()
 136   (setq _keyboard-first-byte_ nil
 137         _keyboard-SS2_ nil
 138         _keyboard-SS3_ nil))
 139
 140 (defun keyboard-define-global-map-iso (map)
 141   (let ((i 160))
 142     (while (< i 256)
 143       (keyboard-define-key map i 'self-insert-iso)
 144       (setq i (1+ i))))
 145   (define-key map "\216" 'keyboard-SS2 t)
 146   (define-key map "\217" 'keyboard-SS3 t)
 147   (define-key map "\e(" 'esc-openpar-prefix)
 148   (define-key map "\e)" 'esc-closepar-prefix)
 149   (if keyboard-allow-latin-input
 150       (progn
 151         (define-key map "\e," 'esc-comma-prefix)
 152         (define-key map "\e-" 'esc-minus-prefix)))
 153   (define-key map "\e$" 'esc-dol-prefix))
 154
 155 (defun keyboard-define-local-map-iso (map)
 156   (let ((i 33))
 157     (while (< i 127)
 158       (keyboard-define-key map i 'self-insert-iso)
 159       (setq i (1+ i)))))
 160
 161 (defun set-keyboard-coding-system-iso2022 (code)
 162   (setq _current-g0_ (coding-system-charset code 0))
 163   (setq _current-g1_ (coding-system-charset code 1))
 164   (setq _current-g2_ (coding-system-charset code 2))
 165   (setq _current-g3_ (coding-system-charset code 3))
 166   (if (null _current-g1_)
 167       (keyboard-set-input-mode t)       ; enable Meta-key
 168     (keyboard-set-input-mode 0))        ; enable 8bit input as chars.
 169   (let (i)
 170     (setq i 160)
 171     (while (< i 256)
 172       (keyboard-define-key global-map i 'self-insert-iso)
 173       (setq i (1+ i))))
 174   (if local-map-iso nil
 175     (setq local-map-iso (make-keymap))
 176     (let (i map)
 177       (setq i 33)
 178       (while (< i 127)
 179         (keyboard-define-key local-map-iso i 'self-insert-iso)
 180         (setq i (1+ i)))
 181       (setq map (current-global-map))
 182       (setq i 161)
 183       (while (< i 255)
 184         (keyboard-define-key map i 'self-insert-iso)
 185         (setq i (1+ i))))
 186     (define-key local-map-iso "\C-g" 'mule-keyboard-quit))
 187   (if esc-dol-map nil
 188     (setq esc-dol-map (make-keymap)
 189           esc-openpar-map (make-keymap)
 190           esc-closepar-map (make-keymap)
 191           esc-comma-map (make-keymap)
 192           esc-minus-map (make-keymap)
 193           esc-dol-openpar-map (make-keymap)
 194           esc-dol-closepar-map (make-keymap)
 195           esc-dol-comma-map (make-keymap)
 196           esc-dol-minus-map (make-keymap))
 197     (fset 'esc-dol-prefix esc-dol-map)
 198     (fset 'esc-openpar-prefix esc-openpar-map)
 199     (fset 'esc-closepar-prefix esc-closepar-map)
 200     (fset 'esc-comma-prefix esc-comma-map)
 201     (fset 'esc-minus-prefix esc-minus-map)
 202     (fset 'esc-dol-openpar-prefix esc-dol-openpar-map)
 203     (fset 'esc-dol-closepar-prefix esc-dol-closepar-map)
 204     (fset 'esc-dol-comma-prefix esc-dol-comma-map)
 205     (fset 'esc-dol-minus-prefix esc-dol-minus-map)
 206     (define-key esc-dol-map "(" 'esc-dol-openpar-prefix)
 207     (define-key esc-dol-map ")" 'esc-dol-closepar-prefix)
 208     (define-key esc-dol-map "," 'esc-dol-comma-prefix)
 209     (define-key esc-dol-map "-" 'esc-dol-minus-prefix)
 210     (let (i)
 211       (setq i ?0)
 212       (while (< i ?`)
 213         (keyboard-define-key esc-openpar-map i 'keyboard-designate-94-GL)
 214         (keyboard-define-key esc-closepar-map i 'keyboard-designate-94-GR)
 215         (keyboard-define-key esc-comma-map i 'keyboard-designate-96-GL)
 216         (keyboard-define-key esc-minus-map i 'keyboard-designate-96-GR)
 217         (keyboard-define-key esc-dol-map i 'keyboard-designate-94n-GL)
 218         (keyboard-define-key esc-dol-openpar-map i 'keyboard-designate-94n-GL)
 219         (keyboard-define-key esc-dol-closepar-map i 'keyboard-designate-94n-GR)
 220         (keyboard-define-key esc-dol-comma-map i 'keyboard-designate-96n-GL)
 221         (keyboard-define-key esc-dol-minus-map i 'keyboard-designate-96n-GR)
 222         (setq i (1+ i)))))
 223   (define-key global-map "\216" 'keyboard-SS2 t)
 224   (define-key global-map "\217" 'keyboard-SS3 t)
 225   (define-key esc-map "(" 'esc-openpar-prefix)
 226   (define-key esc-map ")" 'esc-closepar-prefix)
 227   (if keyboard-allow-latin-input
 228       (progn
 229         (define-key esc-map "," 'esc-comma-prefix)
 230         (define-key esc-map "-" 'esc-minus-prefix)))
 231   (define-key esc-map "$" 'esc-dol-prefix)
 232   (keyboard-reset-state)
 233   (setq keyboard-coding-system code)
 234   )
 235
 236 (defun mule-keyboard-quit ()
 237   (interactive)
 238   (keyboard-reset-state)
 239   (if _keyboard-saved-local-map_
 240       (keyboard-use-local-map _keyboard-saved-local-map_))
 241   (keyboard-quit))
 242
 243 (defun keyboard-change-local-map-for-iso ()
 244   (if (eq (keyboard-current-local-map) (keyboard-local-map))
 245       nil
 246     (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
 247     (keyboard-use-local-map (keyboard-local-map))))
 248
 249 (defun keyboard-designate-94-GL ()
 250   (interactive)
 251   (if (and (coding-system-use-japanese-jisx0201-roman keyboard-coding-system)
 252            (eq 'japanese-jisx0201-roman
 253                (charset-from-attributes 1 94 last-command-char)))
 254       (setq _current-g0_ 'ascii)
 255     (setq _current-g0_ (charset-from-attributes 1 94 last-command-char)))
 256   (if (eq _current-g0_ 'ascii)
 257       (keyboard-use-local-map _keyboard-saved-local-map_)
 258     (keyboard-change-local-map-for-iso)))
 259
 260 (defun keyboard-designate-94-GR ()
 261   (interactive)
 262   (setq _current-g1_ (charset-from-attributes 1 94 last-command-char)))
 263
 264 (defun keyboard-designate-96-GL ()
 265   (interactive)
 266   (setq _current-g0_ (charset-from-attributes 1 96 last-command-char))
 267   (keyboard-change-local-map-for-iso))
 268
 269 (defun keyboard-designate-96-GR ()
 270   (interactive)
 271   (setq _current-g1_ (charset-from-attributes 1 96 last-command-char)))
 272
 273 (defun keyboard-designate-94n-GL ()
 274   (interactive)
 275   (if (and (coding-system-use-japanese-jisx0208-1978 keyboard-coding-system)
 276            (eq 'japanese-jisx0208-1978
 277                (charset-from-attributes 2 94 last-command-char)))
 278       (setq _current-g0_ 'japanese-jisx0208)
 279     (setq _current-g0_ (charset-from-attributes 2 94 last-command-char)))
 280   (keyboard-change-local-map-for-iso))
 281
 282 (defun keyboard-designate-94n-GR ()
 283   (interactive)
 284   (setq _current-g1_ (charset-from-attributes 2 94 last-command-char)))
 285
 286 (defun keyboard-designate-96n-GL ()
 287   (interactive)
 288   (setq _current-g0_ (charset-from-attributes 2 96 last-command-char))
 289   (keyboard-change-local-map-for-iso))
 290
 291 (defun keyboard-designate-96n-GR ()
 292   (interactive)
 293   (setq _current-g1_ (charset-from-attributes 2 96 last-command-char)))
 294
 295 (defun keyboard-SS2 ()
 296   (interactive)
 297   (setq _keyboard-SS2_ t)
 298   (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
 299   (keyboard-change-local-map-for-iso))
 300
 301 (defun keyboard-SS3 ()
 302   (interactive)
 303   (setq _keyboard-SS3_ t)
 304   (setq _saved-local-map-single-shift_ (keyboard-current-local-map))
 305   (keyboard-change-local-map-for-iso))
 306
 307 (defun self-insert-iso ()
 308   (interactive)
 309   (let ((charset (cond (_keyboard-SS2_ _current-g2_)
 310                        (_keyboard-SS3_ _current-g3_)
 311                        ((< last-command-char 128) _current-g0_)
 312                        (t _current-g1_))))
 313     (if (not charset) (mule-keyboard-quit))
 314     (if (= (charset-dimension charset) 1)
 315         (progn
 316           (keyboard-self-insert (make-char charset last-command-char))
 317           (if (or _keyboard-SS2_ _keyboard-SS3_)
 318               (keyboard-use-local-map _saved-local-map-single-shift_))
 319           (keyboard-reset-state))
 320       (if _keyboard-first-byte_
 321           (progn
 322             (keyboard-self-insert (make-char charset _keyboard-first-byte_
 323                                              last-command-char))
 324             (if (or _keyboard-SS2_ _keyboard-SS3_)
 325                 (keyboard-use-local-map _saved-local-map-single-shift_))
 326             (keyboard-reset-state))
 327         (setq _keyboard-first-byte_ last-command-char)))))
 328
 329 \f
 330 (defun keyboard-define-global-map-shift-jis (map)
 331   (let ((i 128))
 332     (while (< i 160)
 333       (keyboard-define-key map i 'self-insert-shift-jis-japanese)
 334       (setq i (1+ i)))
 335     (while (< i 224)
 336       (keyboard-define-key map i 'self-insert-shift-jis-kana)
 337       (setq i (1+ i)))
 338     (while (< i 256)
 339       (keyboard-define-key map i 'self-insert-shift-jis-japanese)
 340       (setq i (1+ i)))))
 341
 342 (defun keyboard-define-local-map-shift-jis (map)
 343   (let ((i 64))
 344     (while (< i 256)
 345       (keyboard-define-key map i 'self-insert-shift-jis-japanese2)
 346       (setq i (1+ i)))))
 347
 348 (defun set-keyboard-coding-system-shift-jis ()
 349   (keyboard-set-input-mode 0)           ; enable 8bit input as chars
 350   (keyboard-define-global-map-shift-jis global-map)
 351   (if local-map-shift-jis
 352       nil
 353     (setq local-map-shift-jis (make-keymap))
 354     (keyboard-define-local-map-shift-jis local-map-shift-jis)
 355     (define-key local-map-shift-jis "\C-g" 'mule-keyboard-quit))
 356   (setq _keyboard-first-byte_ nil)
 357   (setq keyboard-coding-system 'shift-jis))
 358
 359 (defun self-insert-shift-jis-japanese ()
 360   (interactive)
 361   (setq _keyboard-first-byte_ last-command-char)
 362   (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
 363   (keyboard-use-local-map (keyboard-local-map)))
 364
 365 (defun self-insert-shift-jis-japanese2 ()
 366   (interactive)
 367   (if _keyboard-first-byte_
 368       (let ((char
 369              (decode-shift-jis-char _keyboard-first-byte_ last-command-char)))
 370         (keyboard-self-insert char)
 371         (setq _keyboard-first-byte_ nil)))
 372   (keyboard-use-local-map _keyboard-saved-local-map_))
 373
 374 (defun self-insert-shift-jis-kana ()
 375   (interactive)
 376   (keyboard-self-insert (make-char 'japanese-jisx0201-kana last-command-char)))
 377
 378 \f
 379 (defun keyboard-define-global-map-big5 (map)
 380   (let ((i ?\xA1))
 381     (while (< i ?\xFE)
 382       (keyboard-define-key map i 'self-insert-big5-1)
 383       (setq i (1+ i)))))
 384
 385 (defun keyboard-define-local-map-big5 (map)
 386   (let ((i ?\x40))
 387     (while (< i ?\x7F)
 388       (keyboard-define-key map i 'self-insert-big5-2)
 389       (setq i (1+ i)))
 390     (setq i ?\xA1)
 391     (while (< i ?\xFF)
 392       (keyboard-define-key map i 'self-insert-big5-2)
 393       (setq i (1+ i)))
 394     ))
 395
 396 (defun set-keyboard-coding-system-big5 ()
 397   (require 'chinese)
 398   (keyboard-set-input-mode 0)           ; enable 8bit input as chars
 399   (keyboard-define-global-map-big5 global-map)
 400   (if local-map-big5
 401       nil
 402     (setq local-map-big5 (make-keymap))
 403     (keyboard-define-local-map-big5 local-map-big5)
 404     (define-key local-map-big5 "\C-g" 'mule-keyboard-quit))
 405   (setq _keyboard-first-byte_ 0)
 406   (setq keyboard-coding-system 'big5))
 407
 408 (defun self-insert-big5-1 ()
 409   (interactive)
 410   (setq _keyboard-first-byte_ last-command-char)
 411   (setq _keyboard-saved-local-map_ (keyboard-current-local-map))
 412   (keyboard-use-local-map (keyboard-local-map)))
 413
 414 (defun self-insert-big5-2 ()
 415   (interactive)
 416   (if _keyboard-first-byte_
 417       (progn
 418         (keyboard-self-insert
 419          (decode-big5-char _keyboard-first-byte_ last-command-char
 420                            'character))
 421         (setq _keyboard-first-byte_ nil)))
 422   (keyboard-use-local-map _keyboard-saved-local-map_))
 423
 424 \f
 425 (defun check-auto-fill ()
 426   (if (and auto-fill-function (> (current-column) fill-column))
 427       (funcall auto-fill-function)))