Adding title-case.

This commit is contained in:
Alex Shinn 2014-05-18 10:58:43 +09:00
parent 05a4fbdbdc
commit 1eeed831a5
2 changed files with 25 additions and 2 deletions

View file

@ -492,6 +492,21 @@
(char-set-union %char-set:letter %char-set:digit (char-set #\_)))
(define (char-word-constituent? ch)
(char-set-contains? char-set:word-constituent ch))
(define char-set:title-case
(char-set-union
(ucs-range->char-set #x1F88 #x1F90)
(ucs-range->char-set #x1F98 #x1FA0)
(ucs-range->char-set #x1FA8 #x1FB0)
(char-set #\x01C5 #\x01C8 #\x01CB #\x01F2 #\x1FBC #\x1FCC #\x1FFC)))
(define get-char-set:cased
(let ((char-set:cased #f))
(lambda ()
(if (not char-set:cased)
(set! char-set:cased
(char-set-union char-set:upper-case
char-set:lower-case
char-set:title-case)))
char-set:cased)))
(define (match/bos str i ch start end matches)
(string-cursor=? i start))
@ -537,6 +552,8 @@
(if (flag-set? flags ~ci?) %char-set:letter %char-set:lower-case))
((upper-case upper)
(if (flag-set? flags ~ci?) %char-set:letter %char-set:upper-case))
((title-case title)
(if (flag-set? flags ~ci?) %char-set:letter (char-set)))
((alphabetic alpha) %char-set:letter)
((numeric num digit) %char-set:digit)
((alphanumeric alphanum alnum) %char-set:letter+digit)
@ -554,9 +571,11 @@
((any) char-set:full)
((nonl) char-set:nonl)
((lower-case lower)
(if (flag-set? flags ~ci?) char-set:letter char-set:lower-case))
(if (flag-set? flags ~ci?) (get-char-set:cased) char-set:lower-case))
((upper-case upper)
(if (flag-set? flags ~ci?) char-set:letter char-set:upper-case))
(if (flag-set? flags ~ci?) (get-char-set:cased) char-set:upper-case))
((title-case title)
(if (flag-set? flags ~ci?) (get-char-set:cased) char-set:title-case))
((alphabetic alpha) char-set:letter)
((numeric num digit) char-set:digit)
((alphanumeric alphanum alnum) char-set:letter+digit)

View file

@ -152,6 +152,10 @@
(test-re #f '(* lower) "abcD")
(test-re '("abcD") '(w/nocase (* lower)) "abcD")
(test-re '("σζ") '(* lower) "σζ")
(test-re '("Σ") '(* upper) "Σ")
(test-re '("\x01C5;") '(* title) "\x01C5;")
(test-re '("σζ\x01C5;") '(w/nocase (* lower)) "σζ\x01C5;")
(test-re '("кириллица") '(* alpha) "кириллица")
(test-re #f '(w/ascii (* alpha)) "кириллица")