; -*- Scheme -*-
;
; $Id: string46.scm,v 1.1 1998/03/16 07:59:56 foner Exp $

;+doc
; procedure: substring:trim-left-by-proc-pos
; arguments: string start end proc
; signature: string x int x int x (char -> bool) -> int
; pre:       (and (<= 0 start) (< start end) (<= end (string-length string)))
;
; Return the ...
;-doc

(define substring:trim-right-by-proc-pos
  (lambda (s ss se p)
    (if (zero? se)
	0
	(let loop ((i (- se 1)))
	  (cond ((zero? i) (if (p (string-ref s 0)) 0 1))
		((p (string-ref s i)) (loop (- i 1)))
		(else (+ i 1)))))))

;------------

;+doc
; procedure: string:trim-right-by-proc
; arguments: string proc
; signature: string x (char -> bool) -> string
; 
; Trims characters off the right of STRING using PROC, which should
; return #t for each character that needs to be removed, and returns
; the resulting string
;
; Examples:
;
; > (string:trim-right-by-proc "ABCDefghIJKLmnop" char-lower-case?)
; "ABCDefghIJKL"
;
; Strip lower case characters.
;
; > (string:trim-right-by-proc "" char-lower-case?)
; ""
; 
; If the string is empty, the procedure does nothing.
;
; > (string:trim-right-by-proc "ABCDefghIJKLmnop" char-whitespace?)
; "ABCDefghIJKLmnop"
;
; Returns a copy of the string if there are no characters stripped.
;-doc

(define string:trim-right-by-proc
  (lambda (s p)
    (let ((sl (string-length s)))
      (substring s 0 (substring:trim-right-by-proc-pos s 0 sl p)))))

; eof
