1 ;;; encoded-kb.el --- handler to input multibyte characters encoded somehow
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2004, 2005
5 ;; National Institute of Advanced Industrial Science and Technology (AIST)
6 ;; Registration Number H14PRO021
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
29 ;; Usually this map is empty (even if Encoded-kbd mode is on), but if
30 ;; the keyboard coding system is iso-2022-based, it defines dummy key
31 ;; bindings for ESC $ ..., etc. so that those bindings in
32 ;; key-translation-map take effect.
33 (defconst encoded-kbd-mode-map (make-sparse-keymap)
34 "Keymap for Encoded-kbd minor mode.")
36 ;; Subsidiary keymaps for handling ISO2022 escape sequences.
38 (defvar encoded-kbd-iso2022-esc-map
39 (let ((map (make-sparse-keymap)))
40 (define-key map "$" 'encoded-kbd-iso2022-esc-dollar-prefix)
41 (define-key map "(" 'encoded-kbd-iso2022-designation-prefix)
42 (define-key map ")" 'encoded-kbd-iso2022-designation-prefix)
43 (define-key map "," 'encoded-kbd-iso2022-designation-prefix)
44 (define-key map "-" 'encoded-kbd-iso2022-designation-prefix)
46 "Keymap for handling ESC code in Encoded-kbd mode.")
47 (fset 'encoded-kbd-iso2022-esc-prefix encoded-kbd-iso2022-esc-map)
49 (defvar encoded-kbd-iso2022-esc-dollar-map
50 (let ((map (make-sparse-keymap)))
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 (define-key map "@" 'encoded-kbd-iso2022-designation)
56 (define-key map "A" 'encoded-kbd-iso2022-designation)
57 (define-key map "B" 'encoded-kbd-iso2022-designation)
59 "Keymap for handling ESC $ sequence in Encoded-kbd mode.")
60 (fset 'encoded-kbd-iso2022-esc-dollar-prefix
61 encoded-kbd-iso2022-esc-dollar-map)
63 (defvar encoded-kbd-iso2022-designation-map
64 (let ((map (make-sparse-keymap))
68 (setq final-char (charset-iso-final-char (car l)))
70 (define-key map (char-to-string final-char)
71 'encoded-kbd-iso2022-designation))
74 "Keymap for handling ISO2022 designation sequence in Encoded-kbd mode.")
75 (fset 'encoded-kbd-iso2022-designation-prefix
76 encoded-kbd-iso2022-designation-map)
78 ;; Keep information of designation state of ISO2022 encoding. When
79 ;; Encoded-kbd mode is on, this is set to a vector of length 4, the
80 ;; elements are character sets currently designated to graphic
81 ;; registers 0 thru 3.
83 (defvar encoded-kbd-iso2022-designations nil)
84 (put 'encoded-kbd-iso2022-designations 'permanent-local t)
86 ;; Keep information of invocation state of ISO2022 encoding. When
87 ;; Encoded-kbd mode is on, this is set to a vector of length 3,
88 ;; graphic register numbers currently invoked to graphic plane 1 and
89 ;; 2, and a single shifted graphic register number.
91 (defvar encoded-kbd-iso2022-invocations nil)
92 (put 'encoded-kbd-iso2022-invocations 'permanent-local t)
94 (defsubst encoded-kbd-last-key ()
95 (let ((keys (this-single-command-keys)))
96 (aref keys (1- (length keys)))))
98 (defun encoded-kbd-iso2022-designation (ignore)
99 "Do ISO2022 designation according to the current key in Encoded-kbd mode.
100 The following key sequence may cause multilingual text insertion."
101 (let ((key-seq (this-single-command-keys))
102 (prev-g0-charset (aref encoded-kbd-iso2022-designations
103 (aref encoded-kbd-iso2022-invocations 0)))
104 intermediate-char final-char
105 reg dimension chars charset)
106 (if (= (length key-seq) 4)
107 ;; ESC $ <intermediate-char> <final-char>
108 (setq intermediate-char (aref key-seq 2)
110 chars (if (< intermediate-char ?,) 94 96)
111 final-char (aref key-seq 3)
112 reg (mod intermediate-char 4))
113 (if (= (aref key-seq 1) ?$)
114 ;; ESC $ <final-char>
117 final-char (aref key-seq 2)
119 ;; ESC <intermediate-char> <final-char>
120 (setq intermediate-char (aref key-seq 1)
122 chars (if (< intermediate-char ?,) 94 96)
123 final-char (aref key-seq 2)
124 reg (mod intermediate-char 4))))
125 (aset encoded-kbd-iso2022-designations reg
126 (iso-charset dimension chars final-char)))
129 (defun encoded-kbd-iso2022-single-shift (ignore)
130 (let ((char (encoded-kbd-last-key)))
131 (aset encoded-kbd-iso2022-invocations 2 (if (= char ?\216) 2 3)))
134 (defun encoded-kbd-self-insert-iso2022-7bit (ignore)
135 (let ((char (encoded-kbd-last-key))
136 (charset (aref encoded-kbd-iso2022-designations
137 (or (aref encoded-kbd-iso2022-invocations 2)
138 (aref encoded-kbd-iso2022-invocations 0)))))
139 (aset encoded-kbd-iso2022-invocations 2 nil)
140 (vector (if (= (charset-dimension charset) 1)
141 (make-char charset char)
142 (make-char charset char (read-char-exclusive))))))
144 (defun encoded-kbd-self-insert-iso2022-8bit (ignore)
145 (let ((char (encoded-kbd-last-key))
146 (charset (aref encoded-kbd-iso2022-designations
147 (or (aref encoded-kbd-iso2022-invocations 2)
148 (aref encoded-kbd-iso2022-invocations 1)))))
149 (aset encoded-kbd-iso2022-invocations 2 nil)
150 (vector (if (= (charset-dimension charset) 1)
151 (make-char charset char)
152 (make-char charset char (read-char-exclusive))))))
154 (defun encoded-kbd-self-insert-sjis (ignore)
155 (let ((char (encoded-kbd-last-key)))
157 (if (or (< char ?\xA0) (>= char ?\xE0))
158 (decode-sjis-char (+ (ash char 8) (read-char-exclusive)))
159 (make-char 'katakana-jisx0201 char)))))
161 (defun encoded-kbd-self-insert-big5 (ignore)
162 (let ((char (encoded-kbd-last-key)))
164 (decode-big5-char (+ (ash char 8) (read-char-exclusive))))))
166 (defun encoded-kbd-self-insert-ccl (ignore)
167 (let ((str (char-to-string (encoded-kbd-last-key)))
168 (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4)))
169 (vec [nil nil nil nil nil nil nil nil nil])
171 (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0)
172 (dotimes (i 9) (aset vec i nil))
173 (setq str (format "%s%c" str (read-char-exclusive))))
174 (vector (aref result 0))))
176 (defun encoded-kbd-setup-keymap (keymap coding)
177 ;; At first, reset the keymap.
178 (define-key encoded-kbd-mode-map "\e" nil)
179 ;; Then setup the keymap according to the keyboard coding system.
181 ((eq (coding-system-type coding) 1) ; SJIS
185 (vector i) 'encoded-kbd-self-insert-sjis)
189 ((eq (coding-system-type coding) 3) ; Big5
193 (vector i) 'encoded-kbd-self-insert-big5)
197 ((eq (coding-system-type coding) 2) ; ISO-2022
198 (let ((flags (coding-system-flags coding))
201 nil ; Don't support locking-shift.
202 (setq encoded-kbd-iso2022-designations (make-vector 4 nil)
203 encoded-kbd-iso2022-invocations (make-vector 3 nil))
206 (if (charsetp (aref flags i))
207 (aset encoded-kbd-iso2022-designations
209 (setq use-designation t)
210 (if (charsetp (car-safe (aref flags i)))
211 (aset encoded-kbd-iso2022-designations
212 i (car (aref flags i)))))))
213 (aset encoded-kbd-iso2022-invocations 0 0)
214 (if (aref encoded-kbd-iso2022-designations 1)
215 (aset encoded-kbd-iso2022-invocations 1 1))
216 (when use-designation
217 (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)
218 (define-key keymap "\e" 'encoded-kbd-iso2022-esc-prefix))
219 (when (or (aref flags 2) (aref flags 3))
221 [?\216] 'encoded-kbd-iso2022-single-shift)
223 [?\217] 'encoded-kbd-iso2022-single-shift))
224 (or (eq (aref flags 0) 'ascii)
227 (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
232 (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit))
235 ((eq (coding-system-type coding) 4) ; CCL-base
236 (let ((valid-codes (or (coding-system-get coding 'valid-codes)
240 (setq elt (car valid-codes) valid-codes (cdr valid-codes))
242 (setq from (car elt) to (cdr elt))
243 (setq from (setq to elt)))
247 (vector from) 'encoded-kbd-self-insert-ccl))
248 (setq from (1+ from))))
254 ;; Input mode at the time Encoded-kbd mode is turned on is saved here.
255 ;; XXX This should be made display-local somehow.
256 (defvar saved-input-mode nil)
259 (defun encoded-kbd-setup-display (display)
260 "Set up a `key-translation-map' for `keyboard-coding-system' on DISPLAY.
262 DISPLAY may be a display id, a frame, or nil for the selected frame's display."
263 (let ((frame (if (framep display) display (car (frames-on-display-list display)))))
265 (with-selected-frame frame
266 ;; Remove any previous encoded-kb keymap from key-translation-map.
267 (let ((m (terminal-local-value 'key-translation-map frame)))
268 (if (equal (keymap-prompt m) "encoded-kb")
269 (set-terminal-local-value 'key-translation-map frame (keymap-parent m))
270 (while (keymap-parent m)
271 (if (equal (keymap-prompt (keymap-parent m)) "encoded-kb")
272 (set-keymap-parent m (keymap-parent (keymap-parent m))))
273 (setq m (keymap-parent m)))))
275 (if (keyboard-coding-system)
276 ;; We are turning on Encoded-kbd mode.
277 (let ((coding (keyboard-coding-system))
278 (keymap (make-sparse-keymap "encoded-kb"))
280 (set-keymap-parent keymap (terminal-local-value 'key-translation-map frame))
281 (set-terminal-local-value 'key-translation-map frame keymap)
283 (setq saved-input-mode (current-input-mode)))
284 (setq result (and coding (encoded-kbd-setup-keymap keymap coding)))
288 (nth 0 saved-input-mode)
289 (nth 1 saved-input-mode)
291 (nth 3 saved-input-mode)))
292 (setq saved-input-mode nil)
293 (error "Unsupported coding system in Encoded-kbd mode: %S"
295 ;; We are turning off Encoded-kbd mode.
296 (and saved-input-mode
297 (apply 'set-input-mode saved-input-mode))
298 (setq saved-input-mode nil))))))
300 (provide 'encoded-kb)
302 ;;; arch-tag: 76f0f9b3-65e7-45c3-b692-59509a87ad44
303 ;;; encoded-kb.el ends here