Lots of work

This commit is contained in:
2025-10-17 16:47:03 -07:00
parent 9ab3a6c374
commit c309b1df38
6 changed files with 284 additions and 43 deletions

View File

@ -33,10 +33,10 @@ trashinfo file belongs to.")
:initarg :name
:type string
:documentation "The name of this trashinfo file without the extension.")
(path :reader trashinfo-path
:initarg :path
:type pathname
:documentation "Path to the original location of the file.")
(original-path :reader trashinfo-original-path
:initarg :original-path
:type pathname
:documentation "Path to the original location of the file.")
(deletion-date :reader trashinfo-deletion-date
:initarg :deletion-date
:type local-time:timestamp
@ -44,6 +44,16 @@ trashinfo file belongs to.")
trashed."))
(:documentation "Represents a .trashinfo file."))
(defmethod print-object ((obj trashinfo) stream)
(print-unreadable-object (obj stream :type t :identity t)
(princ (trashinfo-name obj) stream)))
(defmethod trashinfo-info-file ((trashinfo trashinfo))
(with-slots (name trash-directory) trashinfo
(merge-pathnames (make-pathname :name (format nil "~A.trashinfo" name)
:directory '(:relative "info"))
trash-directory)))
(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
(with-slots (name trash-directory) trashinfo
(merge-pathnames (make-pathname :name name :directory '(:relative "files"))
@ -81,13 +91,14 @@ trashed."))
(setq second (next-int 2))
(local-time:encode-timestamp 0 second minute hour day month year))))
(declaim (ftype (function (pathname string) pathname) compute-trashinfo-source-file))
(declaim (ftype (function ((or pathname string) string) pathname)
compute-trashinfo-source-file))
(defun compute-trashinfo-source-file (trash-directory name)
"Return the pathname object for the actual trashinfo file corresponding to the
trashed file NAME in TRASH-DIRECTORY."
(merge-pathnames (make-pathname :name name :type "trashinfo"
(merge-pathnames (make-pathname :name (format nil "~A.trashinfo" name)
:directory '(:relative "info"))
trash-directory))
(ensure-nonwild-pathname trash-directory :ensure-directory t)))
(declaim (ftype (function (pathname string stream &key (:source-file pathname))
trashinfo)
@ -137,7 +148,7 @@ trashed file NAME in TRASH-DIRECTORY."
"End-of-file without both \"Path\" and \"DeletionDate\"")
(return (make-instance 'trashinfo
:deletion-date deletion-date
:path path :name name
:original-path path :name name
:trash-directory trash-directory)))))
(declaim (ftype (function ((or pathname string) string) trashinfo)))
@ -169,9 +180,9 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
format-trashinfo))
(defun format-trashinfo (trashinfo &optional stream)
"Write the trashinfo file out to STREAM."
(with-slots (path deletion-date) trashinfo
(with-slots (original-path deletion-date) trashinfo
(format stream "[Trash Info]~%Path=~A~%DeletionDate=~A~%"
(url-encode path :safe-chars '(#\/))
(url-encode original-path :safe-chars '(#\/))
(format-trashinfo-timestamp deletion-date))))
(declaim (ftype (function (pathname (or string pathname)) stream)
@ -187,9 +198,8 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
:verbose nil)
for info-file = (merge-pathnames
(make-pathname
:name (format nil "~A-~D"
name (random most-positive-fixnum))
:type "trashinfo")
:name (format nil "~A-~D.trashinfo"
name (random most-positive-fixnum)))
info-dir)
for stream = (open info-file :direction :output
:if-exists nil
@ -197,13 +207,6 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
until stream
finally (return stream)))
(declaim (ftype (function (string string) string) remove-suffix))
(defun remove-suffix (string suffix)
"Return STRING without SIFFIX."
(if (uiop:string-suffix-p string suffix)
(subseq string 0 (- (length string) (length suffix)))
string))
(declaim (ftype (function (pathname (or pathname string)
&optional local-time:timestamp)
trashinfo)
@ -221,8 +224,9 @@ TRASH-DIRECTORY. Return a trashinfo object pointing to this file."
(signal e))))
(let ((trashinfo
(make-instance 'trashinfo
:path (uiop:native-namestring
(merge-pathnames path (uiop:getcwd)))
:original-path (uiop:native-namestring
(merge-pathnames path
(uiop:getcwd)))
:name (remove-suffix
(file-or-dir-namestring
(pathname stream))