mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Add char-set debugging function

Browse source 
* libguile/srfi-14.c (scm_sys_char_set_dump): new function

* libguile/srfi-14.h: declaration of scm_sys_char_set_dump
This commit is contained in:
Michael Gran 2009-09-03 08:29:45 -07:00
parent 719bb8cd5d
commit ba8477ecce
2 changed files with 47 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

64
libguile/srfi-14.c
View file

@ -2052,31 +2052,59 @@ define_charset (const char *name, const scm_t_char_set *p)
return scm_permanent_object (cs);
}
#ifdef SCM_CHARSET_DEBUG
SCM_DEFINE (scm_debug_char_set, "debug-char-set", 1, 0, 0,
(SCM charset),
"Print out the internal C structure of @var{charset}.\n")
#define FUNC_NAME s_scm_debug_char_set
SCM_DEFINE (scm_sys_char_set_dump, "%char-set-dump", 1, 0, 0, (SCM charset),
"Returns an association list containing debugging information\n"
"for @var{charset}. The association list has the following entries."
"@table @code\n"
"@item char-set\n"
"The char-set itself.\n"
"@item len\n"
"The number of character ranges the char-set contains\n"
"@item ranges\n"
"A list of lists where each sublist a range of code points\n"
"and their associated characters"
"@end table")
#define FUNC_NAME s_scm_sys_char_set_dump
{
int i;
scm_t_char_set *cs = SCM_CHARSET_DATA (charset);
fprintf (stderr, "cs %p\n", cs);
fprintf (stderr, "len %d\n", cs->len);
fprintf (stderr, "arr %p\n", cs->ranges);
SCM e1, e2, e3;
SCM ranges = SCM_EOL, elt;
size_t i;
scm_t_char_set *cs;
char codepoint_string_lo[9], codepoint_string_hi[9];
SCM_VALIDATE_SMOB (1, charset, charset);
cs = SCM_CHARSET_DATA (charset);
e1 = scm_cons (scm_from_locale_symbol ("char-set"),
charset);
e2 = scm_cons (scm_from_locale_symbol ("n"),
scm_from_size_t (cs->len));
for (i = 0; i < cs->len; i++)
{
if (cs->ranges[i].lo == cs->ranges[i].hi)
fprintf (stderr, "%04x\n", cs->ranges[i].lo);
if (cs->ranges[i].lo > 0xFFFF)
sprintf (codepoint_string_lo, "U+%06x", cs->ranges[i].lo);
else
fprintf (stderr, "%04x..%04x\t[%d]\n",
cs->ranges[i].lo,
cs->ranges[i].hi, cs->ranges[i].hi - cs->ranges[i].lo + 1);
sprintf (codepoint_string_lo, "U+%04x", cs->ranges[i].lo);
if (cs->ranges[i].hi > 0xFFFF)
sprintf (codepoint_string_hi, "U+%06x", cs->ranges[i].hi);
else
sprintf (codepoint_string_hi, "U+%04x", cs->ranges[i].hi);
elt = scm_list_4 (SCM_MAKE_CHAR (cs->ranges[i].lo),
SCM_MAKE_CHAR (cs->ranges[i].hi),
scm_from_locale_string (codepoint_string_lo),
scm_from_locale_string (codepoint_string_hi));
ranges = scm_append (scm_list_2 (ranges,
scm_list_1 (elt)));
}
printf ("\n");
return SCM_UNSPECIFIED;
e3 = scm_cons (scm_from_locale_symbol ("ranges"),
ranges);
return scm_list_3 (e1, e2, e3);
}
#undef FUNC_NAME
#endif /* SCM_CHARSET_DEBUG */

4
libguile/srfi-14.h
View file

@ -100,9 +100,7 @@ SCM_API SCM scm_char_set_intersection_x (SCM cs1, SCM rest);
SCM_API SCM scm_char_set_difference_x (SCM cs1, SCM rest);
SCM_API SCM scm_char_set_xor_x (SCM cs1, SCM rest);
SCM_API SCM scm_char_set_diff_plus_intersection_x (SCM cs1, SCM cs2, SCM rest);
#if SCM_CHARSET_DEBUG
SCM_API SCM scm_debug_char_set (SCM cs);
#endif /* SCM_CHARSET_DEBUG */
SCM_API SCM scm_sys_char_set_dump (SCM charset);
SCM_API SCM scm_char_set_lower_case;
SCM_API SCM scm_char_set_upper_case;