comparison src/intl.c @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 9ee227acff29
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Various functions for internationalizing XEmacs
2 Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois.
3
4 This file is part of XEmacs.
5
6 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 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: Not in FSF. */
22
23 /* This stuff is far, far from working. */
24
25 #include <config.h>
26 #include "lisp.h"
27
28 #include "bytecode.h"
29 #include "device.h"
30
31 #if defined (HAVE_X_WINDOWS) && defined (HAVE_X11_XLOCALE_H)
32 #include <X11/Xlocale.h>
33 #else
34 #ifdef HAVE_LOCALE_H
35 #include <locale.h>
36 #endif
37 #endif
38
39 #ifdef I18N4
40 #include <X11/Xlib.h>
41
42 unsigned long input_method_event_mask;
43 Atom wc_atom;
44
45 /* init_input -- Set things up for i18n level 4 input.
46 */
47 void
48 init_input (CONST char *res_name, CONST char *res_class, Display *display)
49 {
50 XIMStyles *styles;
51 unsigned short i;
52
53 input_method = 0;
54 input_method_style = 0;
55 initial_input_context = 0;
56 input_method_event_mask = 0;
57
58 input_method = XOpenIM (display, NULL,
59 (char *) res_name, (char *) res_class);
60
61 if (!input_method)
62 {
63 stderr_out ("WARNING: XOpenIM() failed...no input server\n");
64 return;
65 }
66
67 /* Query input method for supported input styles and pick one.
68 Right now, we choose a style which supports root-window preediting. */
69 XGetIMValues (input_method, XNQueryInputStyle, &styles, NULL);
70 for (i = 0; i < styles->count_styles; i++)
71 {
72 if (styles->supported_styles[i] == (XIMPreeditNothing|XIMStatusNothing))
73 {
74 input_method_style= styles->supported_styles[i];
75 break;
76 }
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, multipling 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 try_again:
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 try_again;
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
168 Lisp_Object Qdomain;
169 Lisp_Object Qdefer_gettext;
170
171 DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, Signore_defer_gettext,
172 1, 1, 0 /*
173 If OBJ is of the form (defer-gettext \"string\"), return the string.
174 The purpose of the defer-gettext symbol is to identify strings which
175 are translated when they are referenced instead of when they are defined.
176 */ )
177 (obj)
178 Lisp_Object obj;
179 {
180 if (CONSP (obj) && SYMBOLP (Fcar (obj)) && EQ (Fcar (obj), Qdefer_gettext))
181 return Fcar (Fcdr (obj));
182 else
183 return obj;
184 }
185
186 DEFUN ("gettext", Fgettext, Sgettext, 1, 1, 0 /*
187 Look up STRING in the default message domain and return its translation.
188 This function does nothing if I18N3 was not enabled when Emacs was compiled.
189 */ )
190 (string)
191 Lisp_Object string;
192 {
193 #ifdef I18N3
194 /* #### What should happen here is:
195
196 1) If the string has no `string-translatable' property or its value
197 is nil, no translation takes place. The `string-translatable' property
198 only gets added when a constant string is read in from a .el or .elc
199 file, to avoid excessive translation. (The user can also explicitly
200 add this property to a string.)
201 2) If the string's `string-translatable' property is a string,
202 that string should be returned. `format' add this property.
203 This allows translation to take place at the proper time but
204 avoids excessive translation if the string is not destined for
205 a translating stream. (See print_internal().)
206 3) If gettext() returns the same string, then Fgettext() should return
207 the same object, minus the 'string-translatable' property. */
208
209 if (STRINGP (string)) {
210 #ifdef DEBUG_XEMACS
211 stderr_out ("\nFgettext (%s) called.\n", string_data (XSTRING (string)));
212 #endif
213 return build_string (gettext ((char *) string_data (XSTRING (string))));
214 } else {
215 return string;
216 }
217 #else
218 return string;
219 #endif
220 }
221
222 #ifdef I18N3
223
224 /* #### add the function `force-gettext', perhaps in Lisp. This
225 ignores the `string-translatable' property and simply calls gettext()
226 on the string. Add the functions `set-string-translatable' and
227 `set-stream-translating'. */
228
229 #endif
230
231 DEFUN ("dgettext", Fdgettext, Sdgettext, 2, 2, 0 /*
232 Look up STRING in the specified message domain and return its translation.
233 This function does nothing if I18N3 was not enabled when Emacs was compiled.
234 */ )
235 (domain, string)
236 Lisp_Object domain, string;
237 {
238 CHECK_STRING (domain);
239 CHECK_STRING (string);
240 #ifdef I18N3
241 return build_string (dgettext ((char *) string_data (XSTRING (domain)),
242 (char *) string_data (XSTRING (string))));
243 #else
244 return string;
245 #endif
246 }
247
248 DEFUN ("bind-text-domain", Fbind_text_domain, Sbind_text_domain, 2, 2, 0 /*
249 Associate a pathname with a message domain.
250 Here's how the path to message files is constructed under SunOS 5.0:
251 {pathname}/{LANG}/LC_MESSAGES/{domain}.mo
252 This function does nothing if I18N3 was not enabled when Emacs was compiled.
253 */ )
254 (domain, pathname)
255 Lisp_Object domain, pathname;
256 {
257 CHECK_STRING (domain);
258 CHECK_STRING (pathname);
259 #ifdef I18N3
260 return build_string (bindtextdomain ((char *) string_data (XSTRING (domain)),
261 (char *) string_data (XSTRING (pathname))));
262 #else
263 return Qnil;
264 #endif
265 }
266
267 extern int load_in_progress;
268
269 DEFUN ("set-domain", Fset_domain, Sset_domain, 1, 1, 0 /*
270 Specify the domain used for translating messages in this source file.
271 The domain declaration may only appear at top-level, and should preceed
272 all function and variable definitions.
273
274 The presence of this declaration in a compiled file effectively sets the
275 domain of all functions and variables which are defined in that file.
276 Bug: it has no effect on source (.el) files, only compiled (.elc) files.
277 */ )
278 (domain_name)
279 Lisp_Object domain_name;
280 {
281 CHECK_STRING (domain_name);
282 if (load_in_progress)
283 {
284 #ifdef I18N3
285 Vfile_domain = Fpurecopy (domain_name);
286 return Vfile_domain;
287 #else
288 return (domain_name);
289 #endif
290 }
291 else
292 return Qnil;
293 }
294
295
296 /************************************************************************/
297 /* initialization */
298 /************************************************************************/
299
300 void
301 init_intl_very_early (void)
302 {
303 #if defined (I18N2) || defined (I18N3) || defined (I18N4)
304 setlocale (LC_ALL, "");
305 #endif
306
307 #ifdef I18N3
308 textdomain ("emacs");
309 #endif
310 }
311
312 void
313 syms_of_intl (void)
314 {
315 defsymbol (&Qdomain, "domain");
316
317 /* defer-gettext is defined as a symbol because when it is used in menu
318 specification strings, it is not evaluated as a function by
319 menu_item_descriptor_to_widget_value(). */
320 defsymbol (&Qdefer_gettext, "defer-gettext");
321
322 defsubr (&Signore_defer_gettext);
323 defsubr (&Sgettext);
324 defsubr (&Sdgettext);
325 defsubr (&Sbind_text_domain);
326 defsubr (&Sset_domain);
327 }
328
329 void
330 vars_of_intl (void)
331 {
332 #ifdef I18N2
333 Fprovide (intern ("i18n2"));
334 #endif
335 #ifdef I18N3
336 Fprovide (intern ("i18n3"));
337 #endif
338 }