Zander671/cl-xdg-trash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add --force flag

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-02-24 19:03:41 -08:00
parent 23839f980e
commit 3c9285fddc
3 changed files with 88 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
cl-xdg-trash/directorysizes.lisp
View File

@ -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))

86
cl-xdg-trash/trash.lisp
View File

@ -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

17
clash/clash.lisp
View File

@ -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."