add char-asian-punctuation?

Author: wargrey

character.rkt

@@ -31,6 +31,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; http://www.unicode.org/reports/tr44/#General_Category_Values
+;;; https://www.unicodepedia.com/groups/
 (define char-letter? : (-> Char Boolean)
   (lambda [ch]
     (and (memq (char-general-category ch) '(lu ll lt lm lo))
@@ -46,21 +47,6 @@
     (and (memq (char-general-category ch) '(mn mc me))
          #true)))
 
-(define char-number? : (-> Char Boolean)
-  (lambda [ch]
-    (and (memq (char-general-category ch) '(nd nl no))
-         #true)))
-
-(define char-punctuation? : (-> Char Boolean)
-  (lambda [ch]
-    (and (memq (char-general-category ch) '(pc pd ps pe pi pf po))
-         #true)))
-
-(define char-symbol? : (-> Char Boolean)
-  (lambda [ch]
-    (and (memq (char-general-category ch) '(sm sc sk so))
-         #true)))
-
 (define char-math? : (-> Char Boolean)
   (lambda [ch] ; symbol other
     (eq? (char-general-category ch) 'so)))
@@ -79,6 +65,20 @@
   (lambda [ch] ; letter other
     (eq? (char-general-category ch) 'lo)))
 
+(define char-asian-punctuation? : (-> Char Boolean)
+  (lambda [ch]
+    (define unicode (char->integer ch))
+    
+    (or
+     ; General Punctuation Block
+     (<= #x2000 unicode #x206F)
+     
+     ; CJK Symbol and Punctuation Block
+     (<= #x3000 unicode #x303F)
+
+     ; Halfwidth and Fullwidth Forms Block
+     (<= #xFF00 unicode #xFFEE))))
+
 (define char-emoji? : (-> Char Boolean)
   (lambda [ch] ; symbol other
     (eq? (char-general-category ch) 'so)))

digitama/tamer/stat.rkt

@@ -126,15 +126,9 @@
       (define/override (table-of-contents part ri) empty-block)
       (define/override (local-table-of-contents part ri) empty-block)
 
-      (define/override (get-substitutions)
-        '((#rx"---" "\U2014")
-          (#rx"--" "\U2013")
-          (#rx"``" "\U201C")
-          (#rx"''" "\U201D")
-          (#rx"'" "\U2019")))
-
       (define/override (render-part self ri)
-        (parameterize ([default-word-group 'head])
+        (parameterize ([default-word-group 'head]
+                       [current-output-port /dev/stdout])
           (super render-part self ri)))
 
       (define/override (render-paragraph self parent ri)
@@ -173,6 +167,7 @@
                          [else (string-word-count-done wstat++)])))
 
       (define (word-count-symbol self part [group (default-word-group)])
+        ; `decode-string` produces these before we see the `part`
         (case self
           [(mdash) (word-count "\U2014" part group)]
           [(ndash) (word-count "\U2013" part group)]

digitama/unicode.rkt

@@ -62,6 +62,10 @@
                            [(not (eq? c #\linefeed)) (wc as ls++ ws++ nl es #false #false idx++)]
                            [(and prev-cr?) (wc as ls++ ws nl es #false #false idx++)] ; CRLF
                            [else (wc as ls++ ws++ (unsafe-idx+ nl 1) es #false #false idx++)]))]
+                  [(char-punctuation? c)
+                   (if (char-asian-punctuation? c)
+                       (wc (unsafe-idx+ as 1) ls ws nl es #false #false idx++)
+                       (wc as ls ws nl es #true #false idx++))]
                   [else (wc as ls ws nl es #true #false idx++)]))
 
           (make-word-statistics (+ (word-statistics-asian pstats) as)