1916 |
(progn ,@body) |
(progn ,@body) |
1917 |
(set-category-table current-category-table)))) |
(set-category-table current-category-table)))) |
1918 |
|
|
1919 |
|
(defun define-translation-hash-table (symbol table) |
1920 |
|
"Define SYMBOL as the name of the hash translation TABLE for use in CCL. |
1921 |
|
|
1922 |
|
Analogous to `define-translation-table', but updates |
1923 |
|
`translation-hash-table-vector' and the table is for use in the CCL |
1924 |
|
`lookup-integer' and `lookup-character' functions." |
1925 |
|
(unless (and (symbolp symbol) |
1926 |
|
(hash-table-p table)) |
1927 |
|
(error "Bad args to define-translation-hash-table")) |
1928 |
|
(let ((len (length translation-hash-table-vector)) |
1929 |
|
(id 0) |
1930 |
|
done) |
1931 |
|
(put symbol 'translation-hash-table table) |
1932 |
|
(while (not done) |
1933 |
|
(if (>= id len) |
1934 |
|
(setq translation-hash-table-vector |
1935 |
|
(vconcat translation-hash-table-vector [nil]))) |
1936 |
|
(let ((slot (aref translation-hash-table-vector id))) |
1937 |
|
(if (or (not slot) |
1938 |
|
(eq (car slot) symbol)) |
1939 |
|
(progn |
1940 |
|
(aset translation-hash-table-vector id (cons symbol table)) |
1941 |
|
(setq done t)) |
1942 |
|
(setq id (1+ id))))) |
1943 |
|
(put symbol 'translation-hash-table-id id) |
1944 |
|
id)) |
1945 |
|
|
1946 |
;;; Initialize some variables. |
;;; Initialize some variables. |
1947 |
|
|
1948 |
(put 'use-default-ascent 'char-table-extra-slots 0) |
(put 'use-default-ascent 'char-table-extra-slots 0) |