From c1bf82f25da4b391b489b18fdb7de22ff25d44d1 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Sat, 16 Jan 2021 01:14:35 +0100
Subject: [PATCH] ambrevar: Move relative-path to `file'.

---
 .local/share/common-lisp/source/ambrevar/file.lisp  | 10 ++++++++++
 .local/share/common-lisp/source/ambrevar/shell.lisp | 10 +---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/.local/share/common-lisp/source/ambrevar/file.lisp b/.local/share/common-lisp/source/ambrevar/file.lisp
index 247b31e2..f4773335 100644
--- a/.local/share/common-lisp/source/ambrevar/file.lisp
+++ b/.local/share/common-lisp/source/ambrevar/file.lisp
@@ -82,6 +82,16 @@ This returns the directory name for directories."
     (subseq path
             (1+ last-separator))))
 
+(export-always 'relative-path)
+(defmethod relative-path ((file file) &optional (parent-directory *default-pathname-defaults*))
+  "Return PATH relative to PARENT-DIRECTORY.
+If PARENT-DIRECTORY is not a parent of PATH, return PATH."
+  (setf parent-directory (path (uiop:ensure-directory-pathname parent-directory)))
+  (if (str:starts-with? parent-directory
+                        (path file))
+      (subseq (path file) (length parent-directory))
+      (path file)))
+
 ;; TODO: Support `*print-pretty*'?
 ;; TODO: `*print-readably*'?
 (defmethod print-object ((file file) stream)
diff --git a/.local/share/common-lisp/source/ambrevar/shell.lisp b/.local/share/common-lisp/source/ambrevar/shell.lisp
index 956d9008..f0eb51e9 100644
--- a/.local/share/common-lisp/source/ambrevar/shell.lisp
+++ b/.local/share/common-lisp/source/ambrevar/shell.lisp
@@ -321,15 +321,7 @@ Return process name as second value."
 (export-always 'sha1)
 (defun sha1 (file)                  ; TODO: Use pure CL / FFI version?
   "Return checksum of FILE."
-  (first (first (tokenize (cmd:$cmd "sha1sum" file)))))
-
-(export-always 'relative-path)
-(defun relative-path (path &optional (parent-directory *default-pathname-defaults*))
-  "Return PATH relative to PARENT-DIRECTORY.
-If PARENT-DIRECTORY is not a parent of PATH, return PATH."
-  (or (uiop:subpathp (uiop:merge-pathnames* path) ; The `merge-pathnames*' ensure PATH is absolute.
-                     (uiop:ensure-directory-pathname parent-directory))
-      path))
+  (first (first (tokenize (cmd:$cmd "sha1sum" (write-to-string (ambrevar/file:path file)))))))
 
 (export-always 'toggle-interpol-readtable)
 (defun toggle-interpol-readtable ()