diff --git a/cl-xdg-trash/directorysizes.lisp b/cl-xdg-trash/directorysizes.lisp index ce307cb..3e9bac1 100644 --- a/cl-xdg-trash/directorysizes.lisp +++ b/cl-xdg-trash/directorysizes.lisp @@ -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))) diff --git a/cl-xdg-trash/mountpoints.lisp b/cl-xdg-trash/mountpoints.lisp index 6ae57d2..84e7cf4 100644 --- a/cl-xdg-trash/mountpoints.lisp +++ b/cl-xdg-trash/mountpoints.lisp @@ -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)) diff --git a/cl-xdg-trash/package.lisp b/cl-xdg-trash/package.lisp index be41e02..40e5179 100644 --- a/cl-xdg-trash/package.lisp +++ b/cl-xdg-trash/package.lisp @@ -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)) diff --git a/cl-xdg-trash/trash.lisp b/cl-xdg-trash/trash.lisp index eec0108..91f15ae 100644 --- a/cl-xdg-trash/trash.lisp +++ b/cl-xdg-trash/trash.lisp @@ -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) diff --git a/cl-xdg-trash/trashinfo.lisp b/cl-xdg-trash/trashinfo.lisp index c48e687..6fccdfd 100644 --- a/cl-xdg-trash/trashinfo.lisp +++ b/cl-xdg-trash/trashinfo.lisp @@ -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 diff --git a/clash/clash.lisp b/clash/clash.lisp index 2ccddb6..a432c98 100644 --- a/clash/clash.lisp +++ b/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 ") - :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