Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-cmds.el @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 7039e6323819
children 2923009caf47
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 ;;; mule-cmds.el --- Commands for multilingual environment -*- coding: iso-2022-7bit; -*- 1 ;;; mule-cmds.el --- Commands for multilingual environment -*- coding: iso-2022-7bit; -*-
2 2
3 ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. 3 ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation. 4 ;; Licensed to the Free Software Foundation.
5 ;; Copyright (C) 1997 MORIOKA Tomohiko 5 ;; Copyright (C) 1997 MORIOKA Tomohiko
6 ;; Copyright (C) 2000, 2001, 2002 Ben Wing.
6 7
7 ;; Keywords: mule, multilingual 8 ;; Keywords: mule, multilingual
8 9
9 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
10 11
26 ;; Note: Some of the code here is now in code-cmds.el 27 ;; Note: Some of the code here is now in code-cmds.el
27 28
28 ;;; Code: 29 ;;; Code:
29 30
30 ;;; MULE related key bindings and menus. 31 ;;; MULE related key bindings and menus.
31
32 (require 'code-cmds)
33 32
34 ;; Preserve the old name 33 ;; Preserve the old name
35 (defvaralias 'mule-keymap 'coding-keymap) 34 (defvaralias 'mule-keymap 'coding-keymap)
36 35
37 (define-key mule-keymap "x" 'set-selection-coding-system) 36 (define-key mule-keymap "x" 'set-selection-coding-system)
56 ;; convenient because it requires shifting on most keyboards. An 55 ;; convenient because it requires shifting on most keyboards. An
57 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' 56 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
58 ;; but it won't be used that frequently. 57 ;; but it won't be used that frequently.
59 (define-key global-map "\C-\\" 'toggle-input-method) 58 (define-key global-map "\C-\\" 'toggle-input-method)
60 59
60 ;; Original mapping will be altered by set-keyboard-coding-system.
61 (define-key global-map [(meta \#)] 'ispell-word) ;originally "$"
62 ;; (define-key global-map [(meta {)] 'insert-parentheses) ;originally "("
63
61 ;;; This is no good because people often type Shift-SPC 64 ;;; This is no good because people often type Shift-SPC
62 ;;; meaning to type SPC. -- rms. 65 ;;; meaning to type SPC. -- rms.
63 ;;; ;; Here's an alternative key binding for X users (Shift-SPACE). 66 ;;; ;; Here's an alternative key binding for X users (Shift-SPACE).
64 ;;; (define-key global-map [?\S- ] 'toggle-input-method) 67 ;;; (define-key global-map '(shift space) 'toggle-input-method)
65
66 (defun coding-system-change-eol-conversion (coding-system eol-type)
67 "Return a coding system which differs from CODING-SYSTEM in eol conversion.
68 The returned coding system converts end-of-line by EOL-TYPE
69 but text as the same way as CODING-SYSTEM.
70 EOL-TYPE should be `lf', `crlf', `cr' or nil.
71 If EOL-TYPE is nil, the returned coding system detects
72 how end-of-line is formatted automatically while decoding.
73
74 EOL-TYPE can be specified by an symbol `unix', `dos' or `mac'.
75 They means `lf', `crlf', and `cr' respectively."
76 (if (symbolp eol-type)
77 (setq eol-type (cond ((or (eq eol-type 'unix)
78 (eq eol-type 'lf))
79 'eol-lf)
80 ((or (eq eol-type 'dos)
81 (eq eol-type 'crlf))
82 'eol-crlf)
83 ((or (eq eol-type 'mac)
84 (eq eol-type 'cr))
85 'eol-cr)
86 (t eol-type))))
87 (let ((orig-eol-type (coding-system-eol-type coding-system)))
88 (if (null orig-eol-type)
89 (if (not eol-type)
90 coding-system
91 (coding-system-property coding-system eol-type))
92 (let ((base (coding-system-base coding-system)))
93 (if (not eol-type)
94 base
95 (if (eq eol-type orig-eol-type)
96 coding-system
97 (setq orig-eol-type (coding-system-eol-type base))
98 (if (null orig-eol-type)
99 (coding-system-property base eol-type))))))))
100
101 ;; (defun coding-system-change-text-conversion (coding-system coding)
102 ;; "Return a coding system which differs from CODING-SYSTEM in text conversion.
103 ;; The returned coding system converts text by CODING
104 ;; but end-of-line as the same way as CODING-SYSTEM.
105 ;; If CODING is nil, the returned coding system detects
106 ;; how text is formatted automatically while decoding."
107 ;; (if (not coding)
108 ;; (coding-system-base coding-system)
109 ;; (let ((eol-type (coding-system-eol-type coding-system)))
110 ;; (coding-system-change-eol-conversion
111 ;; coding
112 ;; (if (numberp eol-type) (aref [unix dos mac] eol-type))))))
113 68
114 (defun view-hello-file () 69 (defun view-hello-file ()
115 "Display the HELLO file which list up many languages and characters." 70 "Display the HELLO file which list up many languages and characters."
116 (interactive) 71 (interactive)
117 ;; We have to decode the file in any environment. 72 ;; We have to decode the file in any environment.
118 (let ((coding-system-for-read 'iso-2022-7bit)) 73 (let ((coding-system-for-read 'iso-2022-7bit))
119 (find-file-read-only (expand-file-name "HELLO" data-directory)))) 74 (find-file-read-only (expand-file-name "HELLO" data-directory))))
120 75
121 76
122 ;;; Language support stuff. 77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
123 78 ;;; Language Support Functions ;;;
79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 (defvar language-info-alist nil 80 (defvar language-info-alist nil
125 "Alist of language environment definitions. 81 "Alist of language environment definitions.
126 Each element looks like: 82 Each element looks like:
127 (LANGUAGE-NAME . ((KEY . INFO) ...)) 83 (LANGUAGE-NAME . ((PROP . VALUE) ...))
128 where LANGUAGE-NAME is a string, the name of the language environment, 84 where LANGUAGE-NAME is a string, the name of the language environment,
129 KEY is a symbol denoting the kind of information, and 85 PROP is a symbol denoting a property, and VALUE is the data associated
130 INFO is the data associated with KEY. 86 with PROP.
131 Meaningful values for KEY include 87 See `set-language-info' for documentation on PROP and VALUE.")
132 88
133 documentation value is documentation of what this language environment 89 (defun get-language-info (lang-env prop)
134 is meant for, and how to use it. 90 "Return information listed under PROP for language environment LANG-ENV.
135 charset value is a list of the character sets used by this 91 PROP is a symbol denoting a property.
136 language environment. 92 For a list of useful values for PROP and their meanings,
137 sample-text value is one line of text, 93 see `set-language-info'."
138 written using those character sets,
139 appropriate for this language environment.
140 setup-function value is a function to call to switch to this
141 language environment.
142 exit-function value is a function to call to leave this
143 language environment.
144 coding-system value is a list of coding systems that are good
145 for saving text written in this language environment.
146 This list serves as suggestions to the user;
147 in effect, as a kind of documentation.
148 coding-priority value is a list of coding systems for this language
149 environment, in order of decreasing priority.
150 This is used to set up the coding system priority
151 list when you switch to this language environment.
152 input-method value is a default input method for this language
153 environment.
154 features value is a list of features requested in this
155 language environment.
156 tutorial value is a tutorial file name written in the language.")
157
158 (defun get-language-info (lang-env key)
159 "Return information listed under KEY for language environment LANG-ENV.
160 KEY is a symbol denoting the kind of information.
161 For a list of useful values for KEY and their meanings,
162 see `language-info-alist'."
163 (if (symbolp lang-env) 94 (if (symbolp lang-env)
164 (setq lang-env (symbol-name lang-env))) 95 (setq lang-env (symbol-name lang-env)))
165 (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) 96 (let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
166 (if lang-slot 97 (if lang-slot
167 (cdr (assq key (cdr lang-slot)))))) 98 (cdr (assq prop (cdr lang-slot))))))
168 99
169 (defun set-language-info (lang-env key info) 100 (defun set-language-info (lang-env prop value)
170 "Modify part of the definition of language environment LANG-ENV. 101 "Modify part of the definition of language environment LANG-ENV.
171 Specifically, this stores the information INFO under KEY 102 Specifically, this stores the information VALUE under PROP
172 in the definition of this language environment. 103 in the definition of this language environment.
173 KEY is a symbol denoting the kind of information. 104 PROP is a symbol denoting a property, and VALUE is the value of that property.
174 INFO is the value for that information. 105
175 106 Meaningful values for PROP include
176 For a list of useful values for KEY and their meanings, 107
177 see `language-info-alist'." 108 documentation VALUE is documentation of what this language environment
109 is meant for, and how to use it.
110
111 charset VALUE is a list of the character sets used by this
112 language environment.
113
114 sample-text VALUE is one line of text,
115 written using those character sets,
116 appropriate for this language environment.
117
118 setup-function VALUE is a function to call to switch to this
119 language environment.
120
121 exit-function VALUE is a function to call to leave this
122 language environment.
123
124 coding-system VALUE is a list of coding systems that are good
125 for saving text written in this language environment.
126 This list serves as suggestions to the user;
127 in effect, as a kind of documentation.
128
129 coding-priority VALUE is a list of coding systems for this language
130 environment, in order of decreasing priority.
131 This is used to set up the coding system priority
132 list when you switch to this language environment.
133
134 input-method VALUE is a default input method for this language
135 environment.
136
137 features VALUE is a list of features requested in this
138 language environment.
139
140 tutorial VALUE is a tutorial file name written in the language.
141
142 locale VALUE is a list of locale expressions, which serve
143 two purposes: (1) Determining the language
144 environment from the current system locale at
145 startup, and (2) determining how to set the system
146 locale when the language environment is changed.
147 Each expression will be tried in turn, and should
148 be a string (for case (1), the string is matched
149 against the current locale using the regular
150 expression \"^STRING[^A-Za-z0-9]\"; for case (2),
151 the string is passed directly to
152 `set-current-locale' until a non-nil result is
153 returned), or a function of one argument. For
154 case (1), this argument will be a locale, and the
155 function should return t or nil to indicate
156 whether this locale matches the language
157 environment; for case (2), the argument will be
158 nil, and the function should call
159 `set-current-locale' itself and return the set
160 locale string if the locale was successfully set,
161 and nil otherwise.
162
163 NOTE: This property is *NOT* used under MS Windows;
164 instead, the `mswindows-locale' property is used.
165
166 cygwin-locale VALUE specifies a general Unix-style C library
167 locale that will be used to initialize the LANG
168 environment variable under MS Windows native, when the
169 system cannot test out the locales specified in the
170 `locale' property. This is so that Cygwin programs
171 can be run from an MS Windows native XEmacs. If not
172 specified, the last entry in `locale' will be used.
173
174 native-coding-system VALUE is a single coding-system expression, or a
175 list of such expressions. These expressions are
176 used to compute the operating system's native
177 coding system, i.e. the coding system to be used
178 as the alias for `native' and `file-name'. This
179 specifies the coding system used for text
180 exchanged with the operating system, such as file
181 names, environment variables, subprocess
182 arguments, etc. Each expression should be either
183 a symbol naming a coding system or a function
184 (anything that is `functionp') of one argument,
185 which is passed the current locale corresponding
186 to this language environment and should return a
187 coding system or nil. Each expression is tried in
188 turn until a coding system is obtained. If there
189 is no non-nil result, or no value is specified for
190 this property, the first coding system listed
191 under the `coding-system' property is used.
192
193 NOTE: This is *NOT* used under MS Windows.
194 Instead, `mswindows-multibyte-system-default'
195 is always used, since the system default code
196 page is what the Win32 API routines make use
197 of, and this cannot be changed. (We get around
198 this by using the Unicode versions whenever
199 possible -- i.e. on Windows NT/2000, and on
200 Windows 9x with the few API's that support
201 Unicode.)
202
203 mswindows-locale VALUE is an element of the form MSWINDOWS-LOCALE, or
204 a list of such elements. Each element is an MS
205 Windows locale, of the form that can be passed to
206 `mswindows-set-current-locale'. This property is used
207 both to determine the current language environment at
208 startup (by matching MSWINDOWS-LOCALE against the
209 value returned by `mswindows-user-default-locale') and
210 to set the values of `set-current-locale' and
211 `mswindows-set-current-locale' when the current
212 language environment is changed. (The correct CLIB
213 locale can always be generated by passing in the
214 SUBLANG, with dashes in place of underscores, or the
215 LANG if there's no SUBLANG. The return value will be
216 the canonicalized locale, in proper CLIB form.)
217
218 If there is no value for this property, the MS Windows
219 locale is assumed to have the same name as the
220 language environment."
178 (if (symbolp lang-env) 221 (if (symbolp lang-env)
179 (setq lang-env (symbol-name lang-env))) 222 (setq lang-env (symbol-name lang-env)))
180 (let (lang-slot key-slot) 223 (let (lang-slot prop-slot)
181 (setq lang-slot (assoc lang-env language-info-alist)) 224 (setq lang-slot (assoc lang-env language-info-alist))
182 (if (null lang-slot) ; If no slot for the language, add it. 225 (if (null lang-slot) ; If no slot for the language, add it.
183 (setq lang-slot (list lang-env) 226 (setq lang-slot (list lang-env)
184 language-info-alist (cons lang-slot language-info-alist))) 227 language-info-alist (cons lang-slot language-info-alist)))
185 (setq key-slot (assq key lang-slot)) 228 (setq prop-slot (assq prop lang-slot))
186 (if (null key-slot) ; If no slot for the key, add it. 229 (if (null prop-slot) ; If no slot for the prop, add it.
187 (progn 230 (progn
188 (setq key-slot (list key)) 231 (setq prop-slot (list prop))
189 (setcdr lang-slot (cons key-slot (cdr lang-slot))))) 232 (setcdr lang-slot (cons prop-slot (cdr lang-slot)))))
190 (setcdr key-slot info))) 233 (setcdr prop-slot value)))
191 234
192 (defun set-language-info-alist (lang-env alist &optional parents) 235 (defun set-language-info-alist (lang-env alist &optional parents)
193 "Store ALIST as the definition of language environment LANG-ENV. 236 "Store ALIST as the definition of language environment LANG-ENV.
194 ALIST is an alist of KEY and INFO values. See the documentation of 237 ALIST is an alist of properties and values. See the documentation of
195 `set-language-info' for the meanings of KEY and INFO." 238 `set-language-info' for the allowed properties."
196 (if (symbolp lang-env) 239 (if (symbolp lang-env)
197 (setq lang-env (symbol-name lang-env))) 240 (setq lang-env (symbol-name lang-env)))
198 (let (; (describe-map describe-language-environment-map) 241 ;; FSF has 30 lines of unbelievably ugly code to set up the menus
199 ; (setup-map setup-language-environment-map) 242 ;; appropriately. We just use a filter.
200 ) 243 (while alist
201 ;; (if parents 244 (set-language-info lang-env (car (car alist)) (cdr (car alist)))
202 ;; (let ((l parents) 245 (setq alist (cdr alist))))
203 ;; map parent-symbol parent)
204 ;; (while l
205 ;; (if (symbolp (setq parent-symbol (car l)))
206 ;; (setq parent (symbol-name parent))
207 ;; (setq parent parent-symbol parent-symbol (intern parent)))
208 ;; (setq map (lookup-key describe-map (vector parent-symbol)))
209 ;; (if (not map)
210 ;; (progn
211 ;; (setq map (intern (format "describe-%s-environment-map"
212 ;; (downcase parent))))
213 ;; (define-prefix-command map)
214 ;; (define-key-after describe-map (vector parent-symbol)
215 ;; (cons parent map) t)))
216 ;; (setq describe-map (symbol-value map))
217 ;; (setq map (lookup-key setup-map (vector parent-symbol)))
218 ;; (if (not map)
219 ;; (progn
220 ;; (setq map (intern (format "setup-%s-environment-map"
221 ;; (downcase parent))))
222 ;; (define-prefix-command map)
223 ;; (define-key-after setup-map (vector parent-symbol)
224 ;; (cons parent map) t)))
225 ;; (setq setup-map (symbol-value map))
226 ;; (setq l (cdr l)))))
227
228 ;; Set up menu items for this language env.
229 (let ((doc (assq 'documentation alist)))
230 (when doc
231 ;; (define-key-after describe-map (vector (intern lang-env))
232 ;; (cons lang-env 'describe-specified-language-support) t)
233 (when (featurep 'menubar)
234 (eval-after-load
235 "menubar-items.elc"
236 `(add-menu-button
237 '("%_Edit" "%_Multilingual (\"Mule\")"
238 "%_Describe Language Support")
239 (vector ,lang-env
240 '(describe-language-environment ,lang-env)
241 t))))
242 ))
243 ;; (define-key-after setup-map (vector (intern lang-env))
244 ;; (cons lang-env 'setup-specified-language-environment) t)
245 (when (featurep 'menubar)
246 (eval-after-load
247 "menubar-items.elc"
248 `(add-menu-button
249 '("%_Edit" "%_Multilingual (\"Mule\")"
250 "%_Set Language Environment")
251 (vector ,lang-env
252 '(set-language-environment ,lang-env)
253 t))))
254
255 (while alist
256 (set-language-info lang-env (car (car alist)) (cdr (car alist)))
257 (setq alist (cdr alist)))))
258 246
259 (defun read-language-name (key prompt &optional default) 247 (defun read-language-name (key prompt &optional default)
260 "Read a language environment name which has information for KEY. 248 "Read a language environment name which has information for KEY.
261 If KEY is nil, read any language environment. 249 If KEY is nil, read any language environment.
262 Prompt with PROMPT. DEFAULT is the default choice of language environment. 250 Prompt with PROMPT. DEFAULT is the default choice of language environment.
640 is still bound to the language environment being exited. 628 is still bound to the language environment being exited.
641 629
642 This hook is mainly used for canceling the effect of 630 This hook is mainly used for canceling the effect of
643 `set-language-environment-hook' (which-see).") 631 `set-language-environment-hook' (which-see).")
644 632
645 (put 'setup-specified-language-environment 'apropos-inhibit t) 633 ;; bogus FSF function setup-specified-language-support.
646
647 (defun setup-specified-language-environment ()
648 "Switch to a specified language environment."
649 (interactive)
650 (let (language-name)
651 (if (and (symbolp last-command-event)
652 (or (not (eq last-command-event 'Default))
653 (setq last-command-event 'English))
654 (setq language-name (symbol-name last-command-event)))
655 (set-language-environment language-name)
656 (error "Bogus calling sequence"))))
657 634
658 (defcustom current-language-environment "English" 635 (defcustom current-language-environment "English"
659 "The last language environment specified with `set-language-environment'. 636 "The last language environment specified with `set-language-environment'.
660 This variable should be set only with \\[customize], which is equivalent 637 This variable should be set only with \\[customize], which is equivalent
661 to using the function `set-language-environment'." 638 to using the function `set-language-environment'."
673 language-info-alist)) 650 language-info-alist))
674 :initialize 'custom-initialize-default 651 :initialize 'custom-initialize-default
675 :group 'mule 652 :group 'mule
676 :type 'string) 653 :type 'string)
677 654
678 (defun reset-language-environment ()
679 "Reset multilingual environment of Emacs to the default status.
680
681 The default status is as follows:
682
683 The default value of `buffer-file-coding-system' is nil.
684 The default coding system for process I/O is nil.
685 The default value for the command `set-terminal-coding-system' is nil.
686 The default value for the command `set-keyboard-coding-system' is nil.
687
688 The order of priorities of coding categories and the coding system
689 bound to each category are as follows
690 coding category coding system
691 --------------------------------------------------
692 iso-7 iso-2022-7bit
693 no-conversion raw-text
694 utf-8 utf-8
695 iso-8-1 iso-8859-1
696 iso-8-2 ctext (iso-8859-1 alias)
697 iso-8-designate ctext (iso-8859-1 alias)
698 iso-lock-shift iso-2022-lock
699 shift-jis shift_jis
700 big5 big5
701 ucs-4 iso-10646-ucs-4
702 "
703 ;; The old table (from FSF synch?) was not what we use (cf mule-coding.el),
704 ;; and as documented iso-8-designate is inconsistent with iso-2022-8bit-ss2.
705 ;; The order of priorities of coding categories and the coding system
706 ;; bound to each category are as follows
707 ;; coding category coding system
708 ;; --------------------------------------------------
709 ;; iso-8-2 iso-8859-1
710 ;; iso-8-1 iso-8859-1
711 ;; iso-7 iso-2022-7bit
712 ;; iso-lock-shift iso-2022-lock
713 ;; iso-8-designate iso-2022-8bit-ss2
714 ;; no-conversion raw-text
715 ;; shift-jis shift_jis
716 ;; big5 big5
717 ;; ucs-4 ----
718 ;; utf-8 ----
719 (interactive)
720
721 (set-coding-category-system 'iso-7 'iso-2022-7)
722 (set-coding-category-system 'iso-8-1 'iso-8859-1)
723 (set-coding-category-system 'iso-8-2 'ctext)
724 (set-coding-category-system 'iso-lock-shift 'iso-2022-lock)
725 (set-coding-category-system 'iso-8-designate 'ctext)
726 (set-coding-category-system 'no-conversion 'raw-text)
727 (set-coding-category-system 'shift-jis 'shift_jis)
728 (set-coding-category-system 'big5 'big5)
729 ;; #### Can we now assume the existence of the 10646 coding systems?
730 ;; #### These lists need to be synched with the ones in mule-coding.el.
731 (cond ((eq (coding-system-type (coding-category-system 'utf-8)) 'utf-8)
732 (set-coding-category-system 'ucs-4 'iso-10646-ucs-4)
733 (set-coding-category-system 'utf-8 'utf-8)
734 (set-coding-priority-list
735 '(iso-7
736 no-conversion
737 utf-8
738 iso-8-1
739 iso-8-2
740 iso-8-designate
741 iso-lock-shift
742 shift-jis
743 big5
744 ucs-4))
745 )
746 (t
747 (set-coding-priority-list
748 '(iso-7
749 no-conversion
750 iso-8-1
751 iso-8-2
752 iso-8-designate
753 iso-lock-shift
754 shift-jis
755 big5))
756 ))
757
758 ;; (update-coding-systems-internal)
759
760 (set-default-coding-systems nil)
761 ;; Don't alter the terminal and keyboard coding systems here.
762 ;; The terminal still supports the same coding system
763 ;; that it supported a minute ago.
764 ;;; (set-terminal-coding-system-internal nil)
765 ;;; (set-keyboard-coding-system-internal nil)
766
767 ;; (setq nonascii-translation-table nil
768 ;; nonascii-insert-offset 0)
769 )
770
771 (defun set-language-environment (language-name) 655 (defun set-language-environment (language-name)
772 "Set up multi-lingual environment for using LANGUAGE-NAME. 656 "Set up multi-lingual environment for using LANGUAGE-NAME.
773 This sets the coding system priority and the default input method 657 This sets the coding system autodetection priority, the default buffer
774 and sometimes other things. LANGUAGE-NAME should be a string 658 coding system, the default input method, the system locale, and other
775 which is the name of a language environment. For example, \"Latin-1\" 659 relevant language properties. LANGUAGE-NAME should be a string, the
776 specifies the character set for the major languages of Western Europe." 660 name of a language environment. For example, \"Latin-1\" specifies
661 the language environment for the major languages of Western Europe."
777 (interactive (list (read-language-name 662 (interactive (list (read-language-name
778 nil 663 nil
779 "Set language environment (default, English): "))) 664 "Set language environment (default, English): ")))
780 (if language-name 665 (if language-name
781 (if (symbolp language-name) 666 (if (symbolp language-name)
782 (setq language-name (symbol-name language-name))) 667 (setq language-name (symbol-name language-name)))
783 (setq language-name "English")) 668 (setq language-name "English"))
784 (or (assoc-ignore-case language-name language-info-alist) 669 (or (assoc-ignore-case language-name language-info-alist)
785 (error "Language environment not defined: %S" language-name)) 670 (error 'invalid-argument "Language environment not defined"
671 language-name))
786 (if current-language-environment 672 (if current-language-environment
787 (let ((func (get-language-info current-language-environment 673 (let ((func (get-language-info current-language-environment
788 'exit-function))) 674 'exit-function)))
789 (run-hooks 'exit-language-environment-hook) 675 (run-hooks 'exit-language-environment-hook)
790 (if (fboundp func) (funcall func)))) 676 (if (fboundp func) (funcall func))))
677 (setq current-language-environment language-name)
791 (let ((default-eol-type (coding-system-eol-type 678 (let ((default-eol-type (coding-system-eol-type
792 default-buffer-file-coding-system))) 679 default-buffer-file-coding-system)))
793 (reset-language-environment) 680 (reset-coding-categories-to-default)
794 681 (set-locale-for-language-environment language-name)
795 (setq current-language-environment language-name)
796 (set-language-environment-coding-systems language-name default-eol-type)) 682 (set-language-environment-coding-systems language-name default-eol-type))
683
684 (finish-set-language-environment language-name))
685
686 (defun finish-set-language-environment (language-name)
687 ;; Internal function. Only what's here is called at startup, once the
688 ;; first language environment is determined. The above stuff was already
689 ;; taken care of very early in the startup sequence, in a special
690 ;; fashion.
797 (let ((input-method (get-language-info language-name 'input-method))) 691 (let ((input-method (get-language-info language-name 'input-method)))
798 (when input-method 692 (when input-method
799 (setq default-input-method input-method) 693 (setq default-input-method input-method)
800 (if input-method-history 694 (if input-method-history
801 (setq input-method-history 695 (setq input-method-history
876 ;; ;; Most Windows programs send out apostrophe's as \222. Most X fonts 770 ;; ;; Most Windows programs send out apostrophe's as \222. Most X fonts
877 ;; ;; don't contain a character at that position. Map it to the ASCII 771 ;; ;; don't contain a character at that position. Map it to the ASCII
878 ;; ;; apostrophe. 772 ;; ;; apostrophe.
879 ;; (aset standard-display-table 146 [39])))) 773 ;; (aset standard-display-table 146 [39]))))
880 774
881 (defun set-language-environment-coding-systems (language-name 775 ;; bogus FSF function describe-specified-language-support.
882 &optional eol-type)
883 "Do various coding system setups for language environment LANGUAGE-NAME.
884
885 The optional arg EOL-TYPE specifies the eol-type of the default value
886 of buffer-file-coding-system set by this function.
887
888 Note that `coding-priority-list' is not reset first; thus changing language
889 environment allows recognition of coding systems from previously set language
890 environments. (This will not work if the desired coding systems are from the
891 same category. E.g., starting with a Hebrew language environment, ISO 8859-8
892 will be recognized. If you shift to Russian, ISO 8859-8 will be shadowed by
893 ISO 8859-5, and cannot be automatically recognized without resetting the
894 language environment to Hebrew. However, if you shift from Japanese to
895 Russian, ISO-2022-JP will continue to be automatically recognized, since
896 ISO-8859-5 and ISO-2022-JP are different coding categories.)"
897 (let* ((priority (get-language-info language-name 'coding-priority))
898 (default-coding (car priority)))
899 (if priority
900 (let ((categories (mapcar 'coding-system-category priority))
901 category checked-categories)
902 (set-default-coding-systems
903 (if (memq eol-type '(lf crlf cr unix dos mac))
904 (coding-system-change-eol-conversion default-coding eol-type)
905 default-coding))
906 ;; (setq default-sendmail-coding-system default-coding)
907 (while priority
908 (unless (memq (setq category (car categories)) checked-categories)
909 (set-coding-category-system category (car priority))
910 (setq checked-categories (cons category checked-categories)))
911 (setq priority (cdr priority)
912 categories (cdr categories)))
913 (set-coding-priority-list (nreverse checked-categories))
914 ;; (update-coding-systems-internal)
915 ))))
916
917 ;; Print all arguments with `princ', then print "\n".
918 (defsubst princ-list (&rest args)
919 (while args (princ (car args)) (setq args (cdr args)))
920 (princ "\n"))
921
922 (put 'describe-specified-language-support 'apropos-inhibit t)
923
924 ;; Print a language specific information such as input methods,
925 ;; charsets, and coding systems. This function is intended to be
926 ;; called from the menu:
927 ;; [menu-bar mule describe-language-environment LANGUAGE]
928 ;; and should not run it by `M-x describe-current-input-method-function'.
929 (defun describe-specified-language-support ()
930 "Describe how Emacs supports the specified language environment."
931 (interactive)
932 (let (language-name)
933 (if (not (and (symbolp last-command-event)
934 (setq language-name (symbol-name last-command-event))))
935 (error "Bogus calling sequence"))
936 (describe-language-environment language-name)))
937 776
938 (defun describe-language-environment (language-name) 777 (defun describe-language-environment (language-name)
939 "Describe how Emacs supports language environment LANGUAGE-NAME." 778 "Describe how Emacs supports language environment LANGUAGE-NAME."
940 (interactive 779 (interactive
941 (list (read-language-name 780 (list (read-language-name
947 (null (get-language-info language-name 'documentation))) 786 (null (get-language-info language-name 'documentation)))
948 (error "No documentation for the specified language")) 787 (error "No documentation for the specified language"))
949 (if (symbolp language-name) 788 (if (symbolp language-name)
950 (setq language-name (symbol-name language-name))) 789 (setq language-name (symbol-name language-name)))
951 (let ((doc (get-language-info language-name 'documentation))) 790 (let ((doc (get-language-info language-name 'documentation)))
952 (with-output-to-temp-buffer "*Help*" 791 (flet ((princ-list (&rest args)
953 (princ-list language-name " language environment" "\n") 792 (while args (princ (car args)) (setq args (cdr args)))
954 (if (stringp doc) 793 (princ "\n")))
955 (progn 794 (with-output-to-temp-buffer "*Help*"
956 (princ-list doc) 795 (princ-list language-name " language environment" "\n")
957 (terpri))) 796 (if (stringp doc)
958 (let ((str (get-language-info language-name 'sample-text)))
959 (if (stringp str)
960 (progn 797 (progn
961 (princ "Sample text:\n") 798 (princ-list doc)
962 (princ-list " " str) 799 (terpri)))
963 (terpri)))) 800 (let ((str (get-language-info language-name 'sample-text)))
964 (let ((input-method (get-language-info language-name 'input-method)) 801 (if (stringp str)
965 (l (copy-sequence input-method-alist))) 802 (progn
966 (princ "Input methods") 803 (princ "Sample text:\n")
967 (when input-method 804 (princ-list " " str)
968 (princ (format " (default, %s)" input-method)) 805 (terpri))))
969 (setq input-method (assoc input-method input-method-alist)) 806 (let ((input-method (get-language-info language-name 'input-method))
970 (setq l (cons input-method (delete input-method l)))) 807 (l (copy-sequence input-method-alist)))
971 (princ ":\n") 808 (princ "Input methods")
972 (while l 809 (when input-method
973 (if (string= language-name (nth 1 (car l))) 810 (princ (format " (default, %s)" input-method))
974 (princ-list " " (car (car l)) 811 (setq input-method (assoc input-method input-method-alist))
975 (format " (`%s' in mode line)" (nth 3 (car l))))) 812 (setq l (cons input-method (delete input-method l))))
976 (setq l (cdr l)))) 813 (princ ":\n")
977 (terpri)
978 (princ "Character sets:\n")
979 (let ((l (get-language-info language-name 'charset)))
980 (if (null l)
981 (princ-list " nothing specific to " language-name)
982 (while l 814 (while l
983 (princ-list " " (car l) ": " 815 (if (string= language-name (nth 1 (car l)))
984 (charset-description (car l))) 816 (princ-list " " (car (car l))
985 (setq l (cdr l))))) 817 (format " (`%s' in mode line)" (nth 3 (car l)))))
986 (terpri) 818 (setq l (cdr l))))
987 (princ "Coding systems:\n") 819 (terpri)
988 (let ((l (get-language-info language-name 'coding-system))) 820 (princ "Character sets:\n")
989 (if (null l) 821 (let ((l (get-language-info language-name 'charset)))
990 (princ-list " nothing specific to " language-name) 822 (if (null l)
991 (while l 823 (princ-list " nothing specific to " language-name)
992 (princ ; (format " %s (`%c' in mode line):\n\t%s\n" 824 (while l
993 ;; In XEmacs, `coding-system-mnemonic' returns string. 825 (princ-list " " (car l) ": "
994 (format " %s (`%s' in mode line):\n\t%s\n" 826 (charset-description (car l)))
995 (car l) 827 (setq l (cdr l)))))
996 (coding-system-mnemonic (car l)) 828 (terpri)
997 (coding-system-doc-string (car l)))) 829 (princ "Coding systems:\n")
998 ;; (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) 830 (let ((l (get-language-info language-name 'coding-system)))
999 ;; (when aliases 831 (if (null l)
1000 ;; (princ "\t") 832 (princ-list " nothing specific to " language-name)
1001 ;; (princ (cons 'alias: (cdr aliases))) 833 (while l
1002 ;; (terpri))) 834 (princ ; (format " %s (`%c' in mode line):\n\t%s\n"
1003 (setq l (cdr l)))))))) 835 ;; In XEmacs, `coding-system-mnemonic' returns string.
836 (format " %s (`%s' in English, `%s' in mode line):\n\t%s\n"
837 (car l)
838 (coding-system-description (car l))
839 (coding-system-mnemonic (car l))
840 (or (coding-system-documentation (car l))
841 "Not documented.")) )
842 ;; (let ((aliases (coding-system-get (car l) 'alias-coding-systems)))
843 ;; (when aliases
844 ;; (princ "\t")
845 ;; (princ (cons 'alias: (cdr aliases)))
846 ;; (terpri)))
847 (setq l (cdr l)))))))))
1004 848
1005 ;;; Charset property 849 ;;; Charset property
1006 850
1007 ;; (defsubst get-charset-property (charset propname) 851 ;; (defsubst get-charset-property (charset propname)
1008 ;; "Return the value of CHARSET's PROPNAME property. 852 ;; "Return the value of CHARSET's PROPNAME property.
1103 ;; ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, 947 ;; ;; Now (substring enc1 i1) and (substring enc2 i2) are the same,
1104 ;; ;; and they are the extra control sequences at the tail to 948 ;; ;; and they are the extra control sequences at the tail to
1105 ;; ;; exclude. 949 ;; ;; exclude.
1106 ;; (substring enc2 0 i2)))) 950 ;; (substring enc2 0 i2))))
1107 951
952
953 ;; #### The following section is utter junk from mule-misc.el.
954 ;; I've deleted everything that's not referenced in mule-packages and
955 ;; not in FSF 20.6; there's no point in keeping old namespace-polluting
956 ;; Mule 2.3 crap around. --ben
957
958 (defvar self-insert-after-hook nil
959 "Hook to run when extended self insertion command exits. Should take
960 two arguments START and END corresponding to character position.")
961
962 (make-variable-buffer-local 'self-insert-after-hook)
963
964 (defun delete-text-in-column (from to)
965 "Delete the text between column FROM and TO (exclusive) of the current line.
966 Nil of FORM or TO means the current column.
967
968 If there's a character across the borders, the character is replaced
969 with the same width of spaces before deleting."
970 (save-excursion
971 (let (p1 p2)
972 (if from
973 (progn
974 (setq p1 (move-to-column from))
975 (if (> p1 from)
976 (progn
977 (delete-char -1)
978 (insert-char ? (- p1 (current-column)))
979 (forward-char (- from p1))))))
980 (setq p1 (point))
981 (if to
982 (progn
983 (setq p2 (move-to-column to))
984 (if (> p2 to)
985 (progn
986 (delete-char -1)
987 (insert-char ? (- p2 (current-column)))
988 (forward-char (- to p2))))))
989 (setq p2 (point))
990 (delete-region p1 p2))))
991
992 (defun cancel-undo-boundary ()
993 "Cancel undo boundary."
994 (if (and (consp buffer-undo-list)
995 (null (car buffer-undo-list)))
996 (setq buffer-undo-list (cdr buffer-undo-list))))
997
998 (defun define-egg-environment (env-sym doc-string enable-function)
999 "Define a new language environment for egg, named by ENV-SYM.
1000 DOC-STRING should be a string describing the environment.
1001 ENABLE-FUNCTION should be a function of no arguments that will be called
1002 when the language environment is made current."
1003 (put env-sym 'egg-environ-doc-string doc-string)
1004 (put env-sym 'set-egg-environ enable-function))
1005
1006
1007 ;; Init code.
1008
1009 ;; auto-language-alist deleted. We have a more sophisticated system,
1010 ;; with the locales stored in the language data.
1011
1012 (defun get-language-environment-from-locale (locale)
1013 "Convert LOCALE into a language environment.
1014 LOCALE is a C library locale string, as returned by `current-locale'.
1015 Uses the `locale' property of the language environment."
1016 (block langenv
1017 (dolist (langcons language-info-alist)
1018 (let* ((lang (car langcons))
1019 (locs (get-language-info lang 'locale))
1020 (case-fold-search t))
1021 (dolist (loc (if (listp locs) locs (list locs)))
1022 (if (cond ((functionp loc)
1023 (funcall loc locale))
1024 ((stringp loc)
1025 (string-match (concat "^" loc "\\([^A-Za-z0-9]\\|$\\)")
1026 locale)))
1027 (return-from langenv lang)))))))
1028
1029 (defun mswindows-get-language-environment-from-locale (ms-locale)
1030 "Convert MS-LOCALE (an MS Windows locale) into a language environment.
1031 MS-LOCALE is in the format recognized by `set-mswindows-current-locale' --
1032 i.e. a language string or a cons (LANG . SUBLANG). Note: This is NOT the
1033 same as the C library locale format (see `set-current-locale')!
1034
1035 This looks up the `mswindows-locale' property of all language environments;
1036 if nothing matching is found, it looks for a language environment with the
1037 same name (modulo case differences) as the LANG part of the locale."
1038 (or (consp ms-locale) (setq ms-locale (cons ms-locale "DEFAULT")))
1039 (or (block langenv
1040 (dolist (langcons language-info-alist)
1041 (let* ((lang (car langcons))
1042 (mswlocs (get-language-info lang 'mswindows-locale))
1043 (mswlocs (if (and (consp mswlocs)
1044 (listp (cdr mswlocs)))
1045 mswlocs (list mswlocs))))
1046 (dolist (loc mswlocs)
1047 (or (consp loc) (setq loc (cons loc "DEFAULT")))
1048 (if (equalp loc ms-locale)
1049 (return-from langenv lang))))))
1050 (dolist (langcons language-info-alist)
1051 (let* ((lang (car langcons)))
1052 (if (equalp lang (car ms-locale))
1053 (return-from nil lang))))))
1054
1055 (defun get-native-coding-system-from-language-environment (langenv locale)
1056 "Return the native coding system appropriate for LANGENV.
1057 LANGENV is a string naming a language environment. May use the LOCALE
1058 \(which should be the C library LOCALE corresponding to LANGENV) to
1059 determine the correct coding system. (For example, in the Japanese language
1060 environment, there are multiple encodings in use: euc-jp, shift-jis, jis7,
1061 jis8, iso-2022-jp, etc. The LOCALE may tell which one is correct.)
1062
1063 Specifically: Under X, the returned value is determined from these two.
1064 Under MS Windows, the native coding system must be set from the default
1065 system locale and is not influenced by LOCALE. (In other words, a program
1066 can't set the text encoding used to communicate with the OS. To get around
1067 this, we use Unicode whenever available, i.e. on Windows NT always and on
1068 Windows 9x for a few system calls.)"
1069 (if (eq system-type 'windows-nt)
1070 ;; should not apply to Cygwin, I don't think
1071 'mswindows-multibyte-system-default
1072 (let ((ncod (get-language-info langenv 'native-coding-system)))
1073 (if (or (functionp ncod) (not (listp ncod)))
1074 (setq ncod (list ncod)))
1075 (let ((native
1076 (dolist (try-native ncod)
1077 (let ((result
1078 (if (functionp try-native)
1079 (funcall try-native locale)
1080 try-native)))
1081 (if result (return result))))))
1082 (or native (car (get-language-info langenv 'coding-system))
1083 'raw-text)))))
1084
1085 (defun get-coding-system-from-locale (locale)
1086 "Return the coding system corresponding to a locale string."
1087 (get-native-coding-system-from-language-environment
1088 (get-language-environment-from-locale locale) locale))
1089
1090 (defvar mswindows-langenv-to-locale-table (make-hash-table)
1091 "Table mapping language environments to associated MS Windows locales.
1092 There may be more than one MS Windows locale that maps to a given language
1093 environment, so once we've made the mapping, we record it here when we need
1094 to make the reverse mapping. For example, all MS Windows locales with
1095 language ENGLISH will map to language environment English, and when the
1096 user starts up in such a locale, switches to another language environment
1097 and then back to English, we want the same locale again.")
1098
1099 (defun set-locale-for-language-environment (langenv)
1100 "Sets the current system locale as appropriate for LANGENV.
1101 LANGENV is a language environment. The locale is determined by looking at
1102 the 'locale (or maybe 'mswindows-locale) property of LANGENV, and then
1103 setting it using `set-current-locale' and maybe also
1104 `mswindows-set-current-locale'. Also sets the LANG environment variable.
1105 Returns non-nil if successfully set the locale(s)."
1106 (flet ((mswindows-get-and-set-locale-from-langenv (langenv)
1107 ;; find the mswindows locale for the langenv, make it current,
1108 ;; and return it. first we check the langenv-to-locale table
1109 ;; ...
1110 (let ((ms-locale
1111 (gethash langenv mswindows-langenv-to-locale-table)))
1112 (if ms-locale (progn
1113 (mswindows-set-current-locale ms-locale)
1114 ms-locale)
1115 ;; ... if not, see if the langenv specifies any locale(s).
1116 ;; if not, construct one from the langenv name.
1117 (let* ((mslocs (get-language-info langenv 'mswindows-locale))
1118 (mslocs (or mslocs (cons (upcase langenv) "DEFAULT")))
1119 (mslocs (if (and (consp mslocs)
1120 (listp (cdr mslocs)))
1121 mslocs (list mslocs))))
1122 (dolist (msloc mslocs)
1123 ;; Sometimes a language with DEFAULT is different from
1124 ;; with SYS_DEFAULT, and on my system
1125 ;; (set-current-locale "chinese") is NOT the same as
1126 ;; (set-current-locale "chinese-default")! The latter
1127 ;; gives Taiwan (DEFAULT), the former PRC (SYS_DEFAULT).
1128 ;; In the interests of consistency, we always use DEFAULT.
1129 (or (consp msloc) (setq msloc (cons msloc "DEFAULT")))
1130 (when (condition-case nil
1131 (progn
1132 (mswindows-set-current-locale msloc)
1133 t)
1134 (error nil))
1135 (return msloc))))))))
1136 (if (eq system-type 'windows-nt)
1137 (let ((ms-locale (mswindows-get-and-set-locale-from-langenv langenv)))
1138 (when ms-locale
1139 ;; also need to set the clib locale.
1140 (or (set-current-locale
1141 ;; if the locale is '("DUTCH" . "DUTCH_BELGIAN"),
1142 ;; try "DUTCH-BELGIAN". (Case is insignificant;
1143 ;; "dutch-belgian" works just as well.) This type
1144 ;; of transformation should always work, and you
1145 ;; get back the canonicalized version -- in this
1146 ;; case "Dutch_Belgium.1252". Note the futility of
1147 ;; trying to construct "Belgium" directly from
1148 ;; "BELGIAN".
1149 ;;
1150 ;; BUT ... We actually have to be trickier.
1151 ;; ("SPANISH" . "SPANISH_DOMINICAN_REPUBLIC") needs
1152 ;; to end up as "SPANISH-DOMINICAN REPUBLIC"; any
1153 ;; other punctuation makes it fail (you either get
1154 ;; Spain for the country, or nil).
1155 ;;
1156 ;; assume it's DEFAULT or NEUTRAL (or something else
1157 ;; without the language in it?) and prepend the
1158 ;; language.
1159 (if (string-match "_" (cdr ms-locale))
1160 (replace-in-string
1161 (replace-match "-" nil nil (cdr ms-locale)) "_" " ")
1162 (format "%s-%s" (car ms-locale) (cdr ms-locale))))
1163 ;; ???? huh ???? if failure, just try the language
1164 ;; name.
1165 (set-current-locale (car ms-locale))))
1166 ;; also set LANG, for the benefit of Cygwin subprocesses.
1167 (let* ((cygloc (or (get-language-info langenv 'cygwin-locale)
1168 (get-language-info langenv 'locale)))
1169 (cygloc (if (listp cygloc) (car (last cygloc)) cygloc)))
1170 (if (and cygloc (stringp cygloc)) (setenv "LANG" cygloc)))
1171 (not (null ms-locale)))
1172
1173 ;; not MS Windows native.
1174
1175 ;; Cygwin is as usual an unholy mixture -- C library locales
1176 ;; that follow Unix conventions, but also MS Windows locales.
1177 ;; So set the MS Windows locale, and then try to find a Unix
1178 ;; locale.
1179 (when (eq system-type 'cygwin32)
1180 (mswindows-get-and-set-locale-from-langenv langenv))
1181 (let ((locs (get-language-info langenv 'locale)))
1182 (dolist (loc (if (listp locs) locs (list locs)))
1183 (let ((retval
1184 (cond ((functionp loc) (funcall loc nil))
1185 ((stringp loc) (set-current-locale loc))
1186 (t nil))))
1187 (when retval
1188 (setenv "LANG" retval)
1189 (return t))))))))
1190
1191 (defun set-language-environment-coding-systems (language-name
1192 &optional eol-type)
1193 "Do various coding system setups for language environment LANGUAGE-NAME.
1194 This function assumes that the locale for LANGUAGE-NAME has been set using
1195 `set-current-locale'.
1196
1197 The optional arg EOL-TYPE specifies the eol-type of the default value
1198 of buffer-file-coding-system set by this function."
1199
1200 ;; The following appeared as the third paragraph of the doc string for this
1201 ;; function, but it's not in FSF 21.0.103, and it's not true, since we call
1202 ;; reset-coding-categories-to-default before calling this function. ####
1203 ;; Should we rethink this?
1204
1205 ; Note that `coding-priority-list' is not reset first; thus changing language
1206 ; environment allows recognition of coding systems from previously set language
1207 ; environments. (This will not work if the desired coding systems are from the
1208 ; same category. E.g., starting with a Hebrew language environment, ISO 8859-8
1209 ; will be recognized. If you shift to Russian, ISO 8859-8 will be shadowed by
1210 ; ISO 8859-5, and cannot be automatically recognized without resetting the
1211 ; language environment to Hebrew. However, if you shift from Japanese to
1212 ; Russian, ISO-2022-JP will continue to be automatically recognized, since
1213 ; ISO-8859-5 and ISO-2022-JP are different coding categories.)"
1214
1215 (flet ((maybe-change-coding-system-with-eol (codesys eol-type)
1216 ;; if the EOL type specifies a specific type of ending,
1217 ;; then add that ending onto the given CODESYS; otherwise,
1218 ;; return CODESYS unchanged.
1219 (if (memq eol-type '(lf crlf cr unix dos mac))
1220 (coding-system-change-eol-conversion codesys eol-type)
1221 codesys)))
1222
1223 ;; initialize category mappings and priority list.
1224 (let* ((priority (get-language-info language-name 'coding-priority))
1225 (default-coding (car priority)))
1226 (if priority
1227 (let ((categories (mapcar 'coding-system-category priority))
1228 category checked-categories)
1229 (while priority
1230 (unless (memq (setq category (car categories)) checked-categories)
1231 (set-coding-category-system category (car priority))
1232 (setq checked-categories (cons category checked-categories)))
1233 (setq priority (cdr priority)
1234 categories (cdr categories)))
1235 (set-coding-priority-list (nreverse checked-categories))
1236 ))
1237
1238 ;; set the default buffer coding system from the first element of the
1239 ;; list in the `coding-priority' property, under Unix. Under Windows, it
1240 ;; should stay at `mswindows-multibyte', which will reference the current
1241 ;; code page. (#### Does it really make sense the set the Unix default
1242 ;; that way? NOTE also that it's not the same as the native coding
1243 ;; system for the locale, which is correct -- the form we choose for text
1244 ;; files should not necessarily have any relevant to whether we're in a
1245 ;; Shift-JIS, EUC-JP, JIS, or other Japanese locale.)
1246 (unless (memq system-type '(windows-nt cygwin32))
1247 (set-default-buffer-file-coding-system
1248 (maybe-change-coding-system-with-eol default-coding eol-type))))
1249 ;; (setq default-sendmail-coding-system default-coding)
1250
1251 ;; set the native and file-name aliases (currently always the same),
1252 ;; and the terminal-write system.
1253 (let ((native (get-native-coding-system-from-language-environment
1254 language-name (current-locale))))
1255 (condition-case nil
1256 (define-coding-system-alias 'file-name native)
1257 (error
1258 (warn "Invalid native-coding-system %s in language environment %s"
1259 native language-name)))
1260 (define-coding-system-alias 'native 'file-name)
1261 (setq default-process-coding-system
1262 (cons (car default-process-coding-system)
1263 (maybe-change-coding-system-with-eol native eol-type))))))
1264
1265 (defun init-locale-at-early-startup ()
1266 "Don't call this."
1267 ;; Called directly from the C code in intl.c, very early in the startup
1268 ;; sequence. Don't call this!!! The main purpose is to set things up
1269 ;; so that non-ASCII strings of all sorts (e.g. file names, command-line
1270 ;; arguments, environment variables) can be correctly processed during
1271 ;; the rest of the startup sequence. As a result, this will almost
1272 ;; certainly be the FIRST Lisp code called when a dumped XEmacs is run,
1273 ;; and it's called before ANY of the external environment is initialized.
1274 ;; Thus, it cannot interact at all with the outside world, make any
1275 ;; system calls, etc! (Except for `set-current-locale'.)
1276 ;;
1277 ;; NOTE: The following are the basic settings we have to deal with when
1278 ;; changing the language environment;
1279 ;;
1280 ;; -- current C library locale
1281 ;; -- under MS Windows, current MS Windows locale
1282 ;; -- LANG environment variable
1283 ;; -- native/file-name coding systems
1284 ;; -- subprocess write coding system (cdr of default-process-coding-system)
1285 ;; -- coding categories (for detection)
1286
1287 (let (langenv)
1288 ;; under ms windows (any):
1289 (if (memq system-type '(windows-nt cygwin32))
1290 (let ((userdef (mswindows-user-default-locale))
1291 (sysdef (mswindows-system-default-locale)))
1292 ;; (1) current langenv comes from user-default locale.
1293 (setq langenv (mswindows-get-language-environment-from-locale
1294 userdef))
1295 ;; (2) init the langenv-to-locale table.
1296 (puthash (mswindows-get-language-environment-from-locale sysdef)
1297 sysdef mswindows-langenv-to-locale-table)
1298 ;; user-default second in langenv-to-locale table so it will
1299 ;; override the system-default if the two are different but both
1300 ;; map to the same language environment
1301 (puthash langenv userdef mswindows-langenv-to-locale-table)
1302 ;; (3) setup C lib locale, MS Windows locale, LANG environment
1303 ;; variable. Note that under Cygwin we are ignoring the
1304 ;; passed-in LANG environment variable for the moment -- it's
1305 ;; usually wrong anyway and just says "C". #### Perhaps we
1306 ;; should reconsider.
1307 (and langenv (set-locale-for-language-environment langenv))
1308 ;; (4) override current MS Windows locale with the user-default
1309 ;; locale. Always init the MS Windows locale from the
1310 ;; user-default locale even if the langenv doesn't correspond;
1311 ;; we might not be able to find a langenv for the user-default
1312 ;; locale but we should still use the right code page, etc.
1313 (mswindows-set-current-locale userdef))
1314 ;; Unix:
1315 (let ((locstring (set-current-locale "")))
1316 ;; assume C lib locale and LANG env var are set correctly. use
1317 ;; them to find the langenv.
1318 (setq langenv
1319 (and locstring (get-language-environment-from-locale
1320 locstring)))))
1321 ;; All systems:
1322 (unless langenv (setq langenv "English"))
1323 (setq current-language-environment langenv)
1324 ;; Setup various coding systems and categories.
1325 (let ((default-eol-type (coding-system-eol-type
1326 default-buffer-file-coding-system)))
1327 (reset-language-environment)
1328 (set-language-environment-coding-systems langenv default-eol-type))))
1329
1330 (defun init-mule-at-startup ()
1331 "Initialize MULE environment at startup. Don't call this."
1332
1333 ;; Fill up the Unicode translation tables for the standard charsets.
1334 ;; Currently this needs to happen after data-directory gets
1335 ;; initialized, which is not long in the startup process before we
1336 ;; are called. However, in reality this is WAY TOO LATE for this to
1337 ;; be happening. All manner of stuff involving paths happens
1338 ;; beforehand, and eventually we want to be able to invoke XEmacs
1339 ;; from a path with Japanese in it without problem. Everything else
1340 ;; is carefully set up to get the coding systems ready before we
1341 ;; have to consult any paths or similarly interact with the system
1342 ;; (except possibly finding the dump file). We need to find a way
1343 ;; of dumping the data that we use to build the tables along with
1344 ;; the rest of the dump data, i.e. in the same file as it or ideally
1345 ;; as a resource attached to the executable itself, so we have
1346 ;; access to it extremely early; then, we call
1347 ;; init-unicode-at-startup from init_intl(), which should (perhaps)
1348 ;; be soon enough.
1349
1350 ;; An alternative is to resurrect my attempts to actually dump the
1351 ;; created tables, which would completely solve things, although
1352 ;; they're somewhat big (HOW BIG? INVESTIGATE) and this would
1353 ;; preclude demand-loading the data. Another possibility would be
1354 ;; to load the tables into memory at dump time (after writing them
1355 ;; out in some super-compressed binary form). Yet another is to
1356 ;; spit out the table data out in C code, which is then compiled in.
1357
1358 ;; We need to go through these, compile a list of what sorts of
1359 ;; multilingual things we want to do early at startup (start XEmacs
1360 ;; from a Japanese or other multilingual directory? Can we then
1361 ;; find the dump file? If the dump file is elsewhere in a Japanese
1362 ;; directory? etc.) and see what we get with the different
1363 ;; possibilities, and what are their strengths and weaknesses.
1364
1365 (init-unicode-at-startup)
1366
1367 ;; This is called (currently; might be moved earlier) from startup.el, after
1368 ;; the basic GUI systems have been initialized, and just before the
1369 ;; init file gets read in. It needs to finish up initializing the current
1370 ;; language environment. Very early in the startup procedure we determined
1371 ;; the default language environment from the locale, and bootstrapped the
1372 ;; native, file-name and process I/O coding systems. Now we need to do it
1373 ;; over `the right away'.
1374 (finish-set-language-environment current-language-environment)
1375
1376 ;; Load a (localizable) locale-specific init file, if it exists.
1377 ;; We now use the language environment name, NOT the locale,
1378 ;; whose name varies from system to system.
1379 (load (format "%s%s/locale-start"
1380 (locate-data-directory "start-files")
1381 current-language-environment)
1382 t t)
1383
1384 ;; #### the rest is junk that should be deleted.
1385
1386 (when current-language-environment
1387 ;; rman seems to be incompatible with encoded text
1388 (setq Manual-use-rosetta-man nil))
1389
1390 ;; Register available input methods by loading LEIM list file.
1391 (load "leim-list.el" 'noerror 'nomessage 'nosuffix)
1392 )
1393
1394 ;; Code deleted: init-mule-tm (Enable the tm package by default)
1108 1395
1109 ;;; mule-cmds.el ends here 1396 ;;; mule-cmds.el ends here