Add --force flag

cl-xdg-trash/directorysizes.lisp

@@ -162,7 +162,8 @@ NO-ERROR, This will return t if the operation succeeded and nil otherwise."
 
 (declaim (ftype (function ((or string pathname) string &key
                                                 (:directorysizes hash-table)
-                                                (:no-write t))
+                                                (:no-write t)
+                                                (:no-error t))
                           (or integer null))
                 update-directorysizes-entry))
 (defun trashed-file-size
@@ -170,7 +171,7 @@ NO-ERROR, This will return t if the operation succeeded and nil otherwise."
      &key
        (directorysizes (read-directorysizes-for-trash-directory
                         trash-directory))
-       no-write)
+       no-write no-errors)
   "Return the size of the trashed file NAME in TRASH-DIRECTORY. If NAME is a
 directory and the file size cache is out of date, update it. As a second value,
 return whether the cache actually needed updating. This can be inhibited by
@@ -204,14 +205,21 @@ destructively updated, even with NO-WRITE)."
                  trashinfo-mtime))
        (setq ret-size (directorysizes-entry-size cur-entry)))
       (t
-       (let ((size (file-size path nil)))
+       (let ((size (if no-errors
+                       ;; as file-size's no-errors argument causes it to return
+                       ;; zero on error, we can't use it here (we want to return
+                       ;; nil)
+                       (handler-case
+                           (file-size path nil)
+                         (error nil nil))
+                       (file-size path nil))))
+         (when (setf ret-size size)
            (setf (gethash name directorysizes)
                  (make-directorysizes-entry
                   :mtime trashinfo-mtime
                   :size size
                   :name name)
-               did-change t
+                 did-change t)))))
-               ret-size size))))
     (when (and (not no-write) did-change)
       (write-directorysizes-for-trash-directory
        trash-directory directorysizes t))

cl-xdg-trash/trash.lisp

@@ -28,20 +28,6 @@
                       (cross-device-error-target condition)))))
   (: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."))
-
-(define-condition file-not-found-error (file-error)
-  ()
-  (:report (lambda (condition stream)
-             (format stream "No such file or directory: ~S"
-                     (uiop:native-namestring (file-error-pathname condition)))))
-  (:documentation "An error representing the case that a file does not exist."))
-
 (define-condition two-arg-file-error (file-error)
   ((action :accessor two-arg-file-error-action
            :type string
@@ -231,13 +217,13 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
     (handler-case
         (osicat-posix:rename (uiop:native-namestring source)
                              (uiop:native-namestring target))
-      (osicat-posix:enoent ()
+      (osicat-posix:posix-error (e)
-        (error 'file-not-found-error :pathname source))
+        (error 'two-arg-file-error
-      (osicat-posix:eacces ()
+               :action "rename"
-        (error 'two-arg-file-error :action "rename"
-                                   :detail "Permission denied"
                :pathname source
-                                   :target target)))))
+               :target target
+               :detail (osicat-posix:strerror
+                        (osicat:system-error-code e)))))))
 
 (declaim (ftype (function ((or pathname string) (or pathname string)) t)
                 copy-file))
@@ -309,7 +295,8 @@ specific directory."
               (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)))))
+      (trashed-file-size trash-directory (trashinfo-name trashinfo)
+                         :no-errors t))))
 
 (declaim (ftype (function ((or pathname string list)) list)
                 normalize-trash-directories)
@@ -377,13 +364,57 @@ corresponding trashed file."
       (trashed-file-size (trashinfo-trash-directory trashinfo)
                          (trashinfo-name trashinfo)))))
 
+(declaim (ftype (function ((or string pathname) &optional t) t)
+                delete-directory-tree))
+(defun delete-directory-tree (path &optional force)
+  "Delete the directory named by PATH and all its subdirectories
+recursively. With FORCE change directory permissions to allow deletion if
+necessary."
+  (flet ((non-directory-file-p (path)
+           (let ((stat (stat path t)))
+             (and stat (not (osicat-posix:s-isdir
+                             (osicat-posix:stat-mode stat))))))
+         (maybe-change-permissions (path)
+           (when force
+             ;; we need read to list subdirectories
+             ;; we need execute and write to delete things
+             (osicat-posix:chmod path #o700))))
+    ;; the queue elements are (path . have-seen-before)
+    (loop with queue = (list (cons (ensure-nonwild-pathname path) nil))
+          while queue
+          for cur = (car queue)
+          do (handler-case
+                 (cond
+                   ((non-directory-file-p (car cur))
+                    (delete-file (car cur))
+                    (pop queue))
+                   (t
+                    (if (not (cdr cur))
+                        (progn
+                          (maybe-change-permissions (car cur))
+                          (setf (cdr cur) t)
+                          (setq queue (nconc (mapcar #'list
+                                                     (list-directory (car cur)))
+                                             queue)))
+                        (progn
+                          (osicat-posix:rmdir (car cur))
+                          (pop queue)))))
+               (osicat-posix:posix-error (e)
+                 (error 'two-arg-file-error
+                        :action "delete"
+                        :pathname (car cur)
+                        :detail (osicat-posix:strerror
+                                 (osicat:system-error-code e))))))))
+
 (declaim (ftype (function (trashinfo
-                           &key (:dry-run t) (:update-directorysizes t))
+                           &key (:dry-run t) (:update-directorysizes t)
+                           (:force t))
                           t)
                 empty-file))
-(defun empty-file (trashinfo &key (dry-run t) (update-directorysizes t))
+(defun empty-file (trashinfo &key (dry-run t) (update-directorysizes t) force)
   "Remove the file represented by TRASHINFO from the trash by deleting it. With
-DRY-RUN, don't actually delete anything."
+DRY-RUN, don't actually delete anything. With FORCE attempt to change file
+permissions to allow deleting."
   (let ((trashed-file (trashinfo-trashed-file trashinfo))
         (info-file (trashinfo-info-file trashinfo))
         (trash-directory (trashinfo-trash-directory trashinfo))
@@ -396,10 +427,7 @@ DRY-RUN, don't actually delete anything."
           ;; there's a much higher chance of failing to remove the actual file
           ;; than the trashinfo, so remove the trashinfo after the actual file
           (if (uiop:directory-exists-p trashed-file)
-              (uiop:delete-directory-tree
+              (delete-directory-tree trashed-file force)
-               (ensure-directory-pathname trashed-file)
-               :validate t
-               :if-does-not-exist :ignore)
               (delete-file trashed-file))
           (delete-file info-file)
           (when update-directorysizes

clash/clash.lisp

@@ -700,7 +700,7 @@ return a list of many indices instead."
    (clingon:make-option
     :flag
     :key :yes
-    :description "don't prompt, just ~A all matching things"
+    :description (format nil "don't prompt, just ~A all matching things" action)
     :short-name #\y
     :long-name "yes")))
 
@@ -756,6 +756,7 @@ return a list of many indices instead."
          (dry-run (clingon:getopt cmd :dry-run))
          (quiet (clingon:getopt cmd :quiet))
          (no-sort (and (clingon:getopt cmd :all) quiet))
+         (force (clingon:getopt cmd :force))
          (objs (list-objects-for-command cmd no-sort))
          (indices (get-indices-for-command "erase" cmd nil objs)))
     (unless (eq indices :cancel)
@@ -765,14 +766,16 @@ return a list of many indices instead."
                 do (mark-directorysizes-dirty (car (aref objs-arr i)))
                 do (dolist (info (cdr (aref objs-arr i)))
                      (cl-xdg-trash:empty-file info :dry-run dry-run
-                                                   :update-directorysizes nil)))
+                                                   :update-directorysizes nil
+                                                   :force force)))
           (loop with infos-arr = (coerce objs 'vector)
                 for i in indices
                 do (mark-directorysizes-dirty
                     (trashinfo-trash-directory (aref infos-arr i)))
                 do (cl-xdg-trash:empty-file (aref infos-arr i)
                                             :dry-run dry-run
-                                            :update-directorysizes nil))))))
+                                            :update-directorysizes nil
+                                            :force force))))))
 
 (defun empty/options ()
   "Return options for the \"empty\" subcommand."
@@ -787,7 +790,13 @@ return a list of many indices instead."
      :key :dry-run
      :description "print what would happen without actually deleting anything"
      :short-name #\N
-     :long-name "dry-run"))))
+     :long-name "dry-run")
+    (clingon:make-option
+     :flag
+     :key :force
+     :description "attempt to change file permissions to allow deleting"
+     :short-name #\o
+     :long-name "force"))))
 
 (defun empty/command ()
   "Return the Clingon command for the \"empty\" subcommand."