Mercurial > hg > xemacs-beta

comparison src/intl.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 183866b06e0b
children 6728e641994e
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Various functions for internationalizing XEmacs 1 /* Various functions for internationalizing XEmacs.
2 Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois. 2 Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 2000, 2001 Ben Wing.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
20 21
21 /* Synched up with: Not in FSF. */ 22 /* Synched up with: Not in FSF. */
22 23
23 /* This stuff is far, far from working. */
24
25 #include <config.h> 24 #include <config.h>
26 #include "lisp.h" 25 #include "lisp.h"
27
28 #include "bytecode.h"
29 #include "device.h"
30 26
31 #if defined (HAVE_X_WINDOWS) && defined (HAVE_X11_XLOCALE_H) 27 #if defined (HAVE_X_WINDOWS) && defined (HAVE_X11_XLOCALE_H)
32 #include <X11/Xlocale.h> 28 #include <X11/Xlocale.h>
33 #else 29 #else
34 #ifdef HAVE_LOCALE_H 30 #ifdef HAVE_LOCALE_H
35 #include <locale.h> 31 #include <locale.h>
36 #endif 32 #endif
37 #endif 33 #endif
38 34
39 #ifdef I18N4 35 #ifdef HAVE_X_WINDOWS
40 #include <X11/Xlib.h> 36 int init_x_locale (Lisp_Object locale);
41 37 #endif
42 unsigned long input_method_event_mask; 38
43 Atom wc_atom; 39 DEFUN ("current-locale", Fcurrent_locale, 0, 0, 0, /*
44 40 Return the current locale.
45 /* init_input -- Set things up for i18n level 4 input. 41 This is of the form LANG_COUNTRY.ENCODING, or LANG_COUNTRY, or LANG,
46 */ 42 or .ENCODING. Unfortunately, the meanings of these three values are
47 void 43 system-dependent, and there is no universal agreement.
48 init_input (const char *res_name, const char *res_class, Display *display) 44 */
49 { 45 ())
50 XIMStyles *styles; 46 {
51 unsigned short i; 47 Extbyte *loc;
52 48
53 input_method = 0; 49 loc = setlocale (LC_CTYPE, NULL);
54 input_method_style = 0; 50 if (!loc)
55 initial_input_context = 0; 51 return Qnil;
56 input_method_event_mask = 0; 52 return build_ext_string (loc, Qctext);
57 53 }
58 input_method = XOpenIM (display, NULL, 54
59 (char *) res_name, (char *) res_class); 55 DEFUN ("set-current-locale", Fset_current_locale, 1, 1, 0, /*
60 56 Set the user's current locale.
61 if (!input_method) 57 Takes a string, the value passed to setlocale().
58 This is of the form LANG_COUNTRY.ENCODING, or LANG_COUNTRY, or LANG,
59 or .ENCODING. Unfortunately, the meanings of these three values are
60 system-dependent, and there is no universal agreement. This function
61 is meant to be called only from `set-language-environment', which
62 keeps tables to figure out the values to use for particular systems.
63
64 If the empty string is passed in, the locale is initialized from
65 environment variables.
66
67 Returns nil if the call failed (typically, an invalid locale was given).
68 Otherwise, returns the locale, or possibly a more-specified version.
69 */
70 (locale))
71 {
72 Extbyte *loc;
73
74 CHECK_STRING (locale);
75 /* RedHat 6.2 contains a locale called "Francais" with the C-cedilla
76 encoded in ISO2022! */
77 LISP_STRING_TO_EXTERNAL (locale, loc, Qctext);
78 loc = setlocale (LC_ALL, loc);
79 setlocale (LC_NUMERIC, "C");
80 if (!loc)
81 return Qnil;
82 #ifdef HAVE_X_WINDOWS
83 if (!init_x_locale (locale))
62 { 84 {
63 stderr_out ("WARNING: XOpenIM() failed...no input server\n"); 85 /* Locale not supported under X. Put it back. */
64 return; 86 setlocale (LC_ALL, loc);
87 setlocale (LC_NUMERIC, "C");
88 return Qnil;
65 } 89 }
66 90 #endif
67 /* Query input method for supported input styles and pick one. 91
68 Right now, we choose a style which supports root-window preediting. */ 92 return build_ext_string (loc, Qctext);
69 XGetIMValues (input_method, XNQueryInputStyle, &styles, NULL); 93 }
70 for (i = 0; i < styles->count_styles; i++) 94
71 { 95 #if 0
72 if (styles->supported_styles[i] == (XIMPreeditNothing|XIMStatusNothing)) 96
73 { 97 /* #### some old code that I really want to nuke, but I'm not completely
74 input_method_style= styles->supported_styles[i]; 98 sure what it did, so I'll leave it until we get around to implementing
75 break; 99 message-translation and decide whether the functionality that this
76 } 100 is trying to support makes any sense. --ben */
77 }
78
79 if (!input_method_style)
80 {
81 stderr_out ("WARNING: Could not find suitable input style.\n");
82 return;
83 }
84
85 initial_input_context = XCreateIC (input_method,
86 XNInputStyle, input_method_style,
87 NULL);
88 if (!initial_input_context)
89 {
90 stderr_out ("WARNING: Could not create input context.\n");
91 return;
92 }
93
94 XGetICValues (initial_input_context,
95 XNFilterEvents, &input_method_event_mask,
96 NULL);
97
98 /* Get a new atom for wide character client messages. */
99 wc_atom = XInternAtom (display, "Wide Character Event", False);
100 }
101
102
103 /*static widechar_string composed_input_buf = EMPTY_WIDECHAR_STRING;*/
104
105 #define XIM_Composed_Text_BUFSIZE 64
106 typedef struct XIM_Composed_Text {
107 int size;
108 wchar_t data [XIM_Composed_Text_BUFSIZE];
109 } XIM_Composed_Text;
110 static XIM_Composed_Text composed_input_buf = {XIM_Composed_Text_BUFSIZE, {0}};
111 /*static wcidechar composed_input_buf [64] = {0};*/
112 Window main_window; /* Convenient way to refer to main Era window. */
113
114 /* x_get_composed_input -- Process results of input method composition.
115
116 This function copies the results of the input method composition to
117 composed_input_buf. Then for each character, a custom event of type
118 wc_atom is sent with the character as its data.
119
120 It is probably more efficient to copy the composition results to some
121 allocated memory and send a single event pointing to that memory.
122 That would cut down on the event processing as well as allow quick
123 insertion into the buffer of the whole string. It might require some
124 care, though, to avoid fragmenting memory through the allocation and
125 freeing of many small chunks. Maybe the existing system for
126 (single-byte) string allocation can be used, multiplying the length by
127 sizeof (wchar_t) to get the right size.
128 */
129 void
130 x_get_composed_input (XKeyPressedEvent *x_key_event, XIC context,
131 Display *display)
132 {
133 KeySym keysym;
134 Status status;
135 int len;
136 int i;
137 XClientMessageEvent new_event;
138
139 retry:
140 len = XwcLookupString (context, x_key_event, composed_input_buf.data,
141 composed_input_buf.size, &keysym, &status);
142 switch (status)
143 {
144 case XBufferOverflow:
145 /* GROW_WC_STRING (&composed_input_buf, 32); mrb */
146 goto retry;
147 case XLookupChars:
148 break;
149 default:
150 abort ();
151 }
152
153 new_event.type = ClientMessage;
154 new_event.display = x_key_event->display;
155 new_event.window = x_key_event->window;
156 new_event.message_type = wc_atom;
157 new_event.format = 32; /* 32-bit wide data */
158 new_event.data.l[2] = new_event.data.l[3] = new_event.data.l[4] = 0L;
159 new_event.data.l[0] = x_key_event->time;
160 for (i = 0; i < len; i++) {
161 new_event.data.l[1] = ((wchar_t *) composed_input_buf.data)[i];
162 XSendEvent (display, main_window, False, 0L, (XEvent *) &new_event);
163 }
164 }
165 #endif /* I18N4 */
166
167 101
168 Lisp_Object Qdefer_gettext; 102 Lisp_Object Qdefer_gettext;
169 103
170 DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* 104 xxDEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /*
171 If OBJECT is of the form (defer-gettext "string"), return the string. 105 If OBJECT is of the form (defer-gettext "string"), return the string.
172 The purpose of the defer-gettext symbol is to identify strings which 106 The purpose of the defer-gettext symbol is to identify strings which
173 are translated when they are referenced instead of when they are defined. 107 are translated when they are referenced instead of when they are defined.
174 */ 108 */
175 (object)) 109 (object))
179 && EQ (Fcar (object), Qdefer_gettext)) 113 && EQ (Fcar (object), Qdefer_gettext))
180 return Fcar (Fcdr (object)); 114 return Fcar (Fcdr (object));
181 else 115 else
182 return object; 116 return object;
183 } 117 }
118
119 #endif /* 0 */
184 120
185 DEFUN ("gettext", Fgettext, 1, 1, 0, /* 121 DEFUN ("gettext", Fgettext, 1, 1, 0, /*
186 Look up STRING in the default message domain and return its translation. 122 Look up STRING in the default message domain and return its translation.
187 This function does nothing if I18N3 was not enabled when Emacs was compiled. 123 This function does nothing if I18N3 was not enabled when Emacs was compiled.
188 */ 124 */
202 avoids excessive translation if the string is not destined for 138 avoids excessive translation if the string is not destined for
203 a translating stream. (See print_internal().) 139 a translating stream. (See print_internal().)
204 3) If gettext() returns the same string, then Fgettext() should return 140 3) If gettext() returns the same string, then Fgettext() should return
205 the same object, minus the 'string-translatable' property. */ 141 the same object, minus the 'string-translatable' property. */
206 142
207 if (STRINGP (string)) { 143 #endif
208 #ifdef DEBUG_XEMACS
209 stderr_out ("\nFgettext (%s) called.\n", XSTRING_DATA (string));
210 #endif
211 return build_string (gettext ((char *) XSTRING_DATA (string)));
212 } else {
213 return string;
214 }
215 #else
216 return string; 144 return string;
217 #endif
218 } 145 }
219 146
220 #ifdef I18N3 147 #ifdef I18N3
221 148
222 /* #### add the function `force-gettext', perhaps in Lisp. This 149 /* #### add the function `force-gettext', perhaps in Lisp. This
224 on the string. Add the functions `set-string-translatable' and 151 on the string. Add the functions `set-string-translatable' and
225 `set-stream-translating'. */ 152 `set-stream-translating'. */
226 153
227 #endif 154 #endif
228 155
229 DEFUN ("dgettext", Fdgettext, 2, 2, 0, /*
230 Look up STRING in the specified message domain and return its translation.
231 This function does nothing if I18N3 was not enabled when Emacs was compiled.
232 */
233 (domain, string))
234 {
235 CHECK_STRING (domain);
236 CHECK_STRING (string);
237 #ifdef I18N3
238 return build_string (dgettext ((char *) XSTRING_DATA (domain),
239 (char *) XSTRING_DATA (string)));
240 #else
241 return string;
242 #endif
243 }
244
245 DEFUN ("bind-text-domain", Fbind_text_domain, 2, 2, 0, /*
246 Associate a pathname with a message domain.
247 Here's how the path to message files is constructed under SunOS 5.0:
248 {pathname}/{LANG}/LC_MESSAGES/{domain}.mo
249 This function does nothing if I18N3 was not enabled when Emacs was compiled.
250 */
251 (domain, pathname))
252 {
253 CHECK_STRING (domain);
254 CHECK_STRING (pathname);
255 #ifdef I18N3
256 return build_string (bindtextdomain ((char *) XSTRING_DATA (domain),
257 (char *) XSTRING_DATA (pathname)));
258 #else
259 return Qnil;
260 #endif
261 }
262
263 extern int load_in_progress;
264
265 DEFUN ("set-domain", Fset_domain, 1, 1, 0, /*
266 Specify the domain used for translating messages in this source file.
267 The domain declaration may only appear at top-level, and should precede
268 all function and variable definitions.
269
270 The presence of this declaration in a compiled file effectively sets the
271 domain of all functions and variables which are defined in that file.
272 Bug: it has no effect on source (.el) files, only compiled (.elc) files.
273 */
274 (domain_name))
275 {
276 CHECK_STRING (domain_name);
277 if (load_in_progress)
278 return (domain_name);
279 else
280 return Qnil;
281 }
282 156
283 157
284 /************************************************************************/ 158 /************************************************************************/
285 /* initialization */ 159 /* initialization */
286 /************************************************************************/ 160 /************************************************************************/
287 161
288 void 162 void
289 init_intl_very_early (void) 163 init_intl (void)
290 { 164 {
291 #if defined (I18N2) || defined (I18N3) || defined (I18N4) 165 if (initialized)
292 setlocale (LC_ALL, ""); 166 {
293 setlocale(LC_NUMERIC, "C"); 167 /* #### port to new error-trapping system when i sync up the code */
294 #endif 168 int count = begin_gc_forbidden ();
295 169 specbind (Qinhibit_quit, Qt);
296 #ifdef I18N3 170 call0_with_handler (Qreally_early_error_handler,
297 textdomain ("emacs"); 171 intern ("init-locale-at-early-startup"));
298 #endif 172 /* Should be calling this here, but problems with
173 `data-directory' and locating the files. See comment in
174 mule-cmds.el:`init-mule-at-startup'.
175
176 call0_with_handler (Qreally_early_error_handler,
177 intern ("init-unicode-at-early-startup"));
178 */
179 unbind_to (count);
180 }
299 } 181 }
300 182
301 void 183 void
302 syms_of_intl (void) 184 syms_of_intl (void)
303 { 185 {
304 /* defer-gettext is defined as a symbol because when it is used in menu
305 specification strings, it is not evaluated as a function by
306 menu_item_descriptor_to_widget_value(). */
307 DEFSYMBOL (Qdefer_gettext);
308
309 DEFSUBR (Fignore_defer_gettext);
310 DEFSUBR (Fgettext); 186 DEFSUBR (Fgettext);
311 DEFSUBR (Fdgettext); 187 DEFSUBR (Fset_current_locale);
312 DEFSUBR (Fbind_text_domain); 188 DEFSUBR (Fcurrent_locale);
313 DEFSUBR (Fset_domain);
314 } 189 }
315 190
316 void 191 void
317 vars_of_intl (void) 192 vars_of_intl (void)
318 { 193 {
319 #ifdef I18N2
320 Fprovide (intern ("i18n2"));
321 #endif
322 #ifdef I18N3 194 #ifdef I18N3
323 Fprovide (intern ("i18n3")); 195 Fprovide (intern ("i18n3"));
324 #endif 196 #endif
325 } 197
198 #ifdef MULE
199 Fprovide (intern ("mule"));
200 #endif /* MULE */
201 }