mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

Improved support for Unicode title case in Guile's string and character APIs.

Browse source 
* doc/ref/api-data.texi (Characters): Documentation for `char-titlecase'.
* doc/ref/api-i18n.texi (Character Case Mapping): Documentation for
  `char-locale-titlecase' and `string-locale-titlecase'.

* libguile/chars.c, libguile/chars.h (scm_char_titlecase, scm_c_titlecase): New
  functions.

* libguile/i18n.c, libguile/i18n.h (chr_to_case, scm_char_locale_titlecase,
  str_to_case, scm_string_locale_titlecase): New functions.
* libguile/i18n.c (scm_char_locale_downcase, scm_char_locale_upcase,
  scm_string_locale_downcase, scm_string_locale_upcase): Refactor to share code
  via chr_to_case and str_to_case, as appropriate.
* module/ice-9/i18n.scm (char-locale-title-case, string-locale-titlecase): New
  functions.

* libguile/srfi-13.c (string_titlecase_x): Use uc_totitle instead of uc_toupper.

* test-suite/tests/chars.test: Tests for `char-titlecase'.
* test-suite/tests/i18n.test: Tests for `char-locale-titlecase' and
  `string-locale-titlecase'.
* test-suite/tests/srfi-13.test: Tests for `string-titlecase'.
This commit is contained in:
Julian Graham 2009-12-22 00:19:56 -05:00
parent 9b5a0d8460
commit 820f33aaed
11 changed files with 227 additions and 103 deletions
Download patch file Download diff file Expand all files Collapse all files

6
test-suite/tests/chars.test
View file

@ -245,7 +245,11 @@
(eqv? (char-upcase #\a) #\A))
(pass-if "char-downcase"
(eqv? (char-downcase #\A) #\a)))
(eqv? (char-downcase #\A) #\a))
(pass-if "char-titlecase"
(and (eqv? (char-titlecase #\a) #\A)
(eqv? (char-titlecase #\763) #\762))))
(with-test-prefix "charnames"

13
test-suite/tests/i18n.test
View file

@ -202,6 +202,14 @@
(and (eq? #\Z (char-locale-upcase #\z))
(eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase"
(and (eq? #\T (char-locale-titlecase #\t))
(eq? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase Dž"
(and (eq? #\762 (char-locale-titlecase #\763))
(eq? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
(pass-if "char-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
@ -229,6 +237,11 @@
(and (string=? "Z" (string-locale-upcase "z"))
(string=? "Z" (string-locale-upcase "z" (make-locale LC_ALL "C")))))
(pass-if "string-locale-titlecase"
(and (string=? "Hello, World" (string-locale-titlecase "hello, world"))
(string=? "Hello, World" (string-locale-titlecase
"hello, world" (make-locale LC_ALL "C")))))
(pass-if "string-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()

19
test-suite/tests/srfi-13.test
View file

@ -147,6 +147,25 @@
(pass-if "more than one match, start and end index"
(string-any char-upper-case? "abCDE" 1 4))))
;;;
;;; string-titlecase
;;;
(with-test-prefix "string-titlecase"
(pass-if "all-lower"
(string=? "Foo" (string-titlecase "foo")))
(pass-if "all-upper"
(string=? "Foo" (string-titlecase "FOO")))
(pass-if "two-words"
(string=? "Hello, World!" (string-titlecase "hello, world!")))
(pass-if "titlecase-characters"
(string=? (list->string '(#\762))
(string-titlecase (list->string '(#\763))))))
;;;
;;; string-append/shared
;;;