981 lines
36 KiB
Common Lisp
981 lines
36 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)
|
|
(:import-from #:cl-xdg-trash/mountpoints
|
|
#:file-or-dir-namestring
|
|
#:ensure-nonwild-pathname)
|
|
(:import-from #:cl-xdg-trash/directorysizes
|
|
#:trashed-file-size)
|
|
(:use #:cl)
|
|
(: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))))))
|
|
|
|
|
|
;; Datetime stuff
|
|
(define-condition date-parse-error (error)
|
|
((source :accessor date-parse-error-source
|
|
:type string
|
|
:initarg :source
|
|
:documentation "The string that failed to parse.")
|
|
(pos :accessor date-parse-error-position
|
|
:type (or null integer)
|
|
:initarg :position
|
|
:initform nil
|
|
:documentation "The position of the error, or nil.")
|
|
(message :accessor date-parse-error-message
|
|
:type string
|
|
:initarg :message
|
|
:documentation "A message describing the error."))
|
|
(:report (lambda (condition stream)
|
|
(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*
|
|
'((1 "january" "jan")
|
|
(2 "february" "feb")
|
|
(3 "march" "mar")
|
|
(4 "april" "apr")
|
|
(5 "may")
|
|
(6 "june" "jun")
|
|
(7 "july" "jly" "jul")
|
|
(8 "august" "aug")
|
|
(9 "september" "sep")
|
|
(10 "october" "oct")
|
|
(11 "november" "nov")
|
|
(12 "december" "dec")))
|
|
|
|
(defun parse-month-string (str)
|
|
(loop for (num . text) in *month-conversion-table*
|
|
when (member str text :test 'equalp)
|
|
do (return num)))
|
|
|
|
(defun add-time-registers (source stamp registers)
|
|
(destructuring-bind (hour minute second am-pm) (last registers 4)
|
|
(local-time:adjust-timestamp stamp
|
|
(offset :sec (parse-integer (or second "0")))
|
|
(offset :minute (parse-integer (or minute "0")))
|
|
(offset :hour
|
|
(if (not hour)
|
|
0
|
|
(cond
|
|
((or (not am-pm) (equalp am-pm "am")) (parse-integer hour))
|
|
((equalp am-pm "pm") (+ (parse-integer hour) 12))
|
|
(t (error 'date-parse-error
|
|
:source source
|
|
:message
|
|
(format nil "excpected \"AM\"/\"PM\", got: ~A"
|
|
am-pm)))))))))
|
|
|
|
(defun current-year ()
|
|
"Return the current year."
|
|
(local-time:timestamp-year (local-time:now)))
|
|
|
|
(defun local-today ()
|
|
"Return a timestamp representing the midnight today in local-time."
|
|
(local-time:adjust-timestamp! (local-time:now)
|
|
(set :hour 0)
|
|
(set :minute 0)
|
|
(set :sec 0)
|
|
(set :nsec 0)))
|
|
|
|
(defparameter *date-parse-formats*
|
|
(let ((time-regexp
|
|
(format nil "(?:\\s|$)(?:\\s*([0-9]{1,2}):([0-9]{1,2})~
|
|
(?::([0-9]{1,2}))?(?:\\s*(AM|PM))?)?"))
|
|
out)
|
|
(flet ((def (regexp func)
|
|
(push (cons (cl-ppcre:create-scanner
|
|
(format nil "~A~A" regexp time-regexp)
|
|
:extended-mode t :case-insensitive-mode t
|
|
:multi-line-mode t)
|
|
func)
|
|
out))
|
|
(def-no-time (regexp func)
|
|
(push (cons (cl-ppcre:create-scanner regexp
|
|
:extended-mode t :case-insensitive-mode t
|
|
:multi-line-mode t)
|
|
func)
|
|
out)))
|
|
(def-no-time "^$"
|
|
(lambda (source registers)
|
|
(declare (ignore source registers))
|
|
(local-time:now)))
|
|
(def-no-time "[0-9]+"
|
|
(lambda (source registers)
|
|
(declare (ignore registers))
|
|
(local-time:unix-to-timestamp (parse-integer source))))
|
|
(def-no-time "now"
|
|
(lambda (source registers)
|
|
(declare (ignore source registers))
|
|
(local-time:now)))
|
|
(def "today"
|
|
(lambda (source registers)
|
|
(add-time-registers source
|
|
(local-today)
|
|
registers)))
|
|
(def "yesterday"
|
|
(lambda (source registers)
|
|
(add-time-registers source
|
|
(local-time:adjust-timestamp! (local-today)
|
|
(offset :day -1))
|
|
registers)))
|
|
;; 2025/10/23 3:00 pm
|
|
(def "([0-9]+)(?:\\s+|/)([0-9]{1,2})(?:\\s+|/)([0-9]{1,2})"
|
|
(lambda (source registers)
|
|
(destructuring-bind (year month day &rest ignore) registers
|
|
(declare (ignore ignore))
|
|
(add-time-registers source
|
|
(local-time:encode-timestamp
|
|
0 0 0 0
|
|
(parse-integer day)
|
|
(parse-integer month)
|
|
(parse-integer year))
|
|
registers))))
|
|
;; Oct 10/23 3:00 PM
|
|
(def "([A-Za-z]+)(?:\\s+|/)([0-9]{1,2})(?:(?:\\s+|/)([0-9]+))?"
|
|
(lambda (source registers)
|
|
(destructuring-bind (month-str day year &rest ignore)
|
|
registers
|
|
(declare (ignore ignore))
|
|
(let ((month (parse-month-string month-str)))
|
|
(unless month
|
|
(error 'date-parse-error
|
|
:source source
|
|
:message (format nil "unknown month: ~S" month-str)))
|
|
(add-time-registers source
|
|
(local-time:encode-timestamp
|
|
0 0 0 0
|
|
(parse-integer day)
|
|
month
|
|
(if year
|
|
(parse-integer year)
|
|
(current-year)))
|
|
registers))))))))
|
|
|
|
(defun parse-date-time (string)
|
|
"Parse date and time from STRING."
|
|
(dolist (entry *date-parse-formats*)
|
|
(destructuring-bind (scanner . func) entry
|
|
(multiple-value-bind (start end reg-starts reg-ends)
|
|
(cl-ppcre:scan scanner string)
|
|
(when (and (eql start 0)
|
|
(eql end (length string)))
|
|
(return-from parse-date-time
|
|
(funcall func
|
|
string
|
|
(loop for s across reg-starts
|
|
for e across reg-ends
|
|
when (and s e)
|
|
collect (subseq string s e)
|
|
else
|
|
collect nil))))))))
|
|
|
|
(defun parse-date-range (string)
|
|
"Parse a date range from STRING."
|
|
(let ((sep (search ".." string)))
|
|
(when (not sep)
|
|
(error 'date-parse-error
|
|
:source string
|
|
:message "expected \"..\" to separate start and end date"))
|
|
(let ((second-sep (search ".." string :start2 (1+ sep))))
|
|
(when second-sep
|
|
(error 'date-parse-error :source string
|
|
:position second-sep
|
|
:message "multiple \"..\" found")))
|
|
(macrolet ((trim (str)
|
|
`(string-trim '(#\Tab #\Space #\Newline) ,str)))
|
|
(cons (parse-date-time (trim (subseq string 0 sep)))
|
|
(parse-date-time (trim (subseq string (+ sep 2))))))))
|
|
|
|
(defun timestamp-in-ranges (stamp ranges)
|
|
"Return non-nil if STAMP is in one of RANGES."
|
|
(some (lambda (range)
|
|
(destructuring-bind (start . end) range
|
|
(when (local-time:timestamp> start end)
|
|
(rotatef start end))
|
|
(and (local-time:timestamp>= stamp start)
|
|
(local-time:timestamp<= stamp end))))
|
|
ranges))
|
|
|
|
(defclass option-date-range (clingon:option)
|
|
((ranges :accessor option-date-range-ranges
|
|
:initarg ranges
|
|
:initform nil
|
|
:type list
|
|
:documentation "List of conses of local-time:timestamps representing
|
|
date ranges.."))
|
|
(:default-initargs :parameter "RANGE"))
|
|
|
|
(defmethod clingon:derive-option-value ((option option-date-range) arg &key)
|
|
(push (parse-date-range arg) (option-date-range-ranges option))
|
|
(option-date-range-ranges option))
|
|
|
|
(defmethod clingon:make-option ((kind (eql :date-range)) &rest args)
|
|
(apply #'make-instance 'option-date-range args))
|
|
|
|
|
|
;; Filtering
|
|
(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
|
|
:description "print information about format strings, then exit"
|
|
:long-name "format-info")
|
|
(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
|
|
:string
|
|
:key :format
|
|
:description "format to print results in"
|
|
:short-name #\f
|
|
:long-name "format")
|
|
(clingon:make-option
|
|
:date-range
|
|
:key :date-ranges
|
|
:description "range of dates to consider in search"
|
|
:short-name #\R
|
|
:long-name "date-range")))
|
|
|
|
(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-for-cmd (cmd trashinfos)
|
|
(let ((ranges (clingon:getopt cmd :date-ranges)))
|
|
(if (not ranges)
|
|
trashinfos
|
|
(delete-if (lambda (info)
|
|
(not (timestamp-in-ranges (trashinfo-deletion-date info)
|
|
ranges)))
|
|
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-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))))))
|
|
|
|
|
|
;; 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)")
|
|
(#\o ,(lambda (stream info)
|
|
(format stream "~A" (trashinfo-original-path info)))
|
|
"the (o)riginal path")
|
|
(#\n ,(lambda (stream info)
|
|
(format stream "~A" (file-or-dir-namestring
|
|
(trashinfo-original-path info))))
|
|
"the original (n)ame")
|
|
(#\d ,(lambda (stream info)
|
|
(format stream "~A" (trashinfo-trash-directory info)))
|
|
"the trash (d)irectory")
|
|
(#\i ,(lambda (stream info)
|
|
(format stream "~A" (trashinfo-info-file info)))
|
|
"the trash(i)nfo file path")
|
|
(#\c ,(lambda (stream info)
|
|
(format stream "~A" (trashinfo-trashed-file info)))
|
|
"the (c)urrent (trashed) path")
|
|
(#\u ,(lambda (stream info)
|
|
(format stream "~A" (local-time:timestamp-to-unix
|
|
(trashinfo-deletion-date info))))
|
|
"the time the file was trashed (in (u)TC seconds)")
|
|
(#\t ,(lambda (stream info)
|
|
(local-time:format-timestring
|
|
stream (trashinfo-deletion-date info)
|
|
:format local-time:+asctime-format+))
|
|
"the (t)ime the file was trashed (pretty-printed local time)")
|
|
(#\s ,(lambda (stream info)
|
|
(format stream "~A" (trashed-file-size
|
|
(trashinfo-trash-directory info)
|
|
(trashinfo-name info))))
|
|
"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 "%"))
|
|
"a liternal %")))
|
|
|
|
(defun process-format-string (format-string)
|
|
"Process FORMAT-STRING into a list of string and functions."
|
|
(let ((start 0)
|
|
out end)
|
|
(labels ((ensure-next-char (i thing)
|
|
(unless (< i (1- (length format-string)))
|
|
(error "Unterminated ~A at char ~A: ~S" thing i format-string)))
|
|
(unknown (i thing)
|
|
(error "Unknown ~A at char ~A: ~S" thing i format-string))
|
|
(push-thing (thing)
|
|
(if (null out)
|
|
(setq out (list thing)
|
|
end out)
|
|
(setf (cdr end) (list thing)
|
|
end (cdr end))))
|
|
(push-string (str)
|
|
(unless (zerop (length str))
|
|
(if (stringp (car end))
|
|
(setf (car end) (format nil "~A~A" (car end) str))
|
|
(push-thing str)))))
|
|
(do ((i 0 (1+ i)))
|
|
((>= i (length format-string)))
|
|
(case (aref format-string i)
|
|
(#\%
|
|
(ensure-next-char i "substitution")
|
|
(push-string (subseq format-string start i))
|
|
(let ((fun (second (assoc (aref format-string (1+ i))
|
|
*trashinfo-formatters*))))
|
|
(unless fun
|
|
(unknown i "substitution"))
|
|
(push-thing fun))
|
|
(setq start (+ i 2)
|
|
i (1+ i)))
|
|
(#\\
|
|
(ensure-next-char i "escape sequence")
|
|
(push-string (subseq format-string start i))
|
|
(push-string
|
|
(case (aref format-string (1+ i))
|
|
(#\\ "\\")
|
|
(#\n (string #\Newline))
|
|
(#\t (string #\Tab))
|
|
(#\0 (string #\Nul))
|
|
(t (unknown i "escape sequence"))))
|
|
(setq start (+ i 2)
|
|
i (1+ i)))))
|
|
(push-string (subseq format-string start))
|
|
out)))
|
|
|
|
(defun format-trashinfo (stream format-object info &key (index 1))
|
|
"Format the trashinfo INFO to STREAM accoring to FORMAT-OBJECT (which is from
|
|
process-format-string)."
|
|
(dolist (part format-object)
|
|
(cond
|
|
((eq :index part)
|
|
(format stream "~A" index))
|
|
((stringp part)
|
|
(format stream "~A" part))
|
|
(t (funcall part stream info)))))
|
|
|
|
(defun print-format-info (&optional (stream t))
|
|
(format stream "~
|
|
Format strings use C-style and printf-style escape sequences. Each character
|
|
other than one of those with a special meaning noted below is copied to the
|
|
output verbatim. The recognized C-style escapes sequences are:
|
|
\"\\0\" - null byte
|
|
\"\\n\" - newline
|
|
\"\\t\" - tab character
|
|
\"\\\\\" - literal backslash
|
|
The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
|
|
(dolist (entry *trashinfo-formatters*)
|
|
(let ((char (first entry))
|
|
(doc (third entry)))
|
|
(format stream " \"%~A\" - ~A~%" char doc))))
|
|
|
|
|
|
;; 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))
|
|
: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 #'trashinfo-original-path))
|
|
(:deletion-date (values
|
|
#'< (lambda (info) (local-time:timestamp-to-unix
|
|
(trashinfo-deletion-date info))))))
|
|
(sort trashinfos
|
|
(if (clingon:getopt cmd :reverse-sort)
|
|
(complement pred-fun)
|
|
pred-fun)
|
|
:key key-fun)))
|
|
|
|
|
|
;; List command
|
|
(defun list/handler (cmd)
|
|
"Handler for the \"list\" subcommand."
|
|
(if (clingon:getopt cmd :print-format-info)
|
|
(print-format-info t)
|
|
(let ((format (process-format-string (or (clingon:getopt cmd :format)
|
|
"%t %o\\n"))))
|
|
(loop for info in (sort-trashinfos-for-cmd
|
|
(list-trashinfos-for-cmd cmd) cmd)
|
|
for i upfrom 1
|
|
do (format-trashinfo t format info :index i)))))
|
|
|
|
(defun list/options ()
|
|
"Return options for the \"list\" subcommand."
|
|
(append
|
|
(clingon-filtering-options)
|
|
(clingon-sort-options)))
|
|
|
|
(defun list/command ()
|
|
"Return the Clingon command for the \"list\" subcommand."
|
|
(clingon:make-command
|
|
:name "list"
|
|
: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))))
|
|
|
|
(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."
|
|
(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."
|
|
(append
|
|
(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 (exclusive with -t)"
|
|
:short-name #\a
|
|
:long-name "all")
|
|
(clingon:make-option
|
|
:list/integer
|
|
:key :indices
|
|
:description
|
|
"restore the Nth file that matched the pattern (after sorting)"
|
|
: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 file"
|
|
:short-name #\O
|
|
:long-name "dont-prompt-only-one"))))
|
|
|
|
(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 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
|
|
: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
|
|
: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))
|
|
:handler #'(lambda (cmd)
|
|
(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
|
|
: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.")
|
|
|
|
(defun toplevel (&optional (args () argsp))
|
|
"Program entry point.
|
|
Args can be supplied to facilitate testing in SLIME."
|
|
(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)))))
|