930 lines
18 KiB
C
930 lines
18 KiB
C
/* Part of SWI-Prolog
|
|
|
|
Author: Jan Wielemaker
|
|
E-mail: J.Wielemaker@vu.nl
|
|
WWW: http://www.swi-prolog.org
|
|
Copyright (C): 2013, VU University Amsterdam
|
|
|
|
This library is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU Lesser General Public
|
|
License as published by the Free Software Foundation; either
|
|
version 2.1 of the License, or (at your option) any later version.
|
|
|
|
This library is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
Lesser General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
*/
|
|
|
|
#include "pl-incl.h"
|
|
#include "pl-locale.h"
|
|
|
|
#if defined(__sun) || __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1070
|
|
#undef HAVE_WCSDUP /* No prototype, so better use our own */
|
|
#endif
|
|
|
|
#ifdef O_LOCALE
|
|
|
|
#include <locale.h>
|
|
|
|
#define LOCK() PL_LOCK(L_LOCALE) /* MT locking */
|
|
#define UNLOCK() PL_UNLOCK(L_LOCALE)
|
|
|
|
#undef LD /* fetch LD once per function */
|
|
#define LD LOCAL_LD
|
|
|
|
#define LSTR_MAX 16
|
|
|
|
#ifndef HAVE_LOCALECONV
|
|
typedef struct
|
|
{ char *decimal_point;
|
|
char *thousands_sep;
|
|
char *grouping;
|
|
} lconv;
|
|
|
|
struct lconv *
|
|
localeconv(void)
|
|
{ static struct lconv defl =
|
|
{ ".",
|
|
",",
|
|
"\003\003"
|
|
};
|
|
|
|
return &defl;
|
|
}
|
|
#endif
|
|
|
|
|
|
#ifndef HAVE_WCSDUP
|
|
static wchar_t *
|
|
my_wcsdup(const wchar_t *in)
|
|
{ wchar_t *copy = malloc((wcslen(in)+1)*sizeof(wchar_t));
|
|
|
|
if ( copy )
|
|
return wcscpy(copy, in);
|
|
|
|
return NULL;
|
|
}
|
|
#define wcsdup(ws) my_wcsdup(ws)
|
|
#endif
|
|
|
|
|
|
static wchar_t *
|
|
ls_to_wcs(const char *in, const wchar_t *on_error)
|
|
{ wchar_t buf[LSTR_MAX];
|
|
mbstate_t state;
|
|
|
|
memset(&state, 0, sizeof(state));
|
|
mbsrtowcs(buf, &in, LSTR_MAX, &state);
|
|
if ( in == NULL )
|
|
{ return wcsdup(buf);
|
|
} else
|
|
{ Sdprintf("Illegal locale string: %s\n", in);
|
|
return wcsdup(on_error);
|
|
}
|
|
}
|
|
|
|
|
|
static int
|
|
init_locale_strings(PL_locale *l, struct lconv *conv)
|
|
{ if ( conv )
|
|
{ l->decimal_point = ls_to_wcs(conv->decimal_point, L".");
|
|
l->thousands_sep = ls_to_wcs(conv->thousands_sep, L",");
|
|
l->grouping = strdup(conv->grouping);
|
|
|
|
return TRUE;
|
|
} else
|
|
{ l->decimal_point = wcsdup(L".");
|
|
l->thousands_sep = wcsdup(L",");
|
|
l->grouping = strdup("\003");
|
|
|
|
return FALSE;
|
|
}
|
|
}
|
|
|
|
|
|
static PL_locale *
|
|
new_locale(PL_locale *proto)
|
|
{ PL_locale *new = PL_malloc(sizeof(*new));
|
|
|
|
if ( new )
|
|
{ memset(new, 0, sizeof(*new));
|
|
new->magic = LOCALE_MAGIC;
|
|
|
|
if ( proto )
|
|
{ new->decimal_point = wcsdup(proto->decimal_point);
|
|
new->thousands_sep = wcsdup(proto->thousands_sep);
|
|
new->grouping = strdup(proto->grouping);
|
|
} else
|
|
{ init_locale_strings(new, localeconv());
|
|
}
|
|
}
|
|
|
|
return new;
|
|
}
|
|
|
|
|
|
static void
|
|
free_locale_strings(PL_locale *l)
|
|
{ free(l->decimal_point);
|
|
free(l->thousands_sep);
|
|
free(l->grouping);
|
|
}
|
|
|
|
static void
|
|
free_locale(PL_locale *l)
|
|
{ if ( l )
|
|
{ free_locale_strings(l);
|
|
|
|
if ( l->alias )
|
|
PL_unregister_atom(l->alias);
|
|
|
|
PL_free(l);
|
|
}
|
|
}
|
|
|
|
static void
|
|
update_locale(PL_locale *l, int category, const char *locale)
|
|
{ free_locale_strings(l);
|
|
init_locale_strings(l, localeconv());
|
|
}
|
|
|
|
|
|
static int
|
|
alias_locale(PL_locale *l, atom_t alias)
|
|
{ int rc;
|
|
|
|
LOCK();
|
|
|
|
if ( !GD->locale.localeTable )
|
|
GD->locale.localeTable = newHTable(16);
|
|
|
|
if ( addHTable(GD->locale.localeTable, (void*)alias, l) )
|
|
{ l->alias = alias;
|
|
PL_register_atom(alias);
|
|
rc = TRUE;
|
|
} else
|
|
{ GET_LD
|
|
term_t obj = PL_new_term_ref();
|
|
|
|
PL_put_atom(obj, alias);
|
|
rc = PL_error("locale_create", 2, "Alias name already taken",
|
|
ERR_PERMISSION, ATOM_create, ATOM_locale, obj);
|
|
}
|
|
UNLOCK();
|
|
|
|
return rc;
|
|
}
|
|
|
|
|
|
/*******************************
|
|
* LOCALE BLOB *
|
|
*******************************/
|
|
|
|
typedef struct locale_ref
|
|
{ PL_locale *data;
|
|
} locale_ref;
|
|
|
|
|
|
static int
|
|
write_locale_ref(IOSTREAM *s, atom_t aref, int flags)
|
|
{ locale_ref *ref = PL_blob_data(aref, NULL, NULL);
|
|
(void)flags;
|
|
|
|
Sfprintf(s, "<locale>(%p)", ref->data);
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
static void
|
|
acquire_locale_ref(atom_t aref)
|
|
{ locale_ref *ref = PL_blob_data(aref, NULL, NULL);
|
|
|
|
(void)ref;
|
|
}
|
|
|
|
|
|
static int
|
|
release_locale_ref(atom_t aref)
|
|
{ locale_ref *ref = PL_blob_data(aref, NULL, NULL);
|
|
|
|
LOCK();
|
|
if ( ref->data->references == 0 )
|
|
free_locale(ref->data);
|
|
else
|
|
ref->data->symbol = 0;
|
|
UNLOCK();
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
static int
|
|
save_locale_ref(atom_t aref, IOSTREAM *fd)
|
|
{ locale_ref *ref = PL_blob_data(aref, NULL, NULL);
|
|
(void)fd;
|
|
|
|
return PL_warning("Cannot save reference to <locale>(%p)", ref->data);
|
|
}
|
|
|
|
|
|
static atom_t
|
|
load_locale_ref(IOSTREAM *fd)
|
|
{ (void)fd;
|
|
|
|
return PL_new_atom("<saved-locale-ref>");
|
|
}
|
|
|
|
|
|
static PL_blob_t locale_blob =
|
|
{ PL_BLOB_MAGIC,
|
|
PL_BLOB_UNIQUE,
|
|
"locale",
|
|
release_locale_ref,
|
|
NULL,
|
|
write_locale_ref,
|
|
acquire_locale_ref,
|
|
save_locale_ref,
|
|
load_locale_ref
|
|
};
|
|
|
|
|
|
/*******************************
|
|
* PROLOG HANDLE *
|
|
*******************************/
|
|
|
|
int
|
|
unifyLocale(term_t t, PL_locale *l, int alias)
|
|
{ GET_LD
|
|
term_t b;
|
|
|
|
if ( l->alias && alias )
|
|
return PL_unify_atom(t, l->alias);
|
|
|
|
if ( l->symbol )
|
|
return PL_unify_atom(t, l->symbol);
|
|
|
|
if ( (b=PL_new_term_ref()) &&
|
|
PL_put_blob(b, &l, sizeof(l), &locale_blob) )
|
|
{ PL_get_atom(b, &l->symbol);
|
|
assert(l->symbol);
|
|
return PL_unify(t, b);
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
int
|
|
getLocale(term_t t, PL_locale **lp)
|
|
{ GET_LD
|
|
atom_t a;
|
|
|
|
if ( PL_get_atom(t, &a) )
|
|
{ PL_locale *l = NULL;
|
|
PL_blob_t *bt;
|
|
locale_ref *ref;
|
|
|
|
if ( a == ATOM_current_locale )
|
|
{ GET_LD
|
|
|
|
l = LD->locale.current;
|
|
} else if ( (ref=PL_blob_data(a, NULL, &bt)) && bt == &locale_blob )
|
|
{ l = ref->data;
|
|
} else if ( GD->locale.localeTable )
|
|
{ Symbol s;
|
|
|
|
if ( (s=lookupHTable(GD->locale.localeTable, (void*)a)) )
|
|
l = s->value;
|
|
}
|
|
|
|
if ( l )
|
|
{ assert(l->magic == LOCALE_MAGIC);
|
|
*lp = acquireLocale(l);
|
|
return TRUE;
|
|
}
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
int
|
|
getLocaleEx(term_t t, PL_locale **lp)
|
|
{ GET_LD
|
|
|
|
if ( getLocale(t, lp) )
|
|
return TRUE;
|
|
|
|
if ( PL_is_atom(t) )
|
|
return PL_existence_error("locale", t);
|
|
else
|
|
return PL_type_error("locale", t);
|
|
}
|
|
|
|
|
|
/*******************************
|
|
* PROLOG BINDING *
|
|
*******************************/
|
|
|
|
static int /* locale_property(Mutex, alias(Name)) */
|
|
locale_alias_property(PL_locale *l, term_t prop ARG_LD)
|
|
{ if ( l->alias )
|
|
return PL_unify_atom(prop, l->alias);
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
static int /* locale_property(Locale, decimal_point(Atom)) */
|
|
locale_decimal_point_property(PL_locale *l, term_t prop ARG_LD)
|
|
{ if ( l->decimal_point && l->decimal_point[0] )
|
|
return PL_unify_wchars(prop, PL_ATOM, (size_t)-1, l->decimal_point);
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
static int /* locale_property(Locale, thousands_sep(Atom)) */
|
|
locale_thousands_sep_property(PL_locale *l, term_t prop ARG_LD)
|
|
{ if ( l->thousands_sep && l->thousands_sep[0] )
|
|
return PL_unify_wchars(prop, PL_ATOM, (size_t)-1, l->thousands_sep);
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
static int /* locale_property(Locale, grouping(List)) */
|
|
locale_grouping_property(PL_locale *l, term_t prop ARG_LD)
|
|
{ if ( l->grouping && l->grouping[0] )
|
|
{ term_t tail = PL_copy_term_ref(prop);
|
|
term_t head = PL_new_term_ref();
|
|
char *s;
|
|
|
|
for(s=l->grouping; ; s++)
|
|
{ if ( !PL_unify_list(tail, head, tail) )
|
|
return FALSE;
|
|
if ( s[1] == 0 || (s[1] == s[0] && s[2] == 0) )
|
|
return ( PL_unify_term(head, PL_FUNCTOR, FUNCTOR_repeat1,
|
|
PL_INT, (int)s[0]) &&
|
|
PL_unify_nil(tail)
|
|
);
|
|
if ( s[0] == CHAR_MAX )
|
|
return PL_unify_nil(tail);
|
|
if ( !PL_unify_integer(head, s[0]) )
|
|
return FALSE;
|
|
}
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
typedef struct
|
|
{ functor_t functor; /* functor of property */
|
|
int (*function)(); /* function to generate */
|
|
} lprop;
|
|
|
|
static const lprop lprop_list [] =
|
|
{ { FUNCTOR_alias1, locale_alias_property },
|
|
{ FUNCTOR_decimal_point1, locale_decimal_point_property },
|
|
{ FUNCTOR_thousands_sep1, locale_thousands_sep_property },
|
|
{ FUNCTOR_grouping1, locale_grouping_property },
|
|
{ 0, NULL }
|
|
};
|
|
|
|
typedef struct
|
|
{ TableEnum e; /* Enumerator on mutex-table */
|
|
PL_locale *l; /* current locale */
|
|
const lprop *p; /* Pointer in properties */
|
|
int enum_properties; /* Enumerate the properties */
|
|
} lprop_enum;
|
|
|
|
|
|
static int
|
|
get_prop_def(term_t t, atom_t expected, const lprop *list, const lprop **def)
|
|
{ GET_LD
|
|
functor_t f;
|
|
|
|
if ( PL_get_functor(t, &f) )
|
|
{ const lprop *p = list;
|
|
|
|
for( ; p->functor; p++ )
|
|
{ if ( f == p->functor )
|
|
{ *def = p;
|
|
return TRUE;
|
|
}
|
|
}
|
|
|
|
PL_error(NULL, 0, NULL, ERR_DOMAIN, expected, t);
|
|
return -1;
|
|
}
|
|
|
|
if ( PL_is_variable(t) )
|
|
return 0;
|
|
|
|
PL_error(NULL, 0, NULL, ERR_TYPE, expected, t);
|
|
return -1;
|
|
}
|
|
|
|
|
|
static int
|
|
advance_lstate(lprop_enum *state)
|
|
{ if ( state->enum_properties )
|
|
{ state->p++;
|
|
if ( state->p->functor )
|
|
return TRUE;
|
|
|
|
state->p = lprop_list;
|
|
}
|
|
if ( state->e )
|
|
{ Symbol s;
|
|
|
|
if ( (s = advanceTableEnum(state->e)) )
|
|
{ state->l = s->value;
|
|
|
|
return TRUE;
|
|
}
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
static void
|
|
free_lstate(lprop_enum *state)
|
|
{ if ( state->e )
|
|
freeTableEnum(state->e);
|
|
else if ( state->l )
|
|
releaseLocale(state->l);
|
|
|
|
freeForeignState(state, sizeof(*state));
|
|
}
|
|
|
|
|
|
static int
|
|
get_atom_arg(term_t t, atom_t *a)
|
|
{ GET_LD
|
|
term_t t2 = PL_new_term_ref();
|
|
|
|
return PL_get_arg(1, t, t2) && PL_get_atom(t2, a);
|
|
}
|
|
|
|
|
|
/** locale_property(?Locale, ?Property) is nondet.
|
|
*/
|
|
|
|
static
|
|
PRED_IMPL("locale_property", 2, locale_property, PL_FA_NONDETERMINISTIC)
|
|
{ PRED_LD
|
|
term_t locale = A1;
|
|
term_t property = A2;
|
|
lprop_enum statebuf;
|
|
lprop_enum *state = NULL;
|
|
|
|
switch( CTX_CNTRL )
|
|
{ case FRG_FIRST_CALL:
|
|
{ memset(&statebuf, 0, sizeof(statebuf));
|
|
state = &statebuf;
|
|
|
|
if ( PL_is_variable(locale) )
|
|
{ switch( get_prop_def(property, ATOM_locale_property,
|
|
lprop_list, &state->p) )
|
|
{ case 1:
|
|
{ atom_t alias;
|
|
|
|
if ( state->p->functor == FUNCTOR_alias1 &&
|
|
get_atom_arg(property, &alias) )
|
|
{ Symbol s;
|
|
|
|
if ( (s=lookupHTable(GD->locale.localeTable, (void*)alias)) )
|
|
return unifyLocale(locale, s->value, FALSE);
|
|
else
|
|
return FALSE;
|
|
}
|
|
state->e = newTableEnum(GD->locale.localeTable);
|
|
goto enumerate;
|
|
}
|
|
case 0:
|
|
state->e = newTableEnum(GD->locale.localeTable);
|
|
state->p = lprop_list;
|
|
state->enum_properties = TRUE;
|
|
goto enumerate;
|
|
case -1:
|
|
return FALSE;
|
|
}
|
|
} else if ( getLocale(locale, &state->l) )
|
|
{ switch( get_prop_def(property, ATOM_locale_property,
|
|
lprop_list, &state->p) )
|
|
{ case 1:
|
|
goto enumerate;
|
|
case 0:
|
|
state->p = lprop_list;
|
|
state->enum_properties = TRUE;
|
|
goto enumerate;
|
|
case -1:
|
|
return FALSE;
|
|
}
|
|
} else
|
|
{ return FALSE;
|
|
}
|
|
}
|
|
case FRG_REDO:
|
|
state = CTX_PTR;
|
|
break;
|
|
case FRG_CUTTED:
|
|
state = CTX_PTR;
|
|
free_lstate(state);
|
|
succeed;
|
|
default:
|
|
assert(0);
|
|
}
|
|
|
|
enumerate:
|
|
if ( !state->l ) /* first time, enumerating locales */
|
|
{ Symbol s;
|
|
|
|
assert(state->e);
|
|
if ( (s=advanceTableEnum(state->e)) )
|
|
{ state->l = s->value;
|
|
} else
|
|
{ freeTableEnum(state->e);
|
|
assert(state != &statebuf);
|
|
return FALSE;
|
|
}
|
|
}
|
|
|
|
{ term_t arg = PL_new_term_ref();
|
|
|
|
if ( !state->enum_properties )
|
|
_PL_get_arg(1, property, arg);
|
|
|
|
for(;;)
|
|
{ if ( (*state->p->function)(state->l, arg PASS_LD) )
|
|
{ if ( state->enum_properties )
|
|
{ if ( !PL_unify_term(property,
|
|
PL_FUNCTOR, state->p->functor,
|
|
PL_TERM, arg) )
|
|
goto error;
|
|
}
|
|
if ( state->e )
|
|
{ if ( !unifyLocale(locale, state->l, TRUE) )
|
|
goto error;
|
|
}
|
|
|
|
if ( advance_lstate(state) )
|
|
{ if ( state == &statebuf )
|
|
{ lprop_enum *copy = allocForeignState(sizeof(*copy));
|
|
|
|
*copy = *state;
|
|
state = copy;
|
|
}
|
|
|
|
ForeignRedoPtr(state);
|
|
}
|
|
|
|
if ( state != &statebuf )
|
|
free_lstate(state);
|
|
return TRUE;
|
|
}
|
|
|
|
if ( !advance_lstate(state) )
|
|
{ error:
|
|
if ( state != &statebuf )
|
|
free_lstate(state);
|
|
return FALSE;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
static int
|
|
set_chars(term_t t, wchar_t **valp)
|
|
{ wchar_t *s;
|
|
|
|
if ( PL_get_wchars(t, NULL, &s, CVT_ATOM|CVT_EXCEPTION) )
|
|
{ free(*valp);
|
|
if ( (*valp = wcsdup(s)) )
|
|
return TRUE;
|
|
return PL_no_memory();
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
#define MAX_GROUPING 10
|
|
|
|
static int
|
|
get_group_size_ex(term_t t, int *s)
|
|
{ int i;
|
|
|
|
if ( PL_get_integer_ex(t, &i) )
|
|
{ if ( i > 0 && i < CHAR_MAX )
|
|
{ *s = i;
|
|
return TRUE;
|
|
}
|
|
return PL_domain_error("digit_group_size", t);
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
static int
|
|
set_grouping(term_t t, char **valp)
|
|
{ GET_LD
|
|
char s[MAX_GROUPING];
|
|
term_t tail = PL_copy_term_ref(t);
|
|
term_t head = PL_new_term_ref();
|
|
char *o = s;
|
|
|
|
while(PL_get_list_ex(tail, head, tail))
|
|
{ int g;
|
|
|
|
if ( o-s+2 >= MAX_GROUPING )
|
|
return PL_representation_error("digit_groups");
|
|
|
|
if ( PL_is_functor(head, FUNCTOR_repeat1) )
|
|
{ if ( !PL_get_nil_ex(tail) )
|
|
return FALSE;
|
|
|
|
_PL_get_arg(1, head, head);
|
|
if ( get_group_size_ex(head, &g) )
|
|
{ *o++ = g;
|
|
goto end;
|
|
}
|
|
return FALSE;
|
|
}
|
|
if ( get_group_size_ex(head, &g) )
|
|
{ *o++ = g;
|
|
} else
|
|
return FALSE;
|
|
}
|
|
|
|
if ( PL_get_nil_ex(tail) )
|
|
{ *o++ = CHAR_MAX; /* no more grouping */
|
|
end:
|
|
*o++ = '\0';
|
|
free(*valp);
|
|
if ( (*valp = strdup(s)) )
|
|
return TRUE;
|
|
return PL_no_memory();
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
/** locale_create(-Locale, +Default, +Options) is det.
|
|
*/
|
|
|
|
static
|
|
PRED_IMPL("locale_create", 3, locale_create, 0)
|
|
{ PRED_LD
|
|
PL_locale *def, *new;
|
|
char *lname;
|
|
|
|
if ( PL_get_chars(A2, &lname, CVT_LIST|CVT_STRING|REP_MB) )
|
|
{ const char *old;
|
|
|
|
LOCK();
|
|
if ( (old=setlocale(LC_NUMERIC, lname)) )
|
|
{ new = new_locale(NULL);
|
|
setlocale(LC_NUMERIC, old);
|
|
} else
|
|
{ assert(0); /* keep compiler happy */
|
|
return FALSE;
|
|
}
|
|
UNLOCK();
|
|
if ( !old )
|
|
{ if ( errno == ENOENT )
|
|
return PL_existence_error("locale", A2);
|
|
else
|
|
return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "setlocale");
|
|
}
|
|
} else
|
|
{ if ( !getLocaleEx(A2, &def) )
|
|
return FALSE;
|
|
new = new_locale(def);
|
|
releaseLocale(def);
|
|
}
|
|
|
|
if ( new )
|
|
{ atom_t alias = 0;
|
|
term_t tail = PL_copy_term_ref(A3);
|
|
term_t head = PL_new_term_ref();
|
|
term_t arg = PL_new_term_ref();
|
|
|
|
while(PL_get_list_ex(tail, head, tail))
|
|
{ atom_t pname;
|
|
int parity;
|
|
|
|
if ( !PL_get_name_arity(head, &pname, &parity) ||
|
|
parity != 1 ||
|
|
!PL_get_arg(1, head, arg) )
|
|
{ PL_type_error("locale_property", head);
|
|
goto error;
|
|
}
|
|
if ( pname == ATOM_alias )
|
|
{ if ( !PL_get_atom_ex(arg, &alias) )
|
|
goto error;
|
|
} else if ( pname == ATOM_decimal_point )
|
|
{ if ( !set_chars(arg, &new->decimal_point) )
|
|
goto error;
|
|
} else if ( pname == ATOM_thousands_sep )
|
|
{ if ( !set_chars(arg, &new->thousands_sep) )
|
|
goto error;
|
|
} else if ( pname == ATOM_grouping )
|
|
{ if ( !set_grouping(arg, &new->grouping) )
|
|
goto error;
|
|
}
|
|
}
|
|
if ( !PL_get_nil_ex(tail) )
|
|
{
|
|
error:
|
|
free_locale(new);
|
|
return FALSE;
|
|
}
|
|
|
|
if ( alias && !alias_locale(new, alias) )
|
|
goto error;
|
|
|
|
return unifyLocale(A1, new, TRUE);
|
|
} else
|
|
{ return PL_no_memory();
|
|
}
|
|
}
|
|
|
|
|
|
static
|
|
PRED_IMPL("locale_destroy", 1, locale_destroy, 0)
|
|
{ PL_locale *l;
|
|
|
|
if ( getLocaleEx(A1, &l) )
|
|
{ if ( l->alias )
|
|
{ Symbol s;
|
|
atom_t alias = l->alias;
|
|
|
|
LOCK();
|
|
if ( (s=lookupHTable(GD->locale.localeTable, (void*)alias)) )
|
|
deleteSymbolHTable(GD->locale.localeTable, s);
|
|
l->alias = 0;
|
|
PL_unregister_atom(alias);
|
|
UNLOCK();
|
|
}
|
|
|
|
releaseLocale(l);
|
|
return TRUE;
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
/** set_locale(+Locale) is det.
|
|
*/
|
|
|
|
static
|
|
PRED_IMPL("set_locale", 1, set_locale, 0)
|
|
{ PRED_LD
|
|
PL_locale *l;
|
|
|
|
if ( getLocaleEx(A1, &l) )
|
|
{ PL_locale *ol = LD->locale.current;
|
|
|
|
if ( l != ol )
|
|
{ IOSTREAM **sp;
|
|
|
|
LD->locale.current = l; /* already acquired */
|
|
if ( ol )
|
|
releaseLocale(ol);
|
|
|
|
if ( (sp=_PL_streams()) ) /* set locale of standard streams */
|
|
{ int i;
|
|
|
|
for(i=0; i<5; i++)
|
|
Ssetlocale(sp[i], l, NULL);
|
|
}
|
|
}
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
/** current_locale(-Locale) is det.
|
|
*/
|
|
|
|
static
|
|
PRED_IMPL("current_locale", 1, current_locale, 0)
|
|
{ PRED_LD
|
|
|
|
if ( LD->locale.current )
|
|
return unifyLocale(A1, LD->locale.current, TRUE);
|
|
|
|
return FALSE;
|
|
}
|
|
|
|
|
|
|
|
/*******************************
|
|
* C INTERFACE *
|
|
*******************************/
|
|
|
|
|
|
static void
|
|
initDefaultsStreamsLocale(PL_locale *l)
|
|
{ IOSTREAM *s = S__getiob();
|
|
int i;
|
|
|
|
for(i=0; i<2; i++, s++)
|
|
{ if ( !s->locale )
|
|
s->locale = acquireLocale(l);
|
|
}
|
|
}
|
|
|
|
|
|
void
|
|
initLocale(void)
|
|
{ GET_LD
|
|
PL_locale *def;
|
|
|
|
if ( !setlocale(LC_NUMERIC, "") )
|
|
{ DEBUG(0, Sdprintf("Failed to set LC_NUMERIC locale\n"));
|
|
}
|
|
|
|
if ( (def = new_locale(NULL)) )
|
|
{ alias_locale(def, ATOM_default);
|
|
def->references++;
|
|
GD->locale.default_locale = def;
|
|
LD->locale.current = acquireLocale(def);
|
|
|
|
initDefaultsStreamsLocale(def);
|
|
}
|
|
}
|
|
|
|
|
|
void
|
|
updateLocale(int category, const char *locale)
|
|
{ update_locale(GD->locale.default_locale, category, locale);
|
|
}
|
|
|
|
|
|
int
|
|
initStreamLocale(IOSTREAM *s)
|
|
{ GET_LD
|
|
PL_locale *l;
|
|
|
|
if ( LD ) /* a Prolog thread */
|
|
l = LD->locale.current;
|
|
else
|
|
l = GD->locale.default_locale;
|
|
|
|
if ( l )
|
|
s->locale = acquireLocale(l);
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
PL_locale *
|
|
acquireLocale(PL_locale *l)
|
|
{ LOCK();
|
|
l->references++;
|
|
UNLOCK();
|
|
|
|
return l;
|
|
}
|
|
|
|
|
|
void
|
|
releaseLocale(PL_locale *l)
|
|
{ LOCK();
|
|
if ( --l->references == 0 && l->symbol == 0 && l->alias == 0 )
|
|
free_locale(l);
|
|
UNLOCK();
|
|
}
|
|
|
|
|
|
|
|
|
|
/*******************************
|
|
* PUBLISH PREDICATES *
|
|
*******************************/
|
|
|
|
BeginPredDefs(locale)
|
|
PRED_DEF("locale_property", 2, locale_property, PL_FA_NONDETERMINISTIC)
|
|
PRED_DEF("locale_create", 3, locale_create, 0)
|
|
PRED_DEF("locale_destroy", 1, locale_destroy, 0)
|
|
PRED_DEF("set_locale", 1, set_locale, 0)
|
|
PRED_DEF("current_locale", 1, current_locale, 0)
|
|
EndPredDefs
|
|
|
|
#endif /*O_LOCALE*/
|