1;;;
2;;; srfi-152 - String Library (reduced)
3;;;
4
5(define-module srfi-152
6  (use srfi-13)
7  ;; Note, 130 version returns a cursor, not an index
8  (use srfi-130
9       :only (string-index string-index-right)
10       :rename ((string-index %string-index)
11                (string-index-right %string-index-right)))
12  (use gauche.unicode)
13  (export
14   ;;
15   string? make-string string
16   string->vector string->list list->string vector->string
17   string-length string-ref substring string-copy
18   string=? string<? string>? string<=? string>=?
19   string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
20   string-append string-map string-for-each
21   read-string write-string
22   string-set! string-fill! string-copy!
23   string=? string<? string>? string<=? string>=?
24   string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
25
26   string-null? string-every string-any
27   string-tabulate string-unfold string-unfold-right
28   reverse-list->string
29
30   string-take string-drop string-take-right string-drop-right
31   string-pad string-pad-right
32   string-trim string-trim-right string-trim-both
33   string-replace
34   string-prefix-length string-suffix-length
35   string-prefix? string-suffix?
36   string-index string-index-right string-skip string-skip-right
37   string-contains string-contains-right
38   string-take-while string-take-while-right
39   string-drop-while string-drop-while-right
40   string-break string-span
41   string-append string-concatenate string-concatenate-reverse
42   string-join
43   string-fold string-fold-right string-count
44   string-filter string-remove
45   string-replicate string-segment string-split))
46(select-module srfi-152)
47
48(define %subs (with-module gauche.internal %maybe-substring))
49
50(define (%negate pred)
51  (lambda (x)
52    (not (pred x))))
53
54(define (string-take-while s pred :optional
55                           (start 0)
56                           (end (string-cursor-end s)))
57  (substring s start (%string-index s (%negate pred) start end)))
58
59(define (string-take-while-right s pred :optional
60                                 (start 0)
61                                 (end (string-cursor-end s)))
62  (substring s (%string-index-right s (%negate pred) start end) end))
63
64(define (string-span s pred :optional
65                     (start 0)
66                     (end (string-cursor-end s)))
67  (let ([cur (%string-index s (%negate pred) start end)])
68    (values (substring s start cur)
69            (substring s cur end))))
70
71(define (string-break s pred :optional
72                      (start 0)
73                      (end (string-cursor-end s)))
74  (let ([cur (%string-index s pred start end)])
75    (values (substring s start cur)
76            (substring s cur end))))
77
78(define (string-segment s k)
79  (let loop ([r '()] [s s])
80    (if (< (string-length s) k)
81      (if (equal? s "")
82        (reverse r)
83        (reverse (cons s r)))
84      (loop (cons (string-copy s 0 k) r)
85            (string-copy s k)))))
86
87(define (string-contains-right s1 s2 :optional (start1 0) end1 start2 end2)
88  (let* ((str1 (%subs s1 start1 end1))
89         (str2 (%subs s2 start2 end2))
90         (res  (string-scan-right str1 str2)))
91    (and res (+ start1 res))))
92
93;; Compatibility
94(define string-drop-while string-trim)
95(define string-drop-while-right string-trim-right)
96(define string-remove string-delete)
97
98;; 'to' is not optional in srfi-152
99(define (string-replicate s from to :optional start end)
100  (xsubstring s from to start end))
101