76 lines
2.3 KiB
Plaintext
76 lines
2.3 KiB
Plaintext
;;;;
|
|
;;;; u n i x . s t k -- Some unix stuff
|
|
;;;;
|
|
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
;;;;
|
|
;;;; Permission to use, copy, and/or distribute this software and its
|
|
;;;; documentation for any purpose and without fee is hereby granted, provided
|
|
;;;; that both the above copyright notice and this permission notice appear in
|
|
;;;; all copies and derived works. Fees for distribution or use of this
|
|
;;;; software or derived works may only be charged with express written
|
|
;;;; permission of the copyright holder.
|
|
;;;; 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: 7-Nov-1995 10:51
|
|
;;;;
|
|
|
|
;;;; This file implements
|
|
;;;; (basename f)
|
|
;;;; (dirname f)
|
|
;;;; (decompose-file-name f) return f expoded in a list
|
|
;;;; (file-is-directory? f)
|
|
;;;; (file-is-regular? f)
|
|
;;;; (file-is-readable? f)
|
|
;;;; (file-is-writable? f)
|
|
|
|
|
|
(define basename '())
|
|
(define dirname '())
|
|
(define decompose-file-name '())
|
|
|
|
|
|
(let ()
|
|
(define (delete-trailing-slashes s)
|
|
(let ((pos (- (string-length s) 1)))
|
|
(while (and (>= pos 0) (char=? (string-ref s pos) #\/))
|
|
(set! pos (- pos 1)))
|
|
(if (= pos -1)
|
|
"/"
|
|
(substring s 0 (+ pos 1)))))
|
|
|
|
(define (decompose name)
|
|
(if (equal? name "/")
|
|
(cons "/" "")
|
|
(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) #\/)))
|
|
(set! pos (- pos 1)))
|
|
|
|
(case pos
|
|
(-1 (cons "." (substring f 0 len)))
|
|
(0 (cons "/" (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 "/")
|
|
(equal? file "."))
|
|
(cons file res)
|
|
(let ((r (decompose file)))
|
|
(decomp (car r)
|
|
(cons (cdr r)
|
|
res)))))))
|
|
(decomp file '())))))
|
|
|
|
(provide "unix")
|