XEmacs 21.4.17 "Jumbo Shrimp".
[chise/xemacs-chise.git.1] / src / intl.c
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, 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
168 Lisp_Object Qdefer_gettext;
169
170 DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /*
171 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
173 are translated when they are referenced instead of when they are defined.
174 */
175        (object))
176 {
177   if (CONSP (object)
178       && SYMBOLP (Fcar (object))
179       && EQ (Fcar (object), Qdefer_gettext))
180     return Fcar (Fcdr (object));
181   else
182     return object;
183 }
184
185 DEFUN ("gettext", Fgettext, 1, 1, 0, /*
186 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.
188 */
189        (string))
190 {
191 #ifdef I18N3
192   /* #### What should happen here is:
193
194      1) If the string has no `string-translatable' property or its value
195         is nil, no translation takes place.  The `string-translatable' property
196         only gets added when a constant string is read in from a .el or .elc
197         file, to avoid excessive translation.  (The user can also explicitly
198         add this property to a string.)
199      2) If the string's `string-translatable' property is a string,
200         that string should be returned.  `format' add this property.
201         This allows translation to take place at the proper time but
202         avoids excessive translation if the string is not destined for
203         a translating stream.  (See print_internal().)
204      3) If gettext() returns the same string, then Fgettext() should return
205         the same object, minus the 'string-translatable' property. */
206
207   if (STRINGP (string)) {
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;
217 #endif
218 }
219
220 #ifdef I18N3
221
222 /* #### add the function `force-gettext', perhaps in Lisp.  This
223    ignores the `string-translatable' property and simply calls gettext()
224    on the string.  Add the functions `set-string-translatable' and
225    `set-stream-translating'. */
226
227 #endif
228
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
283 \f
284 /************************************************************************/
285 /*                            initialization                            */
286 /************************************************************************/
287
288 void
289 init_intl_very_early (void)
290 {
291 #if defined (I18N2) || defined (I18N3) || defined (I18N4)
292   setlocale (LC_ALL, "");
293   setlocale(LC_NUMERIC, "C");
294 #endif
295
296 #ifdef I18N3
297   textdomain ("emacs");
298 #endif
299 }
300
301 void
302 syms_of_intl (void)
303 {
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, "defer-gettext");
308
309   DEFSUBR (Fignore_defer_gettext);
310   DEFSUBR (Fgettext);
311   DEFSUBR (Fdgettext);
312   DEFSUBR (Fbind_text_domain);
313   DEFSUBR (Fset_domain);
314 }
315
316 void
317 vars_of_intl (void)
318 {
319 #ifdef I18N2
320   Fprovide (intern ("i18n2"));
321 #endif
322 #ifdef I18N3
323   Fprovide (intern ("i18n3"));
324 #endif
325 }