771
+ − 1 /* Various functions for internationalizing XEmacs.
428
+ − 2 Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois.
826
+ − 3 Copyright (C) 2000, 2001, 2002 Ben Wing.
428
+ − 4
+ − 5 This file is part of XEmacs.
+ − 6
+ − 7 XEmacs is free software; you can redistribute it and/or modify it
+ − 8 under the terms of the GNU General Public License as published by the
+ − 9 Free Software Foundation; either version 2, or (at your option) any
+ − 10 later version.
+ − 11
+ − 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 15 for more details.
+ − 16
+ − 17 You should have received a copy of the GNU General Public License
+ − 18 along with XEmacs; see the file COPYING. If not, write to
+ − 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 20 Boston, MA 02111-1307, USA. */
+ − 21
+ − 22 /* Synched up with: Not in FSF. */
+ − 23
+ − 24 #include <config.h>
+ − 25 #include "lisp.h"
+ − 26
+ − 27 #if defined (HAVE_X_WINDOWS) && defined (HAVE_X11_XLOCALE_H)
+ − 28 #include <X11/Xlocale.h>
+ − 29 #else
+ − 30 #ifdef HAVE_LOCALE_H
+ − 31 #include <locale.h>
+ − 32 #endif
+ − 33 #endif
+ − 34
771
+ − 35 #ifdef HAVE_X_WINDOWS
+ − 36 int init_x_locale (Lisp_Object locale);
+ − 37 #endif
428
+ − 38
771
+ − 39 DEFUN ("current-locale", Fcurrent_locale, 0, 0, 0, /*
+ − 40 Return the current locale.
+ − 41 This is of the form LANG_COUNTRY.ENCODING, or LANG_COUNTRY, or LANG,
+ − 42 or .ENCODING. Unfortunately, the meanings of these three values are
+ − 43 system-dependent, and there is no universal agreement.
+ − 44 */
+ − 45 ())
+ − 46 {
+ − 47 Extbyte *loc;
428
+ − 48
771
+ − 49 loc = setlocale (LC_CTYPE, NULL);
+ − 50 if (!loc)
+ − 51 return Qnil;
+ − 52 return build_ext_string (loc, Qctext);
428
+ − 53 }
+ − 54
771
+ − 55 DEFUN ("set-current-locale", Fset_current_locale, 1, 1, 0, /*
+ − 56 Set the user's current locale.
+ − 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.
428
+ − 63
771
+ − 64 If the empty string is passed in, the locale is initialized from
+ − 65 environment variables.
428
+ − 66
771
+ − 67 Returns nil if the call failed (typically, an invalid locale was given).
+ − 68 Otherwise, returns the locale, or possibly a more-specified version.
428
+ − 69 */
771
+ − 70 (locale))
428
+ − 71 {
771
+ − 72 Extbyte *loc;
428
+ − 73
771
+ − 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))
428
+ − 84 {
771
+ − 85 /* Locale not supported under X. Put it back. */
+ − 86 setlocale (LC_ALL, loc);
+ − 87 setlocale (LC_NUMERIC, "C");
+ − 88 return Qnil;
428
+ − 89 }
771
+ − 90 #endif
428
+ − 91
771
+ − 92 return build_ext_string (loc, Qctext);
428
+ − 93 }
771
+ − 94
+ − 95 #if 0
428
+ − 96
771
+ − 97 /* #### some old code that I really want to nuke, but I'm not completely
+ − 98 sure what it did, so I'll leave it until we get around to implementing
+ − 99 message-translation and decide whether the functionality that this
+ − 100 is trying to support makes any sense. --ben */
428
+ − 101
+ − 102 Lisp_Object Qdefer_gettext;
+ − 103
826
+ − 104 DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /*
444
+ − 105 If OBJECT is of the form (defer-gettext "string"), return the string.
428
+ − 106 The purpose of the defer-gettext symbol is to identify strings which
+ − 107 are translated when they are referenced instead of when they are defined.
+ − 108 */
444
+ − 109 (object))
428
+ − 110 {
444
+ − 111 if (CONSP (object)
+ − 112 && SYMBOLP (Fcar (object))
+ − 113 && EQ (Fcar (object), Qdefer_gettext))
+ − 114 return Fcar (Fcdr (object));
428
+ − 115 else
444
+ − 116 return object;
428
+ − 117 }
+ − 118
771
+ − 119 #endif /* 0 */
+ − 120
428
+ − 121 DEFUN ("gettext", Fgettext, 1, 1, 0, /*
+ − 122 Look up STRING in the default message domain and return its translation.
+ − 123 This function does nothing if I18N3 was not enabled when Emacs was compiled.
+ − 124 */
+ − 125 (string))
+ − 126 {
+ − 127 #ifdef I18N3
+ − 128 /* #### What should happen here is:
+ − 129
+ − 130 1) If the string has no `string-translatable' property or its value
+ − 131 is nil, no translation takes place. The `string-translatable' property
+ − 132 only gets added when a constant string is read in from a .el or .elc
+ − 133 file, to avoid excessive translation. (The user can also explicitly
+ − 134 add this property to a string.)
+ − 135 2) If the string's `string-translatable' property is a string,
+ − 136 that string should be returned. `format' add this property.
+ − 137 This allows translation to take place at the proper time but
+ − 138 avoids excessive translation if the string is not destined for
+ − 139 a translating stream. (See print_internal().)
+ − 140 3) If gettext() returns the same string, then Fgettext() should return
+ − 141 the same object, minus the 'string-translatable' property. */
+ − 142
+ − 143 #endif
+ − 144 return string;
+ − 145 }
+ − 146
+ − 147 #ifdef I18N3
+ − 148
+ − 149 /* #### add the function `force-gettext', perhaps in Lisp. This
+ − 150 ignores the `string-translatable' property and simply calls gettext()
+ − 151 on the string. Add the functions `set-string-translatable' and
+ − 152 `set-stream-translating'. */
+ − 153
+ − 154 #endif
+ − 155
+ − 156
+ − 157
+ − 158 /************************************************************************/
+ − 159 /* initialization */
+ − 160 /************************************************************************/
+ − 161
+ − 162 void
771
+ − 163 init_intl (void)
428
+ − 164 {
853
+ − 165 /* This function can GC */
771
+ − 166 if (initialized)
+ − 167 {
+ − 168 int count = begin_gc_forbidden ();
853
+ − 169 Lisp_Object args[2];
+ − 170
771
+ − 171 specbind (Qinhibit_quit, Qt);
853
+ − 172 args[0] = Qreally_early_error_handler;
+ − 173 args[1] = intern ("init-locale-at-early-startup");
+ − 174 Fcall_with_condition_handler (2, args);
+ − 175
771
+ − 176 /* Should be calling this here, but problems with
+ − 177 `data-directory' and locating the files. See comment in
+ − 178 mule-cmds.el:`init-mule-at-startup'.
428
+ − 179
853
+ − 180 args[1] = intern ("init-unicode-at-early-startup");
+ − 181 Fcall_with_condition_handler (2, args);
771
+ − 182 */
+ − 183 unbind_to (count);
+ − 184 }
428
+ − 185 }
+ − 186
+ − 187 void
+ − 188 syms_of_intl (void)
+ − 189 {
+ − 190 DEFSUBR (Fgettext);
771
+ − 191 DEFSUBR (Fset_current_locale);
+ − 192 DEFSUBR (Fcurrent_locale);
428
+ − 193 }
+ − 194
+ − 195 void
+ − 196 vars_of_intl (void)
+ − 197 {
+ − 198 #ifdef I18N3
+ − 199 Fprovide (intern ("i18n3"));
+ − 200 #endif
771
+ − 201
+ − 202 #ifdef MULE
+ − 203 Fprovide (intern ("mule"));
+ − 204 #endif /* MULE */
428
+ − 205 }