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