Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-ccl.el @ 3439:d1754e7f0cea

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-06-03 17:50:39 by aidan] Just-in-time Unicode code point support.
author aidan
date Sat, 03 Jun 2006 17:51:06 +0000
parents 7844ab77b582
children aa28d959af41
comparison
equal deleted inserted replaced
3438:14fbcab7c67b 3439:d1754e7f0cea
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation. 4 ;; Licensed to the Free Software Foundation.
5 5
6 ;; Keywords: CCL, mule, multilingual, character set, coding-system 6 ;; Keywords: CCL, mule, multilingual, character set, coding-system
7 7
8 ;; This file is part of X Emacs. 8 ;; This file is part of XEmacs.
9 9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify 10 ;; XEmacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by 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) 12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version. 13 ;; any later version.
14 14
15 ;; GNU Emacs is distributed in the hope that it will be useful, 15 ;; XEmacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 18 ;; GNU General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 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 21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;; Synched up with: FSF 21.0.90 25 ;; Synched up with: FSF 21.0.90
26 26
46 46
47 (defconst ccl-command-table 47 (defconst ccl-command-table
48 [if branch loop break repeat write-repeat write-read-repeat 48 [if branch loop break repeat write-repeat write-read-repeat
49 read read-if read-branch write call end 49 read read-if read-branch write call end
50 read-multibyte-character write-multibyte-character 50 read-multibyte-character write-multibyte-character
51 translate-character 51 translate-character mule-to-unicode unicode-to-mule
52 iterate-multiple-map map-multiple map-single] 52 iterate-multiple-map map-multiple map-single]
53 "Vector of CCL commands (symbols).") 53 "Vector of CCL commands (symbols).")
54 54
55 ;; Put a property to each symbol of CCL commands for the compiler. 55 ;; Put a property to each symbol of CCL commands for the compiler.
56 (let (op (i 0) (len (length ccl-command-table))) 56 (let (op (i 0) (len (length ccl-command-table)))
98 (defconst ccl-extended-code-table 98 (defconst ccl-extended-code-table
99 [read-multibyte-character 99 [read-multibyte-character
100 write-multibyte-character 100 write-multibyte-character
101 translate-character 101 translate-character
102 translate-character-const-tbl 102 translate-character-const-tbl
103 nil nil nil nil nil nil nil nil nil nil nil nil ; 0x04-0x0f 103 mule-to-unicode
104 unicode-to-mule
105 nil nil nil nil nil nil nil nil nil nil ; 0x06-0x0f
104 iterate-multiple-map 106 iterate-multiple-map
105 map-multiple 107 map-multiple
106 map-single 108 map-single
107 ] 109 ]
108 "Vector of CCL extended compiled codes (symbols).") 110 "Vector of CCL extended compiled codes (symbols).")
828 (t 830 (t
829 (ccl-check-register Rrr cmd) 831 (ccl-check-register Rrr cmd)
830 (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) 832 (ccl-embed-extended-command 'translate-character rrr RRR Rrr))))
831 nil) 833 nil)
832 834
835 ;; Compile mule-to-unicode
836 (defun ccl-compile-mule-to-unicode (cmd)
837 (if (/= (length cmd) 3)
838 (error "CCL: Invalid number of arguments: %s" cmd))
839 (let ((RRR (nth 1 cmd))
840 (rrr (nth 2 cmd)))
841 (ccl-check-register RRR cmd)
842 (ccl-check-register rrr cmd)
843 (ccl-embed-extended-command 'mule-to-unicode RRR rrr 0))
844 nil)
845
846 ;; Given a Unicode code point in register rrr, write the charset ID of the
847 ;; corresponding character in RRR, and the Mule-CCL form of its code in rrr.
848 (defun ccl-compile-unicode-to-mule (cmd)
849 (if (/= (length cmd) 3)
850 (error "CCL: Invalid number of arguments: %s" cmd))
851 (let ((rrr (nth 1 cmd))
852 (RRR (nth 2 cmd)))
853 (ccl-check-register rrr cmd)
854 (ccl-check-register RRR cmd)
855 (ccl-embed-extended-command 'unicode-to-mule rrr RRR 0))
856 nil)
857
833 (defun ccl-compile-iterate-multiple-map (cmd) 858 (defun ccl-compile-iterate-multiple-map (cmd)
834 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd) 859 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd)
835 nil) 860 nil)
836 861
837 (defun ccl-compile-map-multiple (cmd) 862 (defun ccl-compile-map-multiple (cmd)
1185 (insert (format "translation table(r%d) r%d r%d\n" Rrr RRR rrr))) 1210 (insert (format "translation table(r%d) r%d r%d\n" Rrr RRR rrr)))
1186 1211
1187 (defun ccl-dump-translate-character-const-tbl (rrr RRR Rrr) 1212 (defun ccl-dump-translate-character-const-tbl (rrr RRR Rrr)
1188 (let ((tbl (ccl-get-next-code))) 1213 (let ((tbl (ccl-get-next-code)))
1189 (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr)))) 1214 (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr))))
1215
1216 (defun ccl-dump-mule-to-unicode (rrr RRR Rrr)
1217 (insert (format "change chars in r%d and r%d to unicode\n" RRR rrr)))
1218
1219 (defun ccl-dump-unicode-to-mule (rrr RRR Rrr)
1220 (insert (format "converter UCS code %d to a Mule char\n" rrr)))
1190 1221
1191 (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) 1222 (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
1192 (let ((notbl (ccl-get-next-code)) 1223 (let ((notbl (ccl-get-next-code))
1193 (i 0) id) 1224 (i 0) id)
1194 (insert (format "iterate-multiple-map r%d r%d\n" RRR rrr)) 1225 (insert (format "iterate-multiple-map r%d r%d\n" RRR rrr))
1357 | (write-multibyte-character REG_0 REG_1) 1388 | (write-multibyte-character REG_0 REG_1)
1358 1389
1359 ;; Call CCL program whose name is ccl-program-name. 1390 ;; Call CCL program whose name is ccl-program-name.
1360 CALL := (call ccl-program-name) 1391 CALL := (call ccl-program-name)
1361 1392
1362 TRANSLATE := ;; Not implemented under XEmacs. 1393 TRANSLATE := ;; Not implemented under XEmacs, except mule-to-unicode and
1363 (translate-character REG(table) REG(charset) REG(codepoint)) 1394 ;; unicode-to-mule.
1364 | (translate-character SYMBOL REG(charset) REG(codepoint)) 1395 (translate-character REG(table) REG(charset) REG(codepoint))
1396 | (translate-character SYMBOL REG(charset) REG(codepoint))
1397 | (mule-to-unicode REG(charset) REG(codepoint))
1398 | (unicode-to-mule REG(unicode,code) REG(CHARSET))
1399
1365 MAP := 1400 MAP :=
1366 (iterate-multiple-map REG REG MAP-IDs) 1401 (iterate-multiple-map REG REG MAP-IDs)
1367 | (map-multiple REG REG (MAP-SET)) 1402 | (map-multiple REG REG (MAP-SET))
1368 | (map-single REG REG MAP-ID) 1403 | (map-single REG REG MAP-ID)
1369 MAP-IDs := MAP-ID ... 1404 MAP-IDs := MAP-ID ...
1371 MAP-ID := INT-OR-CHAR 1406 MAP-ID := INT-OR-CHAR
1372 1407
1373 ;; Terminate the CCL program. 1408 ;; Terminate the CCL program.
1374 END := (end) 1409 END := (end)
1375 1410
1376 ;; CCL registers. These can contain any integer value. As r7 is used by CCL 1411 ;; CCL registers. These can contain any integer value. As r7 is used by the
1377 ;; interpreter itself, its value change unexpectedly. 1412 ;; CCL interpreter itself, its value can change unexpectedly.
1378 REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 1413 REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7
1379 1414
1380 ARG := REG | INT-OR-CHAR 1415 ARG := REG | INT-OR-CHAR
1381 1416
1382 OPERATOR := 1417 OPERATOR :=