Fix bugs and more work on the command line
This commit is contained in:
@ -1,29 +1,35 @@
|
||||
(in-package :cl-xdg-trash/directorysizes)
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) integer) regular-file-size))
|
||||
(defun regular-file-size (path)
|
||||
"Return the size (in bytes) of the non-directory file PATH."
|
||||
(let ((res (osicat-posix:stat (uiop:native-namestring
|
||||
(ensure-nonwild-pathname path)))))
|
||||
(when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
|
||||
(error 'file-error :pathname path))
|
||||
(osicat-posix:stat-size res)))
|
||||
(declaim (ftype (function ((or string pathname)) pathname)
|
||||
directory-as-file-pathname))
|
||||
(defun directory-as-file-pathname (path)
|
||||
"Return PATH as a file, not a directory pathname."
|
||||
(let ((path (ensure-nonwild-pathname path)))
|
||||
(if (uiop:file-pathname-p path)
|
||||
path
|
||||
(make-pathname :name (file-or-dir-namestring path) :type nil
|
||||
:directory (butlast (pathname-directory path))))))
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) integer) file-size))
|
||||
(defun file-size (path)
|
||||
(declaim (ftype (function ((or string pathname) &optional t) integer) file-size))
|
||||
(defun file-size (path &optional (no-errors t))
|
||||
"Return the size of the file (inode) named by PATH."
|
||||
(loop for queue = (list (ensure-nonwild-pathname path)) then queue
|
||||
while queue
|
||||
for cur = (first queue)
|
||||
for res = (osicat-posix:stat cur)
|
||||
for cur = (directory-as-file-pathname (first queue))
|
||||
for res = (handler-bind
|
||||
((osicat-posix:posix-error
|
||||
(lambda (e)
|
||||
(unless no-errors
|
||||
(signal e)))))
|
||||
(osicat-posix:lstat cur))
|
||||
do (pop queue)
|
||||
when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
|
||||
when (and res (osicat-posix:s-isdir (osicat-posix:stat-mode res)))
|
||||
do (setq queue (nconc (uiop:directory*
|
||||
(merge-pathnames
|
||||
uiop:*wild-file-for-directory* cur))
|
||||
uiop:*wild-file-for-directory*
|
||||
(uiop:ensure-directory-pathname cur)))
|
||||
queue))
|
||||
else
|
||||
summing (regular-file-size cur)))
|
||||
else summing (osicat-posix:stat-size res)))
|
||||
|
||||
(declaim (ftype (function (string character &optional (or null integer)) list)
|
||||
split-string))
|
||||
@ -56,11 +62,13 @@ part of STRING."
|
||||
for (size mtime encoded-name) = (split-string line #\Space 3)
|
||||
for name = (url-decode encoded-name)
|
||||
when (and size mtime encoded-name)
|
||||
do (setf (gethash name out)
|
||||
(make-directorysizes-entry
|
||||
:size (parse-integer size)
|
||||
:mtime (parse-integer mtime)
|
||||
:name name))
|
||||
do (handler-case
|
||||
(setf (gethash name out)
|
||||
(make-directorysizes-entry
|
||||
:size (max 0 (parse-integer size))
|
||||
:mtime (max 0 (parse-integer mtime))
|
||||
:name name))
|
||||
(parse-error ()))
|
||||
finally (return out)))
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) hash-table)
|
||||
@ -111,11 +119,12 @@ it."
|
||||
:keep t :directory ,dir :type nil))))
|
||||
|
||||
|
||||
(declaim (ftype (function ((or string pathname) string))
|
||||
(declaim (ftype (function ((or string pathname) string) (or integer null))
|
||||
update-directorysizes-entry))
|
||||
(defun trashed-file-size (trash-directory name)
|
||||
"Return the size of the trashed file NAME in TRASH-DIRECTORY. If NAME is a
|
||||
directory and the file size cache is out of date, update it."
|
||||
directory and the file size cache is out of date, update it. As a second value,
|
||||
return whether the cache actually needed updating."
|
||||
(let* ((directorysizes-path (calculate-directorysizes-path trash-directory))
|
||||
(directorysizes (handler-case
|
||||
(read-directorysizes-file directorysizes-path)
|
||||
@ -147,14 +156,13 @@ directory and the file size cache is out of date, update it."
|
||||
trashinfo-mtime))
|
||||
(setq ret-size (directorysizes-entry-size cur-entry)))
|
||||
(t
|
||||
(let ((orig-size (gethash name directorysizes))
|
||||
(size (file-size path)))
|
||||
(let ((size (file-size path)))
|
||||
(setf (gethash name directorysizes)
|
||||
(make-directorysizes-entry
|
||||
:mtime trashinfo-mtime
|
||||
:size size
|
||||
:name name)
|
||||
did-change (not (eql size orig-size))
|
||||
did-change t
|
||||
ret-size size))))
|
||||
(when did-change
|
||||
(handler-case
|
||||
@ -162,4 +170,4 @@ directory and the file size cache is out of date, update it."
|
||||
(format-directorysizes stream directorysizes))
|
||||
;; ignore errors when updating the cache
|
||||
(osicat-posix:posix-error ())))
|
||||
ret-size))
|
||||
(values ret-size did-change)))
|
||||
|
||||
@ -35,7 +35,7 @@
|
||||
list-linux-mountpoints))
|
||||
(defun list-linux-mountpoints (&key only-real only-writable)
|
||||
"List all mount points on a Linux system. "
|
||||
(with-open-file (in #P"/proc/mounts")
|
||||
(with-open-file (in (uiop:parse-unix-namestring "/proc/mounts"))
|
||||
(loop for line = (read-line in nil)
|
||||
while line
|
||||
for (source target fstype options) = (parse-linux-fstab-line line)
|
||||
@ -74,7 +74,8 @@ be determined."
|
||||
|
||||
(declaim (ftype (function ((or pathname string) &key (:ensure-directory t))
|
||||
pathname)
|
||||
ensure-nonwild-pathname))
|
||||
ensure-nonwild-pathname)
|
||||
(inline ensure-nonwild-pathname))
|
||||
(defun ensure-nonwild-pathname (path &key ensure-directory)
|
||||
"coerce path into a pathname. signal a file-error if it is wild."
|
||||
(if (pathnamep path)
|
||||
@ -89,10 +90,12 @@ be determined."
|
||||
(declaim (ftype (function ((or string pathname)) string) file-or-dir-namestring))
|
||||
(defun file-or-dir-namestring (path)
|
||||
"Return the name of the last component of PATH, be it a file or directory."
|
||||
(if (uiop:pathname-equal path "/")
|
||||
"/"
|
||||
(let ((unix-path (remove-suffix (uiop:unix-namestring path) "/")))
|
||||
(first (last (uiop:split-string unix-path :max 2 :separator '(#\/)))))))
|
||||
(let ((root (uiop:parse-unix-namestring "/")))
|
||||
(if (uiop:pathname-equal path root)
|
||||
(uiop:native-namestring root)
|
||||
(let ((unix-path (remove-suffix (uiop:unix-namestring path) "/")))
|
||||
(first (last (uiop:split-string unix-path :max 2
|
||||
:separator '(#\/))))))))
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) (or pathname null))
|
||||
deepest-existing-path))
|
||||
|
||||
@ -52,13 +52,15 @@
|
||||
"Parser and utility functions for dealing with the directorysizes file.")
|
||||
(:use #:cl)
|
||||
(:import-from #:cl-xdg-trash/mountpoints
|
||||
#:ensure-nonwild-pathname)
|
||||
#:ensure-nonwild-pathname
|
||||
#:file-or-dir-namestring)
|
||||
(:import-from #:cl-xdg-trash/url-encode
|
||||
#:url-encode
|
||||
#:url-decode)
|
||||
(:import-from #:cl-xdg-trash/trashinfo
|
||||
#:compute-trashinfo-source-file)
|
||||
(:export #:read-directorysizes-file
|
||||
(:export #:directory-as-file-pathname
|
||||
#:read-directorysizes-file
|
||||
#:prase-directorysizes
|
||||
#:trashed-file-size
|
||||
#:calculate-directorysizes-path))
|
||||
|
||||
@ -21,10 +21,11 @@
|
||||
:initarg :target
|
||||
:documentation "The destination of the move operation."))
|
||||
(:report (lambda (condition stream)
|
||||
(with-slots (source target) condition
|
||||
(format stream "~S and ~S lie on different devices"
|
||||
(uiop:native-namestring source)
|
||||
(uiop:native-namestring target)))))
|
||||
(format stream "~S and ~S lie on different devices"
|
||||
(uiop:native-namestring
|
||||
(cross-device-error-source condition))
|
||||
(uiop:native-namestring
|
||||
(cross-device-error-target condition)))))
|
||||
(:documentation "An error that arose when moving files across devices."))
|
||||
|
||||
(define-condition file-exists-error (file-error)
|
||||
@ -42,66 +43,63 @@
|
||||
(env (uiop:parse-native-namestring
|
||||
(pathname env) :ensure-directory t))
|
||||
((not homedir)
|
||||
(merge-pathnames #P".local/share/"
|
||||
(merge-pathnames (uiop:parse-unix-namestring ".local/share/")
|
||||
(user-homedir-pathname)))
|
||||
((pathnamep homedir)
|
||||
(merge-pathnames #P".local/share/"
|
||||
(merge-pathnames (uiop:parse-unix-namestring ".local/share/")
|
||||
(uiop:ensure-directory-pathname homedir)))
|
||||
(t
|
||||
(merge-pathnames #P".local/share/"
|
||||
(merge-pathnames (uiop:parse-unix-namestring ".local/share/")
|
||||
(uiop:parse-native-namestring homedir
|
||||
:ensure-directory t))))))
|
||||
|
||||
(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
|
||||
user-home-trash-directory))
|
||||
(defun user-home-trash-directory (&key homedir)
|
||||
(merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir)))
|
||||
(uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P"Trash" (xdg-data-home :homedir homedir))))
|
||||
|
||||
(declaim (ftype (function (integer) t) sticky-bit-set-p)
|
||||
(inline sticky-bit-set-p))
|
||||
(defun sticky-bit-set-p (mode)
|
||||
"Return non-nil if the sticky bit is set in MODE."
|
||||
(not (zerop (logand (ash mode -9) 1))))
|
||||
(not (zerop (logand mode #o1000))))
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) t) valid-toplevel-trash-dir-p))
|
||||
(defun valid-toplevel-trash-dir-p (path)
|
||||
"Return non-nil if PATH is a valid toplevel trash directory. That is, it
|
||||
exists, is a directory, and: (1) is owned by the current user, (2) has the
|
||||
sticky bit set (and the info/ and files/ subdirectories are the same)."
|
||||
(flet ((check-dir (path)
|
||||
(handler-case
|
||||
(let* ((path (ensure-nonwild-pathname path))
|
||||
(stat (osicat-posix:stat path)))
|
||||
(and (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(sticky-bit-set-p (osicat-posix:stat-mode stat))
|
||||
(osicat-posix:access path (logior osicat-posix:r-ok
|
||||
osicat-posix:w-ok))))
|
||||
(osicat-posix:posix-error () nil))))
|
||||
(let* ((path (ensure-nonwild-pathname path :ensure-directory t)))
|
||||
(and (check-dir path)
|
||||
(check-dir (merge-pathnames "info" path))
|
||||
(check-dir (merge-pathnames "files" path))))))
|
||||
(declaim (ftype (function ((or string pathname) &optional t)
|
||||
(or null osicat-posix:stat))
|
||||
stat)
|
||||
(inline stat))
|
||||
(defun stat (path &optional lstat)
|
||||
"Call the stat(2) system call on PATH. With LSTAT, use lstat(2) instead."
|
||||
(let ((path (directory-as-file-pathname
|
||||
(ensure-nonwild-pathname path))))
|
||||
(handler-case
|
||||
(if lstat
|
||||
(osicat-posix:lstat path)
|
||||
(osicat-posix:stat path))
|
||||
(osicat-posix:posix-error () nil))))
|
||||
|
||||
(declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel))
|
||||
(defun find-trash-dirs-for-toplevel (toplevel)
|
||||
"List the trash directories that exist under TOPLEVEL."
|
||||
(let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
|
||||
(let ((uid (osicat-posix:getuid))
|
||||
(top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
|
||||
found)
|
||||
(let ((dir (merge-pathnames #P".Trash/" top-path)))
|
||||
(when (valid-toplevel-trash-dir-p dir)
|
||||
(push dir found)))
|
||||
(let ((uid (osicat-posix:getuid)))
|
||||
(when uid
|
||||
(let* ((dir (merge-pathnames (pathname (format nil ".Trash-~D/" uid))
|
||||
top-path))
|
||||
(stat (handler-case
|
||||
(osicat-posix:stat (uiop:native-namestring dir))
|
||||
(osicat-posix:posix-error () nil))))
|
||||
(when (and stat
|
||||
(osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(eql (osicat-posix:stat-uid stat) uid))
|
||||
(push dir found)))))
|
||||
(nreverse found)))
|
||||
(flet ((check (dir)
|
||||
(let ((stat (stat dir t)))
|
||||
(when (and stat
|
||||
(osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(eql (osicat-posix:stat-uid stat) uid))
|
||||
(push (uiop:ensure-directory-pathname dir) found)))))
|
||||
(check (merge-pathnames (pathname (format nil ".Trash-~D" uid)) top-path))
|
||||
(let* ((dir (uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P".Trash" top-path)))
|
||||
(stat (stat dir t)))
|
||||
(when (and stat
|
||||
(osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(sticky-bit-set-p (osicat-posix:stat-mode stat)))
|
||||
(check (merge-pathnames (pathname (format nil "~D" uid)) dir))))
|
||||
found)))
|
||||
|
||||
(declaim (ftype (function () list) list-toplevel-trash-directories))
|
||||
(defun list-toplevel-trash-directories ()
|
||||
@ -123,20 +121,72 @@ directory)."
|
||||
(or (and include-self (uiop:pathname-equal path home))
|
||||
(uiop:subpathp path home))))
|
||||
|
||||
(declaim (ftype (function ((or pathname string) &optional list) pathname)
|
||||
(declaim (ftype (function ((or pathname string) &optional list) (or pathname null))
|
||||
maybe-create-toplevel-trash-dir))
|
||||
(defun maybe-create-toplevel-trash-dir (root &optional ignored-trash-dirs)
|
||||
"Return or (if it's safe to) create a toplevel trash directory in
|
||||
ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
|
||||
(let ((root (ensure-nonwild-pathname root :ensure-directory t))
|
||||
(uid (osicat-posix:getuid)))
|
||||
(or
|
||||
;; root/.Trash/$UID
|
||||
(let* ((outer (uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P".Trash" root)))
|
||||
(outer-stat (stat outer t)))
|
||||
(when (and outer-stat
|
||||
(osicat-posix:s-isdir (osicat-posix:stat-mode outer-stat))
|
||||
(sticky-bit-set-p (osicat-posix:stat-mode outer-stat)))
|
||||
(let* ((inner (uiop:ensure-directory-pathname
|
||||
(merge-pathnames (pathname (princ-to-string uid))
|
||||
outer)))
|
||||
(inner-stat (stat inner t)))
|
||||
(unless (member inner ignored-trash-dirs :test #'uiop:pathname-equal)
|
||||
(if inner-stat
|
||||
(and (osicat-posix:s-isdir (osicat-posix:stat-mode inner-stat))
|
||||
(eql uid (osicat-posix:stat-uid inner-stat))
|
||||
inner)
|
||||
(handler-case
|
||||
(progn
|
||||
(osicat-posix:mkdir (uiop:native-namestring inner)
|
||||
#o0700)
|
||||
inner)
|
||||
(osicat-posix:posix-error () nil)))))))
|
||||
;; root/.Trash-$UID
|
||||
(let* ((dir (uiop:ensure-directory-pathname
|
||||
(merge-pathnames (format nil ".Trash-~D" uid) root)))
|
||||
(stat (stat dir t)))
|
||||
(unless (member dir ignored-trash-dirs :test #'uiop:pathname-equal)
|
||||
(if stat
|
||||
(and (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(eql uid (osicat-posix:stat-uid stat))
|
||||
dir)
|
||||
(handler-case
|
||||
(progn
|
||||
(osicat-posix:mkdir (uiop:native-namestring dir)
|
||||
#o0700)
|
||||
dir)
|
||||
(osicat-posix:posix-error () nil))))))))
|
||||
|
||||
(declaim (ftype (function ((or pathname string) &optional list) (or null pathname))
|
||||
trash-directory-for-file))
|
||||
(defun trash-directory-for-file (path &optional ignored-trash-dirs)
|
||||
"Return the trash directory into which PATH should be trashed."
|
||||
(let* ((res-path (ensure-nonwild-pathname path))
|
||||
(root (find-filesystem-root res-path)))
|
||||
(or (and (path-in-home-directory-p res-path)
|
||||
(uiop:pathname-equal (find-filesystem-root (user-homedir-pathname))
|
||||
root)
|
||||
(user-home-trash-directory))
|
||||
(or (car (set-difference (find-trash-dirs-for-toplevel root)
|
||||
ignored-trash-dirs
|
||||
:test #'uiop:pathname-equal))
|
||||
(user-home-trash-directory)))))
|
||||
(let* ((ignored-trash-dirs
|
||||
(mapcar (lambda (elt) (ensure-nonwild-pathname
|
||||
elt :ensure-directory t))
|
||||
ignored-trash-dirs))
|
||||
(res-path (ensure-nonwild-pathname path))
|
||||
(root (find-filesystem-root res-path))
|
||||
(home-trash (let ((ht (user-home-trash-directory)))
|
||||
(unless (member ht ignored-trash-dirs
|
||||
:test #'uiop:pathname-equal)
|
||||
ht))))
|
||||
(if (and (path-in-home-directory-p res-path)
|
||||
(uiop:pathname-equal
|
||||
(find-filesystem-root (user-homedir-pathname)) root))
|
||||
home-trash
|
||||
(or (maybe-create-toplevel-trash-dir root ignored-trash-dirs)
|
||||
home-trash))))
|
||||
|
||||
(defun rename-safely (source target)
|
||||
"Move SOURCE to TARGET, signaling an error if TARGET already exists."
|
||||
@ -205,9 +255,10 @@ specific directory."
|
||||
(ensure-nonwild-pathname trash-directory
|
||||
:ensure-directory t)
|
||||
(trash-directory-for-file path ignored-trash-dirs)))
|
||||
(files-dir (ensure-directories-exist (merge-pathnames
|
||||
#P"files/" trash-directory)
|
||||
:verbose nil))
|
||||
(files-dir (ensure-directories-exist
|
||||
(uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P"files" trash-directory))
|
||||
:verbose nil))
|
||||
(trashinfo (make-trashinfo-for trash-directory path))
|
||||
(target (merge-pathnames (make-pathname
|
||||
:name (trashinfo-name trashinfo))
|
||||
@ -235,16 +286,21 @@ specific directory."
|
||||
(defun list-trashed-files-for-directory (trash-directory)
|
||||
"Return a list of trashinfo objects for every trashed file in
|
||||
TRASH-DIRECTORY."
|
||||
(let ((info-dir (merge-pathnames #P"info/" trash-directory)))
|
||||
(let ((info-dir (uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P"info" trash-directory))))
|
||||
(mapcan #'(lambda (path)
|
||||
(let ((name (file-or-dir-namestring path)))
|
||||
(when (uiop:string-suffix-p name ".trashinfo")
|
||||
(handler-case
|
||||
(list (parse-trashinfo-file
|
||||
trash-directory
|
||||
(subseq name 0 (- (length name)
|
||||
(length ".trashinfo")))))
|
||||
(trashinfo-format-error () nil)))))
|
||||
(let ((trashinfo (parse-trashinfo-file
|
||||
trash-directory
|
||||
(subseq
|
||||
name 0 (- (length name)
|
||||
(length ".trashinfo"))))))
|
||||
(when (probe-file
|
||||
(trashinfo-trashed-file trashinfo))
|
||||
(list trashinfo)))
|
||||
(trashinfo-format-error ())))))
|
||||
(uiop:directory-files info-dir))))
|
||||
|
||||
(declaim (ftype (function (&optional (or pathname string list)) list)
|
||||
|
||||
@ -19,9 +19,10 @@ line 1.")
|
||||
:type pathname
|
||||
:documentation "The path to the file the error happened in."))
|
||||
(:report (lambda (condition stream)
|
||||
(with-slots (message line-number source-file) condition
|
||||
(format stream "Error parsing ~A on line ~A: ~A."
|
||||
source-file line-number message)))))
|
||||
(format stream "Error parsing ~A on line ~A: ~A."
|
||||
(trashinfo-format-error-source-file condition)
|
||||
(trashinfo-format-error-line-number condition)
|
||||
(trashinfo-format-error-message condition)))))
|
||||
|
||||
(defclass trashinfo ()
|
||||
((trash-directory :reader trashinfo-trash-directory
|
||||
@ -192,9 +193,10 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
|
||||
:ensure-directory t)
|
||||
with name = (file-or-dir-namestring path)
|
||||
with info-dir = (ensure-directories-exist
|
||||
(merge-pathnames #P"info/"
|
||||
(uiop:ensure-directory-pathname
|
||||
trash-directory))
|
||||
(uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P"info"
|
||||
(uiop:ensure-directory-pathname
|
||||
trash-directory)))
|
||||
:verbose nil)
|
||||
for info-file = (merge-pathnames
|
||||
(make-pathname
|
||||
|
||||
357
clash/clash.lisp
357
clash/clash.lisp
@ -40,10 +40,11 @@
|
||||
:initarg :message
|
||||
:documentation "A message describing the error."))
|
||||
(:report (lambda (condition stream)
|
||||
(with-slots (source pos message) condition
|
||||
(format
|
||||
stream "Failed to parse date ~S~@[ at position ~A~]: ~A"
|
||||
source pos message))))
|
||||
(format
|
||||
stream "Failed to parse date ~S~@[ at position ~A~]: ~A"
|
||||
(date-parse-error-source condition)
|
||||
(date-parse-error-position condition)
|
||||
(date-parse-error-message condition))))
|
||||
(:documentation "A condition representing a failure in parsing a date range."))
|
||||
|
||||
(defparameter *month-conversion-table*
|
||||
@ -234,6 +235,23 @@ date ranges.."))
|
||||
(defun clingon-filtering-options ()
|
||||
"Return some options that can be used by many commands for filtering."
|
||||
(list
|
||||
(clingon:make-option
|
||||
:list/filepath
|
||||
:key :extra-trashes
|
||||
:description "include additional trashes"
|
||||
:short-name #\c
|
||||
:long-name "include-trash")
|
||||
(clingon:make-option
|
||||
:list/filepath
|
||||
:key :ignored-trashes
|
||||
:description "ignore the given trash directory"
|
||||
:long-name "ignore-trash")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :only-explicit-dirs
|
||||
:description "only use trash directories supplied with -c"
|
||||
:short-name #\E
|
||||
:long-name "explicit-trashes-only")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :print-format-info
|
||||
@ -329,9 +347,11 @@ string."
|
||||
|
||||
(defun list-nonexcluded-trash-dirs (cmd)
|
||||
"Return a list of all trash directories, except those excluded by CMD."
|
||||
(append (set-difference (cl-xdg-trash:list-trash-directories)
|
||||
(clingon:getopt cmd :ignored-trashes)
|
||||
:test #'uiop:pathname-equal)
|
||||
(append (unless (clingon:getopt cmd :only-explicit-dirs)
|
||||
(set-difference (cl-xdg-trash:list-trash-directories)
|
||||
(mapcar #'uiop:ensure-directory-pathname
|
||||
(clingon:getopt cmd :ignored-trashes))
|
||||
:test #'uiop:pathname-equal))
|
||||
(mapcar #'ensure-nonwild-pathname
|
||||
(clingon:getopt cmd :extra-trashes))))
|
||||
|
||||
@ -371,6 +391,20 @@ string."
|
||||
|
||||
|
||||
;; Formatting
|
||||
(defun format-size (count &optional base-two (places 2))
|
||||
"Pretty print COUNT, which is a number of bytes. This will append metric
|
||||
suffixes as necessary. If BASE-TWO is non-nil, use MiB, GiB, etc. suffixes
|
||||
instead."
|
||||
(if (not count)
|
||||
"N/A" ;; if find the size of something failed
|
||||
(let* ((base (if base-two 1024 1000))
|
||||
(power (min 10 (floor (if (zerop count) 0 (log count base))))))
|
||||
(if (zerop power)
|
||||
(format nil "~DB" count)
|
||||
(format nil "~,VF~[~:[k~;K~]~:*~;M~;G~;T~;P~;E~;Z~;Y~;R~;Q~]~@[i~]B"
|
||||
places (/ count (expt base power))
|
||||
(1- power) base-two)))))
|
||||
|
||||
(defparameter *trashinfo-formatters*
|
||||
`((#\# :index
|
||||
"the index of the current file (used when prompting for files)")
|
||||
@ -399,11 +433,24 @@ string."
|
||||
stream (trashinfo-deletion-date info)
|
||||
:format local-time:+asctime-format+))
|
||||
"the (t)ime the file was trashed (pretty-printed local time)")
|
||||
(#\t ,(lambda (stream info)
|
||||
(#\s ,(lambda (stream info)
|
||||
(format stream "~A" (trashed-file-size
|
||||
(trashinfo-trash-directory info)
|
||||
(trashinfo-name info))))
|
||||
"the file's (s)size")
|
||||
"the file's (s)size in bytes")
|
||||
(#\h ,(lambda (stream info)
|
||||
(format stream "~A"
|
||||
(format-size (trashed-file-size
|
||||
(trashinfo-trash-directory info)
|
||||
(trashinfo-name info)))))
|
||||
"the file's size with a (h)uman readable suffix (powers of 10)")
|
||||
(#\H ,(lambda (stream info)
|
||||
(format stream "~A"
|
||||
(format-size (trashed-file-size
|
||||
(trashinfo-trash-directory info)
|
||||
(trashinfo-name info))
|
||||
t)))
|
||||
"the file's size with a (H)uman readable suffix (power of 2)")
|
||||
(#\% ,(lambda (stream info)
|
||||
(declare (ignore info))
|
||||
(format stream "%"))
|
||||
@ -539,14 +586,7 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
"Return options for the \"list\" subcommand."
|
||||
(append
|
||||
(clingon-filtering-options)
|
||||
(clingon-sort-options)
|
||||
(list
|
||||
(clingon:make-option
|
||||
:list/filepath
|
||||
:key :extra-trashes
|
||||
:description "include additional trashes"
|
||||
:short-name #\c
|
||||
:long-name "include-trash"))))
|
||||
(clingon-sort-options)))
|
||||
|
||||
(defun list/command ()
|
||||
"Return the Clingon command for the \"list\" subcommand."
|
||||
@ -600,10 +640,83 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
|
||||
|
||||
;; Restore command
|
||||
(declaim (inline single-item-list-p))
|
||||
(defun single-item-list-p (list)
|
||||
"Return non-nil if LIST has only one thing."
|
||||
(and list (null (cdr list))))
|
||||
|
||||
(defun prompt-for-index (stream action max &optional allow-many)
|
||||
"Prompt the user for an index between 1 and MAX to restore. With ALLOW-MANY,
|
||||
return a list of many indices instead."
|
||||
(when (zerop max)
|
||||
(error "Nothing found..."))
|
||||
(format stream "~&Select ~:[indices~;index~] to ~A: "
|
||||
(or (eql 1 max) (not allow-many)) action)
|
||||
(let ((resp-string (read-line stream nil))
|
||||
(seperators '(#\Space #\Tab #\,)))
|
||||
(unless resp-string
|
||||
(error "No number provided"))
|
||||
(let ((parts (uiop:split-string resp-string
|
||||
:separator seperators))
|
||||
(out (make-hash-table :test #'eql)))
|
||||
(unless parts
|
||||
(error "No number provided"))
|
||||
(unless (or allow-many
|
||||
(single-item-list-p parts))
|
||||
(error "Only one item can be selected"))
|
||||
(dolist (part parts)
|
||||
(unless (every (lambda (c) (member c seperators)) part)
|
||||
(let ((n (parse-integer part)))
|
||||
(when (or (< n 1)
|
||||
(> n max))
|
||||
(error "Number ~A out of range [1,~A]" n max))
|
||||
(setf (gethash (1- n) out) t))))
|
||||
(loop for key being the hash-keys of out collect key))))
|
||||
|
||||
(defun restore/handler (cmd)
|
||||
"Handler for the \"restore\" subcommand."
|
||||
(le))
|
||||
(if (clingon:getopt cmd :print-format-info)
|
||||
(print-format-info t)
|
||||
(let ((format (process-format-string (or (clingon:getopt cmd :format)
|
||||
"%#: %t %o\\n")))
|
||||
(infos (list-trashinfos-for-cmd cmd))
|
||||
(target (clingon:getopt cmd :target))
|
||||
(all (clingon:getopt cmd :all))
|
||||
(cli-indices (clingon:getopt cmd :indices)))
|
||||
(when (and all target)
|
||||
(error "Only one of -a and -t can be supplied"))
|
||||
(cond
|
||||
((and (clingon:getopt cmd :dont-prompt-only-one)
|
||||
(single-item-list-p infos))
|
||||
(cl-xdg-trash:restore-file (car infos)))
|
||||
((clingon:getopt cmd :all)
|
||||
(mapc #'cl-xdg-trash:restore-file infos))
|
||||
(cli-indices
|
||||
(unless infos
|
||||
(error "Nothing found..."))
|
||||
(loop with sorted-arr = (sort-trashinfos-for-cmd
|
||||
(coerce infos 'vector) cmd)
|
||||
for i in cli-indices
|
||||
when (or (> i (length sorted-arr))
|
||||
(< i 1))
|
||||
do (error "Index ~S out of bounds [1,~S]"
|
||||
i (length sorted-arr))
|
||||
do (cl-xdg-trash:restore-file (aref sorted-arr (1- i)))))
|
||||
(t
|
||||
(let ((sorted-arr (coerce infos 'vector)))
|
||||
(sort-trashinfos-for-cmd sorted-arr cmd)
|
||||
(loop for info across sorted-arr
|
||||
for i upfrom 1
|
||||
do (format-trashinfo t format info :index i))
|
||||
(let ((idxs (prompt-for-index t "restore"
|
||||
(length sorted-arr)
|
||||
(not target))))
|
||||
(if target
|
||||
(cl-xdg-trash:restore-file (aref sorted-arr (car idxs))
|
||||
:target target)
|
||||
(loop for i in idxs
|
||||
do (cl-xdg-trash:restore-file
|
||||
(aref sorted-arr i)))))))))))
|
||||
|
||||
(defun restore/options ()
|
||||
"Return options for the \"restore\" subcommand."
|
||||
@ -611,10 +724,16 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
(clingon-filtering-options)
|
||||
(clingon-sort-options)
|
||||
(list
|
||||
(clingon:make-option
|
||||
:filepath
|
||||
:key :target
|
||||
:description "where path to restore the file (exclusive with -a)"
|
||||
:short-name #\t
|
||||
:long-name "target")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :all
|
||||
:description "restore all files that match the pattern"
|
||||
:description "restore all files that match the pattern (exclusive with -t)"
|
||||
:short-name #\a
|
||||
:long-name "all")
|
||||
(clingon:make-option
|
||||
@ -627,7 +746,7 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :dont-prompt-only-one
|
||||
:descrition "don't prompt if the pattern matches only one file"
|
||||
:description "don't prompt if the pattern matches only one file"
|
||||
:short-name #\O
|
||||
:long-name "dont-prompt-only-one"))))
|
||||
|
||||
@ -635,23 +754,192 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
"Rethrn the Clingon command for the \"restore\" subcommand."
|
||||
(clingon:make-command
|
||||
:name "restore"
|
||||
:descrition "move files out of the trash"
|
||||
:description "move files out of the trash"
|
||||
:usage "[options] [pattern]"
|
||||
:options (restore/options)
|
||||
:handler #'restore/handler))
|
||||
|
||||
|
||||
;; Toplevel command
|
||||
(defun toplevel/options ()
|
||||
"Return the toplevel options list."
|
||||
;; Empty command
|
||||
(defun prompt-yes-or-no (stream control &rest args)
|
||||
"Prompt the user for a yes or no response."
|
||||
(when control
|
||||
(apply #'format stream control args)
|
||||
(format stream "? (y/n) "))
|
||||
(let ((resp-string (read-line stream nil)))
|
||||
(when resp-string
|
||||
(member resp-string '("yes" "y" "1") :test #'equalp))))
|
||||
|
||||
(defun prompt-to-empty (count quiet)
|
||||
"Prompt for emptying the trash for the \"empty\" command. Specifically, used
|
||||
with -n and -a."
|
||||
(prompt-yes-or-no
|
||||
t "Really erase ~@[~*the above ~]~@[~*~A~:* ~]file~P"
|
||||
(not quiet) (or quiet (/= 1 count)) count))
|
||||
|
||||
(defun empty/handler (cmd)
|
||||
"Handler for the \"empty\" subcommand."
|
||||
(cond
|
||||
((clingon:getopt cmd :print-format-info)
|
||||
(print-format-info t))
|
||||
(t
|
||||
(let ((format (process-format-string
|
||||
(or (clingon:getopt cmd :format)
|
||||
"%#: %t %o\\n")))
|
||||
(dry-run (clingon:getopt cmd :dry-run))
|
||||
(infos (coerce (list-trashinfos-for-cmd cmd) 'vector))
|
||||
(quiet (clingon:getopt cmd :quiet))
|
||||
(yes (clingon:getopt cmd :yes))
|
||||
(all (clingon:getopt cmd :all))
|
||||
(indices (clingon:getopt cmd :indices)))
|
||||
(when (and yes (not (or all indices)))
|
||||
(error "Found -y with neither -a nor -n, doing nothing"))
|
||||
(when (and quiet (not (or all indices)))
|
||||
(error "Found -q with neither -a nor -n, doing nothing"))
|
||||
(when (and (zerop (length infos)) (not quiet))
|
||||
(error "Nothing found..."))
|
||||
(unless all
|
||||
(sort-trashinfos-for-cmd infos cmd))
|
||||
(unless (or yes quiet)
|
||||
(loop for info across infos
|
||||
for i upfrom 1
|
||||
when (or (not indices) (member i indices))
|
||||
do (format-trashinfo t format info :index i)))
|
||||
(cond
|
||||
(all
|
||||
(when (or yes (prompt-to-empty (length infos) quiet))
|
||||
(loop for info across infos
|
||||
do (cl-xdg-trash:empty-file info :dry-run dry-run))))
|
||||
(indices
|
||||
(when (or yes (prompt-to-empty (length indices) quiet))
|
||||
(loop for i in indices
|
||||
when (or (< i 1)
|
||||
(> i (length infos)))
|
||||
do (error "Index ~A out of bounds [1,~A]"
|
||||
i (length infos))
|
||||
else
|
||||
do (cl-xdg-trash:empty-file (aref infos (1- i))
|
||||
:dry-run dry-run))))
|
||||
(t
|
||||
(let ((index (prompt-for-index t "erase" (length infos) t)))
|
||||
(dolist (i index)
|
||||
(cl-xdg-trash:empty-file (aref infos i) :dry-run dry-run)))))))))
|
||||
|
||||
(defun empty/options ()
|
||||
"Return options for the \"empty\" subcommand."
|
||||
(append
|
||||
(clingon-filtering-options)
|
||||
(clingon-sort-options)
|
||||
(list
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :dry-run
|
||||
:description "print what would happen without actually deleting anything"
|
||||
:short-name #\D
|
||||
:long-name "dry-run")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :all
|
||||
:description "erase all matching files"
|
||||
:short-name #\a
|
||||
:long-name "all")
|
||||
(clingon:make-option
|
||||
:list/integer
|
||||
:key :indices
|
||||
:description
|
||||
"erase the Nth file that matched the pattern (after sorting)"
|
||||
:short-name #\n
|
||||
:long-name "nth")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :yes
|
||||
:description "erase files without prompting (implies -q)"
|
||||
:short-name #\y
|
||||
:long-name "yes")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :quiet
|
||||
:description "be less verbose"
|
||||
:short-name #\q
|
||||
:long-name "quiet"))))
|
||||
|
||||
(defun empty/command ()
|
||||
"Return the Clingon command for the \"empty\" subcommand."
|
||||
(clingon:make-command
|
||||
:name "empty"
|
||||
:aliases '("erase" "rm")
|
||||
:description "delete files from the trash permanently"
|
||||
:options (empty/options)
|
||||
:handler #'empty/handler))
|
||||
|
||||
|
||||
;; List trash directories command
|
||||
(defun list-trashes/handler (cmd)
|
||||
"Handler for the \"list-trashes\" subcommand."
|
||||
(let* ((only-home (clingon:getopt cmd :home))
|
||||
(only-toplevel (clingon:getopt cmd :toplevel))
|
||||
(null (clingon:getopt cmd :null))
|
||||
(dirs (cond
|
||||
((or (and only-home only-toplevel)
|
||||
(not (or only-home only-toplevel)))
|
||||
(cl-xdg-trash:list-trash-directories))
|
||||
(only-home
|
||||
(list (cl-xdg-trash:user-home-trash-directory)))
|
||||
(only-toplevel
|
||||
(cl-xdg-trash:list-toplevel-trash-directories)))))
|
||||
(dolist (dir dirs)
|
||||
(format t "~A" (uiop:native-namestring dir))
|
||||
(if null
|
||||
(write-char #\Nul)
|
||||
(terpri)))))
|
||||
|
||||
(defun list-trashes/options ()
|
||||
"Return options for the \"list-trashes\" subcommand."
|
||||
(list
|
||||
(clingon:make-option
|
||||
:list
|
||||
:key :ignored-trashes
|
||||
:description "ignore the given trash directory"
|
||||
:long-name "ignore-trash"
|
||||
:persistent t)))
|
||||
:flag
|
||||
:key :home
|
||||
:description "only list the user's home trash directory"
|
||||
:short-name #\o
|
||||
:long-name "home")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :toplevel
|
||||
:description "only list toplevel trash directories"
|
||||
:short-name #\t
|
||||
:long-name "toplevel")
|
||||
(clingon:make-option
|
||||
:flag
|
||||
:key :null
|
||||
:description "use \\0 (null byte) instead of newline"
|
||||
:short-name #\0
|
||||
:long-name "null")))
|
||||
|
||||
(defun list-trashes/command ()
|
||||
"Return the Clingon command for the \"list-trashes\" subcommand."
|
||||
(clingon:make-command
|
||||
:name "list-trashes"
|
||||
:description "list known trash directories"
|
||||
:options (list-trashes/options)
|
||||
:handler #'list-trashes/handler))
|
||||
|
||||
|
||||
;; Size command
|
||||
(defun size/handler (cmd)
|
||||
"Handler for the \"size\" subcommand."
|
||||
)
|
||||
|
||||
(defun size/options ()
|
||||
"Return options for the \"size\" subcommand."
|
||||
(list
|
||||
()))
|
||||
|
||||
(defun size/command ()
|
||||
"Return the Clingon command for the \"size\" subcommand.")
|
||||
|
||||
|
||||
|
||||
;; Toplevel command
|
||||
(defun toplevel/command ()
|
||||
"Return the toplevel command."
|
||||
(clingon:make-command
|
||||
@ -660,11 +948,16 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
||||
:version "0.1.0"
|
||||
:license "GPL3"
|
||||
:authors '("Alexander Rosenberg <zanderpkg@pm.me>")
|
||||
:options (toplevel/options)
|
||||
:sub-commands (list (list/command)
|
||||
(put/command))
|
||||
(put/command)
|
||||
(restore/command)
|
||||
(list-trashes/command)
|
||||
(empty/command))
|
||||
:handler #'(lambda (cmd)
|
||||
(clingon:print-usage-and-exit cmd t))))
|
||||
(let ((args (clingon:command-arguments cmd)))
|
||||
(when args
|
||||
(error "Unknown subcommand: ~S" (car args)))
|
||||
(clingon:print-usage-and-exit cmd t)))))
|
||||
|
||||
(defparameter *toplevel/help-option*
|
||||
(clingon:make-option
|
||||
|
||||
Reference in New Issue
Block a user