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

(require 'char-set:member?)

;+doc
; procedure: substring:trim-right-pos-with-chars
; arguments: source start end chars
; signature: string x int x int x char-set -> int
; pre:       (and (<= 0 start) (< start end) (<= end (string-length source)))
;
; Returns the position of the first character (starting from the
; right) in SOURCE starting at START (inclusive) and ending at END
; (exclusive) which is not in CHARS.
;
; > (substring:trim-right-pos-with-chars "Betelgeuse   " 0 13 char-set:whitespace)
; 10
;
; > (substring:trim-right-pos-with-chars "Betelgeuse" 0 10 char-set:lower-case)
; 1
;-doc

(define substring:trim-right-pos-with-chars
  (lambda (s ss se chars)
    (let loop ((p (- se 1)))
      (cond ((= p ss) (if (char-set:member? chars (string-ref s p)) 0 (+ 1 p)))
	    ((char-set:member? chars (string-ref s p)) (loop (- p 1)))
	    (else (+ 1 p))))))

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

;+doc
; procedure: substring:trim-right-with-chars
; arguments: source start end chars
; signature: string x int x int x char-set -> string
; pre:       (and (<= 0 start) (< start end) (<= end (string-length source)))
;
; Returns a string consisting of SOURCE between START (inclusive) and
; END (exclusive) with any characters in CHARS stripped of the right side.
;
; > (substring:trim-right-with-chars "Betelgeuse   " 0 13 char-set:whitespace)
; "Betelgeuse"
;
; > (substring:trim-right-with-chars "Betelgeuse" 0 10 char-set:lower-case)
; "B"
;-doc

(define substring:trim-right-with-chars
  (lambda (s ss se chars)
    (let loop ((p (- se 1)))
      (cond ((= p ss)
	     (if (char-set:member? chars (string-ref s p))
		 ""
		 (substring s p (+ 1 p))))
	    ((char-set:member? chars (string-ref s p)) (loop (- p 1)))
	    (else (substring s ss (+ 1 p)))))))

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

;+doc
; procedure: string:trim-right-with-chars
; arguments: source chars
; signature: string char-set -> string
;
; Returns a string consisting of SOURCE with any characters in CHARS
; stripped of the right side. 
;
; > (string:trim-right-with-chars "Betelgeuse   " char-set:whitespace)
; "Betelgeuse"
;
; > (string:trim-right-with-chars "Betelgeuse" char-set:lower-case)
; "B"
;-doc

(define string:trim-right-with-chars
  (lambda (s cs)
    (let ((sl (string-length s)))
      (if (zero? sl)
	  ""
	  (substring:trim-right-with-chars s 0 sl cs)))))

; eof
