diff --git a/scsh/re.scm b/scsh/re.scm index 7a35080..004e1ad 100644 --- a/scsh/re.scm +++ b/scsh/re.scm @@ -148,6 +148,64 @@ 0 items) ans)))) + + +(define (regexp-substitute/global port str re . items) + (let ((range (lambda (start item) ; Return start & end of + (cond ((integer? item) ; ITEM's range in STR. + (values (vector-ref sv item) + (vector-ref ev item))) + ((eq? 'pre item) (values start (vector-ref sv 0))) + (else (error "Illegal substitution item." + item + regexp-substitute))))) + (num-posts (reduce (lambda (count item) + (+ count (if (eq? item 'post) 1 0))) + 0 items))) + (if (and port (< num-posts 2)) + + ;; Output port case, with zero or one POST items. + (let recur ((start 0)) + (let ((match (string-match re str start))) + (and match + (let* ((sv (regexp-match:start match)) + (ev (regexp-match:end match))) + (for-each (lambda (item) + (cond ((string? item) (write-string item port)) + ((eq? 'post item) + (let ((post-start (vector-ref ev 0))) + (or (recur post-start) + (write-string item port post-start)))) + (else (receive (si ei) (range start item) + (write-string str port si ei))))) + items) + #t)))) + + (let ((pieces (let recur ((start 0)) + (let ((match (string-match re str start)) + (cached-post #f)) + (and match + (let* ((sv (regexp-match:start match)) + (ev (regexp-match:end match))) + (reduce (lambda (pieces item) + (cond ((string? item) (cons item pieces)) + ((eq? 'post item) + (append (or cached-post + (begin (set! cached-post + (recur (vector-ref ev 0))) + cached-post)) + pieces)) + (else (receive (si ei) (range start item) + (cons (substring str si e1) + pieces))))) + 0 items))))))) + (and pieces + (let ((pieces (reverse pieces))) + (if port (for-each (lambda (p) (write-string p port)) pieces) + (apply string-append pieces)))))))) + + + ;;; Miscellaneous ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 513ceef..de4fb77 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -427,6 +427,7 @@ regexp? regexp-exec regexp-substitute + regexp-substitute/global regexp-quote))