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

Fix directorysizes stuff

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-02-24 16:27:29 -08:00
parent 2af64d17be
commit 23839f980e
7 changed files with 234 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,25 +1,52 @@
(in-package :cl-xdg-trash/directorysizes) (in-package :cl-xdg-trash/directorysizes)
(declaim (ftype (function ((or string pathname) &optional t t) list)
list-directory))
(defun list-directory (path &optional relative include-dot)
"Return a list of each file in the directory named by PATH."
(let* ((path (ensure-nonwild-pathname path :ensure-directory t))
(abs-path (if relative path (merge-pathnames path)))
(stream (osicat-posix:opendir (uiop:native-namestring path))))
(unwind-protect
(loop for name = (osicat-posix:readdir stream)
while name
for name-pathname = (uiop:parse-native-namestring name)
when (or include-dot
(not (member name '("." "..") :test #'equal)))
collect (if relative
name-pathname
(merge-pathnames name-pathname abs-path)))
(when stream
(osicat-posix:closedir stream)))))
(declaim (ftype (function ((or string pathname) &optional t) integer) file-size)) (declaim (ftype (function ((or string pathname) &optional t) integer) file-size))
(defun file-size (path &optional (no-errors t)) (defun file-size (path &optional (no-errors t))
"Return the size of the file (inode) named by PATH." "Return the size of the file (inode) named by PATH. With NO-ERRORS, ignore any
errors during this process."
(loop for queue = (list (ensure-nonwild-pathname path)) then queue (loop for queue = (list (ensure-nonwild-pathname path)) then queue
while queue while queue
for cur = (directory-as-file-pathname (first queue)) for cur = (directory-as-file-pathname (first queue))
for res = (handler-bind for res = (catch 'return-nil
(handler-bind
((osicat-posix:posix-error ((osicat-posix:posix-error
(lambda (e) (lambda (e)
(unless no-errors (if no-errors
(throw 'return-nil nil)
(signal e))))) (signal e)))))
(osicat-posix:lstat cur)) (osicat-posix:lstat (uiop:native-namestring cur))))
do (pop queue) do (pop queue)
when (and res (osicat-posix:s-isdir (osicat-posix:stat-mode res))) when (and res (osicat-posix:s-isdir (osicat-posix:stat-mode res)))
do (setq queue (nconc (uiop:directory* do (setq queue (nconc (catch 'return-nil
(merge-pathnames (handler-bind
uiop:*wild-file-for-directory* ((osicat-posix:posix-error
(uiop:ensure-directory-pathname cur))) (lambda (e)
(if no-errors
(throw 'return-nil nil)
(signal e)))))
(list-directory cur)))
queue)) queue))
else summing (osicat-posix:stat-size res))) else when res
summing (osicat-posix:stat-size res)))
(declaim (ftype (function (string character &optional (or null integer)) list) (declaim (ftype (function (string character &optional (or null integer)) list)
split-string)) split-string))
@ -156,11 +183,12 @@ destructively updated, even with NO-WRITE)."
(ensure-nonwild-pathname trash-directory (ensure-nonwild-pathname trash-directory
:ensure-directory t))) :ensure-directory t)))
(stat (handler-case (stat (handler-case
(osicat-posix:stat (uiop:native-namestring path)) (osicat-posix:lstat (uiop:native-namestring path))
(t nil nil))) (t nil nil)))
(trashinfo-mtime (trashinfo-mtime
(handler-case (osicat-posix:stat-mtime (handler-case
(osicat-posix:stat (uiop:native-namestring (osicat-posix:stat-mtime
(osicat-posix:lstat (uiop:native-namestring
(compute-trashinfo-source-file (compute-trashinfo-source-file
trash-directory name)))) trash-directory name))))
(t nil nil))) (t nil nil)))
@ -176,7 +204,7 @@ destructively updated, even with NO-WRITE)."
trashinfo-mtime)) trashinfo-mtime))
(setq ret-size (directorysizes-entry-size cur-entry))) (setq ret-size (directorysizes-entry-size cur-entry)))
(t (t
(let ((size (file-size path))) (let ((size (file-size path nil)))
(setf (gethash name directorysizes) (setf (gethash name directorysizes)
(make-directorysizes-entry (make-directorysizes-entry
:mtime trashinfo-mtime :mtime trashinfo-mtime
@ -188,3 +216,37 @@ destructively updated, even with NO-WRITE)."
(write-directorysizes-for-trash-directory (write-directorysizes-for-trash-directory
trash-directory directorysizes t)) trash-directory directorysizes t))
(values ret-size did-change))) (values ret-size did-change)))
(declaim (ftype (function (hash-table) list) hash-table-keys))
(defun hash-table-keys (table)
"Return the keys of TABLE."
(let (keys)
(maphash (lambda (k v)
(declare (ignore v))
(push k keys))
table)
keys))
(declaim (ftype (function ((or pathname string)
&key (:directorysizes hash-table) (:no-write t)
(:no-error t))
hash-table)
prune-directorysizes))
(defun prune-directorysizes
(directory &key (directorysizes
(read-directorysizes-for-trash-directory directory))
no-write no-error)
"Prune the directorysizes file of trash directory DIRECTORY. If you already
have the directorysizes hash-table for DIRECOTRY, pass it in DIRECTORYSIZES. The
pruned table will be returned (it is a copy). If NO-WRITE is nil, update the
actual cache file on disk as well."
(let ((found-names (mapcar #'trashinfo-name
(cl-xdg-trash:list-trashed-files directory)))
(new-ds (make-hash-table :test #'equal)))
(dolist (name found-names)
(let ((entry (gethash name directorysizes)))
(when entry
(setf (gethash name new-ds) entry))))
(unless no-write
(write-directorysizes-for-trash-directory directory new-ds no-error))
new-ds))

24
cl-xdg-trash/mountpoints.lisp
View File

@ -72,6 +72,26 @@ be determined."
(subseq string 0 (- (length string) (length suffix))) (subseq string 0 (- (length string) (length suffix)))
string)) string))
(declaim (ftype (function ((or string pathname)) pathname)
ensure-directory-pathname))
(defun ensure-directory-pathname (path)
"Like uiop:ensure-directory-pathname, but doesn't break with . and * in the
name on SBCL."
(cond
((stringp path) (ensure-directory-pathname (pathname path)))
((or (wild-pathname-p path)
(not (pathnamep path)))
;; use the original error
(uiop:ensure-directory-pathname path))
((uiop:directory-pathname-p path) path)
(t
(make-pathname :directory
(append (or (uiop:normalize-pathname-directory-component
(pathname-directory path))
(list :relative))
(list (file-or-dir-namestring path)))
:name nil :type nil :version nil :defaults path))))
(declaim (ftype (function ((or pathname string) &key (:ensure-directory t)) (declaim (ftype (function ((or pathname string) &key (:ensure-directory t))
pathname) pathname)
ensure-nonwild-pathname) ensure-nonwild-pathname)
@ -83,7 +103,7 @@ be determined."
(when (wild-pathname-p path) (when (wild-pathname-p path)
(error 'file-error :pathname path)) (error 'file-error :pathname path))
(if ensure-directory (if ensure-directory
(uiop:ensure-directory-pathname path) (ensure-directory-pathname path)
path)) path))
(uiop:parse-native-namestring path :ensure-directory ensure-directory))) (uiop:parse-native-namestring path :ensure-directory ensure-directory)))
@ -107,7 +127,7 @@ leaning components of PATH exists, but is not a directory, return nil."
(and (truename path) path) (and (truename path) path)
(file-error () (file-error ()
(loop for cur = (uiop:pathname-parent-directory-pathname (loop for cur = (uiop:pathname-parent-directory-pathname
(uiop:ensure-directory-pathname path)) (ensure-directory-pathname path))
then (uiop:pathname-parent-directory-pathname cur) then (uiop:pathname-parent-directory-pathname cur)
until (probe-file cur) until (probe-file cur)
finally (return (when (uiop:directory-exists-p cur) finally (return (when (uiop:directory-exists-p cur)

10
cl-xdg-trash/package.lisp
View File

@ -13,6 +13,7 @@
(:use #:cl) (:use #:cl)
(:export #:list-mountpoints (:export #:list-mountpoints
#:find-filesystem-root #:find-filesystem-root
#:ensure-directory-pathname
#:ensure-nonwild-pathname #:ensure-nonwild-pathname
#:remove-suffix #:remove-suffix
#:file-or-dir-namestring #:file-or-dir-namestring
@ -27,6 +28,7 @@
#:url-decode) #:url-decode)
(:import-from #:cl-xdg-trash/mountpoints (:import-from #:cl-xdg-trash/mountpoints
#:file-or-dir-namestring #:file-or-dir-namestring
#:ensure-directory-pathname
#:ensure-nonwild-pathname #:ensure-nonwild-pathname
#:remove-suffix #:remove-suffix
#:find-filesystem-root) #:find-filesystem-root)
@ -55,21 +57,25 @@
"Parser and utility functions for dealing with the directorysizes file.") "Parser and utility functions for dealing with the directorysizes file.")
(:use #:cl) (:use #:cl)
(:import-from #:cl-xdg-trash/mountpoints (:import-from #:cl-xdg-trash/mountpoints
#:ensure-directory-pathname
#:ensure-nonwild-pathname #:ensure-nonwild-pathname
#:file-or-dir-namestring) #:file-or-dir-namestring)
(:import-from #:cl-xdg-trash/url-encode (:import-from #:cl-xdg-trash/url-encode
#:url-encode #:url-encode
#:url-decode) #:url-decode)
(:import-from #:cl-xdg-trash/trashinfo (:import-from #:cl-xdg-trash/trashinfo
#:trashinfo-name
#:compute-trashinfo-source-file #:compute-trashinfo-source-file
#:parent-directory #:parent-directory
#:directory-as-file-pathname) #:directory-as-file-pathname)
(:export #:read-directorysizes-file (:export #:list-directory
#:read-directorysizes-file
#:prase-directorysizes #:prase-directorysizes
#:read-directorysizes-for-trash-directory #:read-directorysizes-for-trash-directory
#:write-directorysizes-for-trash-directory #:write-directorysizes-for-trash-directory
#:trashed-file-size #:trashed-file-size
#:calculate-directorysizes-path)) #:calculate-directorysizes-path
#:prune-directorysizes))
(defpackage :cl-xdg-trash (defpackage :cl-xdg-trash
(:documentation (:documentation

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

@ -79,7 +79,7 @@
(user-homedir-pathname))) (user-homedir-pathname)))
((pathnamep homedir) ((pathnamep homedir)
(merge-pathnames (uiop:parse-unix-namestring ".local/share/") (merge-pathnames (uiop:parse-unix-namestring ".local/share/")
(uiop:ensure-directory-pathname homedir))) (ensure-directory-pathname homedir)))
(t (t
(merge-pathnames (uiop:parse-unix-namestring ".local/share/") (merge-pathnames (uiop:parse-unix-namestring ".local/share/")
(uiop:parse-native-namestring homedir (uiop:parse-native-namestring homedir
@ -88,7 +88,7 @@
(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname) (declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
user-home-trash-directory)) user-home-trash-directory))
(defun user-home-trash-directory (&key homedir) (defun user-home-trash-directory (&key homedir)
(uiop:ensure-directory-pathname (ensure-directory-pathname
(merge-pathnames #P"Trash" (xdg-data-home :homedir homedir)))) (merge-pathnames #P"Trash" (xdg-data-home :homedir homedir))))
(declaim (ftype (function (integer) t) sticky-bit-set-p) (declaim (ftype (function (integer) t) sticky-bit-set-p)
@ -122,9 +122,9 @@
(when (and stat (when (and stat
(osicat-posix:s-isdir (osicat-posix:stat-mode stat)) (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
(eql (osicat-posix:stat-uid stat) uid)) (eql (osicat-posix:stat-uid stat) uid))
(push (uiop:ensure-directory-pathname dir) found))))) (push (ensure-directory-pathname dir) found)))))
(check (merge-pathnames (pathname (format nil ".Trash-~D" uid)) top-path)) (check (merge-pathnames (pathname (format nil ".Trash-~D" uid)) top-path))
(let* ((dir (uiop:ensure-directory-pathname (let* ((dir (ensure-directory-pathname
(merge-pathnames #P".Trash" top-path))) (merge-pathnames #P".Trash" top-path)))
(stat (stat dir t))) (stat (stat dir t)))
(when (and stat (when (and stat
@ -162,13 +162,13 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
(uid (osicat-posix:getuid))) (uid (osicat-posix:getuid)))
(or (or
;; root/.Trash/$UID ;; root/.Trash/$UID
(let* ((outer (uiop:ensure-directory-pathname (let* ((outer (ensure-directory-pathname
(merge-pathnames #P".Trash" root))) (merge-pathnames #P".Trash" root)))
(outer-stat (stat outer t))) (outer-stat (stat outer t)))
(when (and outer-stat (when (and outer-stat
(osicat-posix:s-isdir (osicat-posix:stat-mode outer-stat)) (osicat-posix:s-isdir (osicat-posix:stat-mode outer-stat))
(sticky-bit-set-p (osicat-posix:stat-mode outer-stat))) (sticky-bit-set-p (osicat-posix:stat-mode outer-stat)))
(let* ((inner (uiop:ensure-directory-pathname (let* ((inner (ensure-directory-pathname
(merge-pathnames (pathname (princ-to-string uid)) (merge-pathnames (pathname (princ-to-string uid))
outer))) outer)))
(inner-stat (stat inner t))) (inner-stat (stat inner t)))
@ -184,7 +184,7 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
inner) inner)
(osicat-posix:posix-error () nil))))))) (osicat-posix:posix-error () nil)))))))
;; root/.Trash-$UID ;; root/.Trash-$UID
(let* ((dir (uiop:ensure-directory-pathname (let* ((dir (ensure-directory-pathname
(merge-pathnames (format nil ".Trash-~D" uid) root))) (merge-pathnames (format nil ".Trash-~D" uid) root)))
(stat (stat dir t))) (stat (stat dir t)))
(unless (member dir ignored-trash-dirs :test #'uiop:pathname-equal) (unless (member dir ignored-trash-dirs :test #'uiop:pathname-equal)
@ -239,49 +239,17 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
:pathname source :pathname source
:target target))))) :target target)))))
(declaim (ftype (function (integer integer &key (:buffer-size integer)) integer)
copy-file-descriptor))
(defun copy-file-descriptor (in out &key (buffer-size 8192))
"Copy all data from the file descriptor IN to OUT."
(let (buffer)
(unwind-protect
(progn
(setq buffer (cffi:foreign-alloc :char :count buffer-size))
(loop for read = (osicat-posix:read in buffer buffer-size)
while (plusp read)
do (osicat-posix:write out buffer read)
sum read))
(when buffer
(cffi:foreign-free buffer)))))
(declaim (ftype (function ((or pathname string) (or pathname string)) t) (declaim (ftype (function ((or pathname string) (or pathname string)) t)
copy-file)) copy-file))
(defun copy-file (source target) (defun copy-file (source target)
"Copy the normal file SOURCE to TARGET. Error if TARGET already exists." "Copy the normal file SOURCE to TARGET. Error if TARGET already exists."
(handler-case (with-open-file (in (ensure-nonwild-pathname source)
(let ((source (ensure-nonwild-pathname source)) :direction :input
(target (ensure-nonwild-pathname target)) :if-does-not-exist :error)
in out) (with-open-file (out (ensure-nonwild-pathname target)
(unwind-protect :direction :output
(progn :if-exists :error)
(setq in (osicat-posix:open (uiop:copy-stream-to-stream in out))))
(uiop:native-namestring source)
osicat-posix:o-rdonly)
out (osicat-posix:open
(uiop:native-namestring target)
(logior osicat-posix:o-wronly osicat-posix:o-creat)))
(copy-file-descriptor in out))
(when in
(osicat-posix:close in))
(when out
(osicat-posix:close out))))
(osicat-posix:enoent ()
(error 'file-not-found-error :pathname source))
(osicat-posix:eacces ()
(error 'two-arg-file-error :action "copy"
:detail "Permission denied"
:pathname source
:target target))))
(declaim (ftype (function ((or string pathname) (declaim (ftype (function ((or string pathname)
(or string pathname) (or string pathname)
@ -328,7 +296,7 @@ specific directory."
:ensure-directory t) :ensure-directory t)
(trash-directory-for-file path ignored-trash-dirs))) (trash-directory-for-file path ignored-trash-dirs)))
(files-dir (ensure-directories-exist (files-dir (ensure-directories-exist
(uiop:ensure-directory-pathname (ensure-directory-pathname
(merge-pathnames #P"files" trash-directory)) (merge-pathnames #P"files" trash-directory))
:verbose nil)) :verbose nil))
(trashinfo (make-trashinfo-for trash-directory path)) (trashinfo (make-trashinfo-for trash-directory path))
@ -358,7 +326,7 @@ specific directory."
(defun list-trashed-files-for-directory (trash-directory include-missing) (defun list-trashed-files-for-directory (trash-directory include-missing)
"Return a list of trashinfo objects for every trashed file in "Return a list of trashinfo objects for every trashed file in
TRASH-DIRECTORY." TRASH-DIRECTORY."
(let ((info-dir (uiop:ensure-directory-pathname (let ((info-dir (ensure-directory-pathname
(merge-pathnames #P"info" trash-directory)))) (merge-pathnames #P"info" trash-directory))))
(mapcan #'(lambda (path) (mapcan #'(lambda (path)
(let ((name (file-or-dir-namestring path))) (let ((name (file-or-dir-namestring path)))
@ -374,7 +342,7 @@ TRASH-DIRECTORY."
(trashinfo-trashed-file trashinfo))) (trashinfo-trashed-file trashinfo)))
(list trashinfo))) (list trashinfo)))
(trashinfo-format-error ()))))) (trashinfo-format-error ())))))
(uiop:directory-files info-dir)))) (list-directory info-dir))))
(declaim (ftype (function (&optional (or pathname string list) t) list) (declaim (ftype (function (&optional (or pathname string list) t) list)
list-trashed-files)) list-trashed-files))
@ -404,19 +372,16 @@ corresponding trashed file."
(let ((source (trashinfo-trashed-file trashinfo)) (let ((source (trashinfo-trashed-file trashinfo))
(target (ensure-nonwild-pathname target))) (target (ensure-nonwild-pathname target)))
(move-or-copy-files source target :no-cross-device no-cross-device) (move-or-copy-files source target :no-cross-device no-cross-device)
(handler-bind
;; attempt to re-trash the file in case of error
((t #'(lambda (e)
(move-or-copy-files target source
:no-cross-device no-cross-device)
(signal e))))
(delete-file (trashinfo-info-file trashinfo)) (delete-file (trashinfo-info-file trashinfo))
(when update-size-cache (when update-size-cache
(trashed-file-size (trashinfo-trash-directory trashinfo) (trashed-file-size (trashinfo-trash-directory trashinfo)
(trashinfo-name trashinfo)))))) (trashinfo-name trashinfo)))))
(declaim (ftype (function (trashinfo &key (:dry-run t)) t) empty-file)) (declaim (ftype (function (trashinfo
(defun empty-file (trashinfo &key (dry-run t)) &key (:dry-run t) (:update-directorysizes t))
t)
empty-file))
(defun empty-file (trashinfo &key (dry-run t) (update-directorysizes t))
"Remove the file represented by TRASHINFO from the trash by deleting it. With "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."
(let ((trashed-file (trashinfo-trashed-file trashinfo)) (let ((trashed-file (trashinfo-trashed-file trashinfo))
@ -427,24 +392,19 @@ DRY-RUN, don't actually delete anything."
(format t "Deleting ~S~%Deleting ~S~%" (format t "Deleting ~S~%Deleting ~S~%"
(uiop:native-namestring info-file) (uiop:native-namestring info-file)
(uiop:native-namestring trashed-file)) (uiop:native-namestring trashed-file))
(handler-case
(progn (progn
(delete-file info-file) ;; 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) (if (uiop:directory-exists-p trashed-file)
(uiop:delete-directory-tree (uiop:delete-directory-tree
(uiop:ensure-directory-pathname trashed-file) (ensure-directory-pathname trashed-file)
:validate t :validate t
:if-does-not-exist :ignore) :if-does-not-exist :ignore)
(delete-file trashed-file)) (delete-file trashed-file))
(delete-file info-file)
(when update-directorysizes
(trashed-file-size trash-directory name)))))) (trashed-file-size trash-directory name))))))
(declaim (ftype (function ((or string pathname)) list) directory-files))
(defun directory-files (dir)
"Return a list of each file (inode) in DIR."
(uiop:directory* (merge-pathnames
uiop:*wild-file-for-directory*
(ensure-nonwild-pathname dir :ensure-directory t))))
(declaim (ftype (function (&optional (or list string pathname) t) t) empty-all)) (declaim (ftype (function (&optional (or list string pathname) t) t) empty-all))
(defun empty-all (&optional (trash-directories (list-trash-directories)) (defun empty-all (&optional (trash-directories (list-trash-directories))
(dry-run t)) (dry-run t))

9
cl-xdg-trash/trashinfo.lisp
View File

@ -31,7 +31,7 @@
(defun parent-directory (path) (defun parent-directory (path)
"Return the parent directory of PATH." "Return the parent directory of PATH."
(uiop:pathname-parent-directory-pathname (uiop:pathname-parent-directory-pathname
(uiop:ensure-directory-pathname path))) (ensure-directory-pathname path)))
(define-condition trashinfo-format-error (parse-error) (define-condition trashinfo-format-error (parse-error)
((message :accessor trashinfo-format-error-message ((message :accessor trashinfo-format-error-message
@ -274,10 +274,9 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
:ensure-directory t) :ensure-directory t)
with name = (file-or-dir-namestring path) with name = (file-or-dir-namestring path)
with info-dir = (ensure-directories-exist with info-dir = (ensure-directories-exist
(uiop:ensure-directory-pathname (ensure-directory-pathname
(merge-pathnames #P"info" (merge-pathnames
(uiop:ensure-directory-pathname #P"info" (ensure-directory-pathname trash-directory)))
trash-directory)))
:verbose nil) :verbose nil)
for info-file = (merge-pathnames for info-file = (merge-pathnames
(make-pathname (make-pathname

43
clash/clash.lisp
View File

@ -10,8 +10,10 @@
#:parse-trashinfo-file) #:parse-trashinfo-file)
(:import-from #:cl-xdg-trash/mountpoints (:import-from #:cl-xdg-trash/mountpoints
#:file-or-dir-namestring #:file-or-dir-namestring
#:ensure-directory-pathname
#:ensure-nonwild-pathname) #:ensure-nonwild-pathname)
(:import-from #:cl-xdg-trash/directorysizes (:import-from #:cl-xdg-trash/directorysizes
#:list-directory
#:read-directorysizes-for-trash-directory #:read-directorysizes-for-trash-directory
#:write-directorysizes-for-trash-directory) #:write-directorysizes-for-trash-directory)
(:use #:cl #:clash/parse-date #:clash/format) (:use #:cl #:clash/parse-date #:clash/format)
@ -216,7 +218,12 @@ The following suffixes are recognized (in additon to \"B\"):
:flag :flag
:key :size-help :key :size-help
:description "print information about size ranges" :description "print information about size ranges"
:long-name "size-help")))) :long-name "size-help")
(clingon:make-option
:flag
:key :no-warnings
:description "don't print warning messages"
:long-name "no-warnings"))))
(declaim (inline compare-trashinfo-to-string)) (declaim (inline compare-trashinfo-to-string))
(defun compare-trashinfo-to-string (trashinfo filter full-path exact (defun compare-trashinfo-to-string (trashinfo filter full-path exact
@ -271,7 +278,7 @@ string."
"Return a list of all trash directories, except those excluded by CMD." "Return a list of all trash directories, except those excluded by CMD."
(append (unless (clingon:getopt cmd :only-explicit-dirs) (append (unless (clingon:getopt cmd :only-explicit-dirs)
(set-difference (cl-xdg-trash:list-trash-directories) (set-difference (cl-xdg-trash:list-trash-directories)
(mapcar #'uiop:ensure-directory-pathname (mapcar #'ensure-directory-pathname
(clingon:getopt cmd :ignored-trashes)) (clingon:getopt cmd :ignored-trashes))
:test #'uiop:pathname-equal)) :test #'uiop:pathname-equal))
(mapcar #'ensure-nonwild-pathname (mapcar #'ensure-nonwild-pathname
@ -744,6 +751,7 @@ return a list of many indices instead."
;; Empty command ;; Empty command
(defun empty/handler (cmd) (defun empty/handler (cmd)
"Handler for the \"empty\" subcommand." "Handler for the \"empty\" subcommand."
(setq *prune-directorysizes* t)
(let* ((dir-wise (clingon:getopt cmd :directory-wise)) (let* ((dir-wise (clingon:getopt cmd :directory-wise))
(dry-run (clingon:getopt cmd :dry-run)) (dry-run (clingon:getopt cmd :dry-run))
(quiet (clingon:getopt cmd :quiet)) (quiet (clingon:getopt cmd :quiet))
@ -754,12 +762,17 @@ return a list of many indices instead."
(if dir-wise (if dir-wise
(loop with objs-arr = (coerce objs 'vector) (loop with objs-arr = (coerce objs 'vector)
for i in indices for i in indices
do (mark-directorysizes-dirty (car (aref objs-arr i)))
do (dolist (info (cdr (aref objs-arr i))) do (dolist (info (cdr (aref objs-arr i)))
(cl-xdg-trash:empty-file info :dry-run dry-run))) (cl-xdg-trash:empty-file info :dry-run dry-run
:update-directorysizes nil)))
(loop with infos-arr = (coerce objs 'vector) (loop with infos-arr = (coerce objs 'vector)
for i in indices 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) do (cl-xdg-trash:empty-file (aref infos-arr i)
:dry-run dry-run)))))) :dry-run dry-run
:update-directorysizes nil))))))
(defun empty/options () (defun empty/options ()
"Return options for the \"empty\" subcommand." "Return options for the \"empty\" subcommand."
@ -921,10 +934,9 @@ return a list of many indices instead."
(parse-trashinfo-file (parse-trashinfo-file
dir (file-or-dir-namestring path)) dir (file-or-dir-namestring path))
(error () nil))) (error () nil)))
(uiop:directory* (list-directory
(merge-pathnames uiop:*wild-file-for-directory* (ensure-directory-pathname
(uiop:ensure-directory-pathname (merge-pathnames "files" dir)))))
(merge-pathnames "files" dir))))))
(format t "~A~:[~%~;~A~]" (format t "~A~:[~%~;~A~]"
(uiop:native-namestring missing) null #\Nul))))) (uiop:native-namestring missing) null #\Nul)))))
@ -992,6 +1004,11 @@ return a list of many indices instead."
;; Toplevel command ;; Toplevel command
(defun toplevel/post-hook (cmd)
"Post-command hook for the toplevel command."
(declare (ignore cmd))
(flush-directorysizes-cache))
(defun toplevel/command () (defun toplevel/command ()
"Return the toplevel command." "Return the toplevel command."
(clingon:make-command (clingon:make-command
@ -1007,7 +1024,8 @@ return a list of many indices instead."
(empty/command) (empty/command)
(size/command) (size/command)
(missing/command)) (missing/command))
:handler #'handle-toplevel-with-subcommands)) :handler #'handle-toplevel-with-subcommands
:post-hook #'toplevel/post-hook))
(defparameter *toplevel/help-option* (defparameter *toplevel/help-option*
(clingon:make-option (clingon:make-option
@ -1029,7 +1047,9 @@ return a list of many indices instead."
(error 'clingon:exit-error :code 0)) (error 'clingon:exit-error :code 0))
(when (clingon:getopt cmd :size-help) (when (clingon:getopt cmd :size-help)
(print-byte-range-help t) (print-byte-range-help t)
(error 'clingon:exit-error :code 0))) (error 'clingon:exit-error :code 0))
(when (clingon:getopt cmd :no-warnings)
(setq *no-warnings* t)))
(defun toplevel (&optional (args () argsp)) (defun toplevel (&optional (args () argsp))
"Program entry point. "Program entry point.
@ -1040,8 +1060,7 @@ Args can be supplied to facilitate testing in SLIME."
*toplevel/help-option*))) *toplevel/help-option*)))
(if argsp (if argsp
(clingon:run (toplevel/command) args) (clingon:run (toplevel/command) args)
(clingon:run (toplevel/command))) (clingon:run (toplevel/command)))))
(flush-directorysizes-cache)))
;; Used from the build system ;; Used from the build system
(defun make-markdown-doc () (defun make-markdown-doc ()

58
clash/format.lisp
View File

@ -5,7 +5,8 @@
(:import-from #:cl-xdg-trash/directorysizes (:import-from #:cl-xdg-trash/directorysizes
#:read-directorysizes-for-trash-directory #:read-directorysizes-for-trash-directory
#:write-directorysizes-for-trash-directory #:write-directorysizes-for-trash-directory
#:trashed-file-size) #:trashed-file-size
#:prune-directorysizes)
(:import-from #:cl-xdg-trash/trashinfo (:import-from #:cl-xdg-trash/trashinfo
#:trashinfo-trash-directory #:trashinfo-trash-directory
#:trashinfo-name #:trashinfo-name
@ -14,7 +15,10 @@
#:trashinfo-info-file #:trashinfo-info-file
#:trashinfo-trashed-file) #:trashinfo-trashed-file)
(:use #:cl) (:use #:cl)
(:export #:trashinfo-size (:export #:*no-warnings*
#:*prune-directorysizes*
#:mark-directorysizes-dirty
#:trashinfo-size
#:flush-directorysizes-cache #:flush-directorysizes-cache
#:format-size #:format-size
#:parse-format-string #:parse-format-string
@ -31,33 +35,56 @@
(in-package :clash/format) (in-package :clash/format)
(defvar *no-warnings* nil
"If non-nil, don't print warning messages to *error-output*.")
(defvar *prune-directorysizes* nil
"If non-nil, prune the directorysizes cache when flushing it.")
(defvar *directorysizes-cache* (make-hash-table :test #'equal) (defvar *directorysizes-cache* (make-hash-table :test #'equal)
"Cache for directorysizes tables (trash-directory -> (need-flush . table)).") "Cache for directorysizes tables (trash-directory -> (need-flush . table)).")
(defun get-directorysizes-for-directory (directory)
"Return a directorysizes table for DIRECTORY. DIRECTORY should be a pathname
object."
(let ((cur-val (gethash directory *directorysizes-cache*)))
(or cur-val
(setf (gethash directory *directorysizes-cache*)
(cons nil (read-directorysizes-for-trash-directory directory))))))
(defun get-directorysizes-for-trashinfo (trashinfo) (defun get-directorysizes-for-trashinfo (trashinfo)
"Return a directorysizes table for the trash-directory of TRASHINFO." "Return a directorysizes table for the trash-directory of TRASHINFO."
(let* ((trash-directory (trashinfo-trash-directory trashinfo)) (get-directorysizes-for-directory (trashinfo-trash-directory trashinfo)))
(cur-val (gethash trash-directory *directorysizes-cache*)))
(if (hash-table-p cur-val)
cur-val
(setf (gethash trash-directory *directorysizes-cache*)
(cons nil
(read-directorysizes-for-trash-directory trash-directory))))))
(defvar *trashinfo-size-cache* (make-hash-table :test #'eq) (defvar *trashinfo-size-cache* (make-hash-table :test #'eq)
"Cache for trashinfo sizes.") "Cache for trashinfo sizes.")
(defun trashinfo-size (trashinfo) (defun mark-directorysizes-dirty (directory)
"Return the size of TRASHINFO and cache it." "Mark the trash directory DIRECTORY as needing to have its directorysizes
flushed."
(setf (car (get-directorysizes-for-directory directory)) t))
(defun trashinfo-size (trashinfo &optional no-warn)
"Return the size of TRASHINFO and cache it. If an error occurred while getting
the size, return nil. For a given trashinfo, the first time an error occurs,
print a warning to *ERROR-OUTPUT* unless NO-WARN is non-nil."
(let ((res (gethash trashinfo *trashinfo-size-cache* :none))) (let ((res (gethash trashinfo *trashinfo-size-cache* :none)))
(if (eq res :none) (if (eq res :none)
(let ((directorysizes-pair (get-directorysizes-for-trashinfo trashinfo))) (let ((directorysizes-pair (get-directorysizes-for-trashinfo trashinfo)))
(multiple-value-bind (size did-change) (multiple-value-bind (size did-change)
(handler-case
(trashed-file-size (trashed-file-size
(trashinfo-trash-directory trashinfo) (trashinfo-trash-directory trashinfo)
(trashinfo-name trashinfo) (trashinfo-name trashinfo)
:directorysizes (cdr directorysizes-pair) :directorysizes (cdr directorysizes-pair)
:no-write t) :no-write t)
(osicat-posix:posix-error (e)
(unless (or no-warn *no-warnings*)
(format
*error-output* "warning: failed to get size of ~S: ~A~%"
(uiop:native-namestring (trashinfo-trashed-file trashinfo))
(osicat-posix:strerror (osicat:system-error-code e))))
(values nil nil)))
(when did-change (when did-change
(setf (car directorysizes-pair) t)) (setf (car directorysizes-pair) t))
(setf (gethash trashinfo *trashinfo-size-cache*) size))) (setf (gethash trashinfo *trashinfo-size-cache*) size)))
@ -67,8 +94,12 @@
"Flush the cached directorysizes changes." "Flush the cached directorysizes changes."
(maphash (lambda (trash-directory directorysizes-pair) (maphash (lambda (trash-directory directorysizes-pair)
(when (car directorysizes-pair) (when (car directorysizes-pair)
(if *prune-directorysizes*
(prune-directorysizes
trash-directory :directorysizes (cdr directorysizes-pair)
:no-error t)
(write-directorysizes-for-trash-directory (write-directorysizes-for-trash-directory
trash-directory (cdr directorysizes-pair) t))) trash-directory (cdr directorysizes-pair) t))))
*directorysizes-cache*)) *directorysizes-cache*))
(defun format-size (count &optional base-two (places 2)) (defun format-size (count &optional base-two (places 2))
@ -363,7 +394,8 @@ The recognized printf-style sequences for ~A are:
(make-format-code (make-format-code
:name #\s :name #\s
:action (lambda (stream info) :action (lambda (stream info)
(format stream "~A" (trashinfo-size info))) (let ((size (trashinfo-size info)))
(format stream "~:[N/A~;~:*~A~]" size)))
:doc "the file's (s)size in bytes") :doc "the file's (s)size in bytes")
(make-format-code (make-format-code
:name #\h :name #\h