1031 lines
37 KiB
Common Lisp
1031 lines
37 KiB
Common Lisp
(defpackage clash
|
||
(:documentation "Command line interface to the XDG trashcan.")
|
||
(:import-from #:cl-xdg-trash/trashinfo
|
||
#:trashinfo-original-path
|
||
#:trashinfo-trash-directory
|
||
#:trashinfo-info-file
|
||
#:trashinfo-name
|
||
#:trashinfo-trashed-file
|
||
#:trashinfo-deletion-date
|
||
#:parse-trashinfo-file)
|
||
(:import-from #:cl-xdg-trash/mountpoints
|
||
#:file-or-dir-namestring
|
||
#:ensure-nonwild-pathname)
|
||
(:use #:cl #:clash/parse-date #:clash/format)
|
||
(:export #:toplevel))
|
||
|
||
(in-package :clash)
|
||
|
||
;; remove extra newline at the end of the usage message
|
||
(defmethod clingon:print-usage :around (command stream &key)
|
||
(let ((msg (with-output-to-string (str-stream)
|
||
(call-next-method command str-stream))))
|
||
(format stream "~A" (subseq msg 0 (1- (length msg))))))
|
||
|
||
|
||
;; Filtering
|
||
(defparameter *byte-count-suffixes* "kmgtpezyrq"
|
||
"Metric power suffixes used in parse-byte-count.")
|
||
(defparameter *byte-count-pattern*
|
||
(cl-ppcre:create-scanner
|
||
(format nil "^\\s*(?(?=(?:^|[^0-9])\\.[0-9])|([0-9]+))\\.?((?<=\\.)[0-9]+)?~
|
||
\\s*(?:(?:([kmgtpezyrq])(i)?)?B)?$\\s*")
|
||
:extended-mode t
|
||
:case-insensitive-mode t)
|
||
"Regexp scanner for parse-byte-count.")
|
||
|
||
(defun make-float (int dec)
|
||
(if (zerop dec)
|
||
(float int)
|
||
(+ (float int)
|
||
(* (if (minusp int) -1 1)
|
||
(/ (float dec)
|
||
(expt 10 (1+ (floor (log dec 10)))))))))
|
||
|
||
(defun find-suffix-expt (suffix)
|
||
"Find the exponent for SUFFIX."
|
||
(1+ (or (position (coerce suffix 'character)
|
||
*byte-count-suffixes* :test #'equalp)
|
||
-1)))
|
||
|
||
(defun parse-byte-count (string)
|
||
"Parse a byte count from STRING."
|
||
(or (ppcre:register-groups-bind
|
||
((#'parse-integer int dec)
|
||
(#'find-suffix-expt power) base-two)
|
||
(*byte-count-pattern* string :sharedp t)
|
||
(let ((count (* (make-float (or int 0) (or dec 0))
|
||
(expt (if base-two 1024 1000) (or power 0)))))
|
||
(if (and (not power) (plusp (mod count 1)))
|
||
(error "Byte count is not a natural number: ~A" count)
|
||
(values (floor count)))))
|
||
(error "Not a byte count: ~S" string)))
|
||
|
||
(defun parse-byte-range (string)
|
||
"Parse STRING, which should be range of byte counts."
|
||
(destructuring-bind (&optional start end &rest rest)
|
||
(uiop:split-string string :separator '(#\- #\: #\~))
|
||
(when rest
|
||
(error "Garbage after byte range: ~S" string))
|
||
(cond
|
||
((and (plusp (length start))
|
||
(plusp (length end)))
|
||
(cons (parse-byte-count start)
|
||
(parse-byte-count end)))
|
||
((and (plusp (length start))
|
||
(stringp end))
|
||
(cons (parse-byte-count start) nil))
|
||
((stringp end)
|
||
(cons 0 (parse-byte-count end)))
|
||
((plusp (length start))
|
||
(let ((n (parse-byte-count start)))
|
||
(cons n n)))
|
||
(t (error "Not a byte range: ~S" string)))))
|
||
|
||
(defun number-in-byte-ranges (num ranges)
|
||
"Return non-nil if NUM falls within one of RANGES."
|
||
(some (lambda (range)
|
||
(and (>= num (car range))
|
||
(or (not (cdr range))
|
||
(<= num (cdr range)))))
|
||
ranges))
|
||
|
||
(defun print-byte-range-help (stream)
|
||
"Print information about byte range parsing to STREAM."
|
||
(format stream "~
|
||
Byte counts take the form of a number with an optional size suffix. Some
|
||
examples follow (all supported suffixes are listed at the end):
|
||
\"32\" - 32 bytes
|
||
\"51B\" - 51 bytes (space between the number and unit is optional)
|
||
\"3.1B\" - (INVALID) fractional count of bytes
|
||
\".3 KiB\" - 307 bytes (the .2 is rounded off)
|
||
\"1.3 kB\" - 1300 bytes (1.3 kilobytes)
|
||
\"5.3 MiB\" - 5300000 bytes (5.3 mebibytes)
|
||
Byte ranges take the form of one or two byte counts separated by a \"-\", \":\",
|
||
or \"~~\". If one count is given with no separator, items of exactly that size
|
||
match. Otherwise, items between the bounds of the range (inclusive of those
|
||
bounds) match. If the lower bound of a range is omitted (but the separator still
|
||
present), the lower bound is zero. If the upper bound is omitted, there is no
|
||
upper bound. Some examples:
|
||
\"30\" - exactly 30 bytes
|
||
\"-5TB\" - less that or equal to 5 terabytes
|
||
\"10GiB:\" - greater than or equal to 10 gibigytes
|
||
\"10kB-30kB\" - between 10 kilobytes and 30 kilobytes (inclusive)
|
||
Ranges are provided to commands that support them via the -S or --size-range
|
||
flags. These flags can be given any number of times and anything that lies
|
||
within at at least one range will match (that is, the union of all ranges).
|
||
|
||
The following suffixes are recognized (in additon to \"B\"):
|
||
+----------------------+----------------------+
|
||
| ~20:@<Base 10~> | ~20:@<Base 2~> |
|
||
+----------------------+----------------------+
|
||
~:{| ~20@<~:@(~A~)B - 1000^~D~> | ~@*~20@<~:@(~A~)iB - 1024^~D~> |~%~}~
|
||
+----------------------+----------------------+~%"
|
||
(loop for c across *byte-count-suffixes*
|
||
for i upfrom 1
|
||
collect (list c i))))
|
||
|
||
(defun clingon-dir-options ()
|
||
"Return some options that can be used by many commands."
|
||
(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"
|
||
:short-name #\I
|
||
: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")))
|
||
|
||
(defun clingon-filtering-options ()
|
||
"Return some options that can be used by many commands for filtering."
|
||
(append
|
||
(clingon-dir-options)
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :strings
|
||
:description "don't use regexp to match file names"
|
||
:short-name #\s
|
||
:long-name "strings")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :exact
|
||
:description "force exact match"
|
||
:short-name #\e
|
||
:long-name "exact")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :full-path
|
||
:description "match against full file paths"
|
||
:short-name #\p
|
||
:long-name "full-paths")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :case-insensitive
|
||
:description "match case-insensitively"
|
||
:short-name #\i
|
||
:long-name "case-insensitive")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :invert
|
||
:description "invert result"
|
||
:short-name #\v
|
||
:long-name "invert")
|
||
(clingon:make-option
|
||
:date-range
|
||
:key :date-ranges
|
||
:description "range of dates to consider in search"
|
||
:short-name #\R
|
||
:long-name "date-range")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :date-help
|
||
:description "print information about date ranges"
|
||
:long-name "date-help")
|
||
(clingon:make-option
|
||
:multi-parsed
|
||
:key :size-ranges
|
||
:description
|
||
"range of file sizes to consider in search (suffixes like GB or KiB work)"
|
||
:parser #'parse-byte-range
|
||
:parameter "RANGE"
|
||
:short-name #\S
|
||
:long-name "size-range")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :size-help
|
||
:description "print information about size ranges"
|
||
:long-name "size-help"))))
|
||
|
||
(declaim (inline compare-trashinfo-to-string))
|
||
(defun compare-trashinfo-to-string (trashinfo filter full-path exact
|
||
case-insensitive)
|
||
"Compare TRASHINFO's name or path to FILTER using the provided matching
|
||
options."
|
||
(let* ((orig-path (trashinfo-original-path trashinfo))
|
||
(target (if full-path orig-path (file-or-dir-namestring orig-path))))
|
||
(cond
|
||
((and exact case-insensitive) (equalp target filter))
|
||
(exact (equal target filter))
|
||
(t (search filter target :test (if case-insensitive #'equalp #'eql))))))
|
||
|
||
(declaim (inline compare-trashinfo-to-scanner))
|
||
(defun compare-trashinfo-to-scanner (trashinfo filter full-path exact)
|
||
"Compare TRASHINFO's name or path to FILTER, which is a cl-ppcre scanner."
|
||
(let* ((orig-path (trashinfo-original-path trashinfo))
|
||
(target (if full-path orig-path (file-or-dir-namestring orig-path))))
|
||
(multiple-value-bind (start end) (cl-ppcre:scan filter target)
|
||
(and start
|
||
(or (not exact)
|
||
(and (= start 0) (= end (length target))))))))
|
||
|
||
(defun filter-trashinfos-by (trashinfos filter &key regexp full-path
|
||
exact case-insensitive
|
||
invert)
|
||
"Filter the list of trashinfo objects TRASHINFOS by FILTER, which is a
|
||
string."
|
||
(if regexp
|
||
(let ((scanner (cl-ppcre:create-scanner
|
||
filter :case-insensitive-mode case-insensitive)))
|
||
(remove-if
|
||
(lambda (info)
|
||
(let ((res (compare-trashinfo-to-scanner info scanner
|
||
full-path exact)))
|
||
(or (and (not invert) (not res))
|
||
(and invert res))))
|
||
trashinfos))
|
||
(remove-if
|
||
(lambda (info)
|
||
(let ((res (compare-trashinfo-to-string
|
||
info filter full-path exact case-insensitive)))
|
||
(or (and (not invert) (not res))
|
||
(and invert res))))
|
||
trashinfos)))
|
||
|
||
(defun list-nonexcluded-trash-dirs (cmd)
|
||
"Return a list of all trash directories, except those excluded by CMD."
|
||
(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))))
|
||
|
||
(defun limit-trashinfo-dates-and-sizes-for-cmd (cmd trashinfos)
|
||
(let ((dates (clingon:getopt cmd :date-ranges))
|
||
(sizes (clingon:getopt cmd :size-ranges)))
|
||
(if (and (not dates) (not sizes))
|
||
trashinfos
|
||
(delete-if (lambda (info)
|
||
(or (and dates
|
||
(not (timestamp-in-ranges
|
||
(trashinfo-deletion-date info) dates)))
|
||
(and sizes
|
||
(not (number-in-byte-ranges
|
||
(or (trashinfo-size info) 0) sizes)))))
|
||
trashinfos))))
|
||
|
||
(defun list-trashinfos-for-cmd (cmd)
|
||
"List trashinfos for the command CMD."
|
||
(let ((args (clingon:command-arguments cmd)))
|
||
(when (cdr args)
|
||
(clingon:print-usage-and-exit cmd t))
|
||
(limit-trashinfo-dates-and-sizes-for-cmd
|
||
cmd
|
||
(if (not (car args))
|
||
(cl-xdg-trash:list-trashed-files (list-nonexcluded-trash-dirs cmd))
|
||
(let ((filter (car args))
|
||
(strings (clingon:getopt cmd :strings))
|
||
(exact (clingon:getopt cmd :exact))
|
||
(full-path (clingon:getopt cmd :full-path))
|
||
(case-insensitive (clingon:getopt cmd :case-insensitive))
|
||
(invert (clingon:getopt cmd :invert)))
|
||
(filter-trashinfos-by
|
||
(cl-xdg-trash:list-trashed-files
|
||
(list-nonexcluded-trash-dirs cmd))
|
||
filter
|
||
:regexp (not strings)
|
||
:exact exact
|
||
:full-path full-path
|
||
:case-insensitive case-insensitive
|
||
:invert invert))))))
|
||
|
||
|
||
;; Sorting
|
||
(defun clingon-sort-options ()
|
||
"Return a list of sorting options that can be used by many commands."
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :reverse-sort
|
||
:description "reverse sort order"
|
||
:short-name #\r
|
||
:long-name "reverse-sort")
|
||
(clingon:make-option
|
||
:enum
|
||
:key :sort-field
|
||
:description "sort field"
|
||
:short-name #\l
|
||
:long-name "sort-field"
|
||
:items '(("name" . :name)
|
||
("path" . :path)
|
||
("deletion-date" . :deletion-date)
|
||
("size" . :size))
|
||
:initial-value "deletion-date")))
|
||
|
||
(defun sort-trashinfos-for-cmd (trashinfos cmd)
|
||
"Sort the TRASHINFOS according to options passed to CMD."
|
||
(multiple-value-bind (pred-fun key-fun)
|
||
(case (clingon:getopt cmd :sort-field)
|
||
(:name (values #'string-lessp
|
||
(lambda (info) (file-or-dir-namestring
|
||
(trashinfo-original-path info)))))
|
||
(:path (values #'string-lessp
|
||
(lambda (info)
|
||
(uiop:unix-namestring
|
||
(trashinfo-original-path info :resolve t)))))
|
||
(:deletion-date (values
|
||
#'< (lambda (info) (local-time:timestamp-to-unix
|
||
(trashinfo-deletion-date info)))))
|
||
(:size (values (lambda (s1 s2)
|
||
;; if finding the file's size fails, either of these
|
||
;; may be nil
|
||
(cond
|
||
((not s1) t)
|
||
((not s2) nil)
|
||
((< s1 s2))))
|
||
#'trashinfo-size)))
|
||
(sort trashinfos
|
||
(if (clingon:getopt cmd :reverse-sort)
|
||
(complement pred-fun)
|
||
pred-fun)
|
||
:key key-fun)))
|
||
|
||
|
||
;; Formatting
|
||
(defun clingon-format-options (file-default &optional dir-default)
|
||
"Return a list of formatting options that can be used by many commands."
|
||
(append
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :format-help
|
||
:description "print information about format strings, then exit"
|
||
:long-name "format-help")
|
||
(clingon:make-option
|
||
:format-string
|
||
:key :file-format
|
||
:directives *trashinfo-formatters*
|
||
:description "format for printing individual trashed files"
|
||
:short-name #\f
|
||
:long-name "file-format"
|
||
:initial-value file-default))
|
||
(when dir-default
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :directory-wise
|
||
:description "operate on trash directories rather than on trashed files"
|
||
:short-name #\d
|
||
:long-name "direcotries")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :all-directories
|
||
:description "even show directories that have no results"
|
||
:short-name #\D
|
||
:long-name "all-directories")
|
||
(clingon:make-option
|
||
:format-string
|
||
:key :dir-format
|
||
:directives *directory-formatters*
|
||
:description "format for printing trash directories"
|
||
:short-name #\F
|
||
:long-name "directory-format"
|
||
:initial-value dir-default)))))
|
||
|
||
(defun parition-trashinfos (infos)
|
||
"Partition INFOS into a list of conses with the car being the path of the
|
||
trash directory and the cdr being it's trashinfos. As a second value, return a
|
||
list of trash directories that were present in INFOS."
|
||
(let ((out (make-hash-table :test #'equal)))
|
||
(loop for info in infos
|
||
for dir = (uiop:unix-namestring (trashinfo-trash-directory info))
|
||
do (setf (gethash dir out) (cons info (gethash dir out))))
|
||
(loop for dir being the hash-keys of out
|
||
using (hash-value infos)
|
||
collect (cons dir infos) into path-and-infos
|
||
collect dir into dirs
|
||
finally (return (values path-and-infos dirs)))))
|
||
|
||
(defun list-objects-for-command (cmd &optional no-sort)
|
||
"List either individual trashinfos or partitioned trashinfos for CMD."
|
||
(let ((infos (list-trashinfos-for-cmd cmd))
|
||
(all-dirs (clingon:getopt cmd :all-directories)))
|
||
(cond
|
||
((clingon:getopt cmd :directory-wise)
|
||
(multiple-value-bind (path-and-infos dirs) (parition-trashinfos infos)
|
||
(nconc path-and-infos
|
||
(mapcar #'list
|
||
(when all-dirs
|
||
(set-difference (list-nonexcluded-trash-dirs cmd)
|
||
dirs :test #'uiop:pathname-equal))))))
|
||
(all-dirs (error "Can't have -D without -d"))
|
||
(no-sort infos)
|
||
(t (sort-trashinfos-for-cmd infos cmd)))))
|
||
|
||
(defun print-objects-for-command (cmd objs &key (indices t) extra-action)
|
||
"Print OBJS, a list of trashinfos or trash directories, for CMD."
|
||
(if (clingon:getopt cmd :directory-wise)
|
||
(format-list t (clingon:getopt cmd :dir-format) objs
|
||
:indices indices :extra-action extra-action)
|
||
(format-list t (clingon:getopt cmd :file-format) objs
|
||
:indices indices :extra-action extra-action)))
|
||
|
||
|
||
;; List command
|
||
(defun list/handler (cmd)
|
||
"Handler for the \"list\" subcommand."
|
||
(let* ((quiet (clingon:getopt cmd :quiet))
|
||
(objs (list-objects-for-command cmd quiet))
|
||
(total (clingon:getopt cmd :total))
|
||
(dir-wise (clingon:getopt cmd :directory-wise))
|
||
(total-count 0))
|
||
(when (and quiet (not total))
|
||
(error "Can't have -q without -t"))
|
||
(cond
|
||
((and quiet dir-wise)
|
||
(dolist (path-and-infos objs)
|
||
(incf total-count (length (cdr path-and-infos)))))
|
||
(quiet (setq total-count (length objs)))
|
||
(t (print-objects-for-command
|
||
cmd objs
|
||
:extra-action (lambda (obj)
|
||
(incf total-count
|
||
(if dir-wise (length (cdr obj)) 1))))))
|
||
(when total
|
||
(format t "~@[~*Total Matches: ~]~D~%" (not quiet) total-count))))
|
||
|
||
(defun list/options ()
|
||
"Return options for the \"list\" subcommand."
|
||
(append
|
||
(clingon-format-options "%t %o\\n" "Found %c file%m in %p\\n")
|
||
(clingon-filtering-options)
|
||
(clingon-sort-options)
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :total
|
||
:description "print a total after all matches"
|
||
:short-name #\t
|
||
:long-name "total")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :quiet
|
||
:description "don't print matches (use with -t)"
|
||
:short-name #\q
|
||
:long-name "quiet"))))
|
||
|
||
(defun list/command ()
|
||
"Return the Clingon command for the \"list\" subcommand."
|
||
(clingon:make-command
|
||
:name "list"
|
||
:aliases '("ls")
|
||
:description "list files in trash directories"
|
||
:usage "[options] [pattern]"
|
||
:options (list/options)
|
||
:handler #'list/handler))
|
||
|
||
|
||
;; Put command
|
||
(defun put/handler (cmd)
|
||
"Handler for the \"put\" subcommand."
|
||
(let ((no-cross-device (clingon:getopt cmd :no-cross-device))
|
||
(ignored-dirs (clingon:getopt cmd :ignored-trashes))
|
||
(trash-directory (clingon:getopt cmd :trash-directory)))
|
||
(dolist (file (clingon:command-arguments cmd))
|
||
(handler-case
|
||
(cl-xdg-trash:trash-file file :no-cross-device no-cross-device
|
||
:ignored-trash-dirs ignored-dirs
|
||
:trash-directory trash-directory)
|
||
;; in case of an error, just notify the user and continue
|
||
(error (e)
|
||
(format *error-output* "~&~A~&" e))))))
|
||
|
||
(defun put/options ()
|
||
"Return options for the \"put\" subcommand."
|
||
(list
|
||
(clingon:make-option
|
||
:filepath
|
||
:key :trash-directory
|
||
:description "force trashing to a specific directory"
|
||
:long-name "trash-directory")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :no-cross-device
|
||
:description "don't trash files to directories on different devices"
|
||
:short-name #\n
|
||
:long-name "no-cross-device")))
|
||
|
||
(defun put/command ()
|
||
"Return the Clingon command for the \"put\" subcommand"
|
||
(clingon:make-command
|
||
:name "put"
|
||
:aliases '("trash")
|
||
:description "move files to the trash"
|
||
:usage "[-n|--no-cross-device] [--trash-directory=DIR] [files...]"
|
||
:options (put/options)
|
||
:handler #'put/handler))
|
||
|
||
|
||
;; 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))))
|
||
|
||
(declaim (inline enumerate-range))
|
||
(defun enumerate-range (start end)
|
||
"Enumerate all numbers between [start,end]."
|
||
(loop for i upfrom (min start end)
|
||
upto (max start end)
|
||
collect i))
|
||
|
||
(defun parse-index-or-range (max string)
|
||
"Parse the index or range of indices STRING."
|
||
(flet ((parse (str)
|
||
(let ((n (parse-integer str)))
|
||
(when (or (< n 1)
|
||
(> n max))
|
||
(error "Number ~D out of range [1,~D]" n max))
|
||
(1- n))))
|
||
(let ((parts (uiop:split-string string :separator '(#\-))))
|
||
(destructuring-bind (start &optional end &rest rest)
|
||
(mapcar (lambda (part) (string-trim '(#\Space #\Tab) part)) parts)
|
||
(cond
|
||
(rest (error "Invalid range: ~S" string))
|
||
((and (not (zerop (length start)))
|
||
(not (zerop (length end))))
|
||
(enumerate-range (parse start) (parse end)))
|
||
((not (zerop (length end)))
|
||
(enumerate-range 0 (parse end)))
|
||
((and (not (zerop (length start))) (stringp end))
|
||
(enumerate-range (parse start) (1- max)))
|
||
;; if none of the above match, it must be just a number
|
||
(t (list (parse string))))))))
|
||
|
||
(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)
|
||
(finish-output (if (eq stream t) *standard-output* stream))
|
||
(let ((resp-string (read-line *standard-input* nil)))
|
||
(unless resp-string
|
||
(error "No number provided"))
|
||
(let ((parts (uiop:split-string resp-string :separator '(#\,)))
|
||
(out (make-hash-table :test #'eql)))
|
||
(unless parts
|
||
(error "No number provided"))
|
||
(dolist (part parts)
|
||
(dolist (n (parse-index-or-range max part))
|
||
(setf (gethash n out) t)))
|
||
(let ((final-list (loop for key being the hash-keys of out collect key)))
|
||
(unless (or allow-many (single-item-list-p parts))
|
||
(error "Only one item can be selected"))
|
||
final-list))))
|
||
|
||
(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) "))
|
||
(finish-output (if (eq stream t) *standard-output* stream))
|
||
(let ((resp-string (read-line *standard-input* nil)))
|
||
(when resp-string
|
||
(member resp-string '("yes" "y" "1") :test #'equalp))))
|
||
|
||
(defun confirm-action (action count quiet)
|
||
"Confirm with the user that ACTION is OK."
|
||
(prompt-yes-or-no
|
||
t "Really ~A ~@[~*the above ~]~@[~*~A~:* ~]item~P"
|
||
action (not quiet) (or quiet (/= 1 count)) count))
|
||
|
||
(defun get-indices-for-command (action cmd only-one-flag objs)
|
||
"Return indices for CMD."
|
||
(let* ((max (length objs))
|
||
(all (clingon:getopt cmd :all))
|
||
(indices (mapcar
|
||
(lambda (i)
|
||
(when (or (< i 1)
|
||
(> i max))
|
||
(error "Index ~D out of range [1,~D]" i max))
|
||
(1- i))
|
||
(clingon:getopt cmd :indices)))
|
||
(yes (clingon:getopt cmd :yes))
|
||
(quiet (clingon:getopt cmd :quiet))
|
||
(dont-prompt-only-one (clingon:getopt cmd :dont-prompt-only-one)))
|
||
(when only-one-flag
|
||
(when all
|
||
(error "Can't use -a and ~A together" only-one-flag))
|
||
(when (and indices
|
||
(not (single-item-list-p indices)))
|
||
(error "Cant use multiple -n and ~A together" only-one-flag)))
|
||
(when (and indices all)
|
||
(error "Can't use -a and -n together"))
|
||
(unless (or yes quiet)
|
||
(print-objects-for-command cmd objs :indices (or indices t)))
|
||
(cond
|
||
((not objs) (unless quiet
|
||
(error "Nothing to do...")))
|
||
((and dont-prompt-only-one (single-item-list-p objs))
|
||
(list 0))
|
||
(all (if (or yes
|
||
(confirm-action action max (or yes quiet)))
|
||
(enumerate-range 0 (1- max))
|
||
:cancel))
|
||
(indices (if (or yes
|
||
(confirm-action action (length indices)
|
||
(or yes quiet)))
|
||
indices
|
||
:cancel))
|
||
(yes (error "One of -a or -n must be passed with -y"))
|
||
(quiet (error "One of -a or -n must be passed with -q"))
|
||
(t (prompt-for-index t action max (not only-one-flag))))))
|
||
|
||
(defun clingon-indices-options (action)
|
||
"Return options for prompting the user for indices."
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :all
|
||
:description
|
||
(format nil "~A all things that match the pattern" action)
|
||
:short-name #\a
|
||
:long-name "all")
|
||
(clingon:make-option
|
||
:list/integer
|
||
:key :indices
|
||
:description
|
||
(format nil "~A the Nth thing that matched the pattern (after sorting)"
|
||
action)
|
||
:short-name #\n
|
||
:long-name "nth")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :dont-prompt-only-one
|
||
:description "don't prompt if the pattern matches only one thing"
|
||
:short-name #\O
|
||
:long-name "dont-prompt-only-one")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :quiet
|
||
:description (format nil "don't enumerate all options before ~Aing" action)
|
||
:short-name #\q
|
||
:long-name "quiet")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :yes
|
||
:description "don't prompt, just ~A all matching things"
|
||
:short-name #\y
|
||
:long-name "yes")))
|
||
|
||
(defun restore/handler (cmd)
|
||
"Handler for the \"restore\" subcommand."
|
||
(let* ((quiet (clingon:getopt cmd :quiet))
|
||
(no-sort (and (clingon:getopt cmd :all) quiet))
|
||
(infos (list-objects-for-command cmd no-sort))
|
||
(target (clingon:getopt cmd :target))
|
||
(indices (get-indices-for-command "restore" cmd
|
||
(when target "-t")
|
||
infos)))
|
||
;; ensure we actually have a list of trashinfos
|
||
(assert (or (null infos) (not (listp (car infos)))))
|
||
(unless (eq indices :cancel)
|
||
(assert (or (not target) (single-item-list-p indices)))
|
||
(if target
|
||
(cl-xdg-trash:restore-file (nth (car indices) infos) :target target)
|
||
(loop with arr = (coerce infos 'vector)
|
||
for i in indices
|
||
do (format t "~A~%" (aref arr i))
|
||
do (cl-xdg-trash:restore-file (aref arr i)))))))
|
||
|
||
(defun restore/options ()
|
||
"Return options for the \"restore\" subcommand."
|
||
(append
|
||
(clingon-filtering-options)
|
||
(clingon-sort-options)
|
||
(clingon-format-options "%>#: %t %o\\n")
|
||
(clingon-indices-options "restore")
|
||
(list
|
||
(clingon:make-option
|
||
:filepath
|
||
:key :target
|
||
:description "where path to restore the file (exclusive with -a)"
|
||
:short-name #\t
|
||
:long-name "target"))))
|
||
|
||
(defun restore/command ()
|
||
"Rethrn the Clingon command for the \"restore\" subcommand."
|
||
(clingon:make-command
|
||
:name "restore"
|
||
:description "move files out of the trash"
|
||
:usage "[options] [pattern]"
|
||
:options (restore/options)
|
||
:handler #'restore/handler))
|
||
|
||
|
||
;; Empty command
|
||
(defun empty/handler (cmd)
|
||
"Handler for the \"empty\" subcommand."
|
||
(let* ((dir-wise (clingon:getopt cmd :directory-wise))
|
||
(dry-run (clingon:getopt cmd :dry-run))
|
||
(quiet (clingon:getopt cmd :quiet))
|
||
(no-sort (and (clingon:getopt cmd :all) quiet))
|
||
(objs (list-objects-for-command cmd no-sort))
|
||
(indices (get-indices-for-command "erase" cmd nil objs)))
|
||
(unless (eq indices :cancel)
|
||
(if dir-wise
|
||
(loop with objs-arr = (coerce objs 'vector)
|
||
for i in indices
|
||
do (dolist (info (cdr (aref objs-arr i)))
|
||
(cl-xdg-trash:empty-file info :dry-run dry-run)))
|
||
(loop with infos-arr = (coerce objs 'vector)
|
||
for i in indices
|
||
do (cl-xdg-trash:empty-file (aref infos-arr i)
|
||
:dry-run dry-run))))))
|
||
|
||
(defun empty/options ()
|
||
"Return options for the \"empty\" subcommand."
|
||
(append
|
||
(clingon-filtering-options)
|
||
(clingon-sort-options)
|
||
(clingon-format-options "%>#: %t %o\\n" "%>#: %p\\n")
|
||
(clingon-indices-options "erase")
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :dry-run
|
||
:description "print what would happen without actually deleting anything"
|
||
:short-name #\N
|
||
:long-name "dry-run"))))
|
||
|
||
(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
|
||
: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."
|
||
(let* ((quiet (clingon:getopt cmd :quiet))
|
||
(objs (list-objects-for-command cmd quiet))
|
||
(dir-wise (clingon:getopt cmd :directory-wise))
|
||
(base-two (clingon:getopt cmd :base-two))
|
||
(bytes (clingon:getopt cmd :bytes))
|
||
(total-size 0)
|
||
(*format-switch-base-two-base-ten* base-two))
|
||
(when (and bytes base-two)
|
||
(error "Can't pass both -t and -b"))
|
||
(flet ((sum (size)
|
||
(when size (incf total-size size))))
|
||
(cond
|
||
((and quiet dir-wise)
|
||
(dolist (path-and-infos objs)
|
||
(dolist (info (cdr path-and-infos))
|
||
(sum (trashinfo-size info)))))
|
||
(quiet
|
||
(dolist (info objs)
|
||
(sum (trashinfo-size info))))
|
||
(dir-wise
|
||
(print-objects-for-command
|
||
cmd objs :extra-action (lambda (path-and-infos)
|
||
(dolist (info (cdr path-and-infos))
|
||
(sum (trashinfo-size info))))))
|
||
(t
|
||
(print-objects-for-command
|
||
cmd objs :extra-action (lambda (info)
|
||
(sum (trashinfo-size info)))))))
|
||
(format t "~@[~*Total Size: ~]~D~%"
|
||
(not quiet) (if bytes
|
||
total-size
|
||
(format-size total-size base-two)))))
|
||
|
||
(defun size/options ()
|
||
"Return options for the \"size\" subcommand."
|
||
(append
|
||
(clingon-filtering-options)
|
||
(clingon-sort-options)
|
||
(clingon-format-options "%<h %o\\n" "%<h %p\\n")
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :base-two
|
||
:description
|
||
"use base two sizes for the final tally (also switch %h and %H format codes)"
|
||
:short-name #\t
|
||
:long-name "base-two")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :bytes
|
||
:description "print the final tally in bytes"
|
||
:short-name #\b
|
||
:long-name "bytes")
|
||
(clingon:make-option
|
||
:flag
|
||
:key :quiet
|
||
:description "only print the final tally"
|
||
:short-name #\q
|
||
:long-name "quiet"))))
|
||
|
||
(defun size/command ()
|
||
"Return the Clingon command for the \"size\" subcommand."
|
||
(clingon:make-command
|
||
:name "size"
|
||
:description "find the size of one or more trash directory"
|
||
:options (size/options)
|
||
:handler #'size/handler))
|
||
|
||
|
||
;; List files missing either a trashinfo or trashinfos missing a file
|
||
(defun missing-trashinfo/handler (cmd)
|
||
"Handler for the \"missing trashinfo\" subcommand."
|
||
(let ((dirs (list-nonexcluded-trash-dirs cmd))
|
||
(null (clingon:getopt cmd :null)))
|
||
(dolist (dir dirs)
|
||
(dolist (missing
|
||
(delete-if (lambda (path)
|
||
(handler-case
|
||
(parse-trashinfo-file
|
||
dir (file-or-dir-namestring path))
|
||
(error () nil)))
|
||
(uiop:directory*
|
||
(merge-pathnames uiop:*wild-file-for-directory*
|
||
(uiop:ensure-directory-pathname
|
||
(merge-pathnames "files" dir))))))
|
||
(format t "~A~:[~%~;~A~]"
|
||
(uiop:native-namestring missing) null #\Nul)))))
|
||
|
||
(defun missing-file/handler (cmd)
|
||
"Handler for the \"missing file\" subcommand."
|
||
(let ((infos (delete-if (lambda (info)
|
||
(probe-file (trashinfo-trashed-file info)))
|
||
(cl-xdg-trash:list-trashed-files
|
||
(list-nonexcluded-trash-dirs cmd) t)))
|
||
(format (clingon:getopt cmd :format-string)))
|
||
(format-list t format infos)))
|
||
|
||
(defun missing-file/options ()
|
||
"Return options for the \"missing file\" subcommand."
|
||
(append
|
||
(clingon-dir-options)
|
||
(list
|
||
(clingon:make-option
|
||
:flag
|
||
:key :print-format-info
|
||
:description "print information about format strings, then exit"
|
||
:long-name "format-info")
|
||
(clingon:make-option
|
||
:format-string
|
||
:key :format-string
|
||
:description "format for printing each entry"
|
||
:directives *trashinfo-formatters*
|
||
:initial-value "%i %c\\n"
|
||
:short-name #\f
|
||
:long-name "format"))))
|
||
|
||
(defun handle-toplevel-with-subcommands (cmd)
|
||
"Handler for \"missing\" and the toplevel command."
|
||
(let ((args (clingon:command-arguments cmd)))
|
||
(when args
|
||
(error "Unknown subcommand: ~S" (car args)))
|
||
(clingon:print-usage-and-exit cmd t)))
|
||
|
||
(defun missing/command ()
|
||
"Return the Clingon command for the \"missing\" subcommand."
|
||
(clingon:make-command
|
||
:name "missing"
|
||
:description "list unrecoverable files"
|
||
:handler #'handle-toplevel-with-subcommands
|
||
:sub-commands
|
||
(list (clingon:make-command
|
||
:name "trashinfo"
|
||
:aliases '("trashinfos" "info" "infos")
|
||
:description "list trashed files missing their trashinfo file"
|
||
:options (cons
|
||
(clingon:make-option
|
||
:flag
|
||
:key :null
|
||
:description "use null bytes instead of newlines"
|
||
:short-name #\0
|
||
:long-name "null")
|
||
(clingon-dir-options))
|
||
:handler #'missing-trashinfo/handler)
|
||
(clingon:make-command
|
||
:name "file"
|
||
:aliases '("files")
|
||
:description "list trashinfo files missing their trashed file"
|
||
:options (missing-file/options)
|
||
:handler #'missing-file/handler))))
|
||
|
||
|
||
;; Toplevel command
|
||
(defun toplevel/command ()
|
||
"Return the toplevel command."
|
||
(clingon:make-command
|
||
:name "clash"
|
||
:description "command line interface to the XDG trashcan"
|
||
:version "0.1.0"
|
||
:license "GPL3"
|
||
:authors '("Alexander Rosenberg <zanderpkg@pm.me>")
|
||
:sub-commands (list (list/command)
|
||
(put/command)
|
||
(restore/command)
|
||
(list-trashes/command)
|
||
(empty/command)
|
||
(size/command)
|
||
(missing/command))
|
||
:handler #'handle-toplevel-with-subcommands))
|
||
|
||
(defparameter *toplevel/help-option*
|
||
(clingon:make-option
|
||
:flag
|
||
:key :clingon.help.flag
|
||
:description "display usage information, then exit"
|
||
:short-name #\h
|
||
:long-name "help"
|
||
:persistent t)
|
||
"Help option to replace the default Clingon one.")
|
||
|
||
(defmethod clingon:finalize-command :after ((cmd clingon:command))
|
||
;; handle the various help options
|
||
(when (clingon:getopt cmd :format-help)
|
||
(print-clash-format-info (clingon:getopt cmd :dir-format) t)
|
||
(error 'clingon:exit-error :code 0))
|
||
(when (clingon:getopt cmd :date-help)
|
||
(print-date-parsing-help t)
|
||
(error 'clingon:exit-error :code 0))
|
||
(when (clingon:getopt cmd :size-help)
|
||
(print-byte-range-help t)
|
||
(error 'clingon:exit-error :code 0)))
|
||
|
||
(defun toplevel (&optional (args () argsp))
|
||
"Program entry point.
|
||
Args can be supplied to facilitate testing in SLIME."
|
||
#+(and sbcl (not slynk)) (sb-ext:disable-debugger)
|
||
(let ((clingon:*default-options* (list clingon:*default-version-flag*
|
||
clingon:*default-bash-completions-flag*
|
||
*toplevel/help-option*)))
|
||
(if argsp
|
||
(clingon:run (toplevel/command) args)
|
||
(clingon:run (toplevel/command)))))
|