;; data/core/string-lib.scm - string procedures
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

(define-module (core string-lib))

(export tilde-expand trim-whitespace)

(define (tilde-expand filename)
"(tilde-expand filename) => string
Expand character sequences like ~ and ~username in FILENAME like
bash and Emacs do.  FILENAME is unchanged if it has the form
~username, but the given user does not exist."
  (if (and (> (string-length filename) 0)
	      (char=? (string-ref filename 0) #\~))
      (if (or (= (string-length filename) 1)
	      (and (> (string-length filename) 1)
		   (char=? (string-ref filename 1) #\/)))
	  (let ((homedir (vector-ref (getpwuid (getuid)) 5)))
	    (string-append homedir
			   (if (> (string-length filename) 1)
			       (substring filename 1
					  (string-length filename))
			       "")))
; This catch prevents us from dying when the given user name does not
; exist.
	  (catch 'system-error
		 (lambda ()
		   (let* ((username
			   (substring filename 1
				      (if (string-index filename #\/)
					  (string-index filename #\/)
					  (string-length filename))))
			  (homedir (vector-ref (getpwnam username) 5)))
		     (cleanup-filename
		      (string-append homedir "/" 
				     (substring filename
						(1+ (string-length username))
						(string-length filename))))))
		 (lambda ignore filename)))
      filename))

(define (trim-whitespace str)
"(trim-whitespace str) => string
Return STR, but with all whitespace at the beginning and the end removed."
  (let lp ((str str))
    (if (and (> (string-length str) 0)
             (char-whitespace? (string-ref str 0)))
        (lp (substring str 1 (string-length str)))
        (let lp2 ((str str))
          (if (and (> (string-length str) 0)
                   (char-whitespace?
                    (string-ref str (- (string-length str) 1))))
              (lp2 (substring str 0 (- (string-length str) 1)))
              str)))))
