ambrevar/storage: have subpath accept lists as well.
parent
3549a9461e
commit
b225bb05e8
|
@ -21,14 +21,16 @@
|
||||||
(cmd:$cmd "findmnt -n --fstab --output TARGET --json")))))))
|
(cmd:$cmd "findmnt -n --fstab --output TARGET --json")))))))
|
||||||
|
|
||||||
(defun subpath (root &rest subdirs)
|
(defun subpath (root &rest subdirs)
|
||||||
|
"Return merged paths as a string.
|
||||||
|
SUBDIRS can be either a single path or a list of paths."
|
||||||
(str:join (fof:separator)
|
(str:join (fof:separator)
|
||||||
(cons root subdirs)))
|
(cons root (alex:flatten subdirs))))
|
||||||
|
|
||||||
(defun personal (&rest subdirs)
|
(defun personal (&rest subdirs)
|
||||||
(apply #'subpath (uiop:getenv "PERSONAL") subdirs))
|
(subpath (uiop:getenv "PERSONAL") subdirs))
|
||||||
|
|
||||||
(defun home (&rest subdirs)
|
(defun home (&rest subdirs)
|
||||||
(apply #'subpath (uiop:getenv "HOME") subdirs))
|
(subpath (uiop:getenv "HOME") subdirs))
|
||||||
|
|
||||||
(defun basename (pathname)
|
(defun basename (pathname)
|
||||||
(first (last (pathname-directory (uiop:ensure-directory-pathname pathname)))))
|
(first (last (pathname-directory (uiop:ensure-directory-pathname pathname)))))
|
||||||
|
@ -80,11 +82,11 @@ If DESTINATION ends with '.gpg', it gets GPG-encrypted."
|
||||||
(defun write-roots-index (&optional (destination (personal "index")))
|
(defun write-roots-index (&optional (destination (personal "index")))
|
||||||
"Write indexes of `roots' sub-directories to DESTINATION."
|
"Write indexes of `roots' sub-directories to DESTINATION."
|
||||||
(labels ((write-simple-index (target &rest destination-subdir)
|
(labels ((write-simple-index (target &rest destination-subdir)
|
||||||
(write-index target (apply #'subpath destination
|
(write-index target (subpath destination
|
||||||
(append
|
(append
|
||||||
destination-subdir
|
destination-subdir
|
||||||
(list
|
(list
|
||||||
(str:concat (fof:basename target) ".index"))))))
|
(str:concat (fof:basename target) ".index"))))))
|
||||||
(index1 (root)
|
(index1 (root)
|
||||||
(ambrevar/shell:make-directory destination)
|
(ambrevar/shell:make-directory destination)
|
||||||
(alex:mappend
|
(alex:mappend
|
||||||
|
|
Loading…
Reference in New Issue