Lots of work
This commit is contained in:
		| @ -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)) | ||||
|  | ||||
		Reference in New Issue
	
	Block a user