diff options
Diffstat (limited to 'libguile/mbstrings.c')
-rw-r--r-- | libguile/mbstrings.c | 568 |
1 files changed, 568 insertions, 0 deletions
diff --git a/libguile/mbstrings.c b/libguile/mbstrings.c new file mode 100644 index 000000000..4d8bb1834 --- /dev/null +++ b/libguile/mbstrings.c @@ -0,0 +1,568 @@ + + +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program 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. + * + * This program 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 this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + + +#include "extchrs.h" +#include <stdio.h> +#include "_scm.h" + + + +SCM_PROC(s_multi_byte_string_p, "multi-byte-string?", 1, 0, 0, scm_multi_byte_string_p); +#ifdef __STDC__ +SCM +scm_multi_byte_string_p (SCM obj) +#else +SCM +scm_multi_byte_string_p (obj) + SCM obj; +#endif +{ + return (SCM_MB_STRINGP (obj) + ? SCM_BOOL_T + : SCM_BOOL_F); +} + + +#ifdef __STDC__ +SCM +scm_regular_string_p (SCM obj) +#else +SCM +scm_regular_string_p (obj) + SCM obj; +#endif +{ + return (SCM_REGULAR_STRINGP (obj) + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +SCM_PROC(s_list_to_multi_byte_string, "list->multi-byte-string", 1, 0, 0, scm_multi_byte_string); +SCM_PROC(s_multi_byte_string, "multi-byte-string", 0, 0, 1, scm_multi_byte_string); +#ifdef __STDC__ +SCM +scm_multi_byte_string (SCM chrs) +#else +SCM +scm_multi_byte_string (chrs) + SCM chrs; +#endif +{ + SCM res; + register char *data; + long i; + long byte_len; + + i = scm_ilength (chrs); + SCM_ASSERT (i >= 0, chrs, SCM_ARG1, s_multi_byte_string); + i = i * XMB_CUR_MAX; + res = scm_makstr (i, 0); + SCM_SETLENGTH (res, SCM_LENGTH (res), scm_tc7_mb_string); + data = SCM_CHARS (res); + byte_len = 0; + xwctomb (0, 0); + while (i && SCM_NNULLP (chrs)) + { + int used; + SCM ch; + + ch = SCM_CAR (chrs); + SCM_ASSERT (SCM_ICHRP (ch), chrs, SCM_ARG1, s_multi_byte_string); + used = xwctomb (data + byte_len, SCM_ICHR (ch)); + SCM_ASSERT (used >= 0, chrs, SCM_ARG1, s_multi_byte_string); + byte_len += (used ? used : 1); + chrs = SCM_CDR (chrs); + --i; + } + res = scm_vector_set_length_x (res, SCM_MAKINUM (byte_len)); + return res; +} + +#ifdef __STDC__ +int +scm_mb_ilength (unsigned char * data, int size) +#else +int +scm_mb_ilength (data, size) + unsigned char * data; + int size; +#endif +{ + int pos; + int len; + + len = 0; + pos = 0; + xmblen (0, 0); + while (pos < size) + { + int inc; + + inc = xmblen (data + pos, size - pos); + if (inc == 0) + ++inc; + + if (inc < 0) + return -1; + + ++len; + pos += inc; + } + + return len; +} + +SCM_PROC(s_multi_byte_string_length, "multi-byte-string-length", 1, 0, 0, scm_multi_byte_string_length); +#ifdef __STDC__ +SCM +scm_multi_byte_string_length (SCM str) +#else +SCM +scm_multi_byte_string_length (str) + SCM str; +#endif +{ + int size; + int len; + unsigned char * data; + + SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_multi_byte_string_length); + + data = SCM_ROCHARS (str); + size = SCM_ROLENGTH (str); + len = scm_mb_ilength (data, size); + SCM_ASSERT (len >= 0, str, SCM_ARG1, s_multi_byte_string_length); + return SCM_MAKINUM (len); +} + + +SCM_PROC(s_symbol_multi_byte_p, "symbol-multi-byte?", 1, 0, 0, scm_symbol_multi_byte_p); +#ifdef __STDC__ +SCM +scm_symbol_multi_byte_p (SCM symbol) +#else +SCM +scm_symbol_multi_byte_p (symbol) + SCM symbol; +#endif +{ + return SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol); +} + +SCM_PROC(s_set_symbol_multi_byte_x, "set-symbol-multi-byte!", 2, 0, 0, scm_set_symbol_multi_byte_x); +#ifdef __STDC__ +SCM +scm_set_symbol_multi_byte_x (SCM symbol, SCM val) +#else +SCM +scm_set_symbol_multi_byte_x (symbol, val) + SCM symbol; + SCM val; +#endif +{ + if (SCM_TYP7 (symbol) == scm_tc7_msymbol) + { + SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol) = (SCM_FALSEP (val) + ? SCM_BOOL_F + : SCM_BOOL_T); + } + return SCM_UNSPECIFIED; +} + + +SCM_PROC(s_regular_port_p, "regular-port?", 1, 0, 0, scm_regular_port_p); +#ifdef __STDC__ +SCM +scm_regular_port_p (SCM p) +#else +SCM +scm_regular_port_p (p) + SCM p; +#endif +{ + return (SCM_PORT_REPRESENTATION(p) == scm_regular_port + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +SCM_PROC(s_regular_port_x, "regular-port!", 1, 0, 0, scm_regular_port_x); +#ifdef __STDC__ +SCM +scm_regular_port_x (SCM p) +#else +SCM +scm_regular_port_x (p) + SCM p; +#endif +{ + SCM_PORT_REPRESENTATION(p) = scm_regular_port; + return SCM_UNSPECIFIED; +} + +SCM_PROC(s_multi_byte_port_p, "multi-byte-port?", 1, 0, 0, scm_multi_byte_port_p); +#ifdef __STDC__ +SCM +scm_multi_byte_port_p (SCM p) +#else +SCM +scm_multi_byte_port_p (p) + SCM p; +#endif +{ + return (SCM_PORT_REPRESENTATION(p) == scm_mb_port + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +SCM_PROC(s_multi_byte_port_x, "multi-byte-port!", 1, 0, 0, scm_multi_byte_port_x); +#ifdef __STDC__ +SCM +scm_multi_byte_port_x (SCM p) +#else +SCM +scm_multi_byte_port_x (p) + SCM p; +#endif +{ + SCM_PORT_REPRESENTATION(p) = scm_mb_port; + return SCM_UNSPECIFIED; +} + + +SCM_PROC(s_wide_character_port_p, "wide-character-port?", 1, 0, 0, scm_wide_character_port_p); +#ifdef __STDC__ +SCM +scm_wide_character_port_p (SCM p) +#else +SCM +scm_wide_character_port_p (p) + SCM p; +#endif +{ + return (SCM_PORT_REPRESENTATION(p) == scm_wchar_port + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +SCM_PROC(s_wide_character_port_x, "wide-character-port!", 1, 0, 0, scm_wide_character_port_x); +#ifdef __STDC__ +SCM +scm_wide_character_port_x (SCM p) +#else +SCM +scm_wide_character_port_x (p) + SCM p; +#endif +{ + SCM_PORT_REPRESENTATION(p) = scm_wchar_port; + return SCM_UNSPECIFIED; +} + + + + + +#ifdef __STDC__ +void +scm_put_wchar (int c, SCM port, int writing) +#else +void +scm_put_wchar (c, port, writing) + int c; + SCM port; + int writing; +#endif +{ + if (writing) + scm_gen_puts (scm_regular_string, "#\\", port); + switch (SCM_PORT_REPRESENTATION (port)) + { + case scm_regular_port: + { + if (c < 256) + { + if (!writing) + scm_gen_putc ((unsigned char)c, port); + else if ((c <= ' ') && scm_charnames[c]) + scm_gen_puts (scm_regular_string, scm_charnames[c], port); + else if (c > '\177') + scm_intprint (c, 8, port); + else + scm_gen_putc ((int) c, port); + } + else + { + print_octal: + if (!writing) + scm_gen_putc ('\\', port); + scm_intprint (c, 8, port); + } + break; + } + + case scm_mb_port: + { + char buf[256]; + int len; + + if (XMB_CUR_MAX > sizeof (buf)) + goto print_octal; + + len = xwctomb (buf, c); + + if (len < 0) + goto print_octal; + + if (len == 0) + scm_gen_putc (0, port); + else + scm_gen_putc (c, port); + break; + } + + case scm_wchar_port: + { + scm_gen_putc (c, port); + break; + } + } +} + + + + + +#ifdef __STDC__ +void +scm_print_mb_string (SCM exp, SCM port, int writing) +#else +void +scm_print_mb_string (exp, port, writing) + SCM exp; + SCM port; + int writing; +#endif +{ + if (writing) + { + int i; + int len; + char * data; + + scm_gen_putc ('\"', port); + i = 0; + len = SCM_ROLENGTH (exp); + data = SCM_ROCHARS (exp); + + while (i < len) + { + xwchar_t c; + int inc; + + inc = xmbtowc (&c, data + i, len - i); + if (inc == 0) + inc = 1; + if (inc < 0) + { + inc = 1; + c = data[i]; + } + i += inc; + switch (c) + { + case '\"': + case '\\': + scm_gen_putc ('\\', port); + default: + scm_gen_putc (c, port); + } + } + scm_gen_putc ('\"', port); + } + else + scm_gen_write (scm_mb_string, SCM_ROCHARS (exp), SCM_ROLENGTH (exp), port); +} + + +#ifdef __STDC__ +void +scm_print_mb_symbol (SCM exp, SCM port) +#else +void +scm_print_mb_symbol (exp, port) + SCM exp; + SCM port; +#endif +{ + int pos; + int end; + int len; + char * str; + int weird; + int maybe_weird; + int mw_pos; + int inc; + xwchar_t c; + + len = SCM_LENGTH (exp); + str = SCM_CHARS (exp); + scm_remember (&exp); + pos = 0; + weird = 0; + maybe_weird = 0; + + for (end = pos; end < len; end += inc) + { + inc = xmbtowc (&c, str + end, len - end); + if (inc < 0) + { + inc = 1; + c = str[end]; + goto weird_handler; + } + if (inc == 0) + { + inc = 1; + goto weird_handler; + } + switch (c) + { +#ifdef BRACKETS_AS_PARENS + case '[': + case ']': +#endif + case '(': + case ')': + case '\"': + case ';': + case SCM_WHITE_SPACES: + case SCM_LINE_INCREMENTORS: + weird_handler: + if (maybe_weird) + { + end = mw_pos; + maybe_weird = 0; + } + if (!weird) + { + scm_gen_write (scm_regular_string, "#{", 2, port); + weird = 1; + } + if (pos < end) + { + int q; + int qinc; + + q = pos; + while (q < end) + { + qinc = xmbtowc (&c, str + q, end - q); + if (inc <= 0) + { + inc = 1; + c = str[q]; + } + scm_gen_putc (c, port); + q += qinc; + } + } + { + char buf[2]; + buf[0] = '\\'; + buf[1] = str[end]; + scm_gen_write (scm_regular_string, buf, 2, port); + } + pos = end + 1; + break; + case '\\': + if (weird) + goto weird_handler; + if (!maybe_weird) + { + maybe_weird = 1; + mw_pos = pos; + } + break; + case '}': + case '#': + if (weird) + goto weird_handler; + break; + default: + break; + } + } + if (pos < end) + { + int q; + int qinc; + q = pos; + while (q < end) + { + qinc = xmbtowc (&c, str + q, end - q); + if (inc <= 0) + inc = 1; + scm_gen_putc (c, port); + q += qinc; + } + } + if (weird) + scm_gen_write (scm_regular_string, "}#", 2, port); +} + + + + +#ifdef __STDC__ +void +scm_init_mbstrings (void) +#else +void +scm_init_mbstrings () +#endif +{ +#include "mbstrings.x" +} + |