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

;+doc
; procedure: substring:trim-right-pos-with-char
; arguments: source start end char
; signature: string x int x int x char -> 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 CHAR.
;
; > (substring:trim-right-pos-with-char "Betelgeuse   " 0 13 #\space)
; 10
;
; > (substring:trim-right-pos-with-char "B--------" 0 10 #\-)
; 1
;-doc

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

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

;+doc
; procedure: substring:trim-right-with-char
; arguments: source start end char
; signature: string x int x int x char -> string
; pre:       (and (<= 0 start) (< start end) (<= end (string-length source)))
;
; Returns a string consisting of SOURCE between START (inclusive) and
; END (exclusive) with CHAR stripped of the right side.
;
; > (substring:trim-right-with-char "Betelgeuse   " 0 13 #\space)
; "Betelgeuse"
;
; > (substring:trim-right-with-char "B---------" 0 10 #\-)
; "B"
;-doc

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

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

;+doc
; procedure: string:trim-right-with-char
; arguments: string char
; signature: string x char -> string
;
; Trim CHAR off the right end of STRING.
;
; > (string:trim-right-with-char "Betelgeuse   " #\space)
; "Betelgeuse"
;
; > (string:trim-right-with-char "B-------" #\-)
; "B"
;-doc

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

; eof
