-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Thanks for the help!
Kind regards,
Stan.
Kevin Ryde a écrit :
> Stan Pinte <[EMAIL PROTECTED]> writes:
>> I am trying to make string encoding correction in guile...would
>> anyone have developed a binding for libiconv or librecode? Or any
>> other clever suggestion?
>
> My code below using iconv going to and from utf8. "chart_iconv()"
> is the guts. It's obscured a bit by coping when iconv isn't
> available. There's slackness in sizing the output buffer, I assume
> a char is no more than 4 or 6 bytes :). The utf8->locale routine
> tries to transliterate when there's no locale char for a given
> utf8, it's designed for human output.
>
> I didn't try to wrap an actual iconv_t, the only bits I was needing
> was to and from the locale charset, so an iconv_t for each
> direction can be kept open. The occasional arbitrary charset->utf8
> just does a new iconv_open every time. (On glibc that runs pretty
> fast.)
>
>
> ----------------------------------------------------------------------
>
>
> /* Chart miscellaneous C code.
>
> Copyright 2003, 2005, 2006 Kevin Ryde
>
> This file is part of Chart.
>
> Chart is free software; you can redistribute it and/or modify it
> under the terms of the GNU General Public License as published by
> the Free Software Foundation; either version 2, or (at your option)
> any later version.
>
> Chart 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
> General Public License for more details.
>
> You should have received a copy of the GNU General Public License
> along with Chart; see the file COPYING. If not, write to the
> Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
> 02110-1301 USA. */
>
> #include "config.h"
>
> #include <ctype.h> #include <errno.h> #include <locale.h> #include
> <string.h> #include <langinfo.h> #include <nl_types.h> #include
> <stdio.h> /* for NULL */
>
> #if HAVE_UNISTD_H #include <unistd.h> #endif
>
> #if HAVE_ICONV #include <iconv.h> #endif
>
> #if HAVE_MALLOC_H #include <malloc.h> #endif
>
> /* TIOCGWINSZ is in termios.h according to linux kernel man pages
> */ #if HAVE_TERMIOS_H #include <termios.h> #endif
>
> /* TIOCGWINSZ is in sys/ioctl.h on glibc 2.3.5 */ #if
> HAVE_SYS_IOCTL_H #include <sys/ioctl.h> #endif
>
> #include <libguile.h>
>
> #include "gettext.h" #include "misc.h"
>
>
> /*---------------------------------------------------------------------------*/
> /* fake iconv when not otherwise available */
>
> #if ! HAVE_ICONV
>
> struct chart_iconv_t_data { char *from; /* strdup'ed */ char *to;
> /* strdup'ed */ }; typedef struct chart_iconv_t_data *iconv_t;
>
> #define ICONV_CONST
>
> #ifndef EILSEQ /* system without iconv probably doesn't have
> EILSEQ */ #define EILSEQ 12345 #endif
>
> static iconv_t iconv_open (const char *tocode, const char
> *fromcode) { iconv_t cd = malloc (sizeof (struct
> chart_iconv_t_data)); if (cd == NULL) { nomem: errno = ENOMEM;
> return (iconv_t) -1; } cd->from = strdup (fromcode); if (cd->from
> == NULL) { free (cd); goto nomem; } cd->to = strdup (tocode); if
> (cd->to == NULL) { free (cd->from); free (cd); goto nomem; } return
> cd; }
>
> static int iconv_close (iconv_t cd) { free (cd->from); free
> (cd->to); free (cd); return 0; }
>
> /* return non-zero if PART is a suffix of STR */ static int
> strsuffix (const char *part, const char *str) { size_t plen =
> strlen (part); size_t slen = strlen (str); return (slen >= plen &&
> memcmp (str + slen - plen, part, plen) == 0); }
>
> static size_t iconv (iconv_t cd, char **inbuf, size_t *inleft, char
> **outbuf, size_t *outleft) { int c; int latin1, translit;
>
> if (inbuf == NULL) return 0;
>
> latin1 = (strcmp (cd->from, "ISO-8859-1") == 0); translit =
> strsuffix ("//TRANSLIT", cd->to);
>
> for (;;) { if (*inleft == 0) return 0;
>
> if (*outleft == 0) { errno = E2BIG; return (size_t) -1; }
>
> c = (int) (unsigned char) **inbuf;
>
> /* latin1 e-acute -> plain e, to support casablanca SOTA and SOTB
> names (that char is in an otherwise English page) */ if (latin1) {
> if (c == 0xE9) c = 'e'; }
>
> if (translit) { /* non-ASCII sequences translated to '?' no attempt
> is made to tell how many chars a non-ascii run is supposed to be,
> it just becomes a single '?' */ if (! isascii (c)) { while
> ((*inleft) > 1) { c = (int) (unsigned char) *((*inbuf)+1); /* next
> char */ if (isascii (c)) break; (*inbuf)++; (*inleft)--; } c = '?';
> } } else { /* non-ASCII provokes EILSEQ */ if (! isascii (c)) {
> errno = EILSEQ; return (size_t) -1; } }
>
> **outbuf = c;
>
> (*inbuf)++; (*inleft)--;
>
> (*outbuf)++; (*outleft)--; } }
>
> #endif /* ! HAVE_ICONV */
>
>
> /*---------------------------------------------------------------------------*/
> /* iconv stuff */
>
> /* return STR converted using CD if CLOSE_CD is non-zero then CD is
> closed when done (or error) FUNC is the originating function to
> report in an error */ static SCM chart_iconv (const char *func,
> iconv_t cd, SCM str, int close_cd) { ICONV_CONST char *in_str; char
> *in_buf, *out_buf, *out_ptr; size_t in_len, out_alloc, out_left;
> SCM out;
>
> if (! scm_is_string (str)) { if (close_cd) iconv_close (cd);
> scm_wrong_type_arg_msg(func, SCM_ARGn, str, "STRINGP"); }
>
> in_buf = scm_to_locale_stringn (str, &in_len); in_str = in_buf;
>
> out_alloc = 6 * in_len; out_buf = scm_malloc (out_alloc);
>
> out_ptr = out_buf; out_left = out_alloc; if (iconv (cd, &in_str,
> &in_len, &out_ptr, &out_left) == -1) { int err = errno; free
> (in_buf); free (out_buf); if (close_cd) iconv_close (cd); errno =
> err; scm_syserror (func); }
>
> out = scm_mem2string (out_buf, out_alloc - out_left); free
> (in_buf); free (out_buf);
>
> if (close_cd) { if (iconv_close (cd) != 0) scm_syserror (func); }
> return out; }
>
> /* open an iconv_t for charset conversion FROM to TO if cannot open
> then throw an error, reporting FUNC as the originator */ static
> iconv_t chart_iconv_open (const char *func, const char *to, const
> char *from) { iconv_t cd = iconv_open (to, from); if (cd ==
> (iconv_t) -1) scm_syserror (func); return cd; }
>
> SCM_DEFINE (chart_iconv_charset_available_p,
> "iconv-charset-available?", 1, 0, 0, (SCM charset), "Return
> @code{#t} if @var{charset} is known to @code{iconv}, or\n"
> "@code{#f} if not. The test is that @var{charset} can be\n"
> "converted to UTF-8.") #define FUNC_NAME
> s_chart_iconv_charset_available_p { char *c_charset =
> scm_to_locale_string (charset);
>
> #if HAVE_ICONV { iconv_t cd = iconv_open ("UTF-8", c_charset); free
> (c_charset); if (cd == (iconv_t) -1) return SCM_BOOL_F; if
> (iconv_close (cd) != 0) SCM_SYSERROR; return SCM_BOOL_T; }
>
> #else { int cmp = strcmp (c_charset, "ASCII"); free (c_charset); if
> (cmp == 0) return SCM_BOOL_T; else return SCM_BOOL_F; } #endif }
> #undef FUNC_NAME
>
>
> SCM_DEFINE (chart_locale_to_utf8, "locale->utf8", 1, 0, 0, (SCM
> str), "Return @var{str} converted from locale encoding to UTF-8.
> An\n" "error is thrown if @var{str} has invalid bytes.") #define
> FUNC_NAME s_chart_locale_to_utf8 { static iconv_t locale_to_utf8 =
> (iconv_t) -1; const char * codeset;
>
> codeset = nl_langinfo (CODESET); if (strcmp (codeset, "UTF-8") ==
> 0) return str; /* locale is already utf-8, no translation */
>
> if (locale_to_utf8 == (iconv_t) -1) locale_to_utf8 =
> chart_iconv_open (FUNC_NAME, "UTF-8", nl_langinfo (CODESET)); else
> iconv (locale_to_utf8, NULL, NULL, NULL, NULL);
>
> return chart_iconv (FUNC_NAME, locale_to_utf8, str, 0); } #undef
> FUNC_NAME
>
> SCM_DEFINE (chart_charset_to_utf8, "charset->utf8", 2, 0, 0, (SCM
> charset, SCM str), "Return @var{str} converted from the given
> @var{charset} to\n" "UTF-8. @var{charset} is a string, the name of
> a charset. An\n" "error is thrown if @var{str} has invalid
> bytes.") #define FUNC_NAME s_chart_charset_to_utf8 { iconv_t cd;
> char *c_charset = scm_to_locale_string (charset);
>
> if (strcmp (c_charset, "UTF-8") == 0) { free (c_charset); return
> str; /* no conversion */ }
>
> cd = iconv_open ("UTF-8", c_charset); FREE_KEEP_ERRNO (c_charset);
> if (cd == (iconv_t) -1) SCM_SYSERROR;
>
> return chart_iconv (FUNC_NAME, cd, str, 1); } #undef FUNC_NAME
>
>
> static char * scm_strcatdup (const char *s, const char *t) { char
> *r = scm_malloc (strlen (s) + strlen (t) + 1); strcpy (r, s);
> return strcat (r, t); }
>
> SCM_DEFINE (chart_utf8_to_locale, "utf8->locale", 1, 0, 0, (SCM
> str), "Return @var{str} converted from UTF-8 into the locale
> encoding.\n" "\n" "Characters which don't exist in the locale
> charset are\n" "transliterated by @code{iconv} where possible, or
> are changed\n" "to question marks \"?\" otherwise.") #define
> FUNC_NAME s_chart_utf8_to_locale { static iconv_t utf8_to_locale =
> (iconv_t) -1; static iconv_t utf8_to_wchar = (iconv_t) -1;
>
> ICONV_CONST char *in_str; char *in_buf, *out_buf, *out_ptr;
> size_t in_len, out_alloc, out_left; SCM out; const char
> *codeset;
>
> codeset = nl_langinfo (CODESET); if (strcmp (codeset, "UTF-8") ==
> 0) return str; /* locale is already utf-8, no translation */
>
> if (utf8_to_locale == (iconv_t) -1) { const char *codeset =
> nl_langinfo (CODESET); char *locale_translit = scm_strcatdup
> (codeset, "//TRANSLIT"); utf8_to_locale = iconv_open
> (locale_translit, "UTF-8"); free (locale_translit);
>
> if (utf8_to_locale == (iconv_t) -1) utf8_to_locale =
> chart_iconv_open (FUNC_NAME, codeset, "UTF-8"); } else iconv
> (utf8_to_locale, NULL, NULL, NULL, NULL);
>
> in_buf = scm_to_locale_stringn (str, &in_len); in_str = in_buf;
>
> out_alloc = 4 * in_len; out_buf = scm_malloc (out_alloc);
>
> out_ptr = out_buf; out_left = out_alloc;
>
> if (iconv (utf8_to_locale, &in_str, &in_len, &out_ptr, &out_left)
> == -1) { if (errno != EILSEQ) { int old_errno; syserror: old_errno
> = errno; free (in_buf); free (out_buf); errno = old_errno;
> SCM_SYSERROR; }
>
> /* EILSEQ, input char unrepresentable in locale, show "?" */
>
> /* create or reset wchart converter */ if (utf8_to_wchar ==
> (iconv_t) -1) { utf8_to_wchar = iconv_open ("WCHAR_T", "UTF-8"); if
> (utf8_to_wchar == (iconv_t) -1) SCM_SYSERROR; } else iconv
> (utf8_to_wchar, NULL, NULL, NULL, NULL);
>
> for (;;) { wchar_t buf; char *bufptr = (char *) &buf; size_t buflen
> = sizeof(buf); size_t old_in_len = in_len;
>
> /* success if this is the last char of the input string E2BIG if
> there's more input
>
> check in_len has decreased before allowing E2BIG, must have
> converted something or we go into an infinite loop */
>
> if (iconv (utf8_to_wchar, &in_str, &in_len, &bufptr, &buflen) == -1
> && (errno != E2BIG || in_len == old_in_len)) goto syserror;
>
> *out_ptr++ = '?'; out_left--;
>
> /* convert rest of input, looping around for "_" on EILSEQ char */
> if (iconv (utf8_to_locale, &in_str, &in_len, &out_ptr, &out_left)
> != -1) break; if (errno != EILSEQ) goto syserror; } }
>
> out = scm_mem2string (out_buf, out_alloc - out_left); free
> (in_buf); free (out_buf); return out; } #undef FUNC_NAME
>
>
> SCM_DEFINE (chart_utf8_validate, "utf8-validate", 1, 0, 0, (SCM
> str), "Check that @var{str} is a valid UTF-8 encoded string. Throw
> an\n" "error if it's not.\n" "\n" "If @code{iconv} is not
> available, this function does nothing.") #define FUNC_NAME
> s_chart_utf8_validate { #if HAVE_ICONV static iconv_t utf8_to_utf8
> = (iconv_t) -1;
>
> ICONV_CONST char *in_str; char *in_buf, *out_buf, *out_ptr; size_t
> in_len, out_alloc, out_left; int ret, old_errno;
>
> if (utf8_to_utf8 == (iconv_t) -1) { utf8_to_utf8 = iconv_open
> ("UTF-8", "UTF-8"); if (utf8_to_utf8 == (iconv_t) -1) SCM_SYSERROR;
> } else iconv (utf8_to_utf8, NULL, NULL, NULL, NULL);
>
> in_buf = scm_to_locale_stringn (str, &in_len); in_str = in_buf;
>
> out_alloc = in_len; out_buf = scm_malloc (out_alloc);
>
> out_ptr = out_buf; out_left = out_alloc;
>
> ret = iconv (utf8_to_utf8, &in_str, &in_len, &out_ptr, &out_left);
>
> old_errno = errno; free (in_buf); free (out_buf); errno =
> old_errno;
>
> if (ret == -1) SCM_SYSERROR; #else
>
> SCM_VALIDATE_STRING (SCM_ARG1, str); #endif
>
> return SCM_UNSPECIFIED; } #undef FUNC_NAME
>
>
>
> /*---------------------------------------------------------------------------*/
> /* locale info */
>
> SCM_DEFINE (chart_mb_cur_max, "mb-cur-max", 0, 0, 0, (), "Return
> @code{MB_CUR_MAX}, the maximum number of bytes to encode\n" "a
> character in the current locale charset.") #define FUNC_NAME
> s_chart_locale_codeset { return scm_from_int (MB_CUR_MAX); } #undef
> FUNC_NAME
>
> SCM_DEFINE (chart_locale_codeset, "locale-codeset", 0, 0, 0, (),
> "Return the locale charset name (a string).") #define FUNC_NAME
> s_chart_locale_codeset { return scm_from_locale_string (nl_langinfo
> (CODESET)); } #undef FUNC_NAME
>
> SCM_DEFINE (chart_locale_d_fmt, "locale-d-fmt", 0, 0, 0, (),
> "Return the locale date format as a utf8 @code{strftime} format.")
> #define FUNC_NAME s_chart_locale_d_fmt { char *str = nl_langinfo
> (D_FMT);
>
> /* an empty string is not acceptable */ if (str[0] == '\0') str =
> "%x";
>
> return chart_locale_to_utf8 (scm_from_locale_string (str)); }
> #undef FUNC_NAME
>
> SCM_DEFINE (chart_locale_decimal_point, "locale-decimal-point", 0,
> 0, 0, (), "Return the locale decimal point as a utf8 string.")
> #define FUNC_NAME s_chart_locale_decimal_point { char *str =
> localeconv()->decimal_point;
>
> /* an empty string is not acceptable */ if (str[0] == '\0') str =
> ".";
>
> return chart_locale_to_utf8 (scm_from_locale_string (str)); }
> #undef FUNC_NAME
>
> SCM_DEFINE (chart_locale_thousands_sep, "locale-thousands-sep", 0,
> 0, 0, (), "Return the locale thousands separator as a utf8 string.
> This\n" "is an empty string when no thousands separator should be
> shown.") #define FUNC_NAME s_chart_locale_thousands_sep { return
> chart_locale_to_utf8 (scm_from_locale_string
> (localeconv()->thousands_sep)); } #undef FUNC_NAME
>
>
> /*---------------------------------------------------------------------------*/
> /* gettext made available in guile 1.6 */
>
> #if ! HAVE_SCM_GETTEXT
>
> SCM_DEFINE (chart_gettext, "gettext", 1, 0, 0, (SCM str), "Return
> the translation of @var{str}.") #define FUNC_NAME s_chart_gettext {
> SCM_VALIDATE_STRING (SCM_ARG1, str); return scm_from_locale_string
> (gettext (SCM_STRING_CHARS (str))); } #undef FUNC_NAME
>
> SCM_DEFINE (chart_ngettext, "ngettext", 3, 0, 0, (SCM msg, SCM
> plural, SCM n), "Return the translation of @var{msg}/@var{plural}
> according to\n" "the integer @var{n}.") #define FUNC_NAME
> s_chart_ngettext { long nn; SCM_VALIDATE_STRING (SCM_ARG1, msg);
> SCM_VALIDATE_STRING (SCM_ARG2, plural); SCM_VALIDATE_INUM_COPY
> (SCM_ARG3, n, nn); return scm_from_locale_string (ngettext
> (SCM_STRING_CHARS (msg), SCM_STRING_CHARS (plural), nn)); } #undef
> FUNC_NAME
>
>
> SCM_DEFINE (chart_bindtextdomain, "bindtextdomain", 1, 1, 0, (SCM
> domain, SCM dir), "With just a @var{domain} argument, return the
> current directory\n" "searched for translations in that domain.\n"
> "\n" "With a @var{dir} argument, set the directory to search for\n"
> "translations in @var{domain}.") #define FUNC_NAME
> s_chart_bindtextdomain { const char *t; SCM_VALIDATE_STRING
> (SCM_ARG1, domain);
>
> if (SCM_UNBNDP (dir)) { t = bindtextdomain (SCM_STRING_CHARS
> (domain), NULL); return (t == NULL ? SCM_BOOL_F :
> scm_from_locale_string (t)); } else { SCM_VALIDATE_STRING
> (SCM_ARG2, dir); t = bindtextdomain (SCM_STRING_CHARS (domain),
> SCM_STRING_CHARS (dir)); if (t == NULL) SCM_SYSERROR; return
> scm_from_locale_string (t); } } #undef FUNC_NAME
>
> SCM_DEFINE (chart_bind_textdomain_codeset,
> "bind-textdomain-codeset", 1, 1, 0, (SCM domain, SCM codeset),
> "With just a @var{domain} argument, return the currrent codeset\n"
> "used for translations in that domain.\n" "\n" "With a
> @var{codeset} argument, set the codeset to use for\n" "translations
> in @var{domain}.") #define FUNC_NAME
> s_chart_bind_textdomain_codeset { const char *t;
> SCM_VALIDATE_STRING (SCM_ARG1, domain);
>
> if (SCM_UNBNDP (codeset)) { t = bind_textdomain_codeset
> (SCM_STRING_CHARS (domain), NULL); return (t == NULL ? SCM_BOOL_F :
> scm_from_locale_string (t)); } else { SCM_VALIDATE_STRING
> (SCM_ARG2, codeset); t = bind_textdomain_codeset (SCM_STRING_CHARS
> (domain), SCM_STRING_CHARS (codeset)); if (t == NULL) SCM_SYSERROR;
> return scm_from_locale_string (t); } } #undef FUNC_NAME
>
> SCM_DEFINE (chart_textdomain, "textdomain", 0, 1, 0, (SCM domain),
> "With no arguments, return the current default translation\n"
> "domain.\n" "\n" "With an argument, set the default translation
> domain to the\n" "string @var{domain}.") #define FUNC_NAME
> s_chart_textdomain { const char *t;
>
> if (SCM_UNBNDP (domain)) { t = textdomain (NULL); return (t == NULL
> ? SCM_BOOL_F : scm_from_locale_string (t)); } else {
> SCM_VALIDATE_STRING (SCM_ARG1, domain); t = textdomain
> (SCM_STRING_CHARS (domain)); if (t == NULL) SCM_SYSERROR; return
> scm_from_locale_string (t); } } #undef FUNC_NAME
>
> #endif /* HAVE_SCM_GETTEXT */
>
>
> /*---------------------------------------------------------------------------*/
>
>
> SCM_DEFINE (chart_output_port_width, "output-port-width", 0, 1, 0,
> (SCM port), "Return the number of columns of output available on
> @var{port},\n" "or 79 if it cannot be determined. @var{port}
> defaults to\n" "@code{current-output-port}.\n" "\n" "The width of a
> tty is obtained from @code{TIOCGWINSZ}, if that\n" "@code{ioctl} is
> available. For other ports only the default 79\n" "is returned.\n"
> "\n" "This function is slib compatible.") #define FUNC_NAME
> s_chart_output_port_width { if (SCM_UNBNDP (port)) port =
> scm_current_output_port ();
>
> SCM_VALIDATE_PORT (SCM_ARG1, port);
>
> /* A pseudo-tty under emacs has ws_col==0, give the default 79 in
> that case. */ #ifdef TIOCGWINSZ if (scm_is_true (scm_file_port_p
> (port))) { struct winsize w; if (ioctl (scm_to_int (scm_fileno
> (port)), TIOCGWINSZ, &w) == 0 && w.ws_col != 0) return scm_from_int
> (w.ws_col); } #endif
>
> return scm_from_int (79); } #undef FUNC_NAME
>
>
> #if ! HAVE_SCM_PRIMITIVE__EXIT SCM_DEFINE (chart_primitive__exit,
> "primitive-_exit", 1, 0, 0, (SCM status), "") #define FUNC_NAME
> s_chart_primitive__exit { _exit (SCM_UNBNDP (status) ? 0 :
> scm_to_int (status)); } #undef FUNC_NAME #endif
>
>
> SCM_DEFINE (chart_mallinfo_uordblks, "mallinfo-uordblks", 0, 0, 0,
> (), "") #define FUNC_NAME s_chart_output_port_width { #if
> HAVE_MALLINFO return scm_from_int (mallinfo().uordblks); #else
> return scm_from_int (0); #endif } #undef FUNC_NAME
>
>
> /*---------------------------------------------------------------------------*/
>
>
> void chart_misc_init (void) { #ifndef SCM_MAGIC_SNARFER #include
> "misc.x" #endif }
>
> ----------------------------------------------------------------------
>
>
> /* Chart miscellaneous C code headers.
>
> Copyright 2005, 2006 Kevin Ryde
>
> This file is part of Chart.
>
> Chart is free software; you can redistribute it and/or modify it
> under the terms of the GNU General Public License as published by
> the Free Software Foundation; either version 2, or (at your option)
> any later version.
>
> Chart 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
> General Public License for more details.
>
> You should have received a copy of the GNU General Public License
> along with Chart; see the file COPYING. If not, write to the
> Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
> 02110-1301 USA. */
>
>
> /*---------------------------------------------------------------------------*/
> /* guile 1.8 C stuff make available in guile 1.6 */
>
> #if SCM_MAJOR_VERSION == 1 && SCM_MINOR_VERSION == 6
>
> #define scm_is_false(obj) SCM_FALSEP (obj) #define
> scm_is_true(obj) SCM_NFALSEP (obj)
>
> #define scm_to_int(scm) scm_num2int (scm, SCM_ARGn, "chart C
> code") #define scm_to_uint(scm) scm_num2uint (scm, SCM_ARGn,
> "chart C code") #define scm_from_int(n) scm_int2num (n)
>
> /* as supported by scm_to_locale_stringn() below */ #define
> scm_is_string(obj) (SCM_STRINGP (obj) || SCM_SUBSTRP (obj))
>
> #define scm_from_locale_string(str) scm_makfrom0str(str)
>
>
> /* This code is inculded in both misc.c and zlib.c. It's
> duplicated in the two modules because according to libtool having
> one module call functions in another isn't portable. */
>
> static void * scm_malloc (size_t size) { char *p = scm_must_malloc
> (size, "chart"); scm_done_free (size); return p; }
>
> static char * scm_to_locale_stringn (SCM str, size_t *lenp) #define
> FUNC_NAME "scm_to_locale_stringn" { const char *c_str; size_t
> c_len; char *ret;
>
> /* ordinary strings and shared substrings */ SCM_ASSERT_TYPE
> (scm_is_string (str), str, SCM_ARG1, "scm_to_locale_stringn",
> "string"); c_str = SCM_ROCHARS (str); c_len = SCM_STRING_LENGTH
> (str);
>
> if (lenp == NULL) { if (memchr (c_str, '\0', c_len)) scm_misc_error
> (FUNC_NAME, "string contains #\\nul character: ~S", scm_list_1
> (str)); } else *lenp = c_len;
>
> ret = scm_malloc (c_len + 1); memcpy (ret, c_str, c_len);
> scm_remember_upto_here_1 (str); ret[c_len] = '\0'; return ret; }
> #undef FUNC_NAME
>
> static char * scm_to_locale_string (SCM obj) { return
> scm_to_locale_stringn (obj, NULL); }
>
> #endif
>
>
> /*---------------------------------------------------------------------------*/
> /* misc helpers */
>
> #define FREE_KEEP_ERRNO(ptr) \ do { \
> int __old_errno = errno; \ free (ptr); \ errno =
> __old_errno; \ } while (0)
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.5 (Cygwin)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org
iD8DBQFFhaOX/PmuubxPWAIRAvroAJ4xaR5Ix21fYaQCV0KT7MuF13UxkwCfQWdr
okMJTGIaQJp9vPFcAo3bvRk=
=ibCB
-----END PGP SIGNATURE-----
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user
