stk/Lib/unix.stk

;;;;
;;;; u n i x  . s t k			-- Some unix stuff
;;;;
;;;; Copyright <20> 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions.  No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;;
;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;;    Creation date: 29-Mar-1994 17:36
;;;; Last file update:  3-Sep-1999 19:55 (eg)
;;;;

;;;; This file implements
;;;;	(basename f)		
;;;;    (dirname f)
;;;;	(decompose-file-name f)		return f exploded in a list


(define basename 	    '())
(define dirname  	    '())
(define decompose-file-name '())


(let* ((slash (if (eqv? (os-kind) 'Unix) #\/ #\\))
       (sslash (string slash)))
  (define (delete-trailing-slashes s)
    (let ((pos (- (string-length s) 1)))
      (while (and (>= pos 0) (char=? (string-ref s pos) slash)) 
	     (set! pos (- pos 1)))
      (if (= pos -1)
	  sslash
	  (substring s 0 (+ pos 1)))))

  (define (decompose name)
    (if (equal? name sslash)
	(cons sslash "")
	(begin
	  (let* ((f    (delete-trailing-slashes name))
	    	 (len  (string-length f))
		 (pos  (- len 1)))		 
	    
	    ;; find last slash
	    (while (and (>= pos 0) (not (char=? (string-ref f pos) slash)))
		   (set! pos (- pos 1)))

	    (case pos
	      (-1   (cons "." (substring f 0 len)))
	      (0    (cons sslash (substring f 1 len)))
	      (else (cons (delete-trailing-slashes (substring f 0 pos))
			  (substring f (+ pos 1) len))))))))


  (set! basename 	    (lambda (file) (cdr (decompose file))))
  (set! dirname  	    (lambda (file) (car (decompose file))))
  (set! decompose-file-name (lambda (file) 
			      (letrec ((decomp (lambda (file res)
						 (if (or (equal? file sslash)
							 (equal? file "."))
						     (cons file res)
						     (let ((r (decompose file)))
						       (decomp (car r)
							       (cons (cdr r)
								      res)))))))
				(decomp file '())))))


#|

This is another version which uses regexp. decompose-file-name is more 
consistent than the above version (but could yiel compatibility problems)

(require "regexp")

(define (decompose-file-name str)
  (cons (if (and (> (string-length str) 0) 
		 (char=? (string-ref str 0) #\/))
	    "/"
	    ".")
	(split-string str "/")))

(define (dirname str)
  (regexp-replace "^(.*)/(.+)$" str "\\1"))

(define (basename str)
  (regexp-replace "^(.*)/(.*)$" str "\\2"))
|#

(provide "unix")