File: relative-from-absolute.scm

package info (click to toggle)
scsh-0.6 0.6.7-8
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd, wheezy
  • size: 15,124 kB
  • ctags: 16,785
  • sloc: lisp: 82,839; ansic: 23,111; sh: 3,239; makefile: 821
file content (19 lines) | stat: -rw-r--r-- 711 bytes parent folder | download | duplicates (5) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
(define (weed l1 l2)
  (if (or (null? l1) (null? l2) (not (equal? (car l1) (car l2))))
      (values l1 (length l2))
      (weed (cdr l1) (cdr l2))))

(define (list-of-const const count acc)
  (let loop ((count count) (acc acc))
    (if (eqv? count 0)
	acc
	(loop (- count 1) (cons const acc)))))

(define (relative-from-absolute dir0 dir1)
  (if (and (file-name-absolute? dir0) (file-name-absolute? dir1))
      (call-with-values (lambda () (weed (split-file-name dir0) (split-file-name dir1)))
	(lambda (relpath-l rel-up-count)
	  (path-list->file-name  (list-of-const ".." rel-up-count relpath-l))))
      dir0))

(display (relative-from-absolute (car command-line-arguments) (cadr command-line-arguments)))