Fix some bugs and add date-based filtering

cl-xdg-trash/directorysizes.lisp

@@ -55,6 +55,7 @@ part of STRING."
         while line
         for (size mtime encoded-name) = (split-string line #\Space 3)
         for name = (url-decode encoded-name)
+        when (and size mtime encoded-name)
           do (setf (gethash name out)
                    (make-directorysizes-entry
                     :size (parse-integer size)
@@ -86,6 +87,12 @@ part of STRING."
         do (with-slots (size mtime) entry
              (format stream "~A ~A ~A~%" size mtime (url-encode name)))))
 
+(declaim (ftype (function ((or string pathname)) pathname) parent-directory))
+(defun parent-directory (path)
+  "Return the parent directory of PATH."
+  (uiop:pathname-parent-directory-pathname
+   (uiop:ensure-directory-pathname path)))
+
 (defmacro with-atomic-write ((stream path) &body body)
   "Evaluate BODY with STREAM bound to a stream that will write to a temporary
 file. If execution is successful, rename this temporary file to PATH, replacing
@@ -94,7 +101,7 @@ it."
         (target-path (gensym "TARGET-PATH-"))
         (dir (gensym "DIR")))
     `(let* ((,target-path (ensure-nonwild-pathname ,path))
-            (,dir (uiop:pathname-parent-directory-pathname ,target-path)))
+            (,dir (parent-directory ,target-path)))
        (uiop:call-with-temporary-file
         #'(lambda (,stream ,tmp-path)
             ,@body
@@ -150,6 +157,9 @@ directory and the file size cache is out of date, update it."
                did-change (not (eql size orig-size))
                ret-size size))))
     (when did-change
+      (handler-case
           (with-atomic-write (stream directorysizes-path)
-        (format-directorysizes stream directorysizes)))
+            (format-directorysizes stream directorysizes))
+        ;; ignore errors when updating the cache
+        (osicat-posix:posix-error ())))
     ret-size))

cl-xdg-trash/mountpoints.lisp

@@ -131,3 +131,7 @@ determined, return nil."
                   ;; we have reached the root
                   do (return cur)
                 finally (return (or prev bottom))))))))
+
+(defun same-device-p (path1 path2)
+  "Return non-nil if PATH1 and PATH2 are on the same device."
+  (uiop:pathname-equal (find-filesystem-root path1) (find-filesystem-root path2)))

cl-xdg-trash/package.lisp

@@ -15,7 +15,8 @@
            #:find-filesystem-root
            #:ensure-nonwild-pathname
            #:remove-suffix
-           #:file-or-dir-namestring))
+           #:file-or-dir-namestring
+           #:same-device-p))
 
 (defpackage :cl-xdg-trash/trashinfo
   (:documentation

cl-xdg-trash/trash.lisp

@@ -1,5 +1,39 @@
 (in-package :cl-xdg-trash)
 
+(define-condition trash-error (error)
+  ((trash-directory :accessor trash-error-trash-directory
+                    :type (or pathname string)
+                    :initarg :trash-directory
+                    :documentation "The trash directory of the operation."))
+  (:report (lambda (condition stream)
+             (format stream "Error operating on trash directory: ~S"
+                     (uiop:native-namestring (trash-error-trash-directory
+                                              condition)))))
+  (:documentation "A general error that arose when trashing files."))
+
+(define-condition cross-device-error (trash-error)
+  ((source :accessor cross-device-error-source
+           :type (or pathname string)
+           :initarg :source
+           :documentation "The file being moved by the operation.")
+   (target :accessor cross-device-error-target
+           :type (or pathname string)
+           :initarg :target
+           :documentation "The destination of the move operation."))
+  (:report (lambda (condition stream)
+             (with-slots (source target) condition
+               (format stream "~S and ~S lie on different devices"
+                       (uiop:native-namestring source)
+                       (uiop:native-namestring target)))))
+  (:documentation "An error that arose when moving files across devices."))
+
+(define-condition file-exists-error (file-error)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "File exists: ~S"
+                     (uiop:native-namestring (file-error-pathname condition)))))
+  (:documentation "An error representing the case that a file already exists."))
+
 (declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                 xdg-data-home))
 (defun xdg-data-home (&key homedir)
@@ -33,44 +67,41 @@
 (defun valid-toplevel-trash-dir-p (path)
   "Return non-nil if PATH is a valid toplevel trash directory. That is, it
 exists, is a directory, and: (1) is owned by the current user, (2) has the
-sticky bit set."
+sticky bit set (and the info/ and files/ subdirectories are the same)."
   (flet ((check-dir (path)
            (handler-case
                (let* ((path (ensure-nonwild-pathname path))
                       (stat (osicat-posix:stat path)))
                  (and (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
-                      (or (sticky-bit-set-p (osicat-posix:stat-mode stat))
+                      (sticky-bit-set-p (osicat-posix:stat-mode stat))
-                          ;; has to come second as this will throw if it fails
                       (osicat-posix:access path (logior osicat-posix:r-ok
-                                                            osicat-posix:w-ok)))))
+                                                        osicat-posix:w-ok))))
              (osicat-posix:posix-error () nil))))
-    (let* ((path (ensure-nonwild-pathname path :ensure-directory t))
+    (let* ((path (ensure-nonwild-pathname path :ensure-directory t)))
-           (dir-sizes-path (calculate-directorysizes-path path)))
+      (and (check-dir path)
-      (and (uiop:directory-exists-p path)
            (check-dir (merge-pathnames "info" path))
-           (check-dir (merge-pathnames "files" path))
+           (check-dir (merge-pathnames "files" path))))))
-           (if (not (uiop:file-exists-p dir-sizes-path))
-               (check-dir path)
-               (handler-case (osicat-posix:access dir-sizes-path
-                                                  (logior osicat-posix:r-ok
-                                                          osicat-posix:w-ok))
-                 (osicat-posix:posix-error () nil)))))))
 
 (declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel))
 (defun find-trash-dirs-for-toplevel (toplevel)
   "List the trash directories that exist under TOPLEVEL."
   (let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
         found)
-    (let ((dir (merge-pathnames #P".Trash" top-path)))
+    (let ((dir (merge-pathnames #P".Trash/" top-path)))
       (when (valid-toplevel-trash-dir-p dir)
         (push dir found)))
     (let ((uid (osicat-posix:getuid)))
       (when uid
-        (let ((dir (merge-pathnames (pathname (format nil ".Trash-~D" uid))
+        (let* ((dir (merge-pathnames (pathname (format nil ".Trash-~D/" uid))
-                                    top-path)))
+                                     top-path))
-          (when (valid-toplevel-trash-dir-p dir)
+               (stat (handler-case
+                         (osicat-posix:stat (uiop:native-namestring dir))
+                       (osicat-posix:posix-error () nil))))
+          (when (and stat
+                     (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
+                     (eql (osicat-posix:stat-uid stat) uid))
             (push dir found)))))
-    found))
+    (nreverse found)))
 
 (declaim (ftype (function () list) list-toplevel-trash-directories))
 (defun list-toplevel-trash-directories ()
@@ -92,34 +123,100 @@ directory)."
     (or (and include-self (uiop:pathname-equal path home))
         (uiop:subpathp path home))))
 
-(declaim (ftype (function ((or pathname string)) pathname)
+(declaim (ftype (function ((or pathname string) &optional list) pathname)
                 trash-directory-for-file))
-(defun trash-directory-for-file (path)
+(defun trash-directory-for-file (path &optional ignored-trash-dirs)
   "Return the trash directory into which PATH should be trashed."
   (let* ((res-path (ensure-nonwild-pathname path))
          (root (find-filesystem-root res-path)))
     (or (and (path-in-home-directory-p res-path)
              (uiop:pathname-equal (find-filesystem-root (user-homedir-pathname))
                                   root)
-             (car (find-trash-dirs-for-toplevel root)))
+             (user-home-trash-directory))
-        (user-home-trash-directory))))
+        (or (car (set-difference (find-trash-dirs-for-toplevel root)
+                                 ignored-trash-dirs
+                                 :test #'uiop:pathname-equal))
+            (user-home-trash-directory)))))
 
-(declaim (ftype (function ((or pathname string) &optional t) t) trash-file))
+(defun rename-safely (source target)
-(defun trash-file (path &optional (update-size-cache t))
+  "Move SOURCE to TARGET, signaling an error if TARGET already exists."
+  (let ((source (ensure-nonwild-pathname source))
+        (target (ensure-nonwild-pathname target)))
+    ;; without specific OS and file-system support, it's impossible to do theses
+    ;; two operations atomically, so we settle for this
+    (when (probe-file target)
+      (error 'file-exists-error :pathname target))
+    (osicat-posix:rename (uiop:native-namestring source)
+                         (uiop:native-namestring target))))
+
+(declaim (ftype (function ((or pathname string) (or pathname string)) t)
+                copy-file))
+(defun copy-file (source target)
+  "Copy the normal file SOURCE to TARGET. Error if TARGET already exists."
+  (with-open-file (in (ensure-nonwild-pathname source)
+                      :direction :input
+                      :if-does-not-exist :error)
+    (with-open-file (out (ensure-nonwild-pathname target)
+                         :direction :output
+                         :if-exists :error)
+      (uiop:copy-stream-to-stream in out))))
+
+(declaim (ftype (function ((or string pathname)
+                           (or string pathname)
+                           &key (:no-cross-device t))
+                          t)
+                move-or-copy-files))
+(defun move-or-copy-files (source target &key no-cross-device)
+  "Either or move or copy SOURCE to TARGET. Copy SOURCE if it is a regular file
+and SOURCE and TARGET lie on different devices. With NO-CROSS-DEVICE, don't
+ever copy and instead signal an error. Always error if SOURCE is a directory and
+SOURCE and TARGET lie on different devices."
+  (let ((source (ensure-nonwild-pathname source))
+        (target (ensure-nonwild-pathname target)))
+    (handler-case
+        (rename-safely source target)
+      (osicat-posix:exdev ()
+        (if (or no-cross-device
+                (uiop:directory-exists-p source))
+            (error 'cross-device-error :source source
+                                       :target target)
+            (progn
+              (copy-file source target)
+              (delete-file source)))))))
+
+(declaim (ftype (function ((or pathname string)
+                           &key
+                           (:no-cross-device t)
+                           (:ignored-trash-dirs list)
+                           (:update-size-cache t)
+                           (:trash-directory (or null string pathname)))
+                          t)
+                trash-file))
+(defun trash-file (path &key no-cross-device ignored-trash-dirs
+                          (update-size-cache t) trash-directory)
   "Move PATH to the trash. Specifically, move it to the proper trash as
 specified by the XDG standard. If UPDATE-SIZE-CACHE is non-nil (the default)
-also update the directory size cache."
+also update the directory size cache. If NO-CROSS-DEVICE is non-nil, don't trash
+files to directories on other devices. Also, don't move files to trash
+directories in IGNORED-TRASH-DIRS. With TRASH-DIRECTORY, force trashing to a
+specific directory."
   (let* ((path (merge-pathnames (ensure-nonwild-pathname path) (uiop:getcwd)))
-         (trash-directory (trash-directory-for-file path))
+         (trash-directory (if trash-directory
-         (trashinfo (make-trashinfo-for trash-directory path))
+                              (ensure-nonwild-pathname trash-directory
+                                                       :ensure-directory t)
+                              (trash-directory-for-file path ignored-trash-dirs)))
          (files-dir (ensure-directories-exist (merge-pathnames
                                                #P"files/" trash-directory)
-                                              :verbose nil)))
+                                              :verbose nil))
-    (osicat-posix:rename (uiop:native-namestring path)
+         (trashinfo (make-trashinfo-for trash-directory path))
-                         (uiop:native-namestring
+         (target (merge-pathnames (make-pathname
-                          (merge-pathnames
+                                   :name (trashinfo-name trashinfo))
-                           (make-pathname :name (trashinfo-name trashinfo))
                                   files-dir)))
+    (handler-bind
+        ((t (lambda (e)
+              (declare (ignore e))
+              (delete-file (trashinfo-info-file trashinfo)))))
+      (move-or-copy-files path target :no-cross-device no-cross-device))
     (when update-size-cache
       (trashed-file-size trash-directory (trashinfo-name trashinfo)))))
 
@@ -142,10 +239,12 @@ TRASH-DIRECTORY."
     (mapcan #'(lambda (path)
                 (let ((name (file-or-dir-namestring path)))
                   (when (uiop:string-suffix-p name ".trashinfo")
+                    (handler-case
                         (list (parse-trashinfo-file
                                trash-directory
                                (subseq name 0 (- (length name)
-                                             (length ".trashinfo"))))))))
+                                                 (length ".trashinfo")))))
+                      (trashinfo-format-error () nil)))))
             (uiop:directory-files info-dir))))
 
 (declaim (ftype (function (&optional (or pathname string list)) list)
@@ -156,29 +255,30 @@ TRASH-DIRECTORIES. TRASH-DIRECTORIES can also be a single path."
   (mapcan #'list-trashed-files-for-directory
           (normalize-trash-directories trash-directories)))
 
-(declaim (ftype (function (trashinfo &optional (or string pathname) t) t)
+(declaim (ftype (function (trashinfo &key (:target (or string pathname))
+                                     (:update-size-cache t)
+                                     (:no-cross-device t))
+                          t)
                 restore-file))
-(defun restore-file (trashinfo &optional
+(defun restore-file (trashinfo &key
-                                 (target (trashinfo-original-path
+                                 (target (trashinfo-original-path trashinfo))
-                                          trashinfo))
+                                 (update-size-cache t)
-                                 (update-size-cache t))
+                                 no-cross-device)
   "Restore the file pointed to by TRASHINFO. If UPDATE-SIZE-CACHE is non-nil
 (the default), also update the directory size cache."
-  (let ((target (ensure-nonwild-pathname target)))
+  (let ((source (trashinfo-trashed-file trashinfo))
-    (osicat-posix:rename
+        (target (ensure-nonwild-pathname target)))
-     (uiop:native-namestring (trashinfo-trashed-file trashinfo))
+    (move-or-copy-files source target :no-cross-device no-cross-device)
-     (uiop:native-namestring target)))
     (handler-bind
         ;; attempt to re-trash the file in case of error
         ((t #'(lambda (e)
-              (osicat-posix:rename
+                (move-or-copy-files target source
-               (uiop:native-namestring target)
+                                    :no-cross-device no-cross-device)
-               (uiop:native-namestring (trashinfo-trashed-file trashinfo)))
                 (signal e))))
       (delete-file (trashinfo-info-file trashinfo))
       (when update-size-cache
         (trashed-file-size (trashinfo-trash-directory trashinfo)
-                         (trashinfo-name trashinfo)))))
+                           (trashinfo-name trashinfo))))))
 
 (declaim (ftype (function (trashinfo &key (:dry-run t)) t) empty-file))
 (defun empty-file (trashinfo &key (dry-run t))
@@ -193,9 +293,12 @@ DRY-RUN, don't actually delete anything."
         (handler-case
             (progn
               (delete-file info-file)
-              (uiop:delete-directory-tree trashed-file
+              (if (uiop:directory-exists-p trashed-file)
+                  (uiop:delete-directory-tree
+                   (uiop:ensure-directory-pathname trashed-file)
                    :validate t
                    :if-does-not-exist :ignore)
+                  (delete-file trashed-file))
               (trashed-file-size trash-directory name))))))
 
 (declaim (ftype (function ((or string pathname)) list) directory-files))

clash/clash.lisp

@@ -8,7 +8,10 @@
                 #:trashinfo-trashed-file
                 #:trashinfo-deletion-date)
   (:import-from #:cl-xdg-trash/mountpoints
-                #:file-or-dir-namestring)
+                #:file-or-dir-namestring
+                #:ensure-nonwild-pathname)
+  (:import-from #:cl-xdg-trash/directorysizes
+                #:trashed-file-size)
   (:use #:cl)
   (:export #:toplevel))
 
@@ -20,6 +23,212 @@
                (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)
+             (with-slots (source pos message) condition
+               (format
+                stream "Failed to parse date ~S~@[ at position ~A~]: ~A"
+                source pos message))))
+  (: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 ()
@@ -65,7 +274,13 @@
     :key :format
     :description "format to print results in"
     :short-name #\f
-    :long-name "format")))
+    :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
@@ -84,9 +299,7 @@ options."
   "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))))
-    (destructuring-bind (start &optional end &rest ignore)
+    (multiple-value-bind (start end) (cl-ppcre:scan filter target)
-        (multiple-value-list (cl-ppcre:scan filter target))
-      (declare (ignore ignore))
       (and start
            (or (not exact)
                (and (= start 0) (= end (length target))))))))
@@ -116,15 +329,28 @@ string."
 
 (defun list-nonexcluded-trash-dirs (cmd)
   "Return a list of all trash directories, except those excluded by CMD."
-  (set-difference (cl-xdg-trash:list-trash-directories)
+  (append (set-difference (cl-xdg-trash:list-trash-directories)
                           (clingon:getopt cmd :ignored-trashes)
-                  :test #'uiop:pathname-equal))
+                          :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))
@@ -141,40 +367,47 @@ string."
             :exact exact
             :full-path full-path
             :case-insensitive case-insensitive
-           :invert invert)))))
+            :invert invert))))))
 
 
 ;; Formatting
 (defparameter *trashinfo-formatters*
-  `((#\o . ,(lambda (stream info)
+  `((#\# :index
-              "the (o)riginal path"
+         "the index of the current file (used when prompting for files)")
-              (format stream "~A" (trashinfo-original-path info))))
+    (#\o ,(lambda (stream info)
-    (#\n . ,(lambda (stream info)
+            (format stream "~A" (trashinfo-original-path info)))
-              "the original (n)ame"
+         "the (o)riginal path")
+    (#\n ,(lambda (stream info)
             (format stream "~A" (file-or-dir-namestring
-                                   (trashinfo-original-path info)))))
+                                 (trashinfo-original-path info))))
-    (#\d . ,(lambda (stream info)
+         "the original (n)ame")
-              "the trash (d)irectory"
+    (#\d ,(lambda (stream info)
-              (format stream "~A" (trashinfo-trash-directory info))))
+            (format stream "~A" (trashinfo-trash-directory info)))
-    (#\i . ,(lambda (stream info)
+         "the trash (d)irectory")
-              "the trash(i)nfo file path"
+    (#\i ,(lambda (stream info)
-              (format stream "~A" (trashinfo-info-file info))))
+            (format stream "~A" (trashinfo-info-file info)))
-    (#\c . ,(lambda (stream info)
+         "the trash(i)nfo file path")
-              "the (c)urrent (trashed) path"
+    (#\c ,(lambda (stream info)
-              (format stream "~A" (trashinfo-trashed-file info))))
+            (format stream "~A" (trashinfo-trashed-file info)))
-    (#\u . ,(lambda (stream info)
+         "the (c)urrent (trashed) path")
-              "the time the file was trashed (in (u)TC seconds)"
+    (#\u ,(lambda (stream info)
             (format stream "~A" (local-time:timestamp-to-unix
-                                   (trashinfo-deletion-date info)))))
+                                 (trashinfo-deletion-date info))))
-    (#\t . ,(lambda (stream info)
+         "the time the file was trashed (in (u)TC seconds)")
-              "the (t)ime the file was trashed (pretty-printed local time)"
+    (#\t ,(lambda (stream info)
             (local-time:format-timestring
              stream (trashinfo-deletion-date info)
-               :format local-time:+asctime-format+)))
+             :format local-time:+asctime-format+))
-    (#\% . ,(lambda (stream info)
+         "the (t)ime the file was trashed (pretty-printed local time)")
-              "a liternal %"
+    (#\t ,(lambda (stream info)
+            (format stream "~A" (trashed-file-size
+                                 (trashinfo-trash-directory info)
+                                 (trashinfo-name info))))
+         "the file's (s)size")
+    (#\% ,(lambda (stream info)
             (declare (ignore info))
-              (format stream "%")))))
+            (format stream "%"))
+         "a liternal %")))
 
 (defun process-format-string (format-string)
   "Process FORMAT-STRING into a list of string and functions."
@@ -202,9 +435,9 @@ string."
           (#\%
            (ensure-next-char i "substitution")
            (push-string (subseq format-string start i))
-           (let ((fun (cdr (assoc (aref format-string (1+ i))
+           (let ((fun (second (assoc (aref format-string (1+ i))
                                      *trashinfo-formatters*))))
-             (unless (functionp fun)
+             (unless fun
                (unknown i "substitution"))
              (push-thing fun))
            (setq start (+ i 2)
@@ -224,13 +457,16 @@ string."
       (push-string (subseq format-string start))
       out)))
 
-(defun format-trashinfo (stream format-object info)
+(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)
-    (if (stringp part)
+    (cond
-        (format stream "~A" part)
+      ((eq :index part)
-        (funcall part stream info))))
+       (format stream "~A" index))
+      ((stringp part)
+       (format stream "~A" part))
+      (t (funcall part stream info)))))
 
 (defun print-format-info (&optional (stream t))
   (format stream "~
@@ -243,8 +479,8 @@ output verbatim. The recognized C-style escapes sequences are:
   \"\\\\\" - literal backslash
 The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
   (dolist (entry *trashinfo-formatters*)
-    (let ((char (car entry))
+    (let ((char (first entry))
-          (doc (documentation (cdr entry) t)))
+          (doc (third entry)))
       (format stream "  \"%~A\" - ~A~%" char doc))))
 
 
@@ -289,30 +525,121 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
 
 ;; List command
 (defun list/handler (cmd)
-  "Toplevel for the \"list\" subcommand."
+  "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"))))
-        (dolist (info (sort-trashinfos-for-cmd
+        (loop for info in (sort-trashinfos-for-cmd
-                       (list-trashinfos-for-cmd cmd) cmd))
+                           (list-trashinfos-for-cmd cmd) cmd)
-          (format-trashinfo t format info)))))
+              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)))
+   (clingon-sort-options)
+   (list
+    (clingon:make-option
+     :list/filepath
+     :key :extra-trashes
+     :description "include additional trashes"
+     :short-name #\c
+     :long-name "include-trash"))))
 
 (defun list/command ()
   "Return the Clingon command for the \"list\" subcommand."
   (clingon:make-command
    :name "list"
    :description "list files in trash directories"
-   :usage "[pattern]"
+   :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
+
+(defun restore/handler (cmd)
+  "Handler for the \"restore\" subcommand."
+  (le))
+
+(defun restore/options ()
+  "Return options for the \"restore\" subcommand."
+  (append
+   (clingon-filtering-options)
+   (clingon-sort-options)
+   (list
+    (clingon:make-option
+     :flag
+     :key :all
+     :description "restore all files that match the pattern"
+     :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
+     :descrition "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"
+   :descrition "move files out of the trash"
+   :usage "[options] [pattern]"
+   :options (restore/options)
+   :handler #'restore/handler))
+
 
 ;; Toplevel command
 (defun toplevel/options ()
@@ -334,7 +661,8 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
    :license "GPL3"
    :authors '("Alexander Rosenberg <zanderpkg@pm.me>")
    :options (toplevel/options)
-   :sub-commands (list (list/command))
+   :sub-commands (list (list/command)
+                       (put/command))
    :handler #'(lambda (cmd)
                 (clingon:print-usage-and-exit cmd t))))