Fix bugs and more work on the command line
This commit is contained in:
		| @ -1,29 +1,35 @@ | |||||||
| (in-package :cl-xdg-trash/directorysizes) | (in-package :cl-xdg-trash/directorysizes) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) integer) regular-file-size)) | (declaim (ftype (function ((or string pathname)) pathname) | ||||||
| (defun regular-file-size (path) |                 directory-as-file-pathname)) | ||||||
|   "Return the size (in bytes) of the non-directory file PATH." | (defun directory-as-file-pathname (path) | ||||||
|   (let ((res (osicat-posix:stat (uiop:native-namestring |   "Return PATH as a file, not a directory pathname." | ||||||
|                                  (ensure-nonwild-pathname path))))) |   (let ((path (ensure-nonwild-pathname path))) | ||||||
|     (when (osicat-posix:s-isdir (osicat-posix:stat-mode res)) |     (if (uiop:file-pathname-p path) | ||||||
|       (error 'file-error :pathname path)) |         path | ||||||
|     (osicat-posix:stat-size res))) |         (make-pathname :name (file-or-dir-namestring path) :type nil | ||||||
|  |                        :directory (butlast (pathname-directory path)))))) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) integer) file-size)) | (declaim (ftype (function ((or string pathname) &optional t) integer) file-size)) | ||||||
| (defun file-size (path) | (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." | ||||||
|   (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 = (first queue) |         for cur = (directory-as-file-pathname (first queue)) | ||||||
|         for res = (osicat-posix:stat cur) |         for res = (handler-bind | ||||||
|  |                       ((osicat-posix:posix-error | ||||||
|  |                          (lambda (e) | ||||||
|  |                            (unless no-errors | ||||||
|  |                              (signal e))))) | ||||||
|  |                     (osicat-posix:lstat cur)) | ||||||
|         do (pop queue) |         do (pop queue) | ||||||
|         when (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 (uiop:directory* | ||||||
|                                  (merge-pathnames |                                  (merge-pathnames | ||||||
|                                   uiop:*wild-file-for-directory* cur)) |                                   uiop:*wild-file-for-directory* | ||||||
|  |                                   (uiop:ensure-directory-pathname cur))) | ||||||
|                                 queue)) |                                 queue)) | ||||||
|         else |         else summing (osicat-posix:stat-size res))) | ||||||
|           summing (regular-file-size cur))) |  | ||||||
|  |  | ||||||
| (declaim (ftype (function (string character &optional (or null integer)) list) | (declaim (ftype (function (string character &optional (or null integer)) list) | ||||||
|                 split-string)) |                 split-string)) | ||||||
| @ -56,11 +62,13 @@ part of STRING." | |||||||
|         for (size mtime encoded-name) = (split-string line #\Space 3) |         for (size mtime encoded-name) = (split-string line #\Space 3) | ||||||
|         for name = (url-decode encoded-name) |         for name = (url-decode encoded-name) | ||||||
|         when (and size mtime encoded-name) |         when (and size mtime encoded-name) | ||||||
|           do (setf (gethash name out) |           do (handler-case | ||||||
|  |                  (setf (gethash name out) | ||||||
|                        (make-directorysizes-entry |                        (make-directorysizes-entry | ||||||
|                     :size (parse-integer size) |                         :size (max 0 (parse-integer size)) | ||||||
|                     :mtime (parse-integer mtime) |                         :mtime (max 0 (parse-integer mtime)) | ||||||
|                         :name name)) |                         :name name)) | ||||||
|  |                (parse-error ())) | ||||||
|         finally (return out))) |         finally (return out))) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) hash-table) | (declaim (ftype (function ((or string pathname)) hash-table) | ||||||
| @ -111,11 +119,12 @@ it." | |||||||
|         :keep t :directory ,dir :type nil)))) |         :keep t :directory ,dir :type nil)))) | ||||||
|  |  | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname) string)) | (declaim (ftype (function ((or string pathname) string) (or integer null)) | ||||||
|                 update-directorysizes-entry)) |                 update-directorysizes-entry)) | ||||||
| (defun trashed-file-size (trash-directory name) | (defun trashed-file-size (trash-directory name) | ||||||
|   "Return the size of the trashed file NAME in TRASH-DIRECTORY. If NAME is a |   "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." | directory and the file size cache is out of date, update it. As a second value, | ||||||
|  | return whether the cache actually needed updating." | ||||||
|   (let* ((directorysizes-path (calculate-directorysizes-path trash-directory)) |   (let* ((directorysizes-path (calculate-directorysizes-path trash-directory)) | ||||||
|          (directorysizes (handler-case |          (directorysizes (handler-case | ||||||
|                              (read-directorysizes-file directorysizes-path) |                              (read-directorysizes-file directorysizes-path) | ||||||
| @ -147,14 +156,13 @@ directory and the file size cache is out of date, update it." | |||||||
|                  trashinfo-mtime)) |                  trashinfo-mtime)) | ||||||
|        (setq ret-size (directorysizes-entry-size cur-entry))) |        (setq ret-size (directorysizes-entry-size cur-entry))) | ||||||
|       (t |       (t | ||||||
|        (let ((orig-size (gethash name directorysizes)) |        (let ((size (file-size path))) | ||||||
|              (size (file-size path))) |  | ||||||
|          (setf (gethash name directorysizes) |          (setf (gethash name directorysizes) | ||||||
|                (make-directorysizes-entry |                (make-directorysizes-entry | ||||||
|                 :mtime trashinfo-mtime |                 :mtime trashinfo-mtime | ||||||
|                 :size size |                 :size size | ||||||
|                 :name name) |                 :name name) | ||||||
|                did-change (not (eql size orig-size)) |                did-change t | ||||||
|                ret-size size)))) |                ret-size size)))) | ||||||
|     (when did-change |     (when did-change | ||||||
|       (handler-case |       (handler-case | ||||||
| @ -162,4 +170,4 @@ directory and the file size cache is out of date, update it." | |||||||
|             (format-directorysizes stream directorysizes)) |             (format-directorysizes stream directorysizes)) | ||||||
|         ;; ignore errors when updating the cache |         ;; ignore errors when updating the cache | ||||||
|         (osicat-posix:posix-error ()))) |         (osicat-posix:posix-error ()))) | ||||||
|     ret-size)) |     (values ret-size did-change))) | ||||||
|  | |||||||
| @ -35,7 +35,7 @@ | |||||||
|                 list-linux-mountpoints)) |                 list-linux-mountpoints)) | ||||||
| (defun list-linux-mountpoints (&key only-real only-writable) | (defun list-linux-mountpoints (&key only-real only-writable) | ||||||
|   "List all mount points on a Linux system. " |   "List all mount points on a Linux system. " | ||||||
|   (with-open-file (in #P"/proc/mounts") |   (with-open-file (in (uiop:parse-unix-namestring "/proc/mounts")) | ||||||
|     (loop for line = (read-line in nil) |     (loop for line = (read-line in nil) | ||||||
|           while line |           while line | ||||||
|           for (source target fstype options) = (parse-linux-fstab-line line) |           for (source target fstype options) = (parse-linux-fstab-line line) | ||||||
| @ -74,7 +74,8 @@ be determined." | |||||||
|  |  | ||||||
| (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) | ||||||
|  |          (inline ensure-nonwild-pathname)) | ||||||
| (defun ensure-nonwild-pathname (path &key ensure-directory) | (defun ensure-nonwild-pathname (path &key ensure-directory) | ||||||
|   "coerce path into a pathname. signal a file-error if it is wild." |   "coerce path into a pathname. signal a file-error if it is wild." | ||||||
|   (if (pathnamep path) |   (if (pathnamep path) | ||||||
| @ -89,10 +90,12 @@ be determined." | |||||||
| (declaim (ftype (function ((or string pathname)) string) file-or-dir-namestring)) | (declaim (ftype (function ((or string pathname)) string) file-or-dir-namestring)) | ||||||
| (defun file-or-dir-namestring (path) | (defun file-or-dir-namestring (path) | ||||||
|   "Return the name of the last component of PATH, be it a file or directory." |   "Return the name of the last component of PATH, be it a file or directory." | ||||||
|   (if (uiop:pathname-equal path "/") |   (let ((root (uiop:parse-unix-namestring "/"))) | ||||||
|       "/" |     (if (uiop:pathname-equal path root) | ||||||
|  |         (uiop:native-namestring root) | ||||||
|         (let ((unix-path (remove-suffix (uiop:unix-namestring path) "/"))) |         (let ((unix-path (remove-suffix (uiop:unix-namestring path) "/"))) | ||||||
|         (first (last (uiop:split-string unix-path :max 2 :separator '(#\/))))))) |           (first (last (uiop:split-string unix-path :max 2 | ||||||
|  |                                                     :separator '(#\/)))))))) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) (or pathname null)) | (declaim (ftype (function ((or string pathname)) (or pathname null)) | ||||||
|                 deepest-existing-path)) |                 deepest-existing-path)) | ||||||
|  | |||||||
| @ -52,13 +52,15 @@ | |||||||
|    "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-nonwild-pathname) |                 #:ensure-nonwild-pathname | ||||||
|  |                 #: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 | ||||||
|                 #:compute-trashinfo-source-file) |                 #:compute-trashinfo-source-file) | ||||||
|   (:export #:read-directorysizes-file |   (:export #:directory-as-file-pathname | ||||||
|  |            #:read-directorysizes-file | ||||||
|            #:prase-directorysizes |            #:prase-directorysizes | ||||||
|            #:trashed-file-size |            #:trashed-file-size | ||||||
|            #:calculate-directorysizes-path)) |            #:calculate-directorysizes-path)) | ||||||
|  | |||||||
| @ -21,10 +21,11 @@ | |||||||
|            :initarg :target |            :initarg :target | ||||||
|            :documentation "The destination of the move operation.")) |            :documentation "The destination of the move operation.")) | ||||||
|   (:report (lambda (condition stream) |   (:report (lambda (condition stream) | ||||||
|              (with-slots (source target) condition |  | ||||||
|              (format stream "~S and ~S lie on different devices" |              (format stream "~S and ~S lie on different devices" | ||||||
|                        (uiop:native-namestring source) |                      (uiop:native-namestring | ||||||
|                        (uiop:native-namestring target))))) |                       (cross-device-error-source condition)) | ||||||
|  |                      (uiop:native-namestring | ||||||
|  |                       (cross-device-error-target condition))))) | ||||||
|   (:documentation "An error that arose when moving files across devices.")) |   (:documentation "An error that arose when moving files across devices.")) | ||||||
|  |  | ||||||
| (define-condition file-exists-error (file-error) | (define-condition file-exists-error (file-error) | ||||||
| @ -42,66 +43,63 @@ | |||||||
|       (env (uiop:parse-native-namestring |       (env (uiop:parse-native-namestring | ||||||
|             (pathname env) :ensure-directory t)) |             (pathname env) :ensure-directory t)) | ||||||
|       ((not homedir) |       ((not homedir) | ||||||
|        (merge-pathnames #P".local/share/" |        (merge-pathnames (uiop:parse-unix-namestring ".local/share/") | ||||||
|                         (user-homedir-pathname))) |                         (user-homedir-pathname))) | ||||||
|       ((pathnamep homedir) |       ((pathnamep homedir) | ||||||
|        (merge-pathnames #P".local/share/" |        (merge-pathnames (uiop:parse-unix-namestring ".local/share/") | ||||||
|                         (uiop:ensure-directory-pathname homedir))) |                         (uiop:ensure-directory-pathname homedir))) | ||||||
|       (t |       (t | ||||||
|        (merge-pathnames #P".local/share/" |        (merge-pathnames (uiop:parse-unix-namestring ".local/share/") | ||||||
|                         (uiop:parse-native-namestring homedir |                         (uiop:parse-native-namestring homedir | ||||||
|                                                       :ensure-directory t)))))) |                                                       :ensure-directory t)))))) | ||||||
|  |  | ||||||
| (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) | ||||||
|   (merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir))) |   (uiop:ensure-directory-pathname | ||||||
|  |    (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) | ||||||
|          (inline sticky-bit-set-p)) |          (inline sticky-bit-set-p)) | ||||||
| (defun sticky-bit-set-p (mode) | (defun sticky-bit-set-p (mode) | ||||||
|   "Return non-nil if the sticky bit is set in MODE." |   "Return non-nil if the sticky bit is set in MODE." | ||||||
|   (not (zerop (logand (ash mode -9) 1)))) |   (not (zerop (logand mode #o1000)))) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) t) valid-toplevel-trash-dir-p)) | (declaim (ftype (function ((or string pathname) &optional t) | ||||||
| (defun valid-toplevel-trash-dir-p (path) |                           (or null osicat-posix:stat)) | ||||||
|   "Return non-nil if PATH is a valid toplevel trash directory. That is, it |                 stat) | ||||||
| exists, is a directory, and: (1) is owned by the current user, (2) has the |          (inline stat)) | ||||||
| sticky bit set (and the info/ and files/ subdirectories are the same)." | (defun stat (path &optional lstat) | ||||||
|   (flet ((check-dir (path) |   "Call the stat(2) system call on PATH. With LSTAT, use lstat(2) instead." | ||||||
|  |   (let ((path (directory-as-file-pathname | ||||||
|  |                (ensure-nonwild-pathname path)))) | ||||||
|     (handler-case |     (handler-case | ||||||
|                (let* ((path (ensure-nonwild-pathname path)) |         (if lstat | ||||||
|                       (stat (osicat-posix:stat path))) |             (osicat-posix:lstat path) | ||||||
|                  (and (osicat-posix:s-isdir (osicat-posix:stat-mode stat)) |             (osicat-posix:stat path)) | ||||||
|                       (sticky-bit-set-p (osicat-posix:stat-mode stat)) |  | ||||||
|                       (osicat-posix:access path (logior osicat-posix:r-ok |  | ||||||
|                                                         osicat-posix:w-ok)))) |  | ||||||
|       (osicat-posix:posix-error () nil)))) |       (osicat-posix:posix-error () nil)))) | ||||||
|     (let* ((path (ensure-nonwild-pathname path :ensure-directory t))) |  | ||||||
|       (and (check-dir path) |  | ||||||
|            (check-dir (merge-pathnames "info" path)) |  | ||||||
|            (check-dir (merge-pathnames "files" path)))))) |  | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel)) | (declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel)) | ||||||
| (defun find-trash-dirs-for-toplevel (toplevel) | (defun find-trash-dirs-for-toplevel (toplevel) | ||||||
|   "List the trash directories that exist under TOPLEVEL." |   "List the trash directories that exist under TOPLEVEL." | ||||||
|   (let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t)) |   (let ((uid (osicat-posix:getuid)) | ||||||
|  |         (top-path (ensure-nonwild-pathname toplevel :ensure-directory t)) | ||||||
|         found) |         found) | ||||||
|     (let ((dir (merge-pathnames #P".Trash/" top-path))) |     (flet ((check (dir) | ||||||
|       (when (valid-toplevel-trash-dir-p dir) |              (let ((stat (stat dir t))) | ||||||
|         (push dir found))) |  | ||||||
|     (let ((uid (osicat-posix:getuid))) |  | ||||||
|       (when uid |  | ||||||
|         (let* ((dir (merge-pathnames (pathname (format nil ".Trash-~D/" uid)) |  | ||||||
|                                      top-path)) |  | ||||||
|                (stat (handler-case |  | ||||||
|                          (osicat-posix:stat (uiop:native-namestring dir)) |  | ||||||
|                        (osicat-posix:posix-error () nil)))) |  | ||||||
|                (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 dir found))))) |                  (push (uiop:ensure-directory-pathname dir) found))))) | ||||||
|     (nreverse found))) |       (check (merge-pathnames (pathname (format nil ".Trash-~D" uid)) top-path)) | ||||||
|  |       (let* ((dir (uiop:ensure-directory-pathname | ||||||
|  |                    (merge-pathnames #P".Trash" top-path))) | ||||||
|  |              (stat (stat dir t))) | ||||||
|  |         (when (and stat | ||||||
|  |                    (osicat-posix:s-isdir (osicat-posix:stat-mode stat)) | ||||||
|  |                    (sticky-bit-set-p (osicat-posix:stat-mode stat))) | ||||||
|  |           (check (merge-pathnames (pathname (format nil "~D" uid)) dir)))) | ||||||
|  |       found))) | ||||||
|  |  | ||||||
| (declaim (ftype (function () list) list-toplevel-trash-directories)) | (declaim (ftype (function () list) list-toplevel-trash-directories)) | ||||||
| (defun list-toplevel-trash-directories () | (defun list-toplevel-trash-directories () | ||||||
| @ -123,20 +121,72 @@ directory)." | |||||||
|     (or (and include-self (uiop:pathname-equal path home)) |     (or (and include-self (uiop:pathname-equal path home)) | ||||||
|         (uiop:subpathp path home)))) |         (uiop:subpathp path home)))) | ||||||
|  |  | ||||||
| (declaim (ftype (function ((or pathname string) &optional list) pathname) | (declaim (ftype (function ((or pathname string) &optional list) (or pathname null)) | ||||||
|  |                 maybe-create-toplevel-trash-dir)) | ||||||
|  | (defun maybe-create-toplevel-trash-dir (root &optional ignored-trash-dirs) | ||||||
|  |   "Return or (if it's safe to) create a toplevel trash directory in | ||||||
|  | ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!" | ||||||
|  |   (let ((root (ensure-nonwild-pathname root :ensure-directory t)) | ||||||
|  |         (uid (osicat-posix:getuid))) | ||||||
|  |     (or | ||||||
|  |      ;; root/.Trash/$UID | ||||||
|  |      (let* ((outer (uiop: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 | ||||||
|  |                         (merge-pathnames (pathname (princ-to-string uid)) | ||||||
|  |                                          outer))) | ||||||
|  |                 (inner-stat (stat inner t))) | ||||||
|  |            (unless (member inner ignored-trash-dirs :test #'uiop:pathname-equal) | ||||||
|  |              (if inner-stat | ||||||
|  |                  (and (osicat-posix:s-isdir (osicat-posix:stat-mode inner-stat)) | ||||||
|  |                       (eql uid (osicat-posix:stat-uid inner-stat)) | ||||||
|  |                       inner) | ||||||
|  |                  (handler-case | ||||||
|  |                      (progn | ||||||
|  |                        (osicat-posix:mkdir (uiop:native-namestring inner) | ||||||
|  |                                            #o0700) | ||||||
|  |                        inner) | ||||||
|  |                    (osicat-posix:posix-error () nil))))))) | ||||||
|  |      ;; root/.Trash-$UID | ||||||
|  |      (let* ((dir (uiop: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) | ||||||
|  |          (if stat | ||||||
|  |              (and (osicat-posix:s-isdir (osicat-posix:stat-mode stat)) | ||||||
|  |                   (eql uid (osicat-posix:stat-uid stat)) | ||||||
|  |                   dir) | ||||||
|  |              (handler-case | ||||||
|  |                  (progn | ||||||
|  |                    (osicat-posix:mkdir (uiop:native-namestring dir) | ||||||
|  |                                        #o0700) | ||||||
|  |                    dir) | ||||||
|  |                (osicat-posix:posix-error () nil)))))))) | ||||||
|  |  | ||||||
|  | (declaim (ftype (function ((or pathname string) &optional list) (or null pathname)) | ||||||
|                 trash-directory-for-file)) |                 trash-directory-for-file)) | ||||||
| (defun trash-directory-for-file (path &optional ignored-trash-dirs) | (defun trash-directory-for-file (path &optional ignored-trash-dirs) | ||||||
|   "Return the trash directory into which PATH should be trashed." |   "Return the trash directory into which PATH should be trashed." | ||||||
|   (let* ((res-path (ensure-nonwild-pathname path)) |   (let* ((ignored-trash-dirs | ||||||
|          (root (find-filesystem-root res-path))) |            (mapcar (lambda (elt) (ensure-nonwild-pathname | ||||||
|     (or (and (path-in-home-directory-p res-path) |                                   elt :ensure-directory t)) | ||||||
|              (uiop:pathname-equal (find-filesystem-root (user-homedir-pathname)) |                    ignored-trash-dirs)) | ||||||
|                                   root) |          (res-path (ensure-nonwild-pathname path)) | ||||||
|              (user-home-trash-directory)) |          (root (find-filesystem-root res-path)) | ||||||
|         (or (car (set-difference (find-trash-dirs-for-toplevel root) |          (home-trash (let ((ht (user-home-trash-directory))) | ||||||
|                                  ignored-trash-dirs |                        (unless (member ht ignored-trash-dirs | ||||||
|                                  :test #'uiop:pathname-equal)) |                                        :test #'uiop:pathname-equal) | ||||||
|             (user-home-trash-directory))))) |                          ht)))) | ||||||
|  |     (if (and (path-in-home-directory-p res-path) | ||||||
|  |              (uiop:pathname-equal | ||||||
|  |               (find-filesystem-root (user-homedir-pathname)) root)) | ||||||
|  |         home-trash | ||||||
|  |         (or (maybe-create-toplevel-trash-dir root ignored-trash-dirs) | ||||||
|  |             home-trash)))) | ||||||
|  |  | ||||||
| (defun rename-safely (source target) | (defun rename-safely (source target) | ||||||
|   "Move SOURCE to TARGET, signaling an error if TARGET already exists." |   "Move SOURCE to TARGET, signaling an error if TARGET already exists." | ||||||
| @ -205,8 +255,9 @@ specific directory." | |||||||
|                               (ensure-nonwild-pathname trash-directory |                               (ensure-nonwild-pathname trash-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 (merge-pathnames |          (files-dir (ensure-directories-exist | ||||||
|                                                #P"files/" trash-directory) |                      (uiop:ensure-directory-pathname | ||||||
|  |                       (merge-pathnames #P"files" trash-directory)) | ||||||
|                      :verbose nil)) |                      :verbose nil)) | ||||||
|          (trashinfo (make-trashinfo-for trash-directory path)) |          (trashinfo (make-trashinfo-for trash-directory path)) | ||||||
|          (target (merge-pathnames (make-pathname |          (target (merge-pathnames (make-pathname | ||||||
| @ -235,16 +286,21 @@ specific directory." | |||||||
| (defun list-trashed-files-for-directory (trash-directory) | (defun list-trashed-files-for-directory (trash-directory) | ||||||
|   "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 (merge-pathnames #P"info/" trash-directory))) |   (let ((info-dir (uiop:ensure-directory-pathname | ||||||
|  |                    (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))) | ||||||
|                   (when (uiop:string-suffix-p name ".trashinfo") |                   (when (uiop:string-suffix-p name ".trashinfo") | ||||||
|                     (handler-case |                     (handler-case | ||||||
|                         (list (parse-trashinfo-file |                         (let ((trashinfo (parse-trashinfo-file | ||||||
|                                           trash-directory |                                           trash-directory | ||||||
|                                (subseq name 0 (- (length name) |                                           (subseq | ||||||
|                                                  (length ".trashinfo"))))) |                                            name 0 (- (length name) | ||||||
|                       (trashinfo-format-error () nil))))) |                                                      (length ".trashinfo")))))) | ||||||
|  |                           (when (probe-file | ||||||
|  |                                  (trashinfo-trashed-file trashinfo)) | ||||||
|  |                             (list trashinfo))) | ||||||
|  |                       (trashinfo-format-error ()))))) | ||||||
|             (uiop:directory-files info-dir)))) |             (uiop:directory-files info-dir)))) | ||||||
|  |  | ||||||
| (declaim (ftype (function (&optional (or pathname string list)) list) | (declaim (ftype (function (&optional (or pathname string list)) list) | ||||||
|  | |||||||
| @ -19,9 +19,10 @@ line 1.") | |||||||
|                 :type pathname |                 :type pathname | ||||||
|                 :documentation "The path to the file the error happened in.")) |                 :documentation "The path to the file the error happened in.")) | ||||||
|   (:report (lambda (condition stream) |   (:report (lambda (condition stream) | ||||||
|              (with-slots (message line-number source-file) condition |  | ||||||
|              (format stream "Error parsing ~A on line ~A: ~A." |              (format stream "Error parsing ~A on line ~A: ~A." | ||||||
|                        source-file line-number message))))) |                      (trashinfo-format-error-source-file condition) | ||||||
|  |                      (trashinfo-format-error-line-number condition) | ||||||
|  |                      (trashinfo-format-error-message condition))))) | ||||||
|  |  | ||||||
| (defclass trashinfo () | (defclass trashinfo () | ||||||
|   ((trash-directory :reader trashinfo-trash-directory |   ((trash-directory :reader trashinfo-trash-directory | ||||||
| @ -192,9 +193,10 @@ 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 | ||||||
|                          (merge-pathnames #P"info/" |  | ||||||
|                          (uiop:ensure-directory-pathname |                          (uiop:ensure-directory-pathname | ||||||
|                                            trash-directory)) |                           (merge-pathnames #P"info" | ||||||
|  |                                            (uiop:ensure-directory-pathname | ||||||
|  |                                             trash-directory))) | ||||||
|                          :verbose nil) |                          :verbose nil) | ||||||
|         for info-file = (merge-pathnames |         for info-file = (merge-pathnames | ||||||
|                          (make-pathname |                          (make-pathname | ||||||
|  | |||||||
							
								
								
									
										353
									
								
								clash/clash.lisp
									
									
									
									
									
								
							
							
						
						
									
										353
									
								
								clash/clash.lisp
									
									
									
									
									
								
							| @ -40,10 +40,11 @@ | |||||||
|             :initarg :message |             :initarg :message | ||||||
|             :documentation "A message describing the error.")) |             :documentation "A message describing the error.")) | ||||||
|   (:report (lambda (condition stream) |   (:report (lambda (condition stream) | ||||||
|              (with-slots (source pos message) condition |  | ||||||
|              (format |              (format | ||||||
|               stream "Failed to parse date ~S~@[ at position ~A~]: ~A" |               stream "Failed to parse date ~S~@[ at position ~A~]: ~A" | ||||||
|                 source pos message)))) |               (date-parse-error-source condition) | ||||||
|  |               (date-parse-error-position condition) | ||||||
|  |               (date-parse-error-message condition)))) | ||||||
|   (:documentation "A condition representing a failure in parsing a date range.")) |   (:documentation "A condition representing a failure in parsing a date range.")) | ||||||
|  |  | ||||||
| (defparameter *month-conversion-table* | (defparameter *month-conversion-table* | ||||||
| @ -234,6 +235,23 @@ date ranges..")) | |||||||
| (defun clingon-filtering-options () | (defun clingon-filtering-options () | ||||||
|   "Return some options that can be used by many commands for filtering." |   "Return some options that can be used by many commands for filtering." | ||||||
|   (list |   (list | ||||||
|  |    (clingon:make-option | ||||||
|  |     :list/filepath | ||||||
|  |     :key :extra-trashes | ||||||
|  |     :description "include additional trashes" | ||||||
|  |     :short-name #\c | ||||||
|  |     :long-name "include-trash") | ||||||
|  |    (clingon:make-option | ||||||
|  |     :list/filepath | ||||||
|  |     :key :ignored-trashes | ||||||
|  |     :description "ignore the given trash directory" | ||||||
|  |     :long-name "ignore-trash") | ||||||
|  |    (clingon:make-option | ||||||
|  |     :flag | ||||||
|  |     :key :only-explicit-dirs | ||||||
|  |     :description "only use trash directories supplied with -c" | ||||||
|  |     :short-name #\E | ||||||
|  |     :long-name "explicit-trashes-only") | ||||||
|    (clingon:make-option |    (clingon:make-option | ||||||
|     :flag |     :flag | ||||||
|     :key :print-format-info |     :key :print-format-info | ||||||
| @ -329,9 +347,11 @@ string." | |||||||
|  |  | ||||||
| (defun list-nonexcluded-trash-dirs (cmd) | (defun list-nonexcluded-trash-dirs (cmd) | ||||||
|   "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 (set-difference (cl-xdg-trash:list-trash-directories) |   (append (unless (clingon:getopt cmd :only-explicit-dirs) | ||||||
|                           (clingon:getopt cmd :ignored-trashes) |             (set-difference (cl-xdg-trash:list-trash-directories) | ||||||
|                           :test #'uiop:pathname-equal) |                             (mapcar #'uiop:ensure-directory-pathname | ||||||
|  |                                     (clingon:getopt cmd :ignored-trashes)) | ||||||
|  |                             :test #'uiop:pathname-equal)) | ||||||
|           (mapcar #'ensure-nonwild-pathname |           (mapcar #'ensure-nonwild-pathname | ||||||
|                   (clingon:getopt cmd :extra-trashes)))) |                   (clingon:getopt cmd :extra-trashes)))) | ||||||
|  |  | ||||||
| @ -371,6 +391,20 @@ string." | |||||||
|  |  | ||||||
|  |  | ||||||
| ;; Formatting | ;; Formatting | ||||||
|  | (defun format-size (count &optional base-two (places 2)) | ||||||
|  |   "Pretty print COUNT, which is a number of bytes. This will append metric | ||||||
|  | suffixes as necessary. If BASE-TWO is non-nil, use MiB, GiB, etc. suffixes | ||||||
|  | instead." | ||||||
|  |   (if (not count) | ||||||
|  |       "N/A" ;; if find the size of something failed | ||||||
|  |       (let* ((base (if base-two 1024 1000)) | ||||||
|  |              (power (min 10 (floor (if (zerop count) 0 (log count base)))))) | ||||||
|  |         (if (zerop power) | ||||||
|  |             (format nil "~DB" count) | ||||||
|  |             (format nil "~,VF~[~:[k~;K~]~:*~;M~;G~;T~;P~;E~;Z~;Y~;R~;Q~]~@[i~]B" | ||||||
|  |                     places (/ count (expt base power)) | ||||||
|  |                     (1- power) base-two))))) | ||||||
|  |  | ||||||
| (defparameter *trashinfo-formatters* | (defparameter *trashinfo-formatters* | ||||||
|   `((#\# :index |   `((#\# :index | ||||||
|          "the index of the current file (used when prompting for files)") |          "the index of the current file (used when prompting for files)") | ||||||
| @ -399,11 +433,24 @@ string." | |||||||
|              stream (trashinfo-deletion-date info) |              stream (trashinfo-deletion-date info) | ||||||
|              :format local-time:+asctime-format+)) |              :format local-time:+asctime-format+)) | ||||||
|          "the (t)ime the file was trashed (pretty-printed local time)") |          "the (t)ime the file was trashed (pretty-printed local time)") | ||||||
|     (#\t ,(lambda (stream info) |     (#\s ,(lambda (stream info) | ||||||
|             (format stream "~A" (trashed-file-size |             (format stream "~A" (trashed-file-size | ||||||
|                                  (trashinfo-trash-directory info) |                                  (trashinfo-trash-directory info) | ||||||
|                                  (trashinfo-name info)))) |                                  (trashinfo-name info)))) | ||||||
|          "the file's (s)size") |          "the file's (s)size in bytes") | ||||||
|  |     (#\h ,(lambda (stream info) | ||||||
|  |             (format stream "~A" | ||||||
|  |                     (format-size (trashed-file-size | ||||||
|  |                                   (trashinfo-trash-directory info) | ||||||
|  |                                   (trashinfo-name info))))) | ||||||
|  |          "the file's size with a (h)uman readable suffix (powers of 10)") | ||||||
|  |     (#\H ,(lambda (stream info) | ||||||
|  |             (format stream "~A" | ||||||
|  |                     (format-size (trashed-file-size | ||||||
|  |                                   (trashinfo-trash-directory info) | ||||||
|  |                                   (trashinfo-name info)) | ||||||
|  |                                  t))) | ||||||
|  |          "the file's size with a (H)uman readable suffix (power of 2)") | ||||||
|     (#\% ,(lambda (stream info) |     (#\% ,(lambda (stream info) | ||||||
|             (declare (ignore info)) |             (declare (ignore info)) | ||||||
|             (format stream "%")) |             (format stream "%")) | ||||||
| @ -539,14 +586,7 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|   "Return options for the \"list\" subcommand." |   "Return options for the \"list\" subcommand." | ||||||
|   (append |   (append | ||||||
|    (clingon-filtering-options) |    (clingon-filtering-options) | ||||||
|    (clingon-sort-options) |    (clingon-sort-options))) | ||||||
|    (list |  | ||||||
|     (clingon:make-option |  | ||||||
|      :list/filepath |  | ||||||
|      :key :extra-trashes |  | ||||||
|      :description "include additional trashes" |  | ||||||
|      :short-name #\c |  | ||||||
|      :long-name "include-trash")))) |  | ||||||
|  |  | ||||||
| (defun list/command () | (defun list/command () | ||||||
|   "Return the Clingon command for the \"list\" subcommand." |   "Return the Clingon command for the \"list\" subcommand." | ||||||
| @ -600,10 +640,83 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|  |  | ||||||
|  |  | ||||||
| ;; Restore command | ;; Restore command | ||||||
|  | (declaim (inline single-item-list-p)) | ||||||
|  | (defun single-item-list-p (list) | ||||||
|  |   "Return non-nil if LIST has only one thing." | ||||||
|  |   (and list (null (cdr list)))) | ||||||
|  |  | ||||||
|  | (defun prompt-for-index (stream action max &optional allow-many) | ||||||
|  |   "Prompt the user for an index between 1 and MAX to restore. With ALLOW-MANY, | ||||||
|  | return a list of many indices instead." | ||||||
|  |   (when (zerop max) | ||||||
|  |     (error "Nothing found...")) | ||||||
|  |   (format stream "~&Select ~:[indices~;index~] to ~A: " | ||||||
|  |           (or (eql 1 max) (not allow-many)) action) | ||||||
|  |   (let ((resp-string (read-line stream nil)) | ||||||
|  |         (seperators '(#\Space #\Tab #\,))) | ||||||
|  |     (unless resp-string | ||||||
|  |       (error "No number provided")) | ||||||
|  |     (let ((parts (uiop:split-string resp-string | ||||||
|  |                                     :separator seperators)) | ||||||
|  |           (out (make-hash-table :test #'eql))) | ||||||
|  |       (unless parts | ||||||
|  |         (error "No number provided")) | ||||||
|  |       (unless (or allow-many | ||||||
|  |                   (single-item-list-p parts)) | ||||||
|  |         (error "Only one item can be selected")) | ||||||
|  |       (dolist (part parts) | ||||||
|  |         (unless (every (lambda (c) (member c seperators)) part) | ||||||
|  |           (let ((n (parse-integer part))) | ||||||
|  |             (when (or (< n 1) | ||||||
|  |                       (> n max)) | ||||||
|  |               (error "Number ~A out of range [1,~A]" n max)) | ||||||
|  |             (setf (gethash (1- n) out) t)))) | ||||||
|  |       (loop for key being the hash-keys of out collect key)))) | ||||||
|  |  | ||||||
| (defun restore/handler (cmd) | (defun restore/handler (cmd) | ||||||
|   "Handler for the \"restore\" subcommand." |   "Handler for the \"restore\" subcommand." | ||||||
|   (le)) |   (if (clingon:getopt cmd :print-format-info) | ||||||
|  |       (print-format-info t) | ||||||
|  |       (let ((format (process-format-string (or (clingon:getopt cmd :format) | ||||||
|  |                                                "%#: %t  %o\\n"))) | ||||||
|  |             (infos (list-trashinfos-for-cmd cmd)) | ||||||
|  |             (target (clingon:getopt cmd :target)) | ||||||
|  |             (all (clingon:getopt cmd :all)) | ||||||
|  |             (cli-indices (clingon:getopt cmd :indices))) | ||||||
|  |         (when (and all target) | ||||||
|  |           (error "Only one of -a and -t can be supplied")) | ||||||
|  |         (cond | ||||||
|  |           ((and (clingon:getopt cmd :dont-prompt-only-one) | ||||||
|  |                 (single-item-list-p infos)) | ||||||
|  |            (cl-xdg-trash:restore-file (car infos))) | ||||||
|  |           ((clingon:getopt cmd :all) | ||||||
|  |            (mapc #'cl-xdg-trash:restore-file infos)) | ||||||
|  |           (cli-indices | ||||||
|  |            (unless infos | ||||||
|  |              (error "Nothing found...")) | ||||||
|  |            (loop with sorted-arr = (sort-trashinfos-for-cmd | ||||||
|  |                                     (coerce infos 'vector) cmd) | ||||||
|  |                  for i in cli-indices | ||||||
|  |                  when (or (> i (length sorted-arr)) | ||||||
|  |                           (< i 1)) | ||||||
|  |                    do (error "Index ~S out of bounds [1,~S]" | ||||||
|  |                              i (length sorted-arr)) | ||||||
|  |                  do (cl-xdg-trash:restore-file (aref sorted-arr (1- i))))) | ||||||
|  |           (t | ||||||
|  |            (let ((sorted-arr (coerce infos 'vector))) | ||||||
|  |              (sort-trashinfos-for-cmd sorted-arr cmd) | ||||||
|  |              (loop for info across sorted-arr | ||||||
|  |                    for i upfrom 1 | ||||||
|  |                    do (format-trashinfo t format info :index i)) | ||||||
|  |              (let ((idxs (prompt-for-index t "restore" | ||||||
|  |                                            (length sorted-arr) | ||||||
|  |                                            (not target)))) | ||||||
|  |                (if target | ||||||
|  |                    (cl-xdg-trash:restore-file (aref sorted-arr (car idxs)) | ||||||
|  |                                               :target target) | ||||||
|  |                    (loop for i in idxs | ||||||
|  |                          do (cl-xdg-trash:restore-file | ||||||
|  |                              (aref sorted-arr i))))))))))) | ||||||
|  |  | ||||||
| (defun restore/options () | (defun restore/options () | ||||||
|   "Return options for the \"restore\" subcommand." |   "Return options for the \"restore\" subcommand." | ||||||
| @ -611,10 +724,16 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|    (clingon-filtering-options) |    (clingon-filtering-options) | ||||||
|    (clingon-sort-options) |    (clingon-sort-options) | ||||||
|    (list |    (list | ||||||
|  |     (clingon:make-option | ||||||
|  |      :filepath | ||||||
|  |      :key :target | ||||||
|  |      :description "where path to restore the file (exclusive with -a)" | ||||||
|  |      :short-name #\t | ||||||
|  |      :long-name "target") | ||||||
|     (clingon:make-option |     (clingon:make-option | ||||||
|      :flag |      :flag | ||||||
|      :key :all |      :key :all | ||||||
|      :description "restore all files that match the pattern" |      :description "restore all files that match the pattern (exclusive with -t)" | ||||||
|      :short-name #\a |      :short-name #\a | ||||||
|      :long-name "all") |      :long-name "all") | ||||||
|     (clingon:make-option |     (clingon:make-option | ||||||
| @ -627,7 +746,7 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|     (clingon:make-option |     (clingon:make-option | ||||||
|      :flag |      :flag | ||||||
|      :key :dont-prompt-only-one |      :key :dont-prompt-only-one | ||||||
|      :descrition "don't prompt if the pattern matches only one file" |      :description "don't prompt if the pattern matches only one file" | ||||||
|      :short-name #\O |      :short-name #\O | ||||||
|      :long-name "dont-prompt-only-one")))) |      :long-name "dont-prompt-only-one")))) | ||||||
|  |  | ||||||
| @ -635,23 +754,192 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|   "Rethrn the Clingon command for the \"restore\" subcommand." |   "Rethrn the Clingon command for the \"restore\" subcommand." | ||||||
|   (clingon:make-command |   (clingon:make-command | ||||||
|    :name "restore" |    :name "restore" | ||||||
|    :descrition "move files out of the trash" |    :description "move files out of the trash" | ||||||
|    :usage "[options] [pattern]" |    :usage "[options] [pattern]" | ||||||
|    :options (restore/options) |    :options (restore/options) | ||||||
|    :handler #'restore/handler)) |    :handler #'restore/handler)) | ||||||
|  |  | ||||||
|  |  | ||||||
| ;; Toplevel command | ;; Empty command | ||||||
| (defun toplevel/options () | (defun prompt-yes-or-no (stream control &rest args) | ||||||
|   "Return the toplevel options list." |   "Prompt the user for a yes or no response." | ||||||
|  |   (when control | ||||||
|  |     (apply #'format stream control args) | ||||||
|  |     (format stream "? (y/n) ")) | ||||||
|  |   (let ((resp-string (read-line stream nil))) | ||||||
|  |     (when resp-string | ||||||
|  |       (member resp-string '("yes" "y" "1") :test #'equalp)))) | ||||||
|  |  | ||||||
|  | (defun prompt-to-empty (count quiet) | ||||||
|  |   "Prompt for emptying the trash for the \"empty\" command. Specifically, used | ||||||
|  | with -n and -a." | ||||||
|  |   (prompt-yes-or-no | ||||||
|  |    t "Really erase ~@[~*the above ~]~@[~*~A~:* ~]file~P" | ||||||
|  |    (not quiet) (or quiet (/= 1 count)) count)) | ||||||
|  |  | ||||||
|  | (defun empty/handler (cmd) | ||||||
|  |   "Handler for the \"empty\" subcommand." | ||||||
|  |   (cond | ||||||
|  |     ((clingon:getopt cmd :print-format-info) | ||||||
|  |      (print-format-info t)) | ||||||
|  |     (t | ||||||
|  |      (let ((format (process-format-string | ||||||
|  |                     (or (clingon:getopt cmd :format) | ||||||
|  |                         "%#: %t  %o\\n"))) | ||||||
|  |            (dry-run (clingon:getopt cmd :dry-run)) | ||||||
|  |            (infos (coerce (list-trashinfos-for-cmd cmd) 'vector)) | ||||||
|  |            (quiet (clingon:getopt cmd :quiet)) | ||||||
|  |            (yes (clingon:getopt cmd :yes)) | ||||||
|  |            (all (clingon:getopt cmd :all)) | ||||||
|  |            (indices (clingon:getopt cmd :indices))) | ||||||
|  |        (when (and yes (not (or all indices))) | ||||||
|  |          (error "Found -y with neither -a nor -n, doing nothing")) | ||||||
|  |        (when (and quiet (not (or all indices))) | ||||||
|  |          (error "Found -q with neither -a nor -n, doing nothing")) | ||||||
|  |        (when (and (zerop (length infos)) (not quiet)) | ||||||
|  |          (error "Nothing found...")) | ||||||
|  |        (unless all | ||||||
|  |          (sort-trashinfos-for-cmd infos cmd)) | ||||||
|  |        (unless (or yes quiet) | ||||||
|  |          (loop for info across infos | ||||||
|  |                for i upfrom 1 | ||||||
|  |                when (or (not indices) (member i indices)) | ||||||
|  |                  do (format-trashinfo t format info :index i))) | ||||||
|  |        (cond | ||||||
|  |          (all | ||||||
|  |           (when (or yes (prompt-to-empty (length infos) quiet)) | ||||||
|  |             (loop for info across infos | ||||||
|  |                   do (cl-xdg-trash:empty-file info :dry-run dry-run)))) | ||||||
|  |          (indices | ||||||
|  |           (when (or yes (prompt-to-empty (length indices) quiet)) | ||||||
|  |             (loop for i in indices | ||||||
|  |                   when (or (< i 1) | ||||||
|  |                            (> i (length infos))) | ||||||
|  |                     do (error "Index ~A out of bounds [1,~A]" | ||||||
|  |                               i (length infos)) | ||||||
|  |                   else | ||||||
|  |                     do (cl-xdg-trash:empty-file (aref infos (1- i)) | ||||||
|  |                                                 :dry-run dry-run)))) | ||||||
|  |          (t | ||||||
|  |           (let ((index (prompt-for-index t "erase" (length infos) t))) | ||||||
|  |             (dolist (i index) | ||||||
|  |               (cl-xdg-trash:empty-file (aref infos i) :dry-run dry-run))))))))) | ||||||
|  |  | ||||||
|  | (defun empty/options () | ||||||
|  |   "Return options for the \"empty\" subcommand." | ||||||
|  |   (append | ||||||
|  |    (clingon-filtering-options) | ||||||
|  |    (clingon-sort-options) | ||||||
|    (list |    (list | ||||||
|     (clingon:make-option |     (clingon:make-option | ||||||
|     :list |      :flag | ||||||
|     :key :ignored-trashes |      :key :dry-run | ||||||
|     :description "ignore the given trash directory" |      :description "print what would happen without actually deleting anything" | ||||||
|     :long-name "ignore-trash" |      :short-name #\D | ||||||
|     :persistent t))) |      :long-name "dry-run") | ||||||
|  |     (clingon:make-option | ||||||
|  |      :flag | ||||||
|  |      :key :all | ||||||
|  |      :description "erase all matching files" | ||||||
|  |      :short-name #\a | ||||||
|  |      :long-name "all") | ||||||
|  |     (clingon:make-option | ||||||
|  |      :list/integer | ||||||
|  |      :key :indices | ||||||
|  |      :description | ||||||
|  |      "erase the Nth file that matched the pattern (after sorting)" | ||||||
|  |      :short-name #\n | ||||||
|  |      :long-name "nth") | ||||||
|  |     (clingon:make-option | ||||||
|  |      :flag | ||||||
|  |      :key :yes | ||||||
|  |      :description "erase files without prompting (implies -q)" | ||||||
|  |      :short-name #\y | ||||||
|  |      :long-name "yes") | ||||||
|  |     (clingon:make-option | ||||||
|  |      :flag | ||||||
|  |      :key :quiet | ||||||
|  |      :description "be less verbose" | ||||||
|  |      :short-name #\q | ||||||
|  |      :long-name "quiet")))) | ||||||
|  |  | ||||||
|  | (defun empty/command () | ||||||
|  |   "Return the Clingon command for the \"empty\" subcommand." | ||||||
|  |   (clingon:make-command | ||||||
|  |    :name "empty" | ||||||
|  |    :aliases '("erase" "rm") | ||||||
|  |    :description "delete files from the trash permanently" | ||||||
|  |    :options (empty/options) | ||||||
|  |    :handler #'empty/handler)) | ||||||
|  |  | ||||||
|  |  | ||||||
|  | ;; List trash directories command | ||||||
|  | (defun list-trashes/handler (cmd) | ||||||
|  |   "Handler for the \"list-trashes\" subcommand." | ||||||
|  |   (let* ((only-home (clingon:getopt cmd :home)) | ||||||
|  |          (only-toplevel (clingon:getopt cmd :toplevel)) | ||||||
|  |          (null (clingon:getopt cmd :null)) | ||||||
|  |          (dirs (cond | ||||||
|  |                  ((or (and only-home only-toplevel) | ||||||
|  |                       (not (or only-home only-toplevel))) | ||||||
|  |                   (cl-xdg-trash:list-trash-directories)) | ||||||
|  |                  (only-home | ||||||
|  |                   (list (cl-xdg-trash:user-home-trash-directory))) | ||||||
|  |                  (only-toplevel | ||||||
|  |                   (cl-xdg-trash:list-toplevel-trash-directories))))) | ||||||
|  |     (dolist (dir dirs) | ||||||
|  |       (format t "~A" (uiop:native-namestring dir)) | ||||||
|  |       (if null | ||||||
|  |           (write-char #\Nul) | ||||||
|  |           (terpri))))) | ||||||
|  |  | ||||||
|  | (defun list-trashes/options () | ||||||
|  |   "Return options for the \"list-trashes\" subcommand." | ||||||
|  |   (list | ||||||
|  |    (clingon:make-option | ||||||
|  |     :flag | ||||||
|  |     :key :home | ||||||
|  |     :description "only list the user's home trash directory" | ||||||
|  |     :short-name #\o | ||||||
|  |     :long-name "home") | ||||||
|  |    (clingon:make-option | ||||||
|  |     :flag | ||||||
|  |     :key :toplevel | ||||||
|  |     :description "only list toplevel trash directories" | ||||||
|  |     :short-name #\t | ||||||
|  |     :long-name "toplevel") | ||||||
|  |    (clingon:make-option | ||||||
|  |     :flag | ||||||
|  |     :key :null | ||||||
|  |     :description "use \\0 (null byte) instead of newline" | ||||||
|  |     :short-name #\0 | ||||||
|  |     :long-name "null"))) | ||||||
|  |  | ||||||
|  | (defun list-trashes/command () | ||||||
|  |   "Return the Clingon command for the \"list-trashes\" subcommand." | ||||||
|  |   (clingon:make-command | ||||||
|  |    :name "list-trashes" | ||||||
|  |    :description "list known trash directories" | ||||||
|  |    :options (list-trashes/options) | ||||||
|  |    :handler #'list-trashes/handler)) | ||||||
|  |  | ||||||
|  |  | ||||||
|  | ;; Size command | ||||||
|  | (defun size/handler (cmd) | ||||||
|  |   "Handler for the \"size\" subcommand." | ||||||
|  |   ) | ||||||
|  |  | ||||||
|  | (defun size/options () | ||||||
|  |   "Return options for the \"size\" subcommand." | ||||||
|  |   (list | ||||||
|  |    ())) | ||||||
|  |  | ||||||
|  | (defun size/command () | ||||||
|  |   "Return the Clingon command for the \"size\" subcommand.") | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  | ;; Toplevel command | ||||||
| (defun toplevel/command () | (defun toplevel/command () | ||||||
|   "Return the toplevel command." |   "Return the toplevel command." | ||||||
|   (clingon:make-command |   (clingon:make-command | ||||||
| @ -660,11 +948,16 @@ The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%") | |||||||
|    :version "0.1.0" |    :version "0.1.0" | ||||||
|    :license "GPL3" |    :license "GPL3" | ||||||
|    :authors '("Alexander Rosenberg <zanderpkg@pm.me>") |    :authors '("Alexander Rosenberg <zanderpkg@pm.me>") | ||||||
|    :options (toplevel/options) |  | ||||||
|    :sub-commands (list (list/command) |    :sub-commands (list (list/command) | ||||||
|                        (put/command)) |                        (put/command) | ||||||
|  |                        (restore/command) | ||||||
|  |                        (list-trashes/command) | ||||||
|  |                        (empty/command)) | ||||||
|    :handler #'(lambda (cmd) |    :handler #'(lambda (cmd) | ||||||
|                 (clingon:print-usage-and-exit cmd t)))) |                 (let ((args (clingon:command-arguments cmd))) | ||||||
|  |                   (when args | ||||||
|  |                     (error "Unknown subcommand: ~S" (car args))) | ||||||
|  |                   (clingon:print-usage-and-exit cmd t))))) | ||||||
|  |  | ||||||
| (defparameter *toplevel/help-option* | (defparameter *toplevel/help-option* | ||||||
|   (clingon:make-option |   (clingon:make-option | ||||||
|  | |||||||
		Reference in New Issue
	
	Block a user