allow proper list for comma-rule

This commit is contained in:
Alex Shinn 2019-03-11 23:51:42 +08:00
parent bd78ebeed7
commit 956e7ba761
2 changed files with 14 additions and 12 deletions

View file

@ -136,7 +136,7 @@
(test "299792458" (show #f (with ((comma-rule 3)) 299792458)))
(test "299,792,458" (show #f (with ((comma-rule 3)) (numeric 299792458))))
(test "-29,97,92,458"
(show #f (with ((comma-rule '(3 . 2))) (numeric -299792458))))
(show #f (with ((comma-rule '(3 2))) (numeric -299792458))))
(test "299.792.458"
(show #f (with ((comma-rule 3) (comma-sep #\.)) (numeric 299792458))))
(test "299.792.458,0"
@ -231,6 +231,7 @@
(test "1,234,567" (show #f (numeric 1234567 10 #f #f 3)))
(test "567" (show #f (numeric 567 10 #f #f 3)))
(test "1,23,45,67" (show #f (numeric 1234567 10 #f #f 2)))
(test "12,34,567" (show #f (numeric 1234567 10 #f #f '(3 2))))
;; comma-sep
(test "1|234|567" (show #f (numeric 1234567 10 #f #f 3 #\|)))

View file

@ -1,5 +1,5 @@
;; write.scm - written formatting, the default displayed for non-string/chars
;; Copyright (c) 2006-2013 Alex Shinn. All rights reserved.
;; Copyright (c) 2006-2019 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -19,16 +19,17 @@
(get-output-string out)))
(define (string-intersperse-right str sep rule)
(let lp ((i (string-length str))
(rule rule)
(res '()))
(let* ((offset (if (pair? rule) (car rule) rule))
(i2 (if offset (- i offset) 0)))
(if (<= i2 0)
(apply string-append (cons (substring str 0 i) res))
(lp i2
(if (pair? rule) (cdr rule) rule)
(cons sep (cons (substring str i2 i) res)))))))
(let ((start (string-cursor-start str)))
(let lp ((i (string-cursor-end str))
(rule rule)
(res '()))
(let* ((offset (if (pair? rule) (car rule) rule))
(i2 (if offset (string-cursor-back str i offset) start)))
(if (string-cursor<=? i2 start)
(apply string-append (cons (substring-cursor str start i) res))
(lp i2
(if (and (pair? rule) (not (null? (cdr rule)))) (cdr rule) rule)
(cons sep (cons (substring-cursor str i2 i) res))))))))
;;> Outputs the string str, escaping any quote or escape characters.
;;> If esc-ch, which defaults to #\\, is #f, escapes only the