From 3c9285fddcd4987fed1a85477622cd30d8aea6d4 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Tue, 24 Feb 2026 19:03:41 -0800 Subject: [PATCH] Add --force flag --- cl-xdg-trash/directorysizes.lisp | 28 +++++++---- cl-xdg-trash/trash.lisp | 86 +++++++++++++++++++++----------- clash/clash.lisp | 17 +++++-- 3 files changed, 88 insertions(+), 43 deletions(-) diff --git a/cl-xdg-trash/directorysizes.lisp b/cl-xdg-trash/directorysizes.lisp index 288a820..eefa3d6 100644 --- a/cl-xdg-trash/directorysizes.lisp +++ b/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))) - (setf (gethash name directorysizes) - (make-directorysizes-entry - :mtime trashinfo-mtime - :size size - :name name) - did-change t - ret-size size)))) + (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))))) (when (and (not no-write) did-change) (write-directorysizes-for-trash-directory trash-directory directorysizes t)) diff --git a/cl-xdg-trash/trash.lisp b/cl-xdg-trash/trash.lisp index e6098fb..939eb98 100644 --- a/cl-xdg-trash/trash.lisp +++ b/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 () - (error 'file-not-found-error :pathname source)) - (osicat-posix:eacces () - (error 'two-arg-file-error :action "rename" - :detail "Permission denied" - :pathname source - :target target))))) + (osicat-posix:posix-error (e) + (error 'two-arg-file-error + :action "rename" + :pathname source + :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 - (ensure-directory-pathname trashed-file) - :validate t - :if-does-not-exist :ignore) + (delete-directory-tree trashed-file force) (delete-file trashed-file)) (delete-file info-file) (when update-directorysizes diff --git a/clash/clash.lisp b/clash/clash.lisp index 557c118..adb3aa8 100644 --- a/clash/clash.lisp +++ b/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."