Fix directorysizes stuff
This commit is contained in:
@ -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)
|
||||
(trashed-file-size
|
||||
(trashinfo-trash-directory trashinfo)
|
||||
(trashinfo-name trashinfo)
|
||||
:directorysizes (cdr directorysizes-pair)
|
||||
:no-write t)
|
||||
(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)
|
||||
(write-directorysizes-for-trash-directory
|
||||
trash-directory (cdr directorysizes-pair) t)))
|
||||
(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))))
|
||||
*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