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))
(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 (- i offset) 0)))
(if (<= i2 0)
(apply string-append (cons (substring str 0 i) res))
(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 (pair? rule) (cdr rule) rule)
(cons sep (cons (substring str i2 i) res)))))))
(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