mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

Merge branch 'master' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	lib/Makefile.am
	libguile/Makefile.am
	libguile/frames.c
	libguile/gc-card.c
	libguile/gc-freelist.c
	libguile/gc-mark.c
	libguile/gc-segment.c
	libguile/gc_os_dep.c
	libguile/load.c
	libguile/macros.c
	libguile/objcodes.c
	libguile/programs.c
	libguile/strings.c
	libguile/vm.c
	m4/gnulib-cache.m4
	m4/gnulib-comp.m4
	m4/inline.m4
This commit is contained in:
Ludovic Courtès 2009-08-17 23:39:56 +02:00
commit fbb857a472
823 changed files with 61674 additions and 14111 deletions
Download patch file Download diff file Expand all files Collapse all files

206
libguile/print.c
View file

@ -1,18 +1,19 @@
/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* 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.
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 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
* 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
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
@ -22,6 +23,8 @@
#endif
#include <errno.h>
#include <uniconv.h>
#include <unictype.h>
#include "libguile/_scm.h"
#include "libguile/chars.h"
@ -435,21 +438,33 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc3_imm24:
if (SCM_CHARP (exp))
{
long i = SCM_CHAR (exp);
scm_t_wchar i = SCM_CHAR (exp);
const char *name;
if (SCM_WRITINGP (pstate))
{
scm_puts ("#\\", port);
if ((i >= 0) && (i <= ' ') && scm_charnames[i])
scm_puts (scm_charnames[i], port);
#ifndef EBCDIC
else if (i == '\177')
scm_puts (scm_charnames[scm_n_charnames - 1], port);
#endif
else if (i < 0 || i > '\177')
scm_intprint (i, 8, port);
else
scm_putc (i, port);
name = scm_i_charname (exp);
if (name != NULL)
scm_puts (name, port);
else if (uc_is_general_category_withtable (i, UC_CATEGORY_MASK_L
| UC_CATEGORY_MASK_M
| UC_CATEGORY_MASK_N
| UC_CATEGORY_MASK_P
| UC_CATEGORY_MASK_S))
/* Print the character if is graphic character. */
{
if (i<256)
/* Character is graphic. Print it. */
scm_putc (i, port);
else
/* Character is graphic but unrepresentable in
this port's encoding. */
scm_intprint (i, 8, port);
}
else
/* Character is a non-graphical character. */
scm_intprint (i, 8, port);
}
else
scm_putc (i, port);
@ -545,55 +560,113 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break;
}
break;
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
size_t i, j, len;
const char *data;
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
size_t i, j, len;
static char const hex[] = "0123456789abcdef";
char buf[8];
scm_putc ('"', port);
len = scm_i_string_length (exp);
data = scm_i_string_chars (exp);
for (i = 0, j = 0; i < len; ++i)
{
unsigned char ch = data[i];
if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
{
static char const hex[]="0123456789abcdef";
char buf[4];
scm_lfwrite (data+j, i-j, port);
buf[0] = '\\';
buf[1] = 'x';
buf[2] = hex [ch / 16];
buf[3] = hex [ch % 16];
scm_lfwrite (buf, 4, port);
data = scm_i_string_chars (exp);
j = i+1;
}
else if (ch == '"' || ch == '\\')
{
scm_lfwrite (data+j, i-j, port);
scm_putc ('\\', port);
data = scm_i_string_chars (exp);
j = i;
}
}
scm_lfwrite (data+j, i-j, port);
scm_putc ('"', port);
scm_remember_upto_here_1 (exp);
}
else
scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
port);
scm_remember_upto_here_1 (exp);
break;
scm_putc ('"', port);
len = scm_i_string_length (exp);
for (i = 0; i < len; ++i)
{
scm_t_wchar ch = scm_i_string_ref (exp, i);
int printed = 0;
if (ch == ' ' || ch == '\n')
{
scm_putc (ch, port);
printed = 1;
}
else if (ch == '"' || ch == '\\')
{
scm_putc ('\\', port);
scm_i_charprint (ch, port);
printed = 1;
}
else
if (uc_is_general_category_withtable
(ch,
UC_CATEGORY_MASK_L | UC_CATEGORY_MASK_M |
UC_CATEGORY_MASK_N | UC_CATEGORY_MASK_P |
UC_CATEGORY_MASK_S))
{
/* Print the character since it is a graphic
character. */
scm_t_wchar *wbuf;
SCM wstr = scm_i_make_wide_string (1, &wbuf);
char *buf;
size_t len;
wbuf[0] = ch;
buf = u32_conv_to_encoding ("ISO-8859-1",
iconveh_error,
(scm_t_uint32 *) wbuf,
1, NULL, NULL, &len);
if (buf != NULL)
{
/* Character is graphic and representable in
this encoding. Print it. */
scm_lfwrite_str (wstr, port);
free (buf);
printed = 1;
}
}
if (!printed)
{
/* Character is graphic but unrepresentable in
this port's encoding or is not graphic. */
if (ch <= 0xFF)
{
buf[0] = '\\';
buf[1] = 'x';
buf[2] = hex[ch / 16];
buf[3] = hex[ch % 16];
scm_lfwrite (buf, 4, port);
}
else if (ch <= 0xFFFF)
{
buf[0] = '\\';
buf[1] = 'u';
buf[2] = hex[(ch & 0xF000) >> 12];
buf[3] = hex[(ch & 0xF00) >> 8];
buf[4] = hex[(ch & 0xF0) >> 4];
buf[5] = hex[(ch & 0xF)];
scm_lfwrite (buf, 6, port);
j = i + 1;
}
else if (ch > 0xFFFF)
{
buf[0] = '\\';
buf[1] = 'U';
buf[2] = hex[(ch & 0xF00000) >> 20];
buf[3] = hex[(ch & 0xF0000) >> 16];
buf[4] = hex[(ch & 0xF000) >> 12];
buf[5] = hex[(ch & 0xF00) >> 8];
buf[6] = hex[(ch & 0xF0) >> 4];
buf[7] = hex[(ch & 0xF)];
scm_lfwrite (buf, 8, port);
j = i + 1;
}
}
}
scm_putc ('"', port);
scm_remember_upto_here_1 (exp);
}
else
scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
port);
scm_remember_upto_here_1 (exp);
break;
case scm_tc7_symbol:
if (scm_i_symbol_is_interned (exp))
{
scm_print_symbol_name (scm_i_symbol_chars (exp),
scm_i_symbol_length (exp),
port);
scm_i_symbol_length (exp), port);
scm_remember_upto_here_1 (exp);
}
else
@ -668,7 +741,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
? "#<primitive-generic "
: "#<primitive-procedure ",
port);
scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_puts (scm_i_symbol_chars (SCM_SUBR_NAME (exp)), port);
scm_putc ('>', port);
break;
@ -763,6 +836,17 @@ scm_prin1 (SCM exp, SCM port, int writingp)
}
}
/* Print a character.
*/
void
scm_i_charprint (scm_t_uint32 ch, SCM port)
{
scm_t_wchar *wbuf;
SCM wstr = scm_i_make_wide_string (1, &wbuf);
wbuf[0] = ch;
scm_lfwrite_str (wstr, port);
}
/* Print an integer.
*/