Mercurial > emacs

comparison lisp/term/mac-win.el @ 61502:3150e849361e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(kTextEncodingMacRoman, kTextEncodingISOLatin1) (kTextEncodingISOLatin2): Remove constants. (mac-script-code-coding-systems): New constant. (mac-handle-language-change): New function. (special-event-map): Bind it to `language-change' event. (mac-centraleurroman, mac-cyrillic): New coding systems. (mac-font-encoder-list, ccl-encode-mac-centraleurroman-font) (ccl-encode-mac-cyrillic-font): Rename mac-centraleurroman-encoder and mac-cyrillic-encoder to encode-mac-centraleurroman and encode-mac-cyrillic, respectively.
author YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
date Tue, 12 Apr 2005 10:27:29 +0000
parents c47b59f4f76f
children 6b15c97abf1d 146c086df160
comparison
equal deleted inserted replaced
61501:1ccfb57e0ed0 61502:3150e849361e
1083 (put 'clear 'ascii-character ?\C-l) 1083 (put 'clear 'ascii-character ?\C-l)
1084 (put 'return 'ascii-character ?\C-m) 1084 (put 'return 'ascii-character ?\C-m)
1085 (put 'escape 'ascii-character ?\e) 1085 (put 'escape 'ascii-character ?\e)
1086 1086
1087 1087
1088 ;;;; Keysyms 1088 ;;;; Keyboard layout/language change events
1089 1089 (defconst mac-script-code-coding-systems
1090 ;; Define constant values to be set to mac-keyboard-text-encoding 1090 '((0 . mac-roman) ; smRoman
1091 (defconst kTextEncodingMacRoman 0) 1091 (1 . japanese-shift-jis) ; smJapanese
1092 (defconst kTextEncodingISOLatin1 513 "0x201") 1092 (2 . chinese-big5) ; smTradChinese
1093 (defconst kTextEncodingISOLatin2 514 "0x202") 1093 (3 . korean-iso-8bit) ; smKorean
1094 1094 (7 . mac-cyrillic) ; smCyrillic
1095 (25 . chinese-iso-8bit) ; smSimpChinese
1096 (29 . mac-centraleurroman) ; smCentralEuroRoman
1097 )
1098 "Alist of Mac script codes vs Emacs coding systems.")
1099
1100 ;;;; Keyboard layout/language change events
1101 (defun mac-handle-language-change (event)
1102 (interactive "e")
1103 (let ((coding-system
1104 (cdr (assq (car (cadr event)) mac-script-code-coding-systems))))
1105 (set-keyboard-coding-system (or coding-system 'mac-roman))
1106 ;; MacJapanese maps reverse solidus to ?\x80.
1107 (if (eq coding-system 'japanese-shift-jis)
1108 (define-key key-translation-map [?\x80] "\\"))))
1109
1110 (define-key special-event-map [language-change] 'mac-handle-language-change)
1095 1111
1096 ;;;; Selections and cut buffers 1112 ;;;; Selections and cut buffers
1097 1113
1098 ;; Setup to use the Mac clipboard. The functions mac-cut-function and 1114 ;; Setup to use the Mac clipboard. The functions mac-cut-function and
1099 ;; mac-paste-function are defined in mac.c. 1115 ;; mac-paste-function are defined in mac.c.
1137 ;; Exit Emacs with fatal error if this fails. 1153 ;; Exit Emacs with fatal error if this fails.
1138 t)) 1154 t))
1139 1155
1140 (setq frame-creation-function 'x-create-frame-with-faces) 1156 (setq frame-creation-function 'x-create-frame-with-faces)
1141 1157
1142 (define-ccl-program ccl-encode-mac-roman-font 1158 (cp-make-coding-system
1143 `(0 1159 mac-centraleurroman
1144 (if (r0 != ,(charset-id 'ascii)) 1160 (apply
1145 (if (r0 <= ?\x8f) 1161 'vector
1146 (translate-character mac-roman-encoder r0 r1) 1162 (mapcar
1147 ((r1 <<= 7) 1163 (lambda (c) (decode-char 'ucs c))
1148 (r1 |= r2) 1164 ;; mac-centraleurroman (128..255) -> UCS mapping
1149 (translate-character mac-roman-encoder r0 r1))))) 1165 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1150 "CCL program for Mac Roman font")
1151
1152 (let
1153 ((encoding-vector (make-vector 256 nil))
1154 (i 0)
1155 (vec ;; mac-centraleurroman (128..255) -> UCS mapping
1156 [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
1157 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON 1166 #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON
1158 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON 1167 #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON
1159 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE 1168 #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
1160 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK 1169 #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK
1161 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS 1170 #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
1279 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE 1288 #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE
1280 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE 1289 #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE
1281 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE 1290 #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE
1282 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA 1291 #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA
1283 #x02C7 ;; 255:CARON 1292 #x02C7 ;; 255:CARON
1284 ]) 1293 ]))
1285 translation-table) 1294 "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).")
1286 (while (< i 128) 1295 (coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman)
1287 (aset encoding-vector i i) 1296
1288 (setq i (1+ i))) 1297 (cp-make-coding-system
1289 (while (< i 256) 1298 mac-cyrillic
1290 (aset encoding-vector i 1299 (apply
1291 (decode-char 'ucs (aref vec (- i 128)))) 1300 'vector
1292 (setq i (1+ i))) 1301 (mapcar
1293 (setq translation-table 1302 (lambda (c) (decode-char 'ucs c))
1294 (make-translation-table-from-vector encoding-vector)) 1303 ;; mac-cyrillic (128..255) -> UCS mapping
1295 ;; (define-translation-table 'mac-centraleurroman-decoder translation-table) 1304 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
1296 (define-translation-table 'mac-centraleurroman-encoder
1297 (char-table-extra-slot translation-table 0)))
1298
1299 (let
1300 ((encoding-vector (make-vector 256 nil))
1301 (i 0)
1302 (vec ;; mac-cyrillic (128..255) -> UCS mapping
1303 [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A
1304 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE 1305 #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE
1305 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE 1306 #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE
1306 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE 1307 #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE
1307 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE 1308 #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE
1308 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE 1309 #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE
1426 #x044B ;; 251:CYRILLIC SMALL LETTER YERU 1427 #x044B ;; 251:CYRILLIC SMALL LETTER YERU
1427 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN 1428 #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN
1428 #x044D ;; 253:CYRILLIC SMALL LETTER E 1429 #x044D ;; 253:CYRILLIC SMALL LETTER E
1429 #x044E ;; 254:CYRILLIC SMALL LETTER YU 1430 #x044E ;; 254:CYRILLIC SMALL LETTER YU
1430 #x20AC ;; 255:EURO SIGN 1431 #x20AC ;; 255:EURO SIGN
1431 ]) 1432 ]))
1432 translation-table) 1433 "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).")
1433 (while (< i 128) 1434 (coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic)
1434 (aset encoding-vector i i)
1435 (setq i (1+ i)))
1436 (while (< i 256)
1437 (aset encoding-vector i
1438 (decode-char 'ucs (aref vec (- i 128))))
1439 (setq i (1+ i)))
1440 (setq translation-table
1441 (make-translation-table-from-vector encoding-vector))
1442 ;; (define-translation-table 'mac-cyrillic-decoder translation-table)
1443 (define-translation-table 'mac-cyrillic-encoder
1444 (char-table-extra-slot translation-table 0)))
1445 1435
1446 (defvar mac-font-encoder-list 1436 (defvar mac-font-encoder-list
1447 '(("mac-roman" mac-roman-encoder 1437 '(("mac-roman" mac-roman-encoder
1448 ccl-encode-mac-roman-font "%s") 1438 ccl-encode-mac-roman-font "%s")
1449 ("mac-centraleurroman" mac-centraleurroman-encoder 1439 ("mac-centraleurroman" encode-mac-centraleurroman
1450 ccl-encode-mac-centraleurroman-font "%s ce") 1440 ccl-encode-mac-centraleurroman-font "%s ce")
1451 ("mac-cyrillic" mac-cyrillic-encoder 1441 ("mac-cyrillic" encode-mac-cyrillic
1452 ccl-encode-mac-cyrillic-font "%s cy"))) 1442 ccl-encode-mac-cyrillic-font "%s cy")))
1453 1443
1454 (let ((encoder-list 1444 (let ((encoder-list
1455 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list)) 1445 (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
1456 (charset-list 1446 (charset-list
1466 (mu (aref ucs-mule-to-mule-unicode c)) 1456 (mu (aref ucs-mule-to-mule-unicode c))
1467 (mac-encoded (and mu (aref table mu)))) 1457 (mac-encoded (and mu (aref table mu))))
1468 (if mac-encoded 1458 (if mac-encoded
1469 (aset table c mac-encoded)))))))) 1459 (aset table c mac-encoded))))))))
1470 1460
1461 (define-ccl-program ccl-encode-mac-roman-font
1462 `(0
1463 (if (r0 != ,(charset-id 'ascii))
1464 (if (r0 <= ?\x8f)
1465 (translate-character mac-roman-encoder r0 r1)
1466 ((r1 <<= 7)
1467 (r1 |= r2)
1468 (translate-character mac-roman-encoder r0 r1)))))
1469 "CCL program for Mac Roman font")
1470
1471 (define-ccl-program ccl-encode-mac-centraleurroman-font 1471 (define-ccl-program ccl-encode-mac-centraleurroman-font
1472 `(0 1472 `(0
1473 (if (r0 != ,(charset-id 'ascii)) 1473 (if (r0 != ,(charset-id 'ascii))
1474 (if (r0 <= ?\x8f) 1474 (if (r0 <= ?\x8f)
1475 (translate-character mac-centraleurroman-encoder r0 r1) 1475 (translate-character encode-mac-centraleurroman r0 r1)
1476 ((r1 <<= 7) 1476 ((r1 <<= 7)
1477 (r1 |= r2) 1477 (r1 |= r2)
1478 (translate-character mac-centraleurroman-encoder r0 r1))))) 1478 (translate-character encode-mac-centraleurroman r0 r1)))))
1479 "CCL program for Mac Central European Roman font") 1479 "CCL program for Mac Central European Roman font")
1480 1480
1481 (define-ccl-program ccl-encode-mac-cyrillic-font 1481 (define-ccl-program ccl-encode-mac-cyrillic-font
1482 `(0 1482 `(0
1483 (if (r0 != ,(charset-id 'ascii)) 1483 (if (r0 != ,(charset-id 'ascii))
1484 (if (r0 <= ?\x8f) 1484 (if (r0 <= ?\x8f)
1485 (translate-character mac-cyrillic-encoder r0 r1) 1485 (translate-character encode-mac-cyrillic r0 r1)
1486 ((r1 <<= 7) 1486 ((r1 <<= 7)
1487 (r1 |= r2) 1487 (r1 |= r2)
1488 (translate-character mac-cyrillic-encoder r0 r1))))) 1488 (translate-character encode-mac-cyrillic r0 r1)))))
1489 "CCL program for Mac Cyrillic font") 1489 "CCL program for Mac Cyrillic font")
1490 1490
1491 1491
1492 (setq font-ccl-encoder-alist 1492 (setq font-ccl-encoder-alist
1493 (nconc 1493 (nconc