git.chise.org Git - chise/xemacs-chise.git.1/blob - 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 Qdomain;
 169 Lisp_Object Qdefer_gettext;
 170
 171 DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /*
 172 If OBJ is of the form (defer-gettext "string"), return the string.
 173 The purpose of the defer-gettext symbol is to identify strings which
 174 are translated when they are referenced instead of when they are defined.
 175 */
 176        (obj))
 177 {
 178   if (CONSP (obj) && SYMBOLP (Fcar (obj)) && EQ (Fcar (obj), Qdefer_gettext))
 179     return Fcar (Fcdr (obj));
 180   else
 181     return obj;
 182 }
 183
 184 DEFUN ("gettext", Fgettext, 1, 1, 0, /*
 185 Look up STRING in the default message domain and return its translation.
 186 This function does nothing if I18N3 was not enabled when Emacs was compiled.
 187 */
 188        (string))
 189 {
 190 #ifdef I18N3
 191   /* #### What should happen here is:
 192
 193      1) If the string has no `string-translatable' property or its value
 194         is nil, no translation takes place.  The `string-translatable' property
 195         only gets added when a constant string is read in from a .el or .elc
 196         file, to avoid excessive translation.  (The user can also explicitly
 197         add this property to a string.)
 198      2) If the string's `string-translatable' property is a string,
 199         that string should be returned.  `format' add this property.
 200         This allows translation to take place at the proper time but
 201         avoids excessive translation if the string is not destined for
 202         a translating stream.  (See print_internal().)
 203      3) If gettext() returns the same string, then Fgettext() should return
 204         the same object, minus the 'string-translatable' property. */
 205
 206   if (STRINGP (string)) {
 207 #ifdef DEBUG_XEMACS
 208     stderr_out ("\nFgettext (%s) called.\n", XSTRING_DATA (string));
 209 #endif
 210     return build_string (gettext ((char *) XSTRING_DATA (string)));
 211   } else {
 212     return string;
 213   }
 214 #else
 215   return string;
 216 #endif
 217 }
 218
 219 #ifdef I18N3
 220
 221 /* #### add the function `force-gettext', perhaps in Lisp.  This
 222    ignores the `string-translatable' property and simply calls gettext()
 223    on the string.  Add the functions `set-string-translatable' and
 224    `set-stream-translating'. */
 225
 226 #endif
 227
 228 DEFUN ("dgettext", Fdgettext, 2, 2, 0, /*
 229 Look up STRING in the specified message domain and return its translation.
 230 This function does nothing if I18N3 was not enabled when Emacs was compiled.
 231 */
 232        (domain, string))
 233 {
 234   CHECK_STRING (domain);
 235   CHECK_STRING (string);
 236 #ifdef I18N3
 237   return build_string (dgettext ((char *) XSTRING_DATA (domain),
 238                                  (char *) XSTRING_DATA (string)));
 239 #else
 240   return string;
 241 #endif
 242 }
 243
 244 DEFUN ("bind-text-domain", Fbind_text_domain, 2, 2, 0, /*
 245 Associate a pathname with a message domain.
 246 Here's how the path to message files is constructed under SunOS 5.0:
 247   {pathname}/{LANG}/LC_MESSAGES/{domain}.mo
 248 This function does nothing if I18N3 was not enabled when Emacs was compiled.
 249 */
 250        (domain, pathname))
 251 {
 252   CHECK_STRING (domain);
 253   CHECK_STRING (pathname);
 254 #ifdef I18N3
 255   return build_string (bindtextdomain ((char *) XSTRING_DATA (domain),
 256                                        (char *) XSTRING_DATA (pathname)));
 257 #else
 258   return Qnil;
 259 #endif
 260 }
 261
 262 extern int load_in_progress;
 263
 264 DEFUN ("set-domain", Fset_domain, 1, 1, 0, /*
 265 Specify the domain used for translating messages in this source file.
 266 The domain declaration may only appear at top-level, and should precede
 267 all function and variable definitions.
 268
 269 The presence of this declaration in a compiled file effectively sets the
 270 domain of all functions and variables which are defined in that file.
 271 Bug: it has no effect on source (.el) files, only compiled (.elc) files.
 272 */
 273        (domain_name))
 274 {
 275   CHECK_STRING (domain_name);
 276   if (load_in_progress)
 277     {
 278 #ifdef I18N3
 279       Vfile_domain = Fpurecopy (domain_name);
 280       return Vfile_domain;
 281 #else
 282       return (domain_name);
 283 #endif
 284     }
 285   else
 286     return Qnil;
 287 }
 288
 289 \f
 290 /************************************************************************/
 291 /*                            initialization                            */
 292 /************************************************************************/
 293
 294 void
 295 init_intl_very_early (void)
 296 {
 297 #if defined (I18N2) || defined (I18N3) || defined (I18N4)
 298   setlocale (LC_ALL, "");
 299   setlocale(LC_NUMERIC, "C");
 300 #endif
 301
 302 #ifdef I18N3
 303   textdomain ("emacs");
 304 #endif
 305 }
 306
 307 void
 308 syms_of_intl (void)
 309 {
 310   defsymbol (&Qdomain, "domain");
 311
 312   /* defer-gettext is defined as a symbol because when it is used in menu
 313      specification strings, it is not evaluated as a function by
 314      menu_item_descriptor_to_widget_value(). */
 315   defsymbol (&Qdefer_gettext, "defer-gettext");
 316
 317   DEFSUBR (Fignore_defer_gettext);
 318   DEFSUBR (Fgettext);
 319   DEFSUBR (Fdgettext);
 320   DEFSUBR (Fbind_text_domain);
 321   DEFSUBR (Fset_domain);
 322 }
 323
 324 void
 325 vars_of_intl (void)
 326 {
 327 #ifdef I18N2
 328   Fprovide (intern ("i18n2"));
 329 #endif
 330 #ifdef I18N3
 331   Fprovide (intern ("i18n3"));
 332 #endif
 333 }