aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2006-07-04 03:36:57 +0000
committerKenichi Handa2006-07-04 03:36:57 +0000
commitd042f8b42609ab5d2fcf9cfc3917d8ebe962db91 (patch)
tree0387f25fa8a73e78fad01f7696e3d88eef897ef0
parent997c19d3c9f948247ed3a247024623122b592f22 (diff)
downloademacs-d042f8b42609ab5d2fcf9cfc3917d8ebe962db91.tar.gz
emacs-d042f8b42609ab5d2fcf9cfc3917d8ebe962db91.zip
(set-language-info): If LANG-ENV is
the current one, don't call set-language-environment, but call one of set-language-environment-XXX to make INFO effective now. (set-language-environment): Call set-language-environment-XXX functions instead of doing the various setups directly. (set-language-environment-coding-systems): Argument eol-type deleted. (set-language-environment-input-method) (set-language-environment-nonascii-translation) (set-language-environment-charset) (set-language-environment-fontset) (set-language-environment-unibyte): New functions.
-rw-r--r--lisp/international/mule-cmds.el188
1 files changed, 104 insertions, 84 deletions
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 93c075442f6..ae664121a5d 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1128,7 +1128,19 @@ see `language-info-alist'."
1128 (setq lang-env (symbol-name lang-env))) 1128 (setq lang-env (symbol-name lang-env)))
1129 (set-language-info-internal lang-env key info) 1129 (set-language-info-internal lang-env key info)
1130 (if (equal lang-env current-language-environment) 1130 (if (equal lang-env current-language-environment)
1131 (set-language-environment lang-env))) 1131 (cond ((eq key 'coding-priority)
1132 (set-language-environment-coding-systems lang-env))
1133 ((eq key 'input-method)
1134 (set-language-environment-input-method lang-env))
1135 ((eq key 'nonascii-translation)
1136 (set-language-environment-nonascii-translation lang-env))
1137 ((eq key 'charset)
1138 (set-language-environment-charset lang-env))
1139 ((eq key 'overriding-fontspec)
1140 (set-language-environment-fontset lang-env))
1141 ((and (not default-enable-multibyte-characters)
1142 (or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
1143 (set-language-environment-unibyte lang-env)))))
1132 1144
1133(defun set-language-info-internal (lang-env key info) 1145(defun set-language-info-internal (lang-env key info)
1134 "Internal use only. 1146 "Internal use only.
@@ -1835,92 +1847,29 @@ specifies the character set for the major languages of Western Europe."
1835 'exit-function))) 1847 'exit-function)))
1836 (run-hooks 'exit-language-environment-hook) 1848 (run-hooks 'exit-language-environment-hook)
1837 (if (functionp func) (funcall func)))) 1849 (if (functionp func) (funcall func))))
1838 (let ((default-eol-type (coding-system-eol-type
1839 default-buffer-file-coding-system)))
1840 (reset-language-environment)
1841
1842 ;; The features might set up coding systems.
1843 (let ((required-features (get-language-info language-name 'features)))
1844 (while required-features
1845 (require (car required-features))
1846 (setq required-features (cdr required-features))))
1847
1848 (setq current-language-environment language-name)
1849 (set-language-environment-coding-systems language-name default-eol-type))
1850 (let ((input-method (get-language-info language-name 'input-method)))
1851 (when input-method
1852 (setq default-input-method input-method)
1853 (if input-method-history
1854 (setq input-method-history
1855 (cons input-method
1856 (delete input-method input-method-history))))))
1857 (let ((nonascii (get-language-info language-name 'nonascii-translation))
1858 (dos-table
1859 (if (eq window-system 'pc)
1860 (intern
1861 (format "cp%d-nonascii-translation-table" dos-codepage)))))
1862 (cond
1863 ((char-table-p nonascii)
1864 (setq nonascii-translation-table nonascii))
1865 ((and (eq window-system 'pc) (boundp dos-table))
1866 ;; DOS terminals' default is to use a special non-ASCII translation
1867 ;; table as appropriate for the installed codepage.
1868 (setq nonascii-translation-table (symbol-value dos-table)))
1869 ((charsetp nonascii)
1870 (setq nonascii-insert-offset (- (make-char nonascii) 128)))))
1871
1872 ;; Unibyte setups if necessary.
1873 (unless default-enable-multibyte-characters
1874 ;; Syntax and case table.
1875 (let ((syntax (get-language-info language-name 'unibyte-syntax)))
1876 (if syntax
1877 (let ((set-case-syntax-set-multibyte nil))
1878 (load syntax nil t))
1879 ;; No information for syntax and case. Reset to the defaults.
1880 (let ((syntax-table (standard-syntax-table))
1881 (standard-table (standard-case-table))
1882 (case-table (make-char-table 'case-table))
1883 (ch (if (eq window-system 'pc) 128 160)))
1884 (while (< ch 256)
1885 (modify-syntax-entry ch " " syntax-table)
1886 (setq ch (1+ ch)))
1887 (dotimes (i 128)
1888 (aset case-table i (aref standard-table i)))
1889 (set-char-table-extra-slot case-table 0 nil)
1890 (set-char-table-extra-slot case-table 1 nil)
1891 (set-char-table-extra-slot case-table 2 nil)
1892 (set-standard-case-table case-table))
1893 (let ((list (buffer-list)))
1894 (while list
1895 (with-current-buffer (car list)
1896 (set-case-table (standard-case-table)))
1897 (setq list (cdr list))))))
1898 (set-display-table-and-terminal-coding-system language-name))
1899 1850
1851 (reset-language-environment)
1852 ;; The features might set up coding systems.
1900 (let ((required-features (get-language-info language-name 'features))) 1853 (let ((required-features (get-language-info language-name 'features)))
1901 (while required-features 1854 (while required-features
1902 (require (car required-features)) 1855 (require (car required-features))
1903 (setq required-features (cdr required-features)))) 1856 (setq required-features (cdr required-features))))
1904 1857
1905 ;; Don't invoke fontset-related functions if fontsets aren't 1858 (setq current-language-environment language-name)
1906 ;; supported in this build of Emacs. 1859
1907 (when (fboundp 'fontset-list) 1860 (set-language-environment-coding-systems language-name)
1908 (let ((overriding-fontspec (get-language-info language-name 1861 (set-language-environment-input-method language-name)
1909 'overriding-fontspec))) 1862 (set-language-environment-nonascii-translation language-name)
1910 (if overriding-fontspec 1863 (set-language-environment-charset language-name)
1911 (set-overriding-fontspec-internal overriding-fontspec)))) 1864 (set-language-environment-fontset language-name)
1865 ;; Unibyte setups if necessary.
1866 (unless default-enable-multibyte-characters
1867 (set-language-environment-unibyte language-name))
1912 1868
1913 (let ((func (get-language-info language-name 'setup-function))) 1869 (let ((func (get-language-info language-name 'setup-function)))
1914 (if (functionp func) 1870 (if (functionp func)
1915 (funcall func))) 1871 (funcall func)))
1916 (if (and utf-translate-cjk-mode 1872
1917 (not (eq utf-translate-cjk-lang-env language-name))
1918 (catch 'tag
1919 (dolist (charset (get-language-info language-name 'charset))
1920 (if (memq charset utf-translate-cjk-charsets)
1921 (throw 'tag t)))
1922 nil))
1923 (utf-translate-cjk-load-tables))
1924 (run-hooks 'set-language-environment-hook) 1873 (run-hooks 'set-language-environment-hook)
1925 (force-mode-line-update t)) 1874 (force-mode-line-update t))
1926 1875
@@ -1949,14 +1898,11 @@ specifies the character set for the major languages of Western Europe."
1949 ;; proper windows-1252 coding system. --fx] 1898 ;; proper windows-1252 coding system. --fx]
1950 (aset standard-display-table 146 [39])))) 1899 (aset standard-display-table 146 [39]))))
1951 1900
1952(defun set-language-environment-coding-systems (language-name 1901(defun set-language-environment-coding-systems (language-name)
1953 &optional eol-type) 1902 "Do various coding system setups for language environment LANGUAGE-NAME."
1954 "Do various coding system setups for language environment LANGUAGE-NAME.
1955
1956The optional arg EOL-TYPE specifies the eol-type of the default value
1957of `buffer-file-coding-system' set by this function."
1958 (let* ((priority (get-language-info language-name 'coding-priority)) 1903 (let* ((priority (get-language-info language-name 'coding-priority))
1959 (default-coding (car priority))) 1904 (default-coding (car priority))
1905 (eol-type (coding-system-eol-type default-buffer-file-coding-system)))
1960 (if priority 1906 (if priority
1961 (let ((categories (mapcar 'coding-system-category priority))) 1907 (let ((categories (mapcar 'coding-system-category priority)))
1962 (set-default-coding-systems 1908 (set-default-coding-systems
@@ -1971,6 +1917,80 @@ of `buffer-file-coding-system' set by this function."
1971 ;; Changing the binding of a coding category requires this call. 1917 ;; Changing the binding of a coding category requires this call.
1972 (update-coding-systems-internal))))) 1918 (update-coding-systems-internal)))))
1973 1919
1920(defun set-language-environment-input-method (language-name)
1921 "Do various input method setups for language environment LANGUAGE-NAME."
1922 (let ((input-method (get-language-info language-name 'input-method)))
1923 (when input-method
1924 (setq default-input-method input-method)
1925 (if input-method-history
1926 (setq input-method-history
1927 (cons input-method
1928 (delete input-method input-method-history)))))))
1929
1930(defun set-language-environment-nonascii-translation (language-name)
1931 "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME."
1932 (let ((nonascii (get-language-info language-name 'nonascii-translation))
1933 (dos-table
1934 (if (eq window-system 'pc)
1935 (intern
1936 (format "cp%d-nonascii-translation-table" dos-codepage)))))
1937 (cond
1938 ((char-table-p nonascii)
1939 (setq nonascii-translation-table nonascii))
1940 ((and (eq window-system 'pc) (boundp dos-table))
1941 ;; DOS terminals' default is to use a special non-ASCII translation
1942 ;; table as appropriate for the installed codepage.
1943 (setq nonascii-translation-table (symbol-value dos-table)))
1944 ((charsetp nonascii)
1945 (setq nonascii-insert-offset (- (make-char nonascii) 128))))))
1946
1947(defun set-language-environment-charset (language-name)
1948 "Do various charset setups for language environment LANGUAGE-NAME."
1949 (if (and utf-translate-cjk-mode
1950 (not (eq utf-translate-cjk-lang-env language-name))
1951 (catch 'tag
1952 (dolist (charset (get-language-info language-name 'charset))
1953 (if (memq charset utf-translate-cjk-charsets)
1954 (throw 'tag t)))
1955 nil))
1956 (utf-translate-cjk-load-tables)))
1957
1958(defun set-language-environment-fontset (language-name)
1959 "Do various fontset setups for language environment LANGUAGE-NAME."
1960 ;; Don't invoke fontset-related functions if fontsets aren't
1961 ;; supported in this build of Emacs.
1962 (if (fboundp 'fontset-list)
1963 (set-overriding-fontspec-internal
1964 (get-language-info language-name 'overriding-fontspec))))
1965
1966(defun set-language-environment-unibyte (language-name)
1967 "Do various unibyte-mode setups for language environment LANGUAGE-NAME."
1968 ;; Syntax and case table.
1969 (let ((syntax (get-language-info language-name 'unibyte-syntax)))
1970 (if syntax
1971 (let ((set-case-syntax-set-multibyte nil))
1972 (load syntax nil t))
1973 ;; No information for syntax and case. Reset to the defaults.
1974 (let ((syntax-table (standard-syntax-table))
1975 (standard-table (standard-case-table))
1976 (case-table (make-char-table 'case-table))
1977 (ch (if (eq window-system 'pc) 128 160)))
1978 (while (< ch 256)
1979 (modify-syntax-entry ch " " syntax-table)
1980 (setq ch (1+ ch)))
1981 (dotimes (i 128)
1982 (aset case-table i (aref standard-table i)))
1983 (set-char-table-extra-slot case-table 0 nil)
1984 (set-char-table-extra-slot case-table 1 nil)
1985 (set-char-table-extra-slot case-table 2 nil)
1986 (set-standard-case-table case-table))
1987 (let ((list (buffer-list)))
1988 (while list
1989 (with-current-buffer (car list)
1990 (set-case-table (standard-case-table)))
1991 (setq list (cdr list))))))
1992 (set-display-table-and-terminal-coding-system language-name))
1993
1974(defsubst princ-list (&rest args) 1994(defsubst princ-list (&rest args)
1975 "Print all arguments with `princ', then print \"\n\"." 1995 "Print all arguments with `princ', then print \"\n\"."
1976 (while args (princ (car args)) (setq args (cdr args))) 1996 (while args (princ (car args)) (setq args (cdr args)))