(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 ") :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)))))