Finish trashing files

2025-10-03 00:11:02 -07:00
parent 092b0993e7
commit 9ab3a6c374
5 changed files with 306 additions and 5 deletions
--- a/trash.lisp
+++ b/trash.lisp
@ -0,0 +1,92 @@
+(in-package :cl-xdg-trash)
+
+(declaim (ftype (function () (or integer null)) getuid))
+(defun getuid ()
+  "Return the current user's UID, or nil if it cannot be determined."
+  #+sbcl (sb-posix:getuid)
+  #-(or sbcl) nil)
+
+(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
+                xdg-data-home))
+(defun xdg-data-home (&key homedir)
+  (let ((env (uiop:getenv "XDG_DATA_HOME")))
+    (cond
+      (env (uiop:parse-native-namestring
+            (pathname env) :ensure-directory t))
+      ((not homedir)
+       (merge-pathnames #P".local/share/"
+                        (user-homedir-pathname)))
+      ((pathnamep homedir)
+       (merge-pathnames #P".local/share/"
+                        (uiop:ensure-directory-pathname homedir)))
+      (t
+       (merge-pathnames #P".local/share/"
+                        (uiop:parse-native-namestring homedir
+                                                      :ensure-directory t))))))
+
+(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
+                user-home-trash-directory))
+(defun user-home-trash-directory (&key homedir)
+  (merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir)))
+
+(declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel))
+(defun find-trash-dirs-for-toplevel (toplevel)
+  "List the trash directories that exist under TOPLEVEL."
+  (let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
+        found)
+    (let ((dir (merge-pathnames #P".Trash" top-path)))
+      (when (uiop:directory-exists-p dir)
+        (push dir found)))
+    (let ((uid (getuid)))
+      (when uid
+        (let ((dir (merge-pathnames (pathname (format nil ".Trash-~D" uid))
+                                    top-path)))
+          (when (uiop:directory-exists-p dir)
+            (push dir found)))))
+    found))
+
+(declaim (ftype (function () list) list-toplevel-trash-directories))
+(defun list-toplevel-trash-directories ()
+  "List all known trash directories other than the user's trash directory."
+  (mapcan 'find-trash-dirs-for-toplevel (list-mountpoints)))
+
+(declaim (ftype (function () list) list-trash-directories))
+(defun list-trash-directories ()
+  "List all known trash directories."
+  (cons (user-home-trash-directory) (list-toplevel-trash-directories)))
+
+(declaim (ftype (function ((or pathname string) &key (:include-self t)) t)
+                path-in-home-directory-p))
+(defun path-in-home-directory-p (path &key include-self)
+  "Return non-nil if PATH is in the user's home directory (or is the user's home
+directory)."
+  (let ((path (ensure-nonwild-pathname path :ensure-directory t))
+        (home (user-homedir-pathname)))
+    (or (and include-self (uiop:pathname-equal path home))
+        (uiop:subpathp path home))))
+
+(declaim (ftype (function ((or pathname string)) pathname)
+                trash-directory-for-file))
+(defun trash-directory-for-file (path)
+  "Return the trash directory into which PATH should be trashed."
+  (let* ((res-path (ensure-nonwild-pathname path))
+         (root (find-filesystem-root res-path)))
+    (or (and (path-in-home-directory-p res-path)
+             (uiop:pathname-equal (find-filesystem-root (user-homedir-pathname))
+                                  root)
+             (car (find-trash-dirs-for-toplevel root)))
+        (user-home-trash-directory))))
+
+(declaim (ftype (function ((or pathname string)) t) trash-file))
+(defun trash-file (path)
+  "Move PATH to the trash. Specifically, move it to the proper trash as
+specified by the XDG standard."
+  (let* ((path (merge-pathnames (ensure-nonwild-pathname path) (uiop:getcwd)))
+         (trash-directory (trash-directory-for-file path))
+         (trashinfo (make-trashinfo-for trash-directory path))
+         (files-dir (ensure-directories-exist (merge-pathnames
+                                               #P"files/" trash-directory)
+                                              :verbose nil)))
+    (rename-file path (merge-pathnames
+                       (make-pathname :name (trashinfo-name trashinfo))
+                       files-dir))))