| Paste number 53964: | relative-pathname |
| Pasted by: | baggles |
| 6 months, 2 weeks ago | |
| #lispcafe | Context in IRC logs | |
| Paste contents: |
(defun relative-pathname (base path) "Taking two true pathnames, return base relative to path." (let ((base (merge-pathnames base)) (path (merge-pathnames path))) (if (and (eql (pathname-host base) (pathname-host path)) (eql (pathname-device base) (pathname-device path))) (let ((base-directory (copy-list (pathname-directory base))) (path-directory (copy-list (pathname-directory path)))) (loop while (equal (car base-directory) (car path-directory)) do (pop base-directory) (pop path-directory)) (make-pathname :directory (nconc (list :relative) (when base-directory (loop repeat (length base-directory) collecting :up)) path-directory) :defaults path)) path))) WVR> (relative-pathname #P"/a/b/c/" #P"/a/b/d/e") #P"../d/e" WVR> (relative-pathname #P"/a/b/c/" #P"/a/b/c/d/e") #P"d/e" |
Annotations for this paste:
| Annotation number 1: | relative-pathname |
| Pasted by: | baggles |
| 6 months, 2 weeks ago | |
| Context in IRC logs | |
| Paste contents: |
| (defun relative-pathname (base path) "Taking two true pathnames, return base relative to path." (let ((base (merge-pathnames base)) (path (merge-pathnames path))) (if (and (eql (pathname-host base) (pathname-host path)) (eql (pathname-device base) (pathname-device path))) (let ((base-directory (pathname-directory base)) (path-directory (pathname-directory path))) (loop while (equal (car base-directory) (car path-directory)) do (pop base-directory) (pop path-directory)) (make-pathname :directory (append (list :relative) (when base-directory (loop repeat (length base-directory) collecting :up)) path-directory) :defaults path)) path))) |