Mercurial > hg > xemacs-beta
annotate lisp/mule/mule-cmds.el @ 5576:071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
lisp/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (handle-pre-motion-command-current-command-is-motion):
Implement #'keysyms-equal with #'labels + (declare (inline ...)),
instead of abusing macrolet to the same end.
* specifier.el (let-specifier):
* mule/mule-cmds.el (describe-language-environment):
* mule/mule-cmds.el (set-language-environment-coding-systems):
* mule/mule-x-init.el (x-use-halfwidth-roman-font):
* faces.el (Face-frob-property):
* keymap.el (key-sequence-list-description):
* lisp-mode.el (construct-lisp-mode-menu):
* loadhist.el (unload-feature):
* mouse.el (default-mouse-track-check-for-activation):
Declare various labels inline in dumped files when that reduces
the size of the dumped image. Declaring labels inline is normally
only worthwhile for inner loops and so on, but it's reasonable
exercise of the related code to have these changes in core.
tests/ChangeLog addition:
2011-10-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/case-tests.el (uni-mappings):
* automated/database-tests.el (delete-database-files):
* automated/hash-table-tests.el (iterations):
* automated/lisp-tests.el (test1):
* automated/lisp-tests.el (a):
* automated/lisp-tests.el (cl-floor):
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (list-nreverse):
* automated/lisp-tests.el (needs-lexical-context):
* automated/mule-tests.el (featurep):
* automated/os-tests.el (original-string):
* automated/os-tests.el (with):
* automated/symbol-tests.el (check-weak-list-unique):
Replace #'flet with #'labels where appropriate in these tests,
following my own advice on style in the docstrings of those
functions.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 03 Oct 2011 20:16:14 +0100 |
| parents | 3bc58dc9d688 |
| children | d489e88450aa |
| rev | line source |
|---|---|
| 502 | 1 ;;; mule-cmds.el --- Commands for multilingual environment -*- coding: iso-2022-7bit; -*- |
| 428 | 2 |
| 3 ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. | |
| 4 ;; Licensed to the Free Software Foundation. | |
| 5 ;; Copyright (C) 1997 MORIOKA Tomohiko | |
|
5145
0b0241ae382f
fix bug in generating display-table entries for error octet characters
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
6 ;; Copyright (C) 2000, 2001, 2002, 2003, 2010 Ben Wing. |
| 428 | 7 |
| 8 ;; Keywords: mule, multilingual | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5266
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 444 | 25 ;; Note: Some of the code here is now in code-cmds.el |
| 26 | |
| 428 | 27 ;;; Code: |
| 28 | |
| 29 ;;; MULE related key bindings and menus. | |
| 30 | |
| 444 | 31 ;; Preserve the old name |
| 32 (defvaralias 'mule-keymap 'coding-keymap) | |
| 33 | |
| 428 | 34 (define-key mule-keymap "x" 'set-selection-coding-system) |
| 35 (define-key mule-keymap "X" 'set-next-selection-coding-system) | |
| 36 (define-key mule-keymap "\C-\\" 'set-input-method) | |
| 37 ;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs | |
| 38 (define-key mule-keymap "C" 'describe-coding-system) ; XEmacs | |
| 39 (define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs | |
| 40 (define-key mule-keymap "l" 'set-language-environment) | |
| 41 | |
| 42 (define-key help-map "L" 'describe-language-environment) | |
| 43 (define-key help-map "\C-\\" 'describe-input-method) | |
| 44 (define-key help-map "I" 'describe-input-method) | |
| 45 (define-key help-map "h" 'view-hello-file) | |
| 46 | |
| 47 ;; Menu for XEmacs were moved to menubar-items.el. | |
| 48 | |
| 49 | |
| 50 ;; This should be a single character key binding because users use it | |
| 51 ;; very frequently while editing multilingual text. Now we can use | |
| 52 ;; only two such keys: "\C-\\" and "\C-^", but the latter is not | |
| 53 ;; convenient because it requires shifting on most keyboards. An | |
| 54 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' | |
| 55 ;; but it won't be used that frequently. | |
| 56 (define-key global-map "\C-\\" 'toggle-input-method) | |
| 57 | |
| 771 | 58 ;; Original mapping will be altered by set-keyboard-coding-system. |
| 59 (define-key global-map [(meta \#)] 'ispell-word) ;originally "$" | |
| 60 ;; (define-key global-map [(meta {)] 'insert-parentheses) ;originally "(" | |
| 61 | |
| 428 | 62 ;;; This is no good because people often type Shift-SPC |
| 63 ;;; meaning to type SPC. -- rms. | |
| 64 ;;; ;; Here's an alternative key binding for X users (Shift-SPACE). | |
| 771 | 65 ;;; (define-key global-map '(shift space) 'toggle-input-method) |
| 428 | 66 |
| 67 (defun view-hello-file () | |
| 68 "Display the HELLO file which list up many languages and characters." | |
| 69 (interactive) | |
| 70 ;; We have to decode the file in any environment. | |
| 71 (let ((coding-system-for-read 'iso-2022-7bit)) | |
| 72 (find-file-read-only (expand-file-name "HELLO" data-directory)))) | |
| 73 | |
| 3999 | 74 (defvar system-type-file-name-coding |
| 75 '((darwin . utf-8)) | |
| 76 "A map from values of `system-type' to invariant file name coding systems. | |
| 77 Used if a give system type does not vary in the coding system it uses for | |
| 78 file names; otherwise, `language-info-alist' is consulted for this | |
| 79 information. This affects the `file-name' coding system alias, but not the | |
| 80 `file-name-coding-system' variable, which in practice is mostly ignored. ") | |
| 81 | |
| 428 | 82 |
| 771 | 83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 84 ;;; Language Support Functions ;;; | |
| 85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 428 | 86 (defvar language-info-alist nil |
| 87 "Alist of language environment definitions. | |
| 88 Each element looks like: | |
| 771 | 89 (LANGUAGE-NAME . ((PROP . VALUE) ...)) |
| 428 | 90 where LANGUAGE-NAME is a string, the name of the language environment, |
| 771 | 91 PROP is a symbol denoting a property, and VALUE is the data associated |
| 92 with PROP. | |
| 93 See `set-language-info' for documentation on PROP and VALUE.") | |
| 428 | 94 |
| 771 | 95 (defun get-language-info (lang-env prop) |
| 96 "Return information listed under PROP for language environment LANG-ENV. | |
| 97 PROP is a symbol denoting a property. | |
| 98 For a list of useful values for PROP and their meanings, | |
| 99 see `set-language-info'." | |
| 428 | 100 (if (symbolp lang-env) |
| 101 (setq lang-env (symbol-name lang-env))) | |
| 102 (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) | |
| 103 (if lang-slot | |
| 771 | 104 (cdr (assq prop (cdr lang-slot)))))) |
| 428 | 105 |
| 771 | 106 (defun set-language-info (lang-env prop value) |
| 428 | 107 "Modify part of the definition of language environment LANG-ENV. |
| 771 | 108 Specifically, this stores the information VALUE under PROP |
| 428 | 109 in the definition of this language environment. |
| 771 | 110 PROP is a symbol denoting a property, and VALUE is the value of that property. |
| 111 | |
| 112 Meaningful values for PROP include | |
| 113 | |
| 114 documentation VALUE is documentation of what this language environment | |
| 115 is meant for, and how to use it. | |
| 116 | |
| 117 charset VALUE is a list of the character sets used by this | |
| 118 language environment. | |
| 119 | |
| 120 sample-text VALUE is one line of text, | |
| 121 written using those character sets, | |
| 122 appropriate for this language environment. | |
| 123 | |
| 124 setup-function VALUE is a function to call to switch to this | |
| 125 language environment. | |
| 126 | |
| 127 exit-function VALUE is a function to call to leave this | |
| 128 language environment. | |
| 129 | |
| 130 coding-system VALUE is a list of coding systems that are good | |
| 131 for saving text written in this language environment. | |
| 132 This list serves as suggestions to the user; | |
| 133 in effect, as a kind of documentation. | |
| 134 | |
| 135 coding-priority VALUE is a list of coding systems for this language | |
| 136 environment, in order of decreasing priority. | |
| 137 This is used to set up the coding system priority | |
| 138 list when you switch to this language environment. | |
| 139 | |
| 140 input-method VALUE is a default input method for this language | |
| 141 environment. | |
| 142 | |
| 143 features VALUE is a list of features requested in this | |
| 144 language environment. | |
| 145 | |
| 146 tutorial VALUE is a tutorial file name written in the language. | |
| 147 | |
| 148 locale VALUE is a list of locale expressions, which serve | |
| 149 two purposes: (1) Determining the language | |
| 150 environment from the current system locale at | |
| 151 startup, and (2) determining how to set the system | |
| 152 locale when the language environment is changed. | |
| 153 Each expression will be tried in turn, and should | |
| 154 be a string (for case (1), the string is matched | |
| 155 against the current locale using the regular | |
| 156 expression \"^STRING[^A-Za-z0-9]\"; for case (2), | |
| 157 the string is passed directly to | |
| 158 `set-current-locale' until a non-nil result is | |
| 159 returned), or a function of one argument. For | |
| 160 case (1), this argument will be a locale, and the | |
| 161 function should return t or nil to indicate | |
| 162 whether this locale matches the language | |
| 163 environment; for case (2), the argument will be | |
| 164 nil, and the function should call | |
| 165 `set-current-locale' itself and return the set | |
| 166 locale string if the locale was successfully set, | |
| 167 and nil otherwise. | |
| 428 | 168 |
| 771 | 169 NOTE: This property is *NOT* used under MS Windows; |
| 170 instead, the `mswindows-locale' property is used. | |
| 171 | |
| 172 cygwin-locale VALUE specifies a general Unix-style C library | |
| 173 locale that will be used to initialize the LANG | |
| 174 environment variable under MS Windows native, when the | |
| 175 system cannot test out the locales specified in the | |
| 176 `locale' property. This is so that Cygwin programs | |
| 177 can be run from an MS Windows native XEmacs. If not | |
| 178 specified, the last entry in `locale' will be used. | |
| 179 | |
| 180 native-coding-system VALUE is a single coding-system expression, or a | |
| 181 list of such expressions. These expressions are | |
| 182 used to compute the operating system's native | |
| 183 coding system, i.e. the coding system to be used | |
| 184 as the alias for `native' and `file-name'. This | |
| 185 specifies the coding system used for text | |
| 186 exchanged with the operating system, such as file | |
| 187 names, environment variables, subprocess | |
| 188 arguments, etc. Each expression should be either | |
| 189 a symbol naming a coding system or a function | |
| 190 (anything that is `functionp') of one argument, | |
| 191 which is passed the current locale corresponding | |
| 192 to this language environment and should return a | |
| 193 coding system or nil. Each expression is tried in | |
| 194 turn until a coding system is obtained. If there | |
| 195 is no non-nil result, or no value is specified for | |
| 196 this property, the first coding system listed | |
| 197 under the `coding-system' property is used. | |
| 198 | |
| 199 NOTE: This is *NOT* used under MS Windows. | |
| 200 Instead, `mswindows-multibyte-system-default' | |
| 201 is always used, since the system default code | |
| 202 page is what the Win32 API routines make use | |
| 203 of, and this cannot be changed. (We get around | |
| 204 this by using the Unicode versions whenever | |
| 205 possible -- i.e. on Windows NT/2000, and on | |
| 206 Windows 9x with the few API's that support | |
| 207 Unicode.) | |
| 208 | |
| 209 mswindows-locale VALUE is an element of the form MSWINDOWS-LOCALE, or | |
| 210 a list of such elements. Each element is an MS | |
| 211 Windows locale, of the form that can be passed to | |
| 212 `mswindows-set-current-locale'. This property is used | |
| 213 both to determine the current language environment at | |
| 214 startup (by matching MSWINDOWS-LOCALE against the | |
| 215 value returned by `mswindows-user-default-locale') and | |
| 216 to set the values of `set-current-locale' and | |
| 217 `mswindows-set-current-locale' when the current | |
| 218 language environment is changed. (The correct CLIB | |
| 219 locale can always be generated by passing in the | |
| 220 SUBLANG, with dashes in place of underscores, or the | |
| 221 LANG if there's no SUBLANG. The return value will be | |
| 222 the canonicalized locale, in proper CLIB form.) | |
| 223 | |
| 224 If there is no value for this property, the MS Windows | |
| 225 locale is assumed to have the same name as the | |
|
4489
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
226 language environment. |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
227 |
|
4490
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
228 invalid-sequence-coding-system |
|
4489
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
229 VALUE is a fixed-width 8-bit coding system used to |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
230 display Unicode error sequences (using a face to make |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
231 it clear that the data is invalid). In Western Europe |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
232 and the Americas this is normally windows-1252; in |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
233 Russia and the former Soviet Union koi8-ru or |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
234 windows-1251 makes more sense." |
| 428 | 235 (if (symbolp lang-env) |
| 236 (setq lang-env (symbol-name lang-env))) | |
| 771 | 237 (let (lang-slot prop-slot) |
| 428 | 238 (setq lang-slot (assoc lang-env language-info-alist)) |
| 239 (if (null lang-slot) ; If no slot for the language, add it. | |
| 240 (setq lang-slot (list lang-env) | |
| 241 language-info-alist (cons lang-slot language-info-alist))) | |
| 771 | 242 (setq prop-slot (assq prop lang-slot)) |
| 243 (if (null prop-slot) ; If no slot for the prop, add it. | |
| 428 | 244 (progn |
| 771 | 245 (setq prop-slot (list prop)) |
| 246 (setcdr lang-slot (cons prop-slot (cdr lang-slot))))) | |
| 247 (setcdr prop-slot value))) | |
| 428 | 248 |
| 249 (defun set-language-info-alist (lang-env alist &optional parents) | |
| 250 "Store ALIST as the definition of language environment LANG-ENV. | |
| 771 | 251 ALIST is an alist of properties and values. See the documentation of |
| 252 `set-language-info' for the allowed properties." | |
| 428 | 253 (if (symbolp lang-env) |
| 254 (setq lang-env (symbol-name lang-env))) | |
| 771 | 255 ;; FSF has 30 lines of unbelievably ugly code to set up the menus |
| 256 ;; appropriately. We just use a filter. | |
| 257 (while alist | |
| 258 (set-language-info lang-env (car (car alist)) (cdr (car alist))) | |
| 3707 | 259 (setq alist (cdr alist))) |
| 260 lang-env) | |
| 428 | 261 |
| 262 (defun read-language-name (key prompt &optional default) | |
| 263 "Read a language environment name which has information for KEY. | |
| 264 If KEY is nil, read any language environment. | |
| 265 Prompt with PROMPT. DEFAULT is the default choice of language environment. | |
| 266 This returns a language environment name as a string." | |
| 267 (let* ((completion-ignore-case t) | |
| 268 (name (completing-read prompt | |
| 269 language-info-alist | |
| 270 (and key | |
| 271 (function (lambda (elm) (assq key elm)))) | |
| 272 t nil nil default))) | |
| 273 (if (and (> (length name) 0) | |
| 274 (or (not key) | |
| 275 (get-language-info name key))) | |
| 276 name))) | |
| 277 | |
| 278 ;;; Multilingual input methods. | |
| 279 | |
| 280 (defconst leim-list-file-name "leim-list.el" | |
| 281 "Name of LEIM list file. | |
| 282 This file contains a list of libraries of Emacs input methods (LEIM) | |
| 283 in the format of Lisp expression for registering each input method. | |
| 284 Emacs loads this file at startup time.") | |
| 285 | |
| 286 (defvar leim-list-header (format | |
| 287 ";;; %s -- list of LEIM (Library of Emacs Input Method) | |
| 288 ;; | |
| 289 ;; This file contains a list of LEIM (Library of Emacs Input Method) | |
| 290 ;; in the same directory as this file. Loading this file registers | |
| 291 ;; the whole input methods in Emacs. | |
| 292 ;; | |
| 293 ;; Each entry has the form: | |
| 294 ;; (register-input-method | |
| 295 ;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC | |
| 296 ;; TITLE DESCRIPTION | |
| 297 ;; ARG ...) | |
| 298 ;; See the function `register-input-method' for the meanings of arguments. | |
| 299 ;; | |
| 300 ;; If this directory is included in load-path, Emacs automatically | |
| 301 ;; loads this file at startup time. | |
| 302 | |
| 303 " | |
| 304 leim-list-file-name) | |
| 305 "Header to be inserted in LEIM list file.") | |
| 306 | |
| 307 (defvar leim-list-entry-regexp "^(register-input-method" | |
| 308 "Regexp matching head of each entry in LEIM list file. | |
| 309 See also the variable `leim-list-header'") | |
| 310 | |
| 311 (defvar update-leim-list-functions | |
| 312 '(quail-update-leim-list-file) | |
| 313 "List of functions to call to update LEIM list file. | |
| 314 Each function is called with one arg, LEIM directory name.") | |
| 315 | |
| 316 (defun update-leim-list-file (&rest dirs) | |
| 317 "Update LEIM list file in directories DIRS." | |
| 318 (let ((functions update-leim-list-functions)) | |
| 319 (while functions | |
| 320 (apply (car functions) dirs) | |
| 321 (setq functions (cdr functions))))) | |
| 322 | |
| 323 (defvar current-input-method nil | |
| 324 "The current input method for multilingual text. | |
| 325 If nil, that means no input method is activated now.") | |
| 326 (make-variable-buffer-local 'current-input-method) | |
| 327 (put 'current-input-method 'permanent-local t) | |
| 328 | |
| 329 (defvar current-input-method-title nil | |
| 330 "Title string of the current input method shown in mode line.") | |
| 331 (make-variable-buffer-local 'current-input-method-title) | |
| 332 (put 'current-input-method-title 'permanent-local t) | |
| 333 | |
| 334 (defcustom default-input-method nil | |
| 335 "*Default input method for multilingual text (a string). | |
| 336 This is the input method activated automatically by the command | |
| 337 `toggle-input-method' (\\[toggle-input-method])." | |
| 338 :group 'mule | |
| 339 :type '(choice (const nil) string)) | |
| 340 | |
| 341 (put 'input-method-function 'permanent-local t) | |
| 342 | |
| 343 (defvar input-method-history nil | |
| 344 "History list for some commands that read input methods.") | |
| 345 (make-variable-buffer-local 'input-method-history) | |
| 346 (put 'input-method-history 'permanent-local t) | |
| 347 | |
| 348 (defvar inactivate-current-input-method-function nil | |
| 349 "Function to call for inactivating the current input method. | |
| 350 Every input method should set this to an appropriate value when activated. | |
| 351 This function is called with no argument. | |
| 352 | |
| 353 This function should never change the value of `current-input-method'. | |
| 354 It is set to nil by the function `inactivate-input-method'.") | |
| 355 (make-variable-buffer-local 'inactivate-current-input-method-function) | |
| 356 (put 'inactivate-current-input-method-function 'permanent-local t) | |
| 357 | |
| 358 (defvar describe-current-input-method-function nil | |
| 359 "Function to call for describing the current input method. | |
| 360 This function is called with no argument.") | |
| 361 (make-variable-buffer-local 'describe-current-input-method-function) | |
| 362 (put 'describe-current-input-method-function 'permanent-local t) | |
| 363 | |
| 364 (defvar input-method-alist nil | |
| 2970 | 365 "Alist mapping input method names to information used by the LEIM API. |
| 366 Elements have the form (METHOD LANGUAGE ACTIVATOR TITLE DESCRIPTION ARGS...). | |
| 367 Use `register-input-method' to add input methods to the database. See its | |
| 368 documentation for the meanings of the elements.") | |
| 428 | 369 |
| 2970 | 370 (defun register-input-method (method language |
| 371 ;; #### shouldn't be optional, but need to | |
| 372 ;; audit callers | |
| 373 &optional activator title description | |
| 374 &rest args) | |
| 375 "Register METHOD as an input method for language environment LANGUAGE. | |
| 428 | 376 |
| 2970 | 377 METHOD and LANGUAGE may be symbols or strings. |
| 378 ACTIVATOR is the function called to activate this method. METHOD (the | |
| 379 invocation name) and ARGS are passed to the function on activation. | |
| 428 | 380 TITLE is a string to show in the mode line when this method is active. |
| 381 DESCRIPTION is a string describing this method and what it is good for. | |
| 2970 | 382 Optional ARGS, if any, are stored and passed as arguments to ACTIVATOR. |
| 428 | 383 |
| 2970 | 384 When registering a new Quail input method, the input method title should be |
| 385 the one given in the third parameter of `quail-define-package' (if the values | |
| 386 are different, the string specified in this function takes precedence). | |
| 428 | 387 |
| 2970 | 388 The information provided is registered in `input-method-alist'. The commands |
| 389 `describe-input-method' and `list-input-methods' use this database to show | |
| 390 information about input methods without loading them." | |
| 391 (if (symbolp language) | |
| 392 (setq language (symbol-name language))) | |
| 393 (if (symbolp method) | |
| 394 (setq method (symbol-name method))) | |
| 395 (let ((info (append (list language activator title description) args)) | |
| 396 (slot (assoc method input-method-alist))) | |
| 428 | 397 (if slot |
| 398 (setcdr slot info) | |
| 2970 | 399 (setq slot (cons method info)) |
| 428 | 400 (setq input-method-alist (cons slot input-method-alist))))) |
| 401 | |
| 402 (defun read-input-method-name (prompt &optional default inhibit-null) | |
| 403 "Read a name of input method from a minibuffer prompting with PROMPT. | |
| 404 If DEFAULT is non-nil, use that as the default, | |
| 405 and substitute it into PROMPT at the first `%s'. | |
| 406 If INHIBIT-NULL is non-nil, null input signals an error. | |
| 407 | |
| 408 The return value is a string." | |
| 409 (if default | |
| 410 (setq prompt (format prompt default))) | |
| 411 (let* ((completion-ignore-case t) | |
| 412 ;; This binding is necessary because input-method-history is | |
| 413 ;; buffer local. | |
| 414 (input-method (completing-read prompt input-method-alist | |
| 415 nil t nil 'input-method-history | |
| 416 default))) | |
| 417 (if (and input-method (symbolp input-method)) | |
| 418 (setq input-method (symbol-name input-method))) | |
| 419 (if (> (length input-method) 0) | |
| 420 input-method | |
| 421 (if inhibit-null | |
| 422 (error "No valid input method is specified"))))) | |
| 423 | |
| 424 (defun activate-input-method (input-method) | |
| 425 "Switch to input method INPUT-METHOD for the current buffer. | |
| 426 If some other input method is already active, turn it off first. | |
| 427 If INPUT-METHOD is nil, deactivate any current input method." | |
| 428 (if (and input-method (symbolp input-method)) | |
| 429 (setq input-method (symbol-name input-method))) | |
| 430 (if (and current-input-method | |
| 431 (not (string= current-input-method input-method))) | |
| 432 (inactivate-input-method)) | |
| 433 (unless (or current-input-method (null input-method)) | |
| 434 (let ((slot (assoc input-method input-method-alist))) | |
| 435 (if (null slot) | |
| 436 (error "Can't activate input method `%s'" input-method)) | |
| 437 (let ((func (nth 2 slot))) | |
| 438 (if (functionp func) | |
| 439 (apply (nth 2 slot) input-method (nthcdr 5 slot)) | |
| 440 (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) | |
| 441 (progn | |
| 442 (require (cdr func)) | |
| 443 (apply (car func) input-method (nthcdr 5 slot))) | |
| 444 (error "Can't activate input method `%s'" input-method)))) | |
| 445 (setq current-input-method input-method) | |
| 446 (setq current-input-method-title (nth 3 slot)) | |
| 447 (unwind-protect | |
| 448 (run-hooks 'input-method-activate-hook) | |
| 449 (force-mode-line-update))))) | |
| 450 | |
| 451 (defun inactivate-input-method () | |
| 452 "Turn off the current input method." | |
| 453 (when current-input-method | |
| 454 (if input-method-history | |
| 455 (unless (string= current-input-method (car input-method-history)) | |
| 456 (setq input-method-history | |
| 457 (cons current-input-method | |
| 458 (delete current-input-method input-method-history)))) | |
| 459 (setq input-method-history (list current-input-method))) | |
| 460 (unwind-protect | |
| 461 (funcall inactivate-current-input-method-function) | |
| 462 (unwind-protect | |
| 463 (run-hooks 'input-method-inactivate-hook) | |
| 464 (setq current-input-method nil | |
| 465 current-input-method-title nil) | |
| 466 (force-mode-line-update))))) | |
| 467 | |
| 468 (defun set-input-method (input-method) | |
| 469 "Select and activate input method INPUT-METHOD for the current buffer. | |
| 470 This also sets the default input method to the one you specify." | |
| 471 (interactive | |
| 472 (let* ((default (or (car input-method-history) default-input-method))) | |
| 473 (list (read-input-method-name | |
| 474 (if default "Select input method (default %s): " "Select input method: ") | |
| 475 default t)))) | |
| 476 (activate-input-method input-method) | |
| 477 (setq default-input-method input-method)) | |
| 478 | |
| 479 (defun toggle-input-method (&optional arg) | |
| 480 "Turn on or off a multilingual text input method for the current buffer. | |
| 481 | |
| 482 With no prefix argument, if an input method is currently activated, | |
| 483 turn it off. Otherwise, activate an input method -- the one most | |
| 484 recently used, or the one specified in `default-input-method', or | |
| 485 the one read from the minibuffer. | |
| 486 | |
| 487 With a prefix argument, read an input method from the minibuffer and | |
| 488 turn it on. | |
| 489 | |
| 490 The default is to use the most recent input method specified | |
| 491 \(not including the currently active input method, if any)." | |
| 492 (interactive "P") | |
| 493 (if (and current-input-method (not arg)) | |
| 494 (inactivate-input-method) | |
| 495 (let ((default (or (car input-method-history) default-input-method))) | |
| 496 (if (and arg default (equal current-input-method default) | |
| 497 (> (length input-method-history) 1)) | |
| 498 (setq default (nth 1 input-method-history))) | |
| 499 (activate-input-method | |
| 500 (if (or arg (not default)) | |
| 501 (progn | |
| 502 (read-input-method-name | |
| 503 (if default "Input method (default %s): " "Input method: " ) | |
| 504 default t)) | |
| 505 default)) | |
| 506 (or default-input-method | |
| 507 (setq default-input-method current-input-method))))) | |
| 508 | |
| 509 (defun describe-input-method (input-method) | |
| 510 "Describe input method INPUT-METHOD." | |
| 511 (interactive | |
| 512 (list (read-input-method-name | |
| 513 "Describe input method (default, current choice): "))) | |
| 514 (if (and input-method (symbolp input-method)) | |
| 515 (setq input-method (symbol-name input-method))) | |
| 516 (if (null input-method) | |
| 517 (describe-current-input-method) | |
| 518 (with-output-to-temp-buffer "*Help*" | |
| 519 (let ((elt (assoc input-method input-method-alist))) | |
| 520 (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" | |
| 521 input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) | |
| 522 | |
| 523 (defun describe-current-input-method () | |
| 524 "Describe the input method currently in use." | |
| 525 (if current-input-method | |
| 526 (if (and (symbolp describe-current-input-method-function) | |
| 527 (fboundp describe-current-input-method-function)) | |
| 528 (funcall describe-current-input-method-function) | |
| 529 (message "No way to describe the current input method `%s'" | |
| 530 current-input-method) | |
| 531 (ding)) | |
| 532 (error "No input method is activated now"))) | |
| 533 | |
| 534 (defun read-multilingual-string (prompt &optional initial-input input-method) | |
| 535 "Read a multilingual string from minibuffer, prompting with string PROMPT. | |
| 536 The input method selected last time is activated in minibuffer. | |
| 537 If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer | |
| 538 initially. | |
| 539 Optional 3rd argument INPUT-METHOD specifies the input method | |
| 540 to be activated instead of the one selected last time. It is a symbol | |
| 541 or a string." | |
| 542 (setq input-method | |
| 543 (or input-method | |
| 544 current-input-method | |
| 545 default-input-method | |
| 546 (read-input-method-name "Input method: " nil t))) | |
| 547 (if (and input-method (symbolp input-method)) | |
| 548 (setq input-method (symbol-name input-method))) | |
| 549 (let ((prev-input-method current-input-method)) | |
| 550 (unwind-protect | |
| 551 (progn | |
| 552 (activate-input-method input-method) | |
| 553 ;; FSF Emacs | |
| 554 ;; (read-string prompt initial-input nil nil t) | |
| 555 (read-string prompt initial-input nil)) | |
| 556 (activate-input-method prev-input-method)))) | |
| 557 | |
| 558 ;; Variables to control behavior of input methods. All input methods | |
| 559 ;; should react to these variables. | |
| 560 | |
| 561 (defcustom input-method-verbose-flag 'default | |
| 562 "*A flag to control extra guidance given by input methods. | |
| 563 The value should be nil, t, `complex-only', or `default'. | |
| 564 | |
| 565 The extra guidance is done by showing list of available keys in echo | |
| 566 area. When you use the input method in the minibuffer, the guidance | |
| 567 is shown at the bottom short window (split from the existing window). | |
| 568 | |
| 569 If the value is t, extra guidance is always given, if the value is | |
| 570 nil, extra guidance is always suppressed. | |
| 571 | |
| 572 If the value is `complex-only', only complex input methods such as | |
| 573 `chinese-py' and `japanese' give extra guidance. | |
| 574 | |
| 575 If the value is `default', complex input methods always give extra | |
| 576 guidance, but simple input methods give it only when you are not in | |
| 577 the minibuffer. | |
| 578 | |
| 579 See also the variable `input-method-highlight-flag'." | |
| 580 :type '(choice (const t) (const nil) (const complex-only) (const default)) | |
| 581 :group 'mule) | |
| 582 | |
| 583 (defcustom input-method-highlight-flag t | |
| 584 "*If this flag is non-nil, input methods highlight partially-entered text. | |
| 585 For instance, while you are in the middle of a Quail input method sequence, | |
| 586 the text inserted so far is temporarily underlined. | |
| 587 The underlining goes away when you finish or abort the input method sequence. | |
| 588 See also the variable `input-method-verbose-flag'." | |
| 589 :type 'boolean | |
| 590 :group 'mule) | |
| 591 | |
| 592 (defvar input-method-activate-hook nil | |
| 593 "Normal hook run just after an input method is activated. | |
| 594 | |
| 595 The variable `current-input-method' keeps the input method name | |
| 596 just activated.") | |
| 597 | |
| 598 (defvar input-method-inactivate-hook nil | |
| 599 "Normal hook run just after an input method is inactivated. | |
| 600 | |
| 601 The variable `current-input-method' still keeps the input method name | |
| 602 just inactivated.") | |
| 603 | |
| 604 (defvar input-method-after-insert-chunk-hook nil | |
| 605 "Normal hook run just after an input method insert some chunk of text.") | |
| 606 | |
| 607 (defvar input-method-exit-on-first-char nil | |
| 608 "This flag controls a timing when an input method returns. | |
| 609 Usually, the input method does not return while there's a possibility | |
| 610 that it may find a different translation if a user types another key. | |
| 611 But, it this flag is non-nil, the input method returns as soon as | |
| 612 the current key sequence gets long enough to have some valid translation.") | |
| 613 | |
| 614 (defvar input-method-use-echo-area nil | |
| 615 "This flag controls how an input method shows an intermediate key sequence. | |
| 616 Usually, the input method inserts the intermediate key sequence, | |
| 617 or candidate translations corresponding to the sequence, | |
| 618 at point in the current buffer. | |
| 619 But, if this flag is non-nil, it displays them in echo area instead.") | |
| 620 | |
| 621 (defvar input-method-exit-on-invalid-key nil | |
| 442 | 622 "This flag controls the behavior of an input method on invalid key input. |
| 428 | 623 Usually, when a user types a key which doesn't start any character |
| 624 handled by the input method, the key is handled by turning off the | |
| 625 input method temporarily. After that key, the input method is re-enabled. | |
| 626 But, if this flag is non-nil, the input method is never back on.") | |
| 627 | |
| 628 | |
| 629 (defvar set-language-environment-hook nil | |
| 630 "Normal hook run after some language environment is set. | |
| 631 | |
| 632 When you set some hook function here, that effect usually should not | |
| 633 be inherited to another language environment. So, you had better set | |
| 634 another function in `exit-language-environment-hook' (which see) to | |
| 635 cancel the effect.") | |
| 636 | |
| 637 (defvar exit-language-environment-hook nil | |
| 638 "Normal hook run after exiting from some language environment. | |
| 639 When this hook is run, the variable `current-language-environment' | |
| 640 is still bound to the language environment being exited. | |
| 641 | |
| 642 This hook is mainly used for canceling the effect of | |
| 643 `set-language-environment-hook' (which-see).") | |
| 644 | |
| 771 | 645 ;; bogus FSF function setup-specified-language-support. |
| 428 | 646 |
| 647 (defcustom current-language-environment "English" | |
| 648 "The last language environment specified with `set-language-environment'. | |
| 649 This variable should be set only with \\[customize], which is equivalent | |
| 650 to using the function `set-language-environment'." | |
| 651 :link '(custom-manual "(emacs)Language Environments") | |
| 652 :set (lambda (symbol value) (set-language-environment value)) | |
| 653 :get (lambda (x) | |
| 654 (or (car-safe (assoc-ignore-case | |
| 655 (if (symbolp current-language-environment) | |
| 656 (symbol-name current-language-environment) | |
| 657 current-language-environment) | |
| 658 language-info-alist)) | |
| 659 "English")) | |
| 660 :type (cons 'choice (mapcar (lambda (lang) | |
| 661 (list 'const (car lang))) | |
| 662 language-info-alist)) | |
| 663 :initialize 'custom-initialize-default | |
| 664 :group 'mule | |
| 665 :type 'string) | |
| 666 | |
| 667 (defun set-language-environment (language-name) | |
| 668 "Set up multi-lingual environment for using LANGUAGE-NAME. | |
| 771 | 669 This sets the coding system autodetection priority, the default buffer |
| 670 coding system, the default input method, the system locale, and other | |
| 671 relevant language properties. LANGUAGE-NAME should be a string, the | |
| 672 name of a language environment. For example, \"Latin-1\" specifies | |
| 673 the language environment for the major languages of Western Europe." | |
| 428 | 674 (interactive (list (read-language-name |
| 675 nil | |
| 676 "Set language environment (default, English): "))) | |
| 677 (if language-name | |
| 678 (if (symbolp language-name) | |
| 679 (setq language-name (symbol-name language-name))) | |
| 680 (setq language-name "English")) | |
| 681 (or (assoc-ignore-case language-name language-info-alist) | |
| 771 | 682 (error 'invalid-argument "Language environment not defined" |
| 683 language-name)) | |
| 428 | 684 (if current-language-environment |
| 685 (let ((func (get-language-info current-language-environment | |
| 686 'exit-function))) | |
| 687 (run-hooks 'exit-language-environment-hook) | |
| 4145 | 688 (if (functionp func) (funcall func)))) |
| 771 | 689 (setq current-language-environment language-name) |
| 428 | 690 (let ((default-eol-type (coding-system-eol-type |
| 691 default-buffer-file-coding-system))) | |
| 771 | 692 (reset-coding-categories-to-default) |
| 693 (set-locale-for-language-environment language-name) | |
| 694 (set-language-environment-coding-systems language-name default-eol-type)) | |
| 695 | |
| 696 (finish-set-language-environment language-name)) | |
| 428 | 697 |
| 771 | 698 (defun finish-set-language-environment (language-name) |
| 699 ;; Internal function. Only what's here is called at startup, once the | |
| 700 ;; first language environment is determined. The above stuff was already | |
| 701 ;; taken care of very early in the startup sequence, in a special | |
| 702 ;; fashion. | |
| 428 | 703 (let ((input-method (get-language-info language-name 'input-method))) |
| 704 (when input-method | |
| 705 (setq default-input-method input-method) | |
| 706 (if input-method-history | |
| 707 (setq input-method-history | |
| 708 (cons input-method | |
| 709 (delete input-method input-method-history)))))) | |
| 710 ;; (let ((nonascii (get-language-info language-name 'nonascii-translation)) | |
| 711 ;; (dos-table | |
| 712 ;; (if (eq window-system 'pc) | |
| 713 ;; (intern | |
| 714 ;; (concat "cp" dos-codepage "-nonascii-translation-table"))))) | |
| 715 ;; (cond | |
| 716 ;; ((char-table-p nonascii) | |
| 717 ;; (setq nonascii-translation-table nonascii)) | |
| 718 ;; ((and (eq window-system 'pc) (boundp dos-table)) | |
| 719 ;; ;; DOS terminals' default is to use a special non-ASCII translation | |
| 720 ;; ;; table as appropriate for the installed codepage. | |
| 721 ;; (setq nonascii-translation-table (symbol-value dos-table))) | |
| 722 ;; ((charsetp nonascii) | |
| 723 ;; (setq nonascii-insert-offset (- (make-char nonascii) 128))))) | |
| 724 | |
| 725 ;; (setq charset-origin-alist | |
| 726 ;; (get-language-info language-name 'charset-origin-alist)) | |
| 727 | |
| 728 ;; Unibyte setups if necessary. | |
| 729 ;; (unless default-enable-multibyte-characters | |
| 730 ;; ;; Syntax and case table. | |
| 731 ;; (let ((syntax (get-language-info language-name 'unibyte-syntax))) | |
| 732 ;; (if syntax | |
| 733 ;; (let ((set-case-syntax-set-multibyte nil)) | |
| 734 ;; (load syntax nil t)) | |
| 735 ;; ;; No information for syntax and case. Reset to the defaults. | |
| 736 ;; (let ((syntax-table (standard-syntax-table)) | |
| 737 ;; (case-table (standard-case-table)) | |
| 738 ;; (ch (if (eq window-system 'pc) 128 160))) | |
| 739 ;; (while (< ch 256) | |
| 740 ;; (modify-syntax-entry ch " " syntax-table) | |
| 741 ;; (aset case-table ch ch) | |
| 742 ;; (setq ch (1+ ch))) | |
| 743 ;; (set-char-table-extra-slot case-table 0 nil) | |
| 744 ;; (set-char-table-extra-slot case-table 1 nil) | |
| 745 ;; (set-char-table-extra-slot case-table 2 nil)) | |
| 746 ;; (set-standard-case-table (standard-case-table)) | |
| 747 ;; (let ((list (buffer-list))) | |
| 748 ;; (while list | |
| 749 ;; (with-current-buffer (car list) | |
| 750 ;; (set-case-table (standard-case-table))) | |
| 751 ;; (setq list (cdr list)))))) | |
| 752 ;; ;; Display table and coding system for terminal. | |
| 753 ;; (let ((coding (get-language-info language-name 'unibyte-display))) | |
| 754 ;; (if coding | |
| 755 ;; (standard-display-european-internal) | |
| 756 ;; (standard-display-default (if (eq window-system 'pc) 128 160) 255) | |
| 757 ;; (aset standard-display-table 146 nil)) | |
| 758 ;; (or (eq window-system 'pc) | |
| 759 ;; (set-terminal-coding-system coding)))) | |
| 760 | |
| 761 (let ((required-features (get-language-info language-name 'features))) | |
| 762 (while required-features | |
| 763 (require (car required-features)) | |
| 764 (setq required-features (cdr required-features)))) | |
| 765 (let ((func (get-language-info language-name 'setup-function))) | |
| 4145 | 766 (if (functionp func) |
| 428 | 767 (funcall func))) |
| 952 | 768 |
|
4490
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
769 (let ((invalid-sequence-coding-system |
|
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
770 (get-language-info language-name 'invalid-sequence-coding-system)) |
|
4489
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
771 (disp-table (specifier-instance current-display-table)) |
|
4687
02b7c7189041
Random (minimal) performance improvements at startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4621
diff
changeset
|
772 glyph string unicode-error-lookup first-char) |
|
4490
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
773 (when (consp invalid-sequence-coding-system) |
|
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
774 (setq invalid-sequence-coding-system |
|
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
775 (car invalid-sequence-coding-system))) |
|
4489
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
776 (map-char-table |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
777 #'(lambda (key entry) |
|
4590
c83cab5a4f04
Display control characters using carets, invalid-sequence-coding-system
Aidan Kehoe <kehoea@parhasard.net>
parents:
4576
diff
changeset
|
778 (setq string (decode-coding-string (string entry) |
|
c83cab5a4f04
Display control characters using carets, invalid-sequence-coding-system
Aidan Kehoe <kehoea@parhasard.net>
parents:
4576
diff
changeset
|
779 invalid-sequence-coding-system)) |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
5266
diff
changeset
|
780 (when (eql 1 (length string)) |
|
4621
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
781 ;; Treat Unicode error sequence chars as the octets |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
782 ;; corresponding to those on disk: |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
783 (setq unicode-error-lookup |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
784 (get-char-table (aref string 0) |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
785 unicode-error-default-translation-table)) |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
786 (when unicode-error-lookup |
|
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
787 (setq string (format "%c" unicode-error-lookup))) |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
788 ;; Treat control characters specially: |
|
4687
02b7c7189041
Random (minimal) performance improvements at startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4621
diff
changeset
|
789 (setq first-char (aref string 0)) |
|
5266
f9ec07abdbf9
Transform safe calls to (= X Y Z) to (and (= X Y) (= Y Z)); same for < > <= >=
Aidan Kehoe <kehoea@parhasard.net>
parents:
5145
diff
changeset
|
790 (when (or (<= #x00 first-char #x1f) (<= #x80 first-char #x9f)) |
|
4621
127dbf03e1af
Correct a test failure uncovered by the last commit.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4615
diff
changeset
|
791 (setq string (format "^%c" (+ ?@ (aref string 0)))))) |
|
4590
c83cab5a4f04
Display control characters using carets, invalid-sequence-coding-system
Aidan Kehoe <kehoea@parhasard.net>
parents:
4576
diff
changeset
|
792 (setq glyph (make-glyph (vector 'string :data string))) |
|
4490
67fbcaf3dbdc
error-sequence -> invalid-sequence
Aidan Kehoe <kehoea@parhasard.net>
parents:
4489
diff
changeset
|
793 (set-glyph-face glyph 'unicode-invalid-sequence-warning-face) |
|
4489
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
794 (put-char-table key glyph disp-table) |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
795 nil) |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
796 unicode-error-default-translation-table)) |
|
b75b075a9041
Support displaying invalid UTF-8 in language-environment-specific ways.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4468
diff
changeset
|
797 |
| 952 | 798 ;; Fit the charsets preferences in unicode conversions for the |
| 799 ;; language environment. | |
| 1285 | 800 (set-language-unicode-precedence-list |
| 801 (get-language-info language-name 'charset)) | |
| 952 | 802 |
| 428 | 803 (run-hooks 'set-language-environment-hook) |
| 804 (force-mode-line-update t)) | |
| 805 | |
| 806 ;; (defun standard-display-european-internal () | |
| 807 ;; ;; Actually set up direct output of non-ASCII characters. | |
| 808 ;; (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) | |
| 809 ;; ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with | |
| 810 ;; ;; the native font, and codes 160 and 146 stand for something very | |
| 811 ;; ;; different there. | |
| 812 ;; (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) | |
| 813 ;; (progn | |
| 814 ;; ;; Make non-line-break space display as a plain space. | |
| 815 ;; ;; Most X fonts do the wrong thing for code 160. | |
| 816 ;; (aset standard-display-table 160 [32]) | |
| 817 ;; ;; Most Windows programs send out apostrophe's as \222. Most X fonts | |
| 818 ;; ;; don't contain a character at that position. Map it to the ASCII | |
| 819 ;; ;; apostrophe. | |
| 820 ;; (aset standard-display-table 146 [39])))) | |
| 821 | |
| 771 | 822 ;; bogus FSF function describe-specified-language-support. |
| 428 | 823 |
| 824 (defun describe-language-environment (language-name) | |
| 825 "Describe how Emacs supports language environment LANGUAGE-NAME." | |
| 826 (interactive | |
| 827 (list (read-language-name | |
| 828 'documentation | |
| 829 "Describe language environment (default, current choice): "))) | |
| 830 (if (null language-name) | |
| 831 (setq language-name current-language-environment)) | |
| 832 (if (or (null language-name) | |
| 833 (null (get-language-info language-name 'documentation))) | |
| 834 (error "No documentation for the specified language")) | |
| 835 (if (symbolp language-name) | |
| 836 (setq language-name (symbol-name language-name))) | |
| 837 (let ((doc (get-language-info language-name 'documentation))) | |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
838 (labels ((princ-list (&rest args) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
839 (while args (princ (car args)) (setq args (cdr args))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
840 (princ "\n"))) |
|
5576
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5567
diff
changeset
|
841 (declare (inline princ-list)) |
| 771 | 842 (with-output-to-temp-buffer "*Help*" |
| 843 (princ-list language-name " language environment" "\n") | |
| 844 (if (stringp doc) | |
| 428 | 845 (progn |
| 771 | 846 (princ-list doc) |
| 847 (terpri))) | |
| 848 (let ((str (get-language-info language-name 'sample-text))) | |
| 849 (if (stringp str) | |
| 850 (progn | |
| 851 (princ "Sample text:\n") | |
| 852 (princ-list " " str) | |
| 853 (terpri)))) | |
| 854 (let ((input-method (get-language-info language-name 'input-method)) | |
| 855 (l (copy-sequence input-method-alist))) | |
| 856 (princ "Input methods") | |
| 857 (when input-method | |
| 858 (princ (format " (default, %s)" input-method)) | |
| 859 (setq input-method (assoc input-method input-method-alist)) | |
| 860 (setq l (cons input-method (delete input-method l)))) | |
| 861 (princ ":\n") | |
| 428 | 862 (while l |
| 771 | 863 (if (string= language-name (nth 1 (car l))) |
| 864 (princ-list " " (car (car l)) | |
| 865 (format " (`%s' in mode line)" (nth 3 (car l))))) | |
| 866 (setq l (cdr l)))) | |
| 867 (terpri) | |
| 868 (princ "Character sets:\n") | |
| 869 (let ((l (get-language-info language-name 'charset))) | |
| 870 (if (null l) | |
| 871 (princ-list " nothing specific to " language-name) | |
| 872 (while l | |
| 873 (princ-list " " (car l) ": " | |
| 874 (charset-description (car l))) | |
| 875 (setq l (cdr l))))) | |
| 876 (terpri) | |
| 877 (princ "Coding systems:\n") | |
| 878 (let ((l (get-language-info language-name 'coding-system))) | |
| 879 (if (null l) | |
| 880 (princ-list " nothing specific to " language-name) | |
| 881 (while l | |
| 882 (princ ; (format " %s (`%c' in mode line):\n\t%s\n" | |
| 883 ;; In XEmacs, `coding-system-mnemonic' returns string. | |
| 884 (format " %s (`%s' in English, `%s' in mode line):\n\t%s\n" | |
| 885 (car l) | |
| 886 (coding-system-description (car l)) | |
| 887 (coding-system-mnemonic (car l)) | |
| 888 (or (coding-system-documentation (car l)) | |
| 889 "Not documented.")) ) | |
| 890 ;; (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) | |
| 891 ;; (when aliases | |
| 892 ;; (princ "\t") | |
| 893 ;; (princ (cons 'alias: (cdr aliases))) | |
| 894 ;; (terpri))) | |
| 895 (setq l (cdr l))))))))) | |
| 428 | 896 |
| 897 ;;; Charset property | |
| 898 | |
| 899 ;; (defsubst get-charset-property (charset propname) | |
| 900 ;; "Return the value of CHARSET's PROPNAME property. | |
| 901 ;; This is the last value stored with | |
| 902 ;; `(put-charset-property CHARSET PROPNAME VALUE)'." | |
| 903 ;; (plist-get (charset-plist charset) propname)) | |
| 904 | |
| 905 ;; (defsubst put-charset-property (charset propname value) | |
| 906 ;; "Store CHARSETS's PROPNAME property with value VALUE. | |
| 907 ;; It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." | |
| 908 ;; (set-charset-plist charset | |
| 909 ;; (plist-put (charset-plist charset) propname value))) | |
| 910 | |
| 911 (defvar char-code-property-table | |
| 912 (make-char-table 'generic) | |
| 913 "Char-table containing a property list of each character code. | |
| 914 | |
| 915 See also the documentation of `get-char-code-property' and | |
| 916 `put-char-code-property'") | |
| 917 ;; (let ((plist (aref char-code-property-table char))) | |
| 918 (defun get-char-code-property (char propname) | |
| 919 "Return the value of CHAR's PROPNAME property in `char-code-property-table'." | |
| 920 (let ((plist (get-char-table char char-code-property-table))) | |
| 921 (if (listp plist) | |
| 922 (car (cdr (memq propname plist)))))) | |
| 923 | |
| 924 (defun put-char-code-property (char propname value) | |
| 925 "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. | |
| 926 It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." | |
| 927 (let ((plist (get-char-table char char-code-property-table))) | |
| 928 (if plist | |
| 929 (let ((slot (memq propname plist))) | |
| 930 (if slot | |
| 931 (setcar (cdr slot) value) | |
| 932 (nconc plist (list propname value)))) | |
| 933 (put-char-table char (list propname value) char-code-property-table) | |
| 934 ))) | |
| 935 | |
| 936 | |
| 937 ;; Pretty description of encoded string | |
| 938 | |
| 939 ;; Alist of ISO 2022 control code vs the corresponding mnemonic string. | |
|
4468
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
940 (defvar iso-2022-control-alist |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
941 '((?\x1b . "ESC") |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
942 (?\x0e . "SO") |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
943 (?\x0f . "SI") |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
944 (?\x8e . "SS2") |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
945 (?\x8f . "SS3") |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
946 (?\x9b . "CSI"))) |
| 428 | 947 |
|
4468
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
948 (defun encoded-string-description (str coding-system) |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
949 "Return a pretty description of STR that is encoded by CODING-SYSTEM." |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
950 ;; XEmacs; no transformation to unibyte. |
|
4468
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
951 (mapconcat |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
952 (if (and coding-system (eq (coding-system-type coding-system) 'iso2022)) |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
953 ;; Try to get a pretty description for ISO 2022 escape sequences. |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
954 (function (lambda (x) (or (cdr (assq x iso-2022-control-alist)) |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
955 (format "#x%02X" x)))) |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
956 (function (lambda (x) (format "#x%02X" x)))) |
|
a78d697ccd2c
Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents:
4292
diff
changeset
|
957 str " ")) |
| 428 | 958 |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
959 ;; XEmacs; |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4590
diff
changeset
|
960 ;; (defun encode-coding-char (char coding-system) in coding.el. |
| 428 | 961 |
| 771 | 962 |
| 963 ;; #### The following section is utter junk from mule-misc.el. | |
| 964 ;; I've deleted everything that's not referenced in mule-packages and | |
| 965 ;; not in FSF 20.6; there's no point in keeping old namespace-polluting | |
| 966 ;; Mule 2.3 crap around. --ben | |
| 967 | |
| 968 (defvar self-insert-after-hook nil | |
| 969 "Hook to run when extended self insertion command exits. Should take | |
| 970 two arguments START and END corresponding to character position.") | |
| 971 | |
| 972 (make-variable-buffer-local 'self-insert-after-hook) | |
| 973 | |
| 974 (defun delete-text-in-column (from to) | |
| 975 "Delete the text between column FROM and TO (exclusive) of the current line. | |
| 976 Nil of FORM or TO means the current column. | |
| 977 | |
| 978 If there's a character across the borders, the character is replaced | |
| 979 with the same width of spaces before deleting." | |
| 980 (save-excursion | |
| 981 (let (p1 p2) | |
| 982 (if from | |
| 983 (progn | |
| 984 (setq p1 (move-to-column from)) | |
| 985 (if (> p1 from) | |
| 986 (progn | |
| 987 (delete-char -1) | |
| 988 (insert-char ? (- p1 (current-column))) | |
| 989 (forward-char (- from p1)))))) | |
| 990 (setq p1 (point)) | |
| 991 (if to | |
| 992 (progn | |
| 993 (setq p2 (move-to-column to)) | |
| 994 (if (> p2 to) | |
| 995 (progn | |
| 996 (delete-char -1) | |
| 997 (insert-char ? (- p2 (current-column))) | |
| 998 (forward-char (- to p2)))))) | |
| 999 (setq p2 (point)) | |
| 1000 (delete-region p1 p2)))) | |
| 1001 | |
| 1002 (defun cancel-undo-boundary () | |
| 1003 "Cancel undo boundary." | |
| 1004 (if (and (consp buffer-undo-list) | |
| 1005 (null (car buffer-undo-list))) | |
| 1006 (setq buffer-undo-list (cdr buffer-undo-list)))) | |
| 1007 | |
| 1008 (defun define-egg-environment (env-sym doc-string enable-function) | |
| 1009 "Define a new language environment for egg, named by ENV-SYM. | |
| 1010 DOC-STRING should be a string describing the environment. | |
| 1011 ENABLE-FUNCTION should be a function of no arguments that will be called | |
| 1012 when the language environment is made current." | |
| 1013 (put env-sym 'egg-environ-doc-string doc-string) | |
| 1014 (put env-sym 'set-egg-environ enable-function)) | |
| 1015 | |
| 1016 | |
| 1017 ;; Init code. | |
| 1018 | |
| 1019 ;; auto-language-alist deleted. We have a more sophisticated system, | |
| 1020 ;; with the locales stored in the language data. | |
| 1021 | |
| 4145 | 1022 ;; Initialised in mule/general-late.el, which is compiled after all the |
| 1023 ;; language support--and, thus, minority Chinese coding systems and so | |
| 1024 ;; on--has been loaded. | |
| 3707 | 1025 (defvar posix-charset-to-coding-system-hash nil |
| 1026 "A map from the POSIX locale charset versions of the defined coding | |
| 1027 systems' names, with all alpha-numeric characters removed, to the actual | |
| 1028 coding system names. Used at startup when working out which coding system | |
| 1029 should be the default for the locale. ") | |
| 1030 | |
| 1031 (defun parse-posix-locale-string (locale-string) | |
| 1032 "Return values \(LANGUAGE REGION CHARSET MODIFIERS\) given LOCALE-STRING. | |
| 1033 | |
| 1034 LOCALE-STRING should be a POSIX locale. If it cannot be parsed as such, this | |
| 1035 function returns nil. " | |
| 1036 (let (language region charset modifiers locinfo) | |
| 1037 (setq locale-string (downcase locale-string)) | |
| 1038 (cond ((string-match | |
| 1039 #r"^\([a-z0-9]\{2,2\}\)\(_[a-z0-9]\{2,2\}\)?\(\.[^@]*\)?\(@.*\)?$" | |
| 1040 locale-string) | |
| 1041 (setq language (match-string 1 locale-string) | |
| 1042 region (match-string 2 locale-string) | |
| 1043 charset (match-string 3 locale-string) | |
| 1044 modifiers (match-string 4 locale-string) | |
| 1045 region (and region (replace-in-string region "^_" "")) | |
| 1046 charset (and charset (replace-in-string charset #r"^\." "")) | |
| 1047 modifiers (and modifiers | |
| 1048 (replace-in-string modifiers "^@" ""))) | |
| 1049 (when (and modifiers (equal modifiers "euro") (null charset)) | |
| 1050 ;; Not ideal for Latvian, say, but I don't have any locales | |
| 1051 ;; where the @euro modifier doesn't mean ISO-8859-15 in the 956 | |
| 1052 ;; I have. | |
| 1053 (setq charset "iso-8859-15")) | |
| 4073 | 1054 (when (and modifiers (equal modifiers "cyrillic") (null charset)) |
| 1055 ;; Feedback wanted! | |
| 1056 (setq charset "windows-1251")) | |
| 3707 | 1057 (values language region charset modifiers)) |
| 1058 ((and (string-match "^[a-z0-9]+$" locale-string) | |
| 1059 (assoc-ignore-case locale-string language-info-alist)) | |
| 1060 (setq language (get-language-info locale-string 'locale) | |
| 1061 language (if (listp language) (car language) language)) | |
| 1062 (values language region charset modifiers)) | |
| 1063 ((string-match #r"^\([a-z0-9]+\)\.\([a-z0-9]+\)$" locale-string) | |
| 1064 (when (assoc-ignore-case | |
| 1065 (setq locinfo (match-string 1 locale-string)) | |
| 1066 language-info-alist) | |
| 1067 (setq language (get-language-info locinfo 'locale) | |
| 1068 language (if (listp language) (car language) language))) | |
| 1069 (setq charset (match-string 2 locale-string)) | |
| 1070 (values language region charset modifiers))))) | |
| 1071 | |
| 1072 (defun create-variant-language-environment (langenv coding-system) | |
| 1073 "Create a variant of LANGENV with CODING-SYSTEM as its coding systems. | |
| 1074 | |
| 1075 The coding systems in question are those described in the | |
| 1076 `set-language-info' docstring with the property names of | |
| 1077 `native-coding-system' and `coding-system'. The name of the new language | |
| 1078 environment is the name of the old language environment, followed by | |
| 1079 CODING-SYSTEM in parentheses. Returns the name of the new language | |
| 3767 | 1080 environment. |
| 1081 | |
| 1082 This function also modifies the `coding-priority' of a language | |
| 3707 | 1083 environment. " |
| 1084 (check-coding-system coding-system) | |
| 1085 (if (symbolp langenv) (setq langenv (symbol-name langenv))) | |
| 1086 (unless (setq langenv | |
| 1087 (assoc-ignore-case langenv language-info-alist)) | |
| 1088 (error 'wrong-type-argument "Not a known language environment")) | |
| 1089 (set-language-info-alist | |
| 1090 (if (string-match " ([^)]+)$" (car langenv)) | |
| 1091 (replace-match (format " (%s)" | |
| 1092 (upcase (symbol-name | |
| 1093 (coding-system-name coding-system)))) | |
| 3737 | 1094 nil nil (car langenv)) |
| 3707 | 1095 (format "%s (%s)" (car langenv) |
| 1096 (upcase (symbol-name (coding-system-name coding-system))))) | |
| 1097 (destructive-plist-to-alist | |
| 3767 | 1098 (plist-put |
| 1099 (plist-put | |
| 4292 | 1100 (plist-put |
| 1101 (plist-put (alist-to-plist (cdr langenv)) 'native-coding-system | |
| 1102 coding-system) | |
| 1103 'coding-system (cons coding-system | |
| 1104 (cdr (assoc 'coding-system (cdr langenv))))) | |
| 1105 'coding-priority (cons coding-system | |
| 1106 (cdr (assq 'coding-priority (cdr langenv))))) | |
| 1107 ;; The tutorial coding system is important; otherwise the tutorial file | |
| 1108 ;; gets loaded in the variant coding system. | |
| 1109 'tutorial-coding-system | |
| 1110 (or (car-safe (cdr-safe (assoc 'tutorial-coding-system (cdr langenv)))) | |
| 1111 (car-safe (cdr-safe (assoc 'coding-system (cdr langenv))))))))) | |
| 801 | 1112 |
| 771 | 1113 (defun get-language-environment-from-locale (locale) |
| 1114 "Convert LOCALE into a language environment. | |
| 1115 LOCALE is a C library locale string, as returned by `current-locale'. | |
| 1116 Uses the `locale' property of the language environment." | |
| 3707 | 1117 (block langenv |
| 4103 | 1118 (multiple-value-bind (language ignored-arg charset ignored-arg) |
| 3707 | 1119 (parse-posix-locale-string locale) |
| 1120 (let ((case-fold-search t) | |
| 1121 (desired-coding-system | |
| 1122 (and charset (gethash (replace-in-string charset "[^a-z0-9]" "") | |
| 1123 posix-charset-to-coding-system-hash))) | |
| 3767 | 1124 lang locs given-coding-system) |
| 3707 | 1125 (dolist (langcons language-info-alist) |
| 1126 (setq lang (car langcons) | |
| 1127 locs (get-language-info lang 'locale)) | |
| 1128 (dolist (loc (if (listp locs) locs (list locs))) | |
| 1129 (cond ((functionp loc) | |
| 1130 (if (funcall loc locale) | |
| 1131 (return-from langenv lang))) | |
| 1132 ((stringp loc) | |
| 1133 (when (or (equal loc language) | |
| 1134 (string-match | |
| 1135 (format "^%s\\([^A-Za-z0-9]\\|$\\)" loc) | |
| 1136 locale)) | |
| 1137 (if (or (null desired-coding-system) | |
| 1138 (and desired-coding-system | |
| 3767 | 1139 (or (eq desired-coding-system |
| 1140 (setq given-coding-system | |
| 1141 (get-language-info | |
| 1142 lang | |
| 1143 'native-coding-system))) | |
| 1144 (and (listp given-coding-system) | |
| 1145 (memq desired-coding-system | |
| 1146 given-coding-system))))) | |
| 3707 | 1147 (return-from langenv lang) |
| 1148 (return-from langenv | |
| 1149 (create-variant-language-environment | |
| 1150 lang desired-coding-system)))))))))))) | |
| 771 | 1151 |
| 1152 (defun mswindows-get-language-environment-from-locale (ms-locale) | |
| 1153 "Convert MS-LOCALE (an MS Windows locale) into a language environment. | |
| 1154 MS-LOCALE is in the format recognized by `set-mswindows-current-locale' -- | |
| 1155 i.e. a language string or a cons (LANG . SUBLANG). Note: This is NOT the | |
| 1156 same as the C library locale format (see `set-current-locale')! | |
| 1157 | |
| 1158 This looks up the `mswindows-locale' property of all language environments; | |
| 1159 if nothing matching is found, it looks for a language environment with the | |
| 1160 same name (modulo case differences) as the LANG part of the locale." | |
| 1161 (or (consp ms-locale) (setq ms-locale (cons ms-locale "DEFAULT"))) | |
| 1162 (or (block langenv | |
| 1163 (dolist (langcons language-info-alist) | |
| 1164 (let* ((lang (car langcons)) | |
| 1165 (mswlocs (get-language-info lang 'mswindows-locale)) | |
| 1166 (mswlocs (if (and (consp mswlocs) | |
| 1167 (listp (cdr mswlocs))) | |
| 1168 mswlocs (list mswlocs)))) | |
| 1169 (dolist (loc mswlocs) | |
| 1170 (or (consp loc) (setq loc (cons loc "DEFAULT"))) | |
| 1171 (if (equalp loc ms-locale) | |
| 1172 (return-from langenv lang)))))) | |
| 1173 (dolist (langcons language-info-alist) | |
| 1174 (let* ((lang (car langcons))) | |
| 1175 (if (equalp lang (car ms-locale)) | |
| 1176 (return-from nil lang)))))) | |
| 1177 | |
| 1178 (defun get-native-coding-system-from-language-environment (langenv locale) | |
| 1179 "Return the native coding system appropriate for LANGENV. | |
| 1180 LANGENV is a string naming a language environment. May use the LOCALE | |
| 1181 \(which should be the C library LOCALE corresponding to LANGENV) to | |
| 1182 determine the correct coding system. (For example, in the Japanese language | |
| 1183 environment, there are multiple encodings in use: euc-jp, shift-jis, jis7, | |
| 1184 jis8, iso-2022-jp, etc. The LOCALE may tell which one is correct.) | |
| 1185 | |
| 1186 Specifically: Under X, the returned value is determined from these two. | |
| 1187 Under MS Windows, the native coding system must be set from the default | |
| 1188 system locale and is not influenced by LOCALE. (In other words, a program | |
| 1189 can't set the text encoding used to communicate with the OS. To get around | |
| 1190 this, we use Unicode whenever available, i.e. on Windows NT always and on | |
| 1318 | 1191 Windows 9x whenever a Unicode version of a system call is available.)" |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1192 (cond ((eq system-type 'windows-nt) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1193 ;; should not apply to Cygwin, I don't think |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1194 'mswindows-multibyte-system-default) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1195 ((featurep 'cygwin-use-utf-8) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1196 'utf-8) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1197 (t |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1198 (let ((ncod (get-language-info langenv 'native-coding-system))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1199 (if (or (functionp ncod) (not (listp ncod))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1200 (setq ncod (list ncod))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1201 (let ((native |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1202 (dolist (try-native ncod) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1203 (let ((result |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1204 (if (functionp try-native) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1205 (funcall try-native locale) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1206 try-native))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1207 (if result (return result)))))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1208 (or native (car (get-language-info langenv 'coding-system)) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4687
diff
changeset
|
1209 'raw-text)))))) |
| 771 | 1210 |
| 1211 (defun get-coding-system-from-locale (locale) | |
| 1212 "Return the coding system corresponding to a locale string." | |
| 1213 (get-native-coding-system-from-language-environment | |
| 1214 (get-language-environment-from-locale locale) locale)) | |
| 1215 | |
| 1216 (defvar mswindows-langenv-to-locale-table (make-hash-table) | |
| 1217 "Table mapping language environments to associated MS Windows locales. | |
| 1218 There may be more than one MS Windows locale that maps to a given language | |
| 1219 environment, so once we've made the mapping, we record it here when we need | |
| 1220 to make the reverse mapping. For example, all MS Windows locales with | |
| 1221 language ENGLISH will map to language environment English, and when the | |
| 1222 user starts up in such a locale, switches to another language environment | |
| 1223 and then back to English, we want the same locale again.") | |
| 1224 | |
| 1225 (defun set-locale-for-language-environment (langenv) | |
| 1226 "Sets the current system locale as appropriate for LANGENV. | |
| 1227 LANGENV is a language environment. The locale is determined by looking at | |
| 1228 the 'locale (or maybe 'mswindows-locale) property of LANGENV, and then | |
| 1229 setting it using `set-current-locale' and maybe also | |
| 1230 `mswindows-set-current-locale'. Also sets the LANG environment variable. | |
| 1231 Returns non-nil if successfully set the locale(s)." | |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1232 (labels |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1233 ((mswindows-get-and-set-locale-from-langenv (langenv) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1234 ;; find the mswindows locale for the langenv, make it current, |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1235 ;; and return it. first we check the langenv-to-locale table |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1236 ;; ... |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1237 (let ((ms-locale |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1238 (gethash langenv mswindows-langenv-to-locale-table))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1239 (if ms-locale (progn |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1240 (declare-fboundp (mswindows-set-current-locale |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1241 ms-locale)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1242 ms-locale) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1243 ;; ... if not, see if the langenv specifies any locale(s). |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1244 ;; if not, construct one from the langenv name. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1245 (let* ((mslocs (get-language-info langenv 'mswindows-locale)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1246 (mslocs (or mslocs (cons (upcase langenv) "DEFAULT"))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1247 (mslocs (if (and (consp mslocs) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1248 (listp (cdr mslocs))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1249 mslocs (list mslocs)))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1250 (dolist (msloc mslocs) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1251 ;; Sometimes a language with DEFAULT is different from |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1252 ;; with SYS_DEFAULT, and on my system |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1253 ;; (set-current-locale "chinese") is NOT the same as |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1254 ;; (set-current-locale "chinese-default")! The latter |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1255 ;; gives Taiwan (DEFAULT), the former PRC (SYS_DEFAULT). |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1256 ;; In the interests of consistency, we always use DEFAULT. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1257 (or (consp msloc) (setq msloc (cons msloc "DEFAULT"))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1258 (when (condition-case nil |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1259 (progn |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1260 (declare-fboundp (mswindows-set-current-locale |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1261 msloc)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1262 t) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1263 (error nil)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1264 (return msloc)))))))) |
| 771 | 1265 (if (eq system-type 'windows-nt) |
| 1266 (let ((ms-locale (mswindows-get-and-set-locale-from-langenv langenv))) | |
| 1267 (when ms-locale | |
| 1268 ;; also need to set the clib locale. | |
| 1269 (or (set-current-locale | |
| 1270 ;; if the locale is '("DUTCH" . "DUTCH_BELGIAN"), | |
| 1271 ;; try "DUTCH-BELGIAN". (Case is insignificant; | |
| 1272 ;; "dutch-belgian" works just as well.) This type | |
| 1273 ;; of transformation should always work, and you | |
| 1274 ;; get back the canonicalized version -- in this | |
| 1275 ;; case "Dutch_Belgium.1252". Note the futility of | |
| 1276 ;; trying to construct "Belgium" directly from | |
| 1277 ;; "BELGIAN". | |
| 1278 ;; | |
| 1279 ;; BUT ... We actually have to be trickier. | |
| 1280 ;; ("SPANISH" . "SPANISH_DOMINICAN_REPUBLIC") needs | |
| 1281 ;; to end up as "SPANISH-DOMINICAN REPUBLIC"; any | |
| 1282 ;; other punctuation makes it fail (you either get | |
| 1283 ;; Spain for the country, or nil). | |
| 1284 ;; | |
| 1285 ;; assume it's DEFAULT or NEUTRAL (or something else | |
| 1286 ;; without the language in it?) and prepend the | |
| 1287 ;; language. | |
| 1288 (if (string-match "_" (cdr ms-locale)) | |
| 1289 (replace-in-string | |
| 1290 (replace-match "-" nil nil (cdr ms-locale)) "_" " ") | |
| 1291 (format "%s-%s" (car ms-locale) (cdr ms-locale)))) | |
| 1292 ;; ???? huh ???? if failure, just try the language | |
| 1293 ;; name. | |
| 1294 (set-current-locale (car ms-locale)))) | |
| 1295 ;; also set LANG, for the benefit of Cygwin subprocesses. | |
| 1296 (let* ((cygloc (or (get-language-info langenv 'cygwin-locale) | |
| 1297 (get-language-info langenv 'locale))) | |
| 1298 (cygloc (if (listp cygloc) (car (last cygloc)) cygloc))) | |
| 1299 (if (and cygloc (stringp cygloc)) (setenv "LANG" cygloc))) | |
| 1300 (not (null ms-locale))) | |
| 1301 | |
| 1302 ;; not MS Windows native. | |
| 1303 | |
| 1304 ;; Cygwin is as usual an unholy mixture -- C library locales | |
| 1305 ;; that follow Unix conventions, but also MS Windows locales. | |
| 1306 ;; So set the MS Windows locale, and then try to find a Unix | |
| 1307 ;; locale. | |
| 1308 (when (eq system-type 'cygwin32) | |
| 1309 (mswindows-get-and-set-locale-from-langenv langenv)) | |
| 1310 (let ((locs (get-language-info langenv 'locale))) | |
| 1311 (dolist (loc (if (listp locs) locs (list locs))) | |
| 1312 (let ((retval | |
| 1313 (cond ((functionp loc) (funcall loc nil)) | |
| 1314 ((stringp loc) (set-current-locale loc)) | |
| 1315 (t nil)))) | |
| 1316 (when retval | |
| 1317 (setenv "LANG" retval) | |
| 1318 (return t)))))))) | |
| 1319 | |
| 1320 (defun set-language-environment-coding-systems (language-name | |
| 1321 &optional eol-type) | |
| 1322 "Do various coding system setups for language environment LANGUAGE-NAME. | |
| 1323 This function assumes that the locale for LANGUAGE-NAME has been set using | |
| 1324 `set-current-locale'. | |
| 1325 | |
| 1326 The optional arg EOL-TYPE specifies the eol-type of the default value | |
| 1327 of buffer-file-coding-system set by this function." | |
| 1328 | |
| 1329 ;; The following appeared as the third paragraph of the doc string for this | |
| 778 | 1330 ;; function, but it's not in FSF 21.1, and it's not true, since we call |
| 771 | 1331 ;; reset-coding-categories-to-default before calling this function. #### |
| 1332 ;; Should we rethink this? | |
| 1333 | |
| 1334 ; Note that `coding-priority-list' is not reset first; thus changing language | |
| 1335 ; environment allows recognition of coding systems from previously set language | |
| 1336 ; environments. (This will not work if the desired coding systems are from the | |
| 1337 ; same category. E.g., starting with a Hebrew language environment, ISO 8859-8 | |
| 1338 ; will be recognized. If you shift to Russian, ISO 8859-8 will be shadowed by | |
| 1339 ; ISO 8859-5, and cannot be automatically recognized without resetting the | |
| 1340 ; language environment to Hebrew. However, if you shift from Japanese to | |
| 1341 ; Russian, ISO-2022-JP will continue to be automatically recognized, since | |
| 1342 ; ISO-8859-5 and ISO-2022-JP are different coding categories.)" | |
| 1343 | |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1344 (labels ((maybe-change-coding-system-with-eol (codesys eol-type) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1345 ;; if the EOL type specifies a specific type of ending, |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1346 ;; then add that ending onto the given CODESYS; otherwise, |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1347 ;; return CODESYS unchanged. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1348 (if (memq eol-type '(lf crlf cr unix dos mac)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1349 (coding-system-change-eol-conversion codesys eol-type) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5565
diff
changeset
|
1350 codesys))) |
|
5576
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5567
diff
changeset
|
1351 (declare (inline maybe-change-coding-system-with-eol)) |
| 771 | 1352 ;; initialize category mappings and priority list. |
| 1353 (let* ((priority (get-language-info language-name 'coding-priority)) | |
| 1354 (default-coding (car priority))) | |
| 1355 (if priority | |
| 1356 (let ((categories (mapcar 'coding-system-category priority)) | |
| 1357 category checked-categories) | |
| 1358 (while priority | |
| 1359 (unless (memq (setq category (car categories)) checked-categories) | |
| 1360 (set-coding-category-system category (car priority)) | |
| 1361 (setq checked-categories (cons category checked-categories))) | |
| 1362 (setq priority (cdr priority) | |
| 1363 categories (cdr categories))) | |
| 1364 (set-coding-priority-list (nreverse checked-categories)) | |
| 1365 )) | |
| 1366 | |
| 1367 ;; set the default buffer coding system from the first element of the | |
| 1368 ;; list in the `coding-priority' property, under Unix. Under Windows, it | |
| 1369 ;; should stay at `mswindows-multibyte', which will reference the current | |
| 3707 | 1370 ;; code page. ([Does it really make sense to set the Unix default |
| 771 | 1371 ;; that way? NOTE also that it's not the same as the native coding |
| 1372 ;; system for the locale, which is correct -- the form we choose for text | |
| 3707 | 1373 ;; files should not necessarily have any relevance to whether we're in a |
| 1374 ;; Shift-JIS, EUC-JP, JIS, or other Japanese locale.]) | |
| 1375 ;; | |
| 1376 ;; On Unix--with the exception of Mac OS X--there is no way to | |
| 1377 ;; know for certain what coding system to use for file names, and | |
| 1378 ;; the environment is the best guess. If a particular user's | |
| 1379 ;; preferences differ from this, then that particular user needs | |
| 1380 ;; to edit ~/.xemacs/init.el. Aidan Kehoe, Sun Nov 26 18:11:31 CET | |
| 1381 ;; 2006. OS X uses an almost-normal-form version of UTF-8. | |
| 1382 | |
| 771 | 1383 (unless (memq system-type '(windows-nt cygwin32)) |
| 1384 (set-default-buffer-file-coding-system | |
| 1385 (maybe-change-coding-system-with-eol default-coding eol-type)))) | |
| 1386 ;; (setq default-sendmail-coding-system default-coding) | |
| 1387 | |
| 1318 | 1388 ;; set the native coding system and the default process-output system. |
| 771 | 1389 (let ((native (get-native-coding-system-from-language-environment |
|
5565
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1390 language-name (current-locale))) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1391 seven current-input-mode) |
| 1318 | 1392 |
| 771 | 1393 (condition-case nil |
| 1318 | 1394 (define-coding-system-alias 'native |
| 1395 (maybe-change-coding-system-with-eol native eol-type)) | |
| 771 | 1396 (error |
| 1397 (warn "Invalid native-coding-system %s in language environment %s" | |
| 1398 native language-name))) | |
|
4576
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1399 ;; These variables have magic handlers to make setting them equivalent |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1400 ;; to setting the file-name, terminal and keyboard coding system |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1401 ;; aliases. See coding.el. |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1402 (setq file-name-coding-system |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1403 (or |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1404 (let ((fncs (assq system-type system-type-file-name-coding))) |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1405 (and fncs (cdr fncs))) |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1406 native) |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1407 ;; Set the default keyboard and terminal coding systems to the |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1408 ;; native coding system of the language environment. |
|
774e5c7522bf
Preserve the relation btw. file-name-coding-system & the 'file-name c-s alias.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4490
diff
changeset
|
1409 keyboard-coding-system native |
| 3142 | 1410 terminal-coding-system native) |
|
5565
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1411 ;; Does this coding system use bit 8? |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1412 (setq seven (and (eq (coding-system-type native) 'iso2022) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1413 (coding-system-property native 'seven))) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1414 ;; Set the coding system for TTY consoles. |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1415 (dolist (console |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1416 (delete* 'tty (console-list) :key #'console-type :test-not #'eq)) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1417 (set-console-tty-coding-system console native) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1418 (unless seven |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1419 ;; The native coding system uses bit 8, so we need to use that bit |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1420 ;; for character information, not for meta. |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1421 (setq current-input-mode (current-input-mode console)) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1422 (and (memq (second current-input-mode) '(nil t)) |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1423 (set-input-mode nil (first current-input-mode) 'character |
|
48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1424 (third current-input-mode) console)))) |
| 1318 | 1425 ;; process output should not have EOL conversion. under MS Windows |
| 1426 ;; and Cygwin, this screws things up (`cmd' is fine with just LF and | |
| 1427 ;; `bash' chokes on CR-LF). | |
| 771 | 1428 (setq default-process-coding-system |
| 1318 | 1429 (cons (car default-process-coding-system) native))))) |
| 771 | 1430 |
| 1431 (defun init-locale-at-early-startup () | |
| 1432 "Don't call this." | |
| 1433 ;; Called directly from the C code in intl.c, very early in the startup | |
| 1434 ;; sequence. Don't call this!!! The main purpose is to set things up | |
| 1435 ;; so that non-ASCII strings of all sorts (e.g. file names, command-line | |
| 1436 ;; arguments, environment variables) can be correctly processed during | |
| 1437 ;; the rest of the startup sequence. As a result, this will almost | |
| 1438 ;; certainly be the FIRST Lisp code called when a dumped XEmacs is run, | |
| 1439 ;; and it's called before ANY of the external environment is initialized. | |
| 1440 ;; Thus, it cannot interact at all with the outside world, make any | |
| 1441 ;; system calls, etc! (Except for `set-current-locale'.) | |
| 1442 ;; | |
| 1443 ;; NOTE: The following are the basic settings we have to deal with when | |
| 1444 ;; changing the language environment; | |
| 1445 ;; | |
| 1446 ;; -- current C library locale | |
| 1447 ;; -- under MS Windows, current MS Windows locale | |
| 1448 ;; -- LANG environment variable | |
| 1449 ;; -- native/file-name coding systems | |
| 1450 ;; -- subprocess write coding system (cdr of default-process-coding-system) | |
| 1451 ;; -- coding categories (for detection) | |
| 1452 | |
| 1453 (let (langenv) | |
| 1454 ;; under ms windows (any): | |
| 1455 (if (memq system-type '(windows-nt cygwin32)) | |
| 778 | 1456 (let ((userdef (declare-fboundp (mswindows-user-default-locale))) |
| 1457 (sysdef (declare-fboundp (mswindows-system-default-locale)))) | |
| 771 | 1458 ;; (1) current langenv comes from user-default locale. |
| 1459 (setq langenv (mswindows-get-language-environment-from-locale | |
| 1460 userdef)) | |
| 1461 ;; (2) init the langenv-to-locale table. | |
| 1462 (puthash (mswindows-get-language-environment-from-locale sysdef) | |
| 1463 sysdef mswindows-langenv-to-locale-table) | |
| 1464 ;; user-default second in langenv-to-locale table so it will | |
| 1465 ;; override the system-default if the two are different but both | |
| 1466 ;; map to the same language environment | |
| 1467 (puthash langenv userdef mswindows-langenv-to-locale-table) | |
| 1468 ;; (3) setup C lib locale, MS Windows locale, LANG environment | |
| 1469 ;; variable. Note that under Cygwin we are ignoring the | |
| 1470 ;; passed-in LANG environment variable for the moment -- it's | |
| 1471 ;; usually wrong anyway and just says "C". #### Perhaps we | |
| 1472 ;; should reconsider. | |
| 1473 (and langenv (set-locale-for-language-environment langenv)) | |
| 1474 ;; (4) override current MS Windows locale with the user-default | |
| 1475 ;; locale. Always init the MS Windows locale from the | |
| 1476 ;; user-default locale even if the langenv doesn't correspond; | |
| 1477 ;; we might not be able to find a langenv for the user-default | |
| 1478 ;; locale but we should still use the right code page, etc. | |
| 778 | 1479 (declare-fboundp (mswindows-set-current-locale userdef))) |
| 771 | 1480 ;; Unix: |
| 3173 | 1481 (let (locstring) |
| 1482 ;; Init the POSIX locale from the environment--this calls the C | |
| 1483 ;; library's setlocale(3). | |
| 1484 (set-current-locale "") | |
| 1485 ;; Can't let locstring be the result of (set-current-locale "") | |
| 1486 ;; because that can return a more detailed string than we know how | |
| 1487 ;; to handle. | |
| 1488 (setq locstring (current-locale) | |
| 1489 ;; assume C lib locale and LANG env var are set correctly. | |
| 1490 ;; use them to find the langenv. | |
| 1491 langenv | |
| 1492 (and locstring (get-language-environment-from-locale | |
| 1493 locstring))))) | |
| 771 | 1494 ;; All systems: |
| 1495 (unless langenv (setq langenv "English")) | |
| 1496 (setq current-language-environment langenv) | |
| 1497 ;; Setup various coding systems and categories. | |
| 1498 (let ((default-eol-type (coding-system-eol-type | |
| 1499 default-buffer-file-coding-system))) | |
| 1500 (reset-language-environment) | |
| 1501 (set-language-environment-coding-systems langenv default-eol-type)))) | |
| 1502 | |
| 1503 (defun init-mule-at-startup () | |
| 1504 "Initialize MULE environment at startup. Don't call this." | |
| 1505 | |
| 2367 | 1506 (when (not load-unicode-tables-at-dump-time) |
| 1507 (load-unicode-tables)) | |
| 771 | 1508 |
| 2367 | 1509 ;; This is called (currently; might be moved earlier) from startup.el, |
| 1510 ;; after the basic GUI systems have been initialized, and just before the | |
| 1511 ;; init file gets read in. It needs to finish up initializing the | |
| 1512 ;; current language environment. Very early in the startup procedure we | |
| 1513 ;; determined the default language environment from the locale, and | |
| 1514 ;; bootstrapped the native, file-name and process I/O coding systems. | |
| 1515 ;; Now we need to do it over `the right away'. | |
| 771 | 1516 (finish-set-language-environment current-language-environment) |
| 1517 | |
| 1518 ;; Load a (localizable) locale-specific init file, if it exists. | |
| 1519 ;; We now use the language environment name, NOT the locale, | |
| 1520 ;; whose name varies from system to system. | |
| 1521 (load (format "%s%s/locale-start" | |
| 1522 (locate-data-directory "start-files") | |
| 1523 current-language-environment) | |
| 1524 t t) | |
| 1525 | |
| 1526 ;; #### the rest is junk that should be deleted. | |
| 1527 | |
| 1528 (when current-language-environment | |
| 1529 ;; rman seems to be incompatible with encoded text | |
| 1530 (setq Manual-use-rosetta-man nil)) | |
| 1531 | |
| 1532 ;; Register available input methods by loading LEIM list file. | |
|
4615
ba06a6cae484
Actually use leim-list-file-name, #'init-mule-at-startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
1533 (load leim-list-file-name 'noerror 'nomessage 'nosuffix)) |
| 771 | 1534 |
| 1535 ;; Code deleted: init-mule-tm (Enable the tm package by default) | |
| 428 | 1536 |
| 1537 ;;; mule-cmds.el ends here |