/[emacs]/emacs/lisp/international/encoded-kb.el
ViewVC logotype

Diff of /emacs/lisp/international/encoded-kb.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.29 by miles, Mon Sep 1 15:45:28 2003 UTC revision 1.29.2.1 by miles, Sat Sep 4 12:01:09 2004 UTC
# Line 24  Line 24 
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    
# Line 69  Line 73 
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
# Line 104  Line 89 
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
# Line 132  The following key sequence may cause mul Line 120  The following key sequence may cause mul
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)
# Line 276  The following key sequence may cause mul Line 243  The following key sequence may cause mul
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)
# Line 301  In Encoded-kbd mode, a text sent from ke Line 272  In Encoded-kbd mode, a text sent from ke
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    

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.29.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26