diff options
author | Michael Gran <spk121@yahoo.com> | 2009-09-03 08:29:45 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2009-09-03 08:29:45 -0700 |
commit | ba8477eccefae65191a5bc1de2b6f923fe195a91 (patch) | |
tree | a44f5aee957be23fbdf152708d2d3768f7ce3105 | |
parent | 719bb8cd5db10aeb0dad1c16227d6b6abc40e8b6 (diff) | |
download | guile-ba8477eccefae65191a5bc1de2b6f923fe195a91.tar.gz |
Add char-set debugging function
* libguile/srfi-14.c (scm_sys_char_set_dump): new function
* libguile/srfi-14.h: declaration of scm_sys_char_set_dump
-rw-r--r-- | libguile/srfi-14.c | 66 | ||||
-rw-r--r-- | libguile/srfi-14.h | 4 |
2 files changed, 48 insertions, 22 deletions
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c index 822673b92..5751bbeb8 100644 --- a/libguile/srfi-14.c +++ b/libguile/srfi-14.c @@ -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 -{ - 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_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 +{ + 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 + 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 - 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_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 */ + diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h index 1b9c29518..4b1a4b298 100644 --- a/libguile/srfi-14.h +++ b/libguile/srfi-14.h @@ -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; |