Fix directorysizes stuff
This commit is contained in:
@ -1,25 +1,52 @@
|
||||
(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))
|
||||
(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
|
||||
while queue
|
||||
for cur = (directory-as-file-pathname (first queue))
|
||||
for res = (handler-bind
|
||||
for res = (catch 'return-nil
|
||||
(handler-bind
|
||||
((osicat-posix:posix-error
|
||||
(lambda (e)
|
||||
(unless no-errors
|
||||
(if no-errors
|
||||
(throw 'return-nil nil)
|
||||
(signal e)))))
|
||||
(osicat-posix:lstat cur))
|
||||
(osicat-posix:lstat (uiop:native-namestring cur))))
|
||||
do (pop queue)
|
||||
when (and res (osicat-posix:s-isdir (osicat-posix:stat-mode res)))
|
||||
do (setq queue (nconc (uiop:directory*
|
||||
(merge-pathnames
|
||||
uiop:*wild-file-for-directory*
|
||||
(uiop:ensure-directory-pathname cur)))
|
||||
do (setq queue (nconc (catch 'return-nil
|
||||
(handler-bind
|
||||
((osicat-posix:posix-error
|
||||
(lambda (e)
|
||||
(if no-errors
|
||||
(throw 'return-nil nil)
|
||||
(signal e)))))
|
||||
(list-directory cur)))
|
||||
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)
|
||||
split-string))
|
||||
@ -156,11 +183,12 @@ destructively updated, even with NO-WRITE)."
|
||||
(ensure-nonwild-pathname trash-directory
|
||||
:ensure-directory t)))
|
||||
(stat (handler-case
|
||||
(osicat-posix:stat (uiop:native-namestring path))
|
||||
(osicat-posix:lstat (uiop:native-namestring path))
|
||||
(t nil nil)))
|
||||
(trashinfo-mtime
|
||||
(handler-case (osicat-posix:stat-mtime
|
||||
(osicat-posix:stat (uiop:native-namestring
|
||||
(handler-case
|
||||
(osicat-posix:stat-mtime
|
||||
(osicat-posix:lstat (uiop:native-namestring
|
||||
(compute-trashinfo-source-file
|
||||
trash-directory name))))
|
||||
(t nil nil)))
|
||||
@ -176,7 +204,7 @@ destructively updated, even with NO-WRITE)."
|
||||
trashinfo-mtime))
|
||||
(setq ret-size (directorysizes-entry-size cur-entry)))
|
||||
(t
|
||||
(let ((size (file-size path)))
|
||||
(let ((size (file-size path nil)))
|
||||
(setf (gethash name directorysizes)
|
||||
(make-directorysizes-entry
|
||||
:mtime trashinfo-mtime
|
||||
@ -188,3 +216,37 @@ destructively updated, even with NO-WRITE)."
|
||||
(write-directorysizes-for-trash-directory
|
||||
trash-directory directorysizes t))
|
||||
(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))
|
||||
|
||||
@ -72,6 +72,26 @@ be determined."
|
||||
(subseq string 0 (- (length string) (length suffix)))
|
||||
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))
|
||||
pathname)
|
||||
ensure-nonwild-pathname)
|
||||
@ -83,7 +103,7 @@ be determined."
|
||||
(when (wild-pathname-p path)
|
||||
(error 'file-error :pathname path))
|
||||
(if ensure-directory
|
||||
(uiop:ensure-directory-pathname path)
|
||||
(ensure-directory-pathname path)
|
||||
path))
|
||||
(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)
|
||||
(file-error ()
|
||||
(loop for cur = (uiop:pathname-parent-directory-pathname
|
||||
(uiop:ensure-directory-pathname path))
|
||||
(ensure-directory-pathname path))
|
||||
then (uiop:pathname-parent-directory-pathname cur)
|
||||
until (probe-file cur)
|
||||
finally (return (when (uiop:directory-exists-p cur)
|
||||
|
||||
@ -13,6 +13,7 @@
|
||||
(:use #:cl)
|
||||
(:export #:list-mountpoints
|
||||
#:find-filesystem-root
|
||||
#:ensure-directory-pathname
|
||||
#:ensure-nonwild-pathname
|
||||
#:remove-suffix
|
||||
#:file-or-dir-namestring
|
||||
@ -27,6 +28,7 @@
|
||||
#:url-decode)
|
||||
(:import-from #:cl-xdg-trash/mountpoints
|
||||
#:file-or-dir-namestring
|
||||
#:ensure-directory-pathname
|
||||
#:ensure-nonwild-pathname
|
||||
#:remove-suffix
|
||||
#:find-filesystem-root)
|
||||
@ -55,21 +57,25 @@
|
||||
"Parser and utility functions for dealing with the directorysizes file.")
|
||||
(:use #:cl)
|
||||
(:import-from #:cl-xdg-trash/mountpoints
|
||||
#:ensure-directory-pathname
|
||||
#:ensure-nonwild-pathname
|
||||
#:file-or-dir-namestring)
|
||||
(:import-from #:cl-xdg-trash/url-encode
|
||||
#:url-encode
|
||||
#:url-decode)
|
||||
(:import-from #:cl-xdg-trash/trashinfo
|
||||
#:trashinfo-name
|
||||
#:compute-trashinfo-source-file
|
||||
#:parent-directory
|
||||
#:directory-as-file-pathname)
|
||||
(:export #:read-directorysizes-file
|
||||
(:export #:list-directory
|
||||
#:read-directorysizes-file
|
||||
#:prase-directorysizes
|
||||
#:read-directorysizes-for-trash-directory
|
||||
#:write-directorysizes-for-trash-directory
|
||||
#:trashed-file-size
|
||||
#:calculate-directorysizes-path))
|
||||
#:calculate-directorysizes-path
|
||||
#:prune-directorysizes))
|
||||
|
||||
(defpackage :cl-xdg-trash
|
||||
(:documentation
|
||||
|
||||
@ -79,7 +79,7 @@
|
||||
(user-homedir-pathname)))
|
||||
((pathnamep homedir)
|
||||
(merge-pathnames (uiop:parse-unix-namestring ".local/share/")
|
||||
(uiop:ensure-directory-pathname homedir)))
|
||||
(ensure-directory-pathname homedir)))
|
||||
(t
|
||||
(merge-pathnames (uiop:parse-unix-namestring ".local/share/")
|
||||
(uiop:parse-native-namestring homedir
|
||||
@ -88,7 +88,7 @@
|
||||
(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
|
||||
user-home-trash-directory))
|
||||
(defun user-home-trash-directory (&key homedir)
|
||||
(uiop:ensure-directory-pathname
|
||||
(ensure-directory-pathname
|
||||
(merge-pathnames #P"Trash" (xdg-data-home :homedir homedir))))
|
||||
|
||||
(declaim (ftype (function (integer) t) sticky-bit-set-p)
|
||||
@ -122,9 +122,9 @@
|
||||
(when (and stat
|
||||
(osicat-posix:s-isdir (osicat-posix:stat-mode stat))
|
||||
(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))
|
||||
(let* ((dir (uiop:ensure-directory-pathname
|
||||
(let* ((dir (ensure-directory-pathname
|
||||
(merge-pathnames #P".Trash" top-path)))
|
||||
(stat (stat dir t)))
|
||||
(when (and stat
|
||||
@ -162,13 +162,13 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
|
||||
(uid (osicat-posix:getuid)))
|
||||
(or
|
||||
;; root/.Trash/$UID
|
||||
(let* ((outer (uiop:ensure-directory-pathname
|
||||
(let* ((outer (ensure-directory-pathname
|
||||
(merge-pathnames #P".Trash" root)))
|
||||
(outer-stat (stat outer t)))
|
||||
(when (and outer-stat
|
||||
(osicat-posix:s-isdir (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))
|
||||
outer)))
|
||||
(inner-stat (stat inner t)))
|
||||
@ -184,7 +184,7 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
|
||||
inner)
|
||||
(osicat-posix:posix-error () nil)))))))
|
||||
;; root/.Trash-$UID
|
||||
(let* ((dir (uiop:ensure-directory-pathname
|
||||
(let* ((dir (ensure-directory-pathname
|
||||
(merge-pathnames (format nil ".Trash-~D" uid) root)))
|
||||
(stat (stat dir t)))
|
||||
(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
|
||||
: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)
|
||||
copy-file))
|
||||
(defun copy-file (source target)
|
||||
"Copy the normal file SOURCE to TARGET. Error if TARGET already exists."
|
||||
(handler-case
|
||||
(let ((source (ensure-nonwild-pathname source))
|
||||
(target (ensure-nonwild-pathname target))
|
||||
in out)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq in (osicat-posix:open
|
||||
(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))))
|
||||
(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)
|
||||
@ -328,7 +296,7 @@ specific directory."
|
||||
:ensure-directory t)
|
||||
(trash-directory-for-file path ignored-trash-dirs)))
|
||||
(files-dir (ensure-directories-exist
|
||||
(uiop:ensure-directory-pathname
|
||||
(ensure-directory-pathname
|
||||
(merge-pathnames #P"files" trash-directory))
|
||||
:verbose nil))
|
||||
(trashinfo (make-trashinfo-for trash-directory path))
|
||||
@ -358,7 +326,7 @@ specific directory."
|
||||
(defun list-trashed-files-for-directory (trash-directory include-missing)
|
||||
"Return a list of trashinfo objects for every trashed file in
|
||||
TRASH-DIRECTORY."
|
||||
(let ((info-dir (uiop:ensure-directory-pathname
|
||||
(let ((info-dir (ensure-directory-pathname
|
||||
(merge-pathnames #P"info" trash-directory))))
|
||||
(mapcan #'(lambda (path)
|
||||
(let ((name (file-or-dir-namestring path)))
|
||||
@ -374,7 +342,7 @@ TRASH-DIRECTORY."
|
||||
(trashinfo-trashed-file trashinfo)))
|
||||
(list trashinfo)))
|
||||
(trashinfo-format-error ())))))
|
||||
(uiop:directory-files info-dir))))
|
||||
(list-directory info-dir))))
|
||||
|
||||
(declaim (ftype (function (&optional (or pathname string list) t) list)
|
||||
list-trashed-files))
|
||||
@ -404,19 +372,16 @@ corresponding trashed file."
|
||||
(let ((source (trashinfo-trashed-file trashinfo))
|
||||
(target (ensure-nonwild-pathname target)))
|
||||
(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))
|
||||
(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))
|
||||
(declaim (ftype (function (trashinfo
|
||||
&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
|
||||
DRY-RUN, don't actually delete anything."
|
||||
(let ((trashed-file (trashinfo-trashed-file trashinfo))
|
||||
@ -427,24 +392,19 @@ DRY-RUN, don't actually delete anything."
|
||||
(format t "Deleting ~S~%Deleting ~S~%"
|
||||
(uiop:native-namestring info-file)
|
||||
(uiop:native-namestring trashed-file))
|
||||
(handler-case
|
||||
(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)
|
||||
(uiop:delete-directory-tree
|
||||
(uiop:ensure-directory-pathname trashed-file)
|
||||
(ensure-directory-pathname trashed-file)
|
||||
:validate t
|
||||
:if-does-not-exist :ignore)
|
||||
(delete-file trashed-file))
|
||||
(delete-file info-file)
|
||||
(when update-directorysizes
|
||||
(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))
|
||||
(defun empty-all (&optional (trash-directories (list-trash-directories))
|
||||
(dry-run t))
|
||||
|
||||
@ -31,7 +31,7 @@
|
||||
(defun parent-directory (path)
|
||||
"Return the parent directory of PATH."
|
||||
(uiop:pathname-parent-directory-pathname
|
||||
(uiop:ensure-directory-pathname path)))
|
||||
(ensure-directory-pathname path)))
|
||||
|
||||
(define-condition trashinfo-format-error (parse-error)
|
||||
((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)
|
||||
with name = (file-or-dir-namestring path)
|
||||
with info-dir = (ensure-directories-exist
|
||||
(uiop:ensure-directory-pathname
|
||||
(merge-pathnames #P"info"
|
||||
(uiop:ensure-directory-pathname
|
||||
trash-directory)))
|
||||
(ensure-directory-pathname
|
||||
(merge-pathnames
|
||||
#P"info" (ensure-directory-pathname trash-directory)))
|
||||
:verbose nil)
|
||||
for info-file = (merge-pathnames
|
||||
(make-pathname
|
||||
|
||||
@ -10,8 +10,10 @@
|
||||
#:parse-trashinfo-file)
|
||||
(:import-from #:cl-xdg-trash/mountpoints
|
||||
#:file-or-dir-namestring
|
||||
#:ensure-directory-pathname
|
||||
#:ensure-nonwild-pathname)
|
||||
(:import-from #:cl-xdg-trash/directorysizes
|
||||
#:list-directory
|
||||
#:read-directorysizes-for-trash-directory
|
||||
#:write-directorysizes-for-trash-directory)
|
||||
(:use #:cl #:clash/parse-date #:clash/format)
|
||||
@ -216,7 +218,12 @@ The following suffixes are recognized (in additon to \"B\"):
|
||||
:flag
|
||||
:key :size-help
|
||||
: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))
|
||||
(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."
|
||||
(append (unless (clingon:getopt cmd :only-explicit-dirs)
|
||||
(set-difference (cl-xdg-trash:list-trash-directories)
|
||||
(mapcar #'uiop:ensure-directory-pathname
|
||||
(mapcar #'ensure-directory-pathname
|
||||
(clingon:getopt cmd :ignored-trashes))
|
||||
:test #'uiop:pathname-equal))
|
||||
(mapcar #'ensure-nonwild-pathname
|
||||
@ -744,6 +751,7 @@ return a list of many indices instead."
|
||||
;; Empty command
|
||||
(defun empty/handler (cmd)
|
||||
"Handler for the \"empty\" subcommand."
|
||||
(setq *prune-directorysizes* t)
|
||||
(let* ((dir-wise (clingon:getopt cmd :directory-wise))
|
||||
(dry-run (clingon:getopt cmd :dry-run))
|
||||
(quiet (clingon:getopt cmd :quiet))
|
||||
@ -754,12 +762,17 @@ return a list of many indices instead."
|
||||
(if dir-wise
|
||||
(loop with objs-arr = (coerce objs 'vector)
|
||||
for i in indices
|
||||
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)))
|
||||
(cl-xdg-trash:empty-file info :dry-run dry-run
|
||||
:update-directorysizes nil)))
|
||||
(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))))))
|
||||
:dry-run dry-run
|
||||
:update-directorysizes nil))))))
|
||||
|
||||
(defun empty/options ()
|
||||
"Return options for the \"empty\" subcommand."
|
||||
@ -921,10 +934,9 @@ return a list of many indices instead."
|
||||
(parse-trashinfo-file
|
||||
dir (file-or-dir-namestring path))
|
||||
(error () nil)))
|
||||
(uiop:directory*
|
||||
(merge-pathnames uiop:*wild-file-for-directory*
|
||||
(uiop:ensure-directory-pathname
|
||||
(merge-pathnames "files" dir))))))
|
||||
(list-directory
|
||||
(ensure-directory-pathname
|
||||
(merge-pathnames "files" dir)))))
|
||||
(format t "~A~:[~%~;~A~]"
|
||||
(uiop:native-namestring missing) null #\Nul)))))
|
||||
|
||||
@ -992,6 +1004,11 @@ return a list of many indices instead."
|
||||
|
||||
|
||||
;; Toplevel command
|
||||
(defun toplevel/post-hook (cmd)
|
||||
"Post-command hook for the toplevel command."
|
||||
(declare (ignore cmd))
|
||||
(flush-directorysizes-cache))
|
||||
|
||||
(defun toplevel/command ()
|
||||
"Return the toplevel command."
|
||||
(clingon:make-command
|
||||
@ -1007,7 +1024,8 @@ return a list of many indices instead."
|
||||
(empty/command)
|
||||
(size/command)
|
||||
(missing/command))
|
||||
:handler #'handle-toplevel-with-subcommands))
|
||||
:handler #'handle-toplevel-with-subcommands
|
||||
:post-hook #'toplevel/post-hook))
|
||||
|
||||
(defparameter *toplevel/help-option*
|
||||
(clingon:make-option
|
||||
@ -1029,7 +1047,9 @@ return a list of many indices instead."
|
||||
(error 'clingon:exit-error :code 0))
|
||||
(when (clingon:getopt cmd :size-help)
|
||||
(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))
|
||||
"Program entry point.
|
||||
@ -1040,8 +1060,7 @@ Args can be supplied to facilitate testing in SLIME."
|
||||
*toplevel/help-option*)))
|
||||
(if argsp
|
||||
(clingon:run (toplevel/command) args)
|
||||
(clingon:run (toplevel/command)))
|
||||
(flush-directorysizes-cache)))
|
||||
(clingon:run (toplevel/command)))))
|
||||
|
||||
;; Used from the build system
|
||||
(defun make-markdown-doc ()
|
||||
|
||||
@ -5,7 +5,8 @@
|
||||
(:import-from #:cl-xdg-trash/directorysizes
|
||||
#:read-directorysizes-for-trash-directory
|
||||
#:write-directorysizes-for-trash-directory
|
||||
#:trashed-file-size)
|
||||
#:trashed-file-size
|
||||
#:prune-directorysizes)
|
||||
(:import-from #:cl-xdg-trash/trashinfo
|
||||
#:trashinfo-trash-directory
|
||||
#:trashinfo-name
|
||||
@ -14,7 +15,10 @@
|
||||
#:trashinfo-info-file
|
||||
#:trashinfo-trashed-file)
|
||||
(:use #:cl)
|
||||
(:export #:trashinfo-size
|
||||
(:export #:*no-warnings*
|
||||
#:*prune-directorysizes*
|
||||
#:mark-directorysizes-dirty
|
||||
#:trashinfo-size
|
||||
#:flush-directorysizes-cache
|
||||
#:format-size
|
||||
#:parse-format-string
|
||||
@ -31,33 +35,56 @@
|
||||
|
||||
(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)
|
||||
"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)
|
||||
"Return a directorysizes table for the trash-directory of TRASHINFO."
|
||||
(let* ((trash-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))))))
|
||||
(get-directorysizes-for-directory (trashinfo-trash-directory trashinfo)))
|
||||
|
||||
(defvar *trashinfo-size-cache* (make-hash-table :test #'eq)
|
||||
"Cache for trashinfo sizes.")
|
||||
|
||||
(defun trashinfo-size (trashinfo)
|
||||
"Return the size of TRASHINFO and cache it."
|
||||
(defun mark-directorysizes-dirty (directory)
|
||||
"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)))
|
||||
(if (eq res :none)
|
||||
(let ((directorysizes-pair (get-directorysizes-for-trashinfo trashinfo)))
|
||||
(multiple-value-bind (size did-change)
|
||||
(handler-case
|
||||
(trashed-file-size
|
||||
(trashinfo-trash-directory trashinfo)
|
||||
(trashinfo-name trashinfo)
|
||||
:directorysizes (cdr directorysizes-pair)
|
||||
: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
|
||||
(setf (car directorysizes-pair) t))
|
||||
(setf (gethash trashinfo *trashinfo-size-cache*) size)))
|
||||
@ -67,8 +94,12 @@
|
||||
"Flush the cached directorysizes changes."
|
||||
(maphash (lambda (trash-directory 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
|
||||
trash-directory (cdr directorysizes-pair) t)))
|
||||
trash-directory (cdr directorysizes-pair) t))))
|
||||
*directorysizes-cache*))
|
||||
|
||||
(defun format-size (count &optional base-two (places 2))
|
||||
@ -363,7 +394,8 @@ The recognized printf-style sequences for ~A are:
|
||||
(make-format-code
|
||||
:name #\s
|
||||
: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")
|
||||
(make-format-code
|
||||
:name #\h
|
||||
|
||||
Reference in New Issue
Block a user