Anyone having guile binding for libiconv or librecode?

Anyone having guile binding for libiconv or librecode?

[Stan Pinte]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1


Hello,

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?

Kind regards,

Stan.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.5 (Cygwin)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iD8DBQFFgsQO/PmuubxPWAIRAmTmAKCLMGkbaPBnWeehE+4ENsv0ZjRgiACfQwMP
Sq5WJ5+ttbixv3fn4QXPYyY=
=uUC9
-----END PGP SIGNATURE-----



_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user

Re: Anyone having guile binding for libiconv or librecode?

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 835 bytes --]

Stan Pinte <stan@sauvages.be> 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.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: misc.c --]
[-- Type: text/x-csrc, Size: 19500 bytes --]

/* 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
}

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: misc.h --]
[-- Type: text/x-chdr, Size: 2901 bytes --]

/* 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)

[-- Attachment #4: Type: text/plain, Size: 140 bytes --]

_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user

Re: Anyone having guile binding for libiconv or librecode?

[Stan Pinte]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Thanks for the help!

Kind regards,

Stan.

Kevin Ryde a écrit :
> Stan Pinte <stan@sauvages.be> 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

Re: Anyone having guile binding for libiconv or librecode?

[Ludovic Courtès]

Hi,

Stan Pinte <stan@sauvages.be> 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?

I just noticed that Marco Maggi's GEE contains bindings for libiconv:

  https://gna.org/projects/gee

I don't know how it compares to Kevin's.

Thanks,
Ludovic.


_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user

Re: Anyone having guile binding for libiconv or librecode?

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
>   https://gna.org/projects/gee
>
> I don't know how it compares to Kevin's.

Integrated into an encode/decode framework, just from nosing around.

Incidentally, when I compared libiconv and librecode I thought recode
had the odd extra charset and maybe some groovier transliterations, so
it's certainly an option.


_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user