24 |
|
|
25 |
;;; Code: |
;;; Code: |
26 |
|
|
27 |
|
;; Usually this map is empty (even if Encoded-kbd mode is on), but if |
28 |
|
;; the keyboard coding system is iso-2022-based, it defines dummy key |
29 |
|
;; bindings for ESC $ ..., etc. so that those bindings in |
30 |
|
;; key-translation-map take effect. |
31 |
(defconst encoded-kbd-mode-map (make-sparse-keymap) |
(defconst encoded-kbd-mode-map (make-sparse-keymap) |
32 |
"Keymap for Encoded-kbd minor mode.") |
"Keymap for Encoded-kbd minor mode.") |
33 |
|
|
73 |
(fset 'encoded-kbd-iso2022-designation-prefix |
(fset 'encoded-kbd-iso2022-designation-prefix |
74 |
encoded-kbd-iso2022-designation-map) |
encoded-kbd-iso2022-designation-map) |
75 |
|
|
|
(defvar encoded-kbd-iso2022-non-ascii-map |
|
|
(let ((map (make-keymap)) |
|
|
(i 32)) |
|
|
(while (< i 128) |
|
|
(define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit) |
|
|
(setq i (1+ i))) |
|
|
(define-key map "\e" 'encoded-kbd-iso2022-esc-prefix) |
|
|
(setq i 160) |
|
|
(while (< i 256) |
|
|
(define-key map (vector i) 'encoded-kbd-handle-8bit) |
|
|
(setq i (1+ i))) |
|
|
map) |
|
|
"Keymap for handling non-ASCII character set in Encoded-kbd mode.") |
|
|
|
|
|
;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to |
|
|
;; denote what kind of coding-system we are now handling in |
|
|
;; Encoded-kbd mode. |
|
|
(defvar encoded-kbd-coding nil) |
|
|
|
|
76 |
;; Keep information of designation state of ISO2022 encoding. When |
;; Keep information of designation state of ISO2022 encoding. When |
77 |
;; Encoded-kbd mode is on, this is set to a vector of length 4, the |
;; Encoded-kbd mode is on, this is set to a vector of length 4, the |
78 |
;; elements are character sets currently designated to graphic |
;; elements are character sets currently designated to graphic |
89 |
(defvar encoded-kbd-iso2022-invocations nil) |
(defvar encoded-kbd-iso2022-invocations nil) |
90 |
(put 'encoded-kbd-iso2022-invocations 'permanent-local t) |
(put 'encoded-kbd-iso2022-invocations 'permanent-local t) |
91 |
|
|
92 |
(defun encoded-kbd-iso2022-designation () |
(defsubst encoded-kbd-last-key () |
93 |
|
(let ((keys (this-single-command-keys))) |
94 |
|
(aref keys (1- (length keys))))) |
95 |
|
|
96 |
|
(defun encoded-kbd-iso2022-designation (ignore) |
97 |
"Do ISO2022 designation according to the current key in Encoded-kbd mode. |
"Do ISO2022 designation according to the current key in Encoded-kbd mode. |
98 |
The following key sequence may cause multilingual text insertion." |
The following key sequence may cause multilingual text insertion." |
99 |
(interactive) |
(let ((key-seq (this-single-command-keys)) |
|
(let ((key-seq (this-command-keys)) |
|
100 |
(prev-g0-charset (aref encoded-kbd-iso2022-designations |
(prev-g0-charset (aref encoded-kbd-iso2022-designations |
101 |
(aref encoded-kbd-iso2022-invocations 0))) |
(aref encoded-kbd-iso2022-invocations 0))) |
102 |
intermediate-char final-char |
intermediate-char final-char |
120 |
chars (if (< intermediate-char ?,) 94 96) |
chars (if (< intermediate-char ?,) 94 96) |
121 |
final-char (aref key-seq 2) |
final-char (aref key-seq 2) |
122 |
reg (mod intermediate-char 4)))) |
reg (mod intermediate-char 4)))) |
123 |
(if (setq charset (iso-charset dimension chars final-char)) |
(aset encoded-kbd-iso2022-designations reg |
124 |
(aset encoded-kbd-iso2022-designations reg charset) |
(iso-charset dimension chars final-char))) |
125 |
(error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" |
"") |
126 |
dimension chars final-char)) |
|
127 |
|
(defun encoded-kbd-iso2022-single-shift (ignore) |
128 |
(if (memq (aref encoded-kbd-iso2022-designations |
(let ((char (encoded-kbd-last-key))) |
129 |
(aref encoded-kbd-iso2022-invocations 0)) |
(aset encoded-kbd-iso2022-invocations 2 |
130 |
'(ascii latin-jisx0201)) |
(aref encoded-kbd-iso2022-designations |
131 |
;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have |
(if (= char ?\216) 2 3)))) |
132 |
;; to handle characters in this range specially. |
"") |
133 |
(if (not (memq prev-g0-charset '(ascii latin-jisx0201))) |
|
134 |
;; We must exit recursive edit now. |
(defun encoded-kbd-self-insert-iso2022-7bit (ignore) |
135 |
(throw 'exit nil)) |
(let ((char (encoded-kbd-last-key)) |
136 |
;; Graphic plane 0 is for non-ASCII. |
(charset (aref encoded-kbd-iso2022-designations |
137 |
(if (memq prev-g0-charset '(ascii latin-jisx0201)) |
(or (aref encoded-kbd-iso2022-invocations 2) |
138 |
;; We must handle keys specially. |
(aref encoded-kbd-iso2022-invocations 0))))) |
139 |
(let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map)) |
(aset encoded-kbd-iso2022-invocations 2 nil) |
140 |
(recursive-edit)))))) |
(vector (if (= (charset-dimension charset) 1) |
141 |
|
(make-char charset char) |
142 |
(defun encoded-kbd-handle-8bit () |
(make-char charset char (read-char-exclusive)))))) |
143 |
"Handle an 8-bit character entered in Encoded-kbd mode." |
|
144 |
(interactive) |
(defun encoded-kbd-self-insert-iso2022-8bit (ignore) |
145 |
(cond ((eq encoded-kbd-coding 'iso2022-7) |
(let ((char (encoded-kbd-last-key)) |
146 |
(error "Can't handle the character code %d" last-command-char)) |
(charset (aref encoded-kbd-iso2022-designations |
147 |
|
(or (aref encoded-kbd-iso2022-invocations 2) |
148 |
((eq encoded-kbd-coding 'iso2022-8) |
(aref encoded-kbd-iso2022-invocations 1))))) |
|
(cond ((= last-command-char ?\216) |
|
|
(aset encoded-kbd-iso2022-invocations 2 2)) |
|
|
|
|
|
((= last-command-char ?\217) |
|
|
(aset encoded-kbd-iso2022-invocations 2 3)) |
|
|
|
|
|
((>= last-command-char ?\240) |
|
|
(encoded-kbd-self-insert-iso2022-8bit)) |
|
|
|
|
|
(t |
|
|
(error "Can't handle the character code %d" |
|
|
last-command-char)))) |
|
|
|
|
|
((eq encoded-kbd-coding 'sjis) |
|
|
(encoded-kbd-self-insert-sjis)) |
|
|
|
|
|
(t |
|
|
(encoded-kbd-self-insert-big5)))) |
|
|
|
|
|
(defun encoded-kbd-self-insert-iso2022-7bit () |
|
|
(interactive) |
|
|
(let* ((charset (aref encoded-kbd-iso2022-designations |
|
|
(or (aref encoded-kbd-iso2022-invocations 2) |
|
|
(aref encoded-kbd-iso2022-invocations 0)))) |
|
|
(char (if (= (charset-dimension charset) 1) |
|
|
(make-char charset last-command-char) |
|
|
(make-char charset last-command-char (read-char-exclusive))))) |
|
149 |
(aset encoded-kbd-iso2022-invocations 2 nil) |
(aset encoded-kbd-iso2022-invocations 2 nil) |
150 |
(setq unread-command-events (cons char unread-command-events)))) |
(vector (if (= (charset-dimension charset) 1) |
151 |
|
(make-char charset char) |
152 |
|
(make-char charset char (read-char-exclusive)))))) |
153 |
|
|
154 |
|
(defun encoded-kbd-self-insert-sjis (ignore) |
155 |
|
(let ((char (encoded-kbd-last-key))) |
156 |
|
(vector |
157 |
|
(if (or (< char ?\xA0) (>= char ?\xE0)) |
158 |
|
(decode-sjis-char (+ (ash char 8) (read-char-exclusive))) |
159 |
|
(make-char 'katakana-jisx0201 char))))) |
160 |
|
|
161 |
|
(defun encoded-kbd-self-insert-big5 (ignore) |
162 |
|
(let ((char (encoded-kbd-last-key))) |
163 |
|
(vector |
164 |
|
(decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) |
165 |
|
|
166 |
(defun encoded-kbd-self-insert-iso2022-8bit () |
(defun encoded-kbd-self-insert-ccl (ignore) |
167 |
(interactive) |
(let ((str (char-to-string (encoded-kbd-last-key))) |
|
(cond |
|
|
((= last-command-char ?\216) ; SS2 (Single Shift 2) |
|
|
(aset encoded-kbd-iso2022-invocations 2 2)) |
|
|
((= last-command-char ?\217) ; SS3 (Single Shift 3) |
|
|
(aset encoded-kbd-iso2022-invocations 2 3)) |
|
|
(t |
|
|
(let* ((charset (aref encoded-kbd-iso2022-designations |
|
|
(or (aref encoded-kbd-iso2022-invocations 2) |
|
|
(aref encoded-kbd-iso2022-invocations 1)))) |
|
|
(char (if (= (charset-dimension charset) 1) |
|
|
(make-char charset last-command-char) |
|
|
(make-char charset last-command-char |
|
|
(read-char-exclusive))))) |
|
|
(aset encoded-kbd-iso2022-invocations 2 nil) |
|
|
(setq unread-command-events (cons char unread-command-events)))))) |
|
|
|
|
|
(defun encoded-kbd-self-insert-sjis () |
|
|
(interactive) |
|
|
(let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) |
|
|
(decode-sjis-char (+ (ash last-command-char 8) |
|
|
(read-char-exclusive))) |
|
|
(make-char 'katakana-jisx0201 last-command-char)))) |
|
|
(setq unread-command-events (cons char unread-command-events)))) |
|
|
|
|
|
(defun encoded-kbd-self-insert-big5 () |
|
|
(interactive) |
|
|
(let ((char (decode-big5-char (+ (ash last-command-char 8) |
|
|
(read-char-exclusive))))) |
|
|
(setq unread-command-events (cons char unread-command-events)))) |
|
|
|
|
|
(defun encoded-kbd-self-insert-ccl () |
|
|
(interactive) |
|
|
(let ((str (char-to-string last-command-char)) |
|
168 |
(ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) |
(ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) |
169 |
(vec [nil nil nil nil nil nil nil nil nil]) |
(vec [nil nil nil nil nil nil nil nil nil]) |
170 |
result) |
result) |
171 |
(while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) |
(while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) |
172 |
(dotimes (i 9) (aset vec i nil)) |
(dotimes (i 9) (aset vec i nil)) |
173 |
(setq str (format "%s%c" str (read-char-exclusive)))) |
(setq str (format "%s%c" str (read-char-exclusive)))) |
174 |
(setq unread-command-events |
(vector (aref result 0)))) |
|
(append result unread-command-events)))) |
|
175 |
|
|
176 |
(defun encoded-kbd-setup-keymap (coding) |
(defun encoded-kbd-setup-keymap (coding) |
177 |
;; At first, reset the keymap. |
;; At first, reset the keymap. |
178 |
(setcdr encoded-kbd-mode-map nil) |
(define-key encoded-kbd-mode-map "\e" nil) |
179 |
;; Then setup the keymap according to the keyboard coding system. |
;; Then setup the keymap according to the keyboard coding system. |
180 |
(cond |
(cond |
181 |
((eq encoded-kbd-coding 'sjis) |
((eq (coding-system-type coding) 1) ; SJIS |
182 |
(let ((i 128)) |
(let ((i 128)) |
183 |
(while (< i 256) |
(while (< i 256) |
184 |
(define-key encoded-kbd-mode-map |
(define-key key-translation-map |
185 |
(vector i) 'encoded-kbd-self-insert-sjis) |
(vector i) 'encoded-kbd-self-insert-sjis) |
186 |
(setq i (1+ i))))) |
(setq i (1+ i)))) |
187 |
|
8) |
188 |
|
|
189 |
((eq encoded-kbd-coding 'big5) |
((eq (coding-system-type coding) 3) ; Big5 |
190 |
(let ((i 161)) |
(let ((i 161)) |
191 |
(while (< i 255) |
(while (< i 255) |
192 |
(define-key encoded-kbd-mode-map |
(define-key key-translation-map |
193 |
(vector i) 'encoded-kbd-self-insert-big5) |
(vector i) 'encoded-kbd-self-insert-big5) |
194 |
(setq i (1+ i))))) |
(setq i (1+ i)))) |
195 |
|
8) |
196 |
|
|
197 |
((eq encoded-kbd-coding 'iso2022-7) |
((eq (coding-system-type coding) 2) ; ISO-2022 |
198 |
(define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) |
(let ((flags (coding-system-flags coding)) |
199 |
|
use-designation) |
200 |
|
(if (aref flags 8) |
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)) |
204 |
|
(dotimes (i 4) |
205 |
|
(if (aref flags i) |
206 |
|
(if (charsetp (aref flags i)) |
207 |
|
(aset encoded-kbd-iso2022-designations |
208 |
|
i (aref flags i)) |
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 key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) |
219 |
|
(when (or (aref flags 2) (aref flags 3)) |
220 |
|
(define-key key-translation-map |
221 |
|
[?\216] 'encoded-kbd-iso2022-single-shift) |
222 |
|
(define-key key-translation-map |
223 |
|
[?\217] 'encoded-kbd-iso2022-single-shift)) |
224 |
|
(or (eq (aref flags 0) 'ascii) |
225 |
|
(dotimes (i 96) |
226 |
|
(define-key key-translation-map |
227 |
|
(vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) |
228 |
|
(if (aref flags 7) |
229 |
|
t |
230 |
|
(dotimes (i 96) |
231 |
|
(define-key key-translation-map |
232 |
|
(vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) |
233 |
|
8)))) |
234 |
|
|
235 |
((eq encoded-kbd-coding 'iso2022-8) |
((eq (coding-system-type coding) 4) ; CCL-base |
|
(define-key encoded-kbd-mode-map |
|
|
(vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) |
|
|
(define-key encoded-kbd-mode-map |
|
|
(vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) |
|
|
(let ((i 160)) |
|
|
(while (< i 256) |
|
|
(define-key encoded-kbd-mode-map |
|
|
(vector i) 'encoded-kbd-self-insert-iso2022-8bit) |
|
|
(setq i (1+ i))))) |
|
|
|
|
|
((eq encoded-kbd-coding 'ccl) |
|
236 |
(let ((valid-codes (or (coding-system-get coding 'valid-codes) |
(let ((valid-codes (or (coding-system-get coding 'valid-codes) |
237 |
'((128 . 255)))) |
'((128 . 255)))) |
238 |
elt from to) |
elt from to valid) |
239 |
(while valid-codes |
(while valid-codes |
240 |
(setq elt (car valid-codes) valid-codes (cdr valid-codes)) |
(setq elt (car valid-codes) valid-codes (cdr valid-codes)) |
241 |
(if (consp elt) |
(if (consp elt) |
243 |
(setq from (setq to elt))) |
(setq from (setq to elt))) |
244 |
(while (<= from to) |
(while (<= from to) |
245 |
(if (>= from 128) |
(if (>= from 128) |
246 |
(define-key encoded-kbd-mode-map |
(define-key key-translation-map |
247 |
(vector from) 'encoded-kbd-self-insert-ccl)) |
(vector from) 'encoded-kbd-self-insert-ccl)) |
248 |
(setq from (1+ from)))))) |
(setq from (1+ from)))) |
249 |
|
8)) |
250 |
|
|
251 |
(t |
(t |
252 |
(error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) |
nil))) |
253 |
|
|
254 |
|
;; key-translation-map at the time Encoded-kbd mode is turned on is |
255 |
|
;; saved here. |
256 |
|
(defvar saved-key-translation-map nil) |
257 |
|
|
258 |
;; Input mode at the time Encoded-kbd mode is turned on is saved here. |
;; Input mode at the time Encoded-kbd mode is turned on is saved here. |
259 |
(defvar saved-input-mode nil) |
(defvar saved-input-mode nil) |
272 |
as a multilingual text encoded in a coding system set by |
as a multilingual text encoded in a coding system set by |
273 |
\\[set-keyboard-coding-system]." |
\\[set-keyboard-coding-system]." |
274 |
:global t |
:global t |
275 |
;; We must at first reset input-mode to the original. |
|
|
(if saved-input-mode (apply 'set-input-mode saved-input-mode)) |
|
276 |
(if encoded-kbd-mode |
(if encoded-kbd-mode |
277 |
(let ((coding (keyboard-coding-system))) |
;; We are turning on Encoded-kbd mode. |
278 |
(setq saved-input-mode (current-input-mode)) |
(let ((coding (keyboard-coding-system)) |
279 |
(cond ((null coding) |
result) |
280 |
(setq encoded-kbd-mode nil) |
(or saved-key-translation-map |
281 |
(error "No coding system for keyboard input is set")) |
(if (keymapp key-translation-map) |
282 |
|
(setq saved-key-translation-map |
283 |
((= (coding-system-type coding) 1) ; SJIS |
(copy-keymap key-translation-map)) |
284 |
(set-input-mode |
(setq key-translation-map (make-sparse-keymap)))) |
285 |
(nth 0 saved-input-mode) (nth 1 saved-input-mode) |
(or saved-input-mode |
286 |
'use-8th-bit (nth 3 saved-input-mode)) |
(setq saved-input-mode |
287 |
(setq encoded-kbd-coding 'sjis)) |
(current-input-mode))) |
288 |
|
(setq result (and coding (encoded-kbd-setup-keymap coding))) |
289 |
((= (coding-system-type coding) 2) ; ISO2022 |
(if result |
290 |
(if (aref (coding-system-flags coding) 7) ; 7-bit only |
(if (eq result 8) |
291 |
(setq encoded-kbd-coding 'iso2022-7) |
(set-input-mode |
292 |
(set-input-mode |
(nth 0 saved-input-mode) |
293 |
(nth 0 saved-input-mode) (nth 1 saved-input-mode) |
(nth 1 saved-input-mode) |
294 |
'use-8th-bit (nth 3 saved-input-mode)) |
'use-8th-bit |
295 |
(setq encoded-kbd-coding 'iso2022-8)) |
(nth 3 saved-input-mode))) |
296 |
(setq encoded-kbd-iso2022-designations (make-vector 4 nil)) |
(setq encoded-kbd-mode nil |
297 |
(let ((flags (coding-system-flags coding)) |
saved-key-translation-map nil |
298 |
(i 0)) |
saved-input-mode nil) |
299 |
(while (< i 4) |
(error "Unsupported coding system in Encoded-kbd mode: %S" |
300 |
(if (charsetp (aref flags i)) |
coding))) |
301 |
(aset encoded-kbd-iso2022-designations i |
|
302 |
(aref flags i)) |
;; We are turning off Encoded-kbd mode. |
303 |
(if (charsetp (car-safe (aref flags i))) |
(setq key-translation-map saved-key-translation-map |
304 |
(aset encoded-kbd-iso2022-designations i |
saved-key-translation-map nil) |
305 |
(car (aref flags i))))) |
(apply 'set-input-mode saved-input-mode) |
306 |
(setq i (1+ i)))) |
(setq saved-input-mode nil))) |
|
(setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) |
|
|
(aset encoded-kbd-iso2022-invocations 0 0) |
|
|
(aset encoded-kbd-iso2022-invocations 1 1)) |
|
|
|
|
|
((= (coding-system-type coding) 3) ; BIG5 |
|
|
(set-input-mode |
|
|
(nth 0 saved-input-mode) (nth 1 saved-input-mode) |
|
|
'use-8th-bit (nth 3 saved-input-mode)) |
|
|
(setq encoded-kbd-coding 'big5)) |
|
|
|
|
|
((= (coding-system-type coding) 4) ; CCL based coding |
|
|
(set-input-mode |
|
|
(nth 0 saved-input-mode) (nth 1 saved-input-mode) |
|
|
'use-8th-bit (nth 3 saved-input-mode)) |
|
|
(setq encoded-kbd-coding 'ccl)) |
|
|
|
|
|
(t |
|
|
(setq encoded-kbd-mode nil) |
|
|
(error "Coding-system `%s' is not supported in Encoded-kbd mode" |
|
|
(keyboard-coding-system)))) |
|
|
(encoded-kbd-setup-keymap coding)))) |
|
307 |
|
|
308 |
(provide 'encoded-kb) |
(provide 'encoded-kb) |
309 |
|
|