mirrors
/
ambevar-dotfiles
mirror of https://gitlab.com/ambrevar/dotfiles/
1
0
Fork 0
Code Issues Releases Wiki Activity

ambrevar: Move relative-path to `file'.

master
Pierre Neidhardt 2021-01-16 01:14:35 +01:00
parent 312781b0d8
commit c1bf82f25d
2 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.local/share/common-lisp/source/ambrevar/file.lisp
View File

@ -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)

10
.local/share/common-lisp/source/ambrevar/shell.lisp
View File

@ -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 ()