Zander671/cl-xdg-trash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finish library and start work on command

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-10-23 03:49:18 -07:00
parent c309b1df38
commit 0f4a8f23f4
12 changed files with 480 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
cl-xdg-trash.asd → cl-xdg-trash/cl-xdg-trash.asd
View File

@ -16,7 +16,7 @@
(:file "trash"))
:long-description
#.(uiop:read-file-string
(uiop:subpathname *load-pathname* "README.md")))
(uiop:subpathname *load-pathname* "../README.md")))
(defsystem #:cl-xdg-trash/tests
:description "Tests for cl-xdg-trash"

4
directorysizes.lisp → cl-xdg-trash/directorysizes.lisp
View File

@ -71,7 +71,7 @@ part of STRING."
(declaim (ftype (function ((or string pathname)) pathname)
calculate-direcotrysizes-path))
(defun calculate-direcotrysizes-path (trash-directory)
(defun calculate-directorysizes-path (trash-directory)
"Return the directorysizes file for TRASH-DIRECTORY."
(merge-pathnames #P"directorysizes"
(ensure-nonwild-pathname trash-directory
@ -109,7 +109,7 @@ it."
(defun trashed-file-size (trash-directory name)
"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."
(let* ((directorysizes-path (calculate-direcotrysizes-path trash-directory))
(let* ((directorysizes-path (calculate-directorysizes-path trash-directory))
(directorysizes (handler-case
(read-directorysizes-file directorysizes-path)
(file-error ()

0
mountpoints.lisp → cl-xdg-trash/mountpoints.lisp
View File

15
package.lisp → cl-xdg-trash/package.lisp
View File

@ -59,11 +59,22 @@
#:compute-trashinfo-source-file)
(:export #:read-directorysizes-file
#:prase-directorysizes
#:trashed-file-size))
#:trashed-file-size
#:calculate-directorysizes-path))
(defpackage :cl-xdg-trash
(:documentation
"Common Lisp interface to the XDG trash specification.")
(:use #:cl #:cl-xdg-trash/trashinfo #:cl-xdg-trash/url-encode
#:cl-xdg-trash/mountpoints #:cl-xdg-trash/directorysizes)
(:export))
(:export #:xdg-data-home
#:user-home-trash-directory
#:valid-toplevel-trash-dir-p
#:list-toplevel-trash-directories
#:list-trash-directories
#:trash-directory-for-file
#:trash-file
#:list-trashed-files
#:restore-file
#:empty-file
#:empty-all))

0
test-url-encode.lisp → cl-xdg-trash/test-url-encode.lisp
View File

101
trash.lisp → cl-xdg-trash/trash.lisp
View File

@ -1,10 +1,5 @@
(in-package :cl-xdg-trash)
(declaim (ftype (function () integer) getuid))
(defun getuid ()
"Return the current user's UID."
(osicat-posix:getuid))
(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
xdg-data-home))
(defun xdg-data-home (&key homedir)
@ -28,19 +23,52 @@
(defun user-home-trash-directory (&key homedir)
(merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir)))
(declaim (ftype (function (integer) t) sticky-bit-set-p)
(inline sticky-bit-set-p))
(defun sticky-bit-set-p (mode)
"Return non-nil if the sticky bit is set in MODE."
(not (zerop (logand (ash mode -9) 1))))
(declaim (ftype (function ((or string pathname)) t) valid-toplevel-trash-dir-p))
(defun valid-toplevel-trash-dir-p (path)
"Return non-nil if PATH is a valid toplevel trash directory. That is, it
exists, is a directory, and: (1) is owned by the current user, (2) has the
sticky bit set."
(flet ((check-dir (path)
(handler-case
(let* ((path (ensure-nonwild-pathname path))
(stat (osicat-posix:stat path)))
(and (osicat-posix:s-isdir (osicat-posix:stat-mode stat))
(or (sticky-bit-set-p (osicat-posix:stat-mode stat))
;; has to come second as this will throw if it fails
(osicat-posix:access path (logior osicat-posix:r-ok
osicat-posix:w-ok)))))
(osicat-posix:posix-error () nil))))
(let* ((path (ensure-nonwild-pathname path :ensure-directory t))
(dir-sizes-path (calculate-directorysizes-path path)))
(and (uiop:directory-exists-p path)
(check-dir (merge-pathnames "info" path))
(check-dir (merge-pathnames "files" path))
(if (not (uiop:file-exists-p dir-sizes-path))
(check-dir path)
(handler-case (osicat-posix:access dir-sizes-path
(logior osicat-posix:r-ok
osicat-posix:w-ok))
(osicat-posix:posix-error () nil)))))))
(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)
(when (valid-toplevel-trash-dir-p dir)
(push dir found)))
(let ((uid (getuid)))
(let ((uid (osicat-posix:getuid)))
(when uid
(let ((dir (merge-pathnames (pathname (format nil ".Trash-~D" uid))
top-path)))
(when (uiop:directory-exists-p dir)
(when (valid-toplevel-trash-dir-p dir)
(push dir found)))))
found))
@ -107,7 +135,7 @@ also update the directory size cache."
trash-directories)))
(declaim (ftype (function (pathname) list) list-trashed-files-for-directory))
(defun list-trasheds-file-for-directory (trash-directory)
(defun list-trashed-files-for-directory (trash-directory)
"Return a list of trashinfo objects for every trashed file in
TRASH-DIRECTORY."
(let ((info-dir (merge-pathnames #P"info/" trash-directory)))
@ -121,28 +149,67 @@ TRASH-DIRECTORY."
(uiop:directory-files info-dir))))
(declaim (ftype (function (&optional (or pathname string list)) list)
normalize-trash-directories))
list-trashed-files))
(defun list-trashed-files (&optional (trash-directories (list-trash-directories)))
"Return a list of trashinfo objects for each trashed file in
TRASH-DIRECTORIES. TRASH-DIRECTORIES can also be a single path."
(mapcan #'list-trashed-file-for-directory
(mapcan #'list-trashed-files-for-directory
(normalize-trash-directories trash-directories)))
(declaim (ftype (function (trashinfo &optional t) t) restore-file))
(defun restore-file (trashinfo &optional (update-size-cache t))
(declaim (ftype (function (trashinfo &optional (or string pathname) t) t)
restore-file))
(defun restore-file (trashinfo &optional
(target (trashinfo-original-path
trashinfo))
(update-size-cache t))
"Restore the file pointed to by TRASHINFO. If UPDATE-SIZE-CACHE is non-nil
(the default), also update the directory size cache."
(osicat-posix:rename
(uiop:native-namestring (trashinfo-trashed-file trashinfo))
(uiop:native-namestring (trashinfo-original-path trashinfo)))
(let ((target (ensure-nonwild-pathname target)))
(osicat-posix:rename
(uiop:native-namestring (trashinfo-trashed-file trashinfo))
(uiop:native-namestring target)))
(handler-bind
;; attempt to re-trash the file in case of error
((t #'(lambda (e)
(osicat-posix:rename
(uiop:native-namestring (trashinfo-original-path trashinfo))
(uiop:native-namestring target)
(uiop:native-namestring (trashinfo-trashed-file trashinfo)))
(signal e))))
(delete-file (trashinfo-info-file trashinfo))
(when update-size-cache
(trashed-file-size (trashinfo-trash-directory trashinfo)
(trashinfo-name trashinfo)))))
(declaim (ftype (function (trashinfo &key (:dry-run t)) t) empty-file))
(defun empty-file (trashinfo &key (dry-run t))
"Remove the file represented by TRASHINFO from the trash by deleting it. With
DRY-RUN, don't actually delete anything."
(let ((trashed-file (trashinfo-trashed-file trashinfo))
(info-file (trashinfo-info-file trashinfo))
(trash-directory (trashinfo-trash-directory trashinfo))
(name (trashinfo-name trashinfo)))
(if dry-run
(format t "deleting: ~S~%deleting: ~S~%" info-file trashed-file)
(handler-case
(progn
(delete-file info-file)
(uiop:delete-directory-tree trashed-file
:validate t
:if-does-not-exist :ignore)
(trashed-file-size trash-directory name))))))
(declaim (ftype (function ((or string pathname)) list) directory-files))
(defun directory-files (dir)
"Return a list of each file (inode) in DIR."
(uiop:directory* (merge-pathnames
uiop:*wild-file-for-directory*
(ensure-nonwild-pathname dir :ensure-directory t))))
(declaim (ftype (function (&optional (or list string pathname) t) t) empty-all))
(defun empty-all (&optional (trash-directories (list-trash-directories))
(dry-run t))
"Empty each of TRASH-DIRECTORIES (defaulting to all known directories). With
DRY-RUN just print the directories that will be removed without actually doing
anything."
(dolist (trashinfo (list-trashed-files trash-directories))
(empty-file trashinfo :dry-run dry-run)))

0
trashinfo.lisp → cl-xdg-trash/trashinfo.lisp
View File

0
url-encode.lisp → cl-xdg-trash/url-encode.lisp
View File

1
clash/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
clash

6
clash/Makefile Normal file
View File

@ -0,0 +1,6 @@
LISP=sbcl
clash: clash.asd clash.lisp
$(LISP) --eval '(ql:quickload :clash)' \
--eval '(asdf:make :clash)' \
--eval '(uiop:quit)'

14
clash/clash.asd Normal file
View File

@ -0,0 +1,14 @@
(defsystem #:clash
:version "0.1.0"
:description "Command line interface to the XDG trashcan."
:author "Alexander Rosenberg <zanderpkg@pm.me>"
:maintainer "Alexander Rosenberg <zanderpkg@pm.me>"
:homepage "https://git.zander.im/Zander671/cl-xdg-trash"
:license "GPL3"
:depends-on (#:cl-xdg-trash #:cl-ppcre #:clingon)
:serial t
:components
((:file "clash"))
:build-operation "program-op"
:build-pathname "clash"
:entry-point "clash:toplevel")

359
clash/clash.lisp Normal file
View File

@ -0,0 +1,359 @@
(defpackage clash
(:documentation "Command line interface to the XDG trashcan.")
(:import-from #:cl-xdg-trash/trashinfo
#:trashinfo-original-path
#:trashinfo-trash-directory
#:trashinfo-info-file
#:trashinfo-name
#:trashinfo-trashed-file
#:trashinfo-deletion-date)
(:import-from #:cl-xdg-trash/mountpoints
#:file-or-dir-namestring)
(:use #:cl)
(:export #:toplevel))
(in-package :clash)
;; remove extra newline at the end of the usage message
(defmethod clingon:print-usage :around (command stream &key)
(let ((msg (with-output-to-string (str-stream)
(call-next-method command str-stream))))
(format stream "~A" (subseq msg 0 (1- (length msg))))))
;; Filtering
(defun clingon-filtering-options ()
"Return some options that can be used by many commands for filtering."
(list
(clingon:make-option
:flag
:key :print-format-info
:description "print information about format strings, then exit"
:long-name "format-info")
(clingon:make-option
:flag
:key :strings
:description "don't use regexp to match file names"
:short-name #\s
:long-name "strings")
(clingon:make-option
:flag
:key :exact
:description "force exact match"
:short-name #\e
:long-name "exact")
(clingon:make-option
:flag
:key :full-path
:description "match against full file paths"
:short-name #\p
:long-name "full-paths")
(clingon:make-option
:flag
:key :case-insensitive
:description "match case-insensitively"
:short-name #\i
:long-name "case-insensitive")
(clingon:make-option
:flag
:key :invert
:description "invert result"
:short-name #\v
:long-name "invert")
(clingon:make-option
:string
:key :format
:description "format to print results in"
:short-name #\f
:long-name "format")))
(declaim (inline compare-trashinfo-to-string))
(defun compare-trashinfo-to-string (trashinfo filter full-path exact
case-insensitive)
"Compare TRASHINFO's name or path to FILTER using the provided matching
options."
(let* ((orig-path (trashinfo-original-path trashinfo))
(target (if full-path orig-path (file-or-dir-namestring orig-path))))
(cond
((and exact case-insensitive) (equalp target filter))
(exact (equal target filter))
(t (search filter target :test (if case-insensitive #'equalp #'eql))))))
(declaim (inline compare-trashinfo-to-scanner))
(defun compare-trashinfo-to-scanner (trashinfo filter full-path exact)
"Compare TRASHINFO's name or path to FILTER, which is a cl-ppcre scanner."
(let* ((orig-path (trashinfo-original-path trashinfo))
(target (if full-path orig-path (file-or-dir-namestring orig-path))))
(destructuring-bind (start &optional end &rest ignore)
(multiple-value-list (cl-ppcre:scan filter target))
(declare (ignore ignore))
(and start
(or (not exact)
(and (= start 0) (= end (length target))))))))
(defun filter-trashinfos-by (trashinfos filter &key regexp full-path
exact case-insensitive
invert)
"Filter the list of trashinfo objects TRASHINFOS by FILTER, which is a
string."
(if regexp
(let ((scanner (cl-ppcre:create-scanner
filter :case-insensitive-mode case-insensitive)))
(remove-if
(lambda (info)
(let ((res (compare-trashinfo-to-scanner info scanner
full-path exact)))
(or (and (not invert) (not res))
(and invert res))))
trashinfos))
(remove-if
(lambda (info)
(let ((res (compare-trashinfo-to-string
info filter full-path exact case-insensitive)))
(or (and (not invert) (not res))
(and invert res))))
trashinfos)))
(defun list-nonexcluded-trash-dirs (cmd)
"Return a list of all trash directories, except those excluded by CMD."
(set-difference (cl-xdg-trash:list-trash-directories)
(clingon:getopt cmd :ignored-trashes)
:test #'uiop:pathname-equal))
(defun list-trashinfos-for-cmd (cmd)
"List trashinfos for the command CMD."
(let ((args (clingon:command-arguments cmd)))
(when (cdr args)
(clingon:print-usage-and-exit cmd t))
(if (not (car args))
(cl-xdg-trash:list-trashed-files (list-nonexcluded-trash-dirs cmd))
(let ((filter (car args))
(strings (clingon:getopt cmd :strings))
(exact (clingon:getopt cmd :exact))
(full-path (clingon:getopt cmd :full-path))
(case-insensitive (clingon:getopt cmd :case-insensitive))
(invert (clingon:getopt cmd :invert)))
(filter-trashinfos-by
(cl-xdg-trash:list-trashed-files
(list-nonexcluded-trash-dirs cmd))
filter
:regexp (not strings)
:exact exact
:full-path full-path
:case-insensitive case-insensitive
:invert invert)))))
;; Formatting
(defparameter *trashinfo-formatters*
`((#\o . ,(lambda (stream info)
"the (o)riginal path"
(format stream "~A" (trashinfo-original-path info))))
(#\n . ,(lambda (stream info)
"the original (n)ame"
(format stream "~A" (file-or-dir-namestring
(trashinfo-original-path info)))))
(#\d . ,(lambda (stream info)
"the trash (d)irectory"
(format stream "~A" (trashinfo-trash-directory info))))
(#\i . ,(lambda (stream info)
"the trash(i)nfo file path"
(format stream "~A" (trashinfo-info-file info))))
(#\c . ,(lambda (stream info)
"the (c)urrent (trashed) path"
(format stream "~A" (trashinfo-trashed-file info))))
(#\u . ,(lambda (stream info)
"the time the file was trashed (in (u)TC seconds)"
(format stream "~A" (local-time:timestamp-to-unix
(trashinfo-deletion-date info)))))
(#\t . ,(lambda (stream info)
"the (t)ime the file was trashed (pretty-printed local time)"
(local-time:format-timestring
stream (trashinfo-deletion-date info)
:format local-time:+asctime-format+)))
(#\% . ,(lambda (stream info)
"a liternal %"
(declare (ignore info))
(format stream "%")))))
(defun process-format-string (format-string)
"Process FORMAT-STRING into a list of string and functions."
(let ((start 0)
out end)
(labels ((ensure-next-char (i thing)
(unless (< i (1- (length format-string)))
(error "Unterminated ~A at char ~A: ~S" thing i format-string)))
(unknown (i thing)
(error "Unknown ~A at char ~A: ~S" thing i format-string))
(push-thing (thing)
(if (null out)
(setq out (list thing)
end out)
(setf (cdr end) (list thing)
end (cdr end))))
(push-string (str)
(unless (zerop (length str))
(if (stringp (car end))
(setf (car end) (format nil "~A~A" (car end) str))
(push-thing str)))))
(do ((i 0 (1+ i)))
((>= i (length format-string)))
(case (aref format-string i)
(#\%
(ensure-next-char i "substitution")
(push-string (subseq format-string start i))
(let ((fun (cdr (assoc (aref format-string (1+ i))
*trashinfo-formatters*))))
(unless (functionp fun)
(unknown i "substitution"))
(push-thing fun))
(setq start (+ i 2)
i (1+ i)))
(#\\
(ensure-next-char i "escape sequence")
(push-string (subseq format-string start i))
(push-string
(case (aref format-string (1+ i))
(#\\ "\\")
(#\n (string #\Newline))
(#\t (string #\Tab))
(#\0 (string #\Nul))
(t (unknown i "escape sequence"))))
(setq start (+ i 2)
i (1+ i)))))
(push-string (subseq format-string start))
out)))
(defun format-trashinfo (stream format-object info)
"Format the trashinfo INFO to STREAM accoring to FORMAT-OBJECT (which is from
process-format-string)."
(dolist (part format-object)
(if (stringp part)
(format stream "~A" part)
(funcall part stream info))))
(defun print-format-info (&optional (stream t))
(format stream "~
Format strings use C-style and printf-style escape sequences. Each character
other than one of those with a special meaning noted below is copied to the
output verbatim. The recognized C-style escapes sequences are:
\"\\0\" - null byte
\"\\n\" - newline
\"\\t\" - tab character
\"\\\\\" - literal backslash
The recognizes printf-style sequences are (parenthesis denote the mnemonic):~%")
(dolist (entry *trashinfo-formatters*)
(let ((char (car entry))
(doc (documentation (cdr entry) t)))
(format stream " \"%~A\" - ~A~%" char doc))))
;; Sorting
(defun clingon-sort-options ()
"Return a list of sorting options that can be used by many commands."
(list
(clingon:make-option
:flag
:key :reverse-sort
:description "reverse sort order"
:short-name #\r
:long-name "reverse-sort")
(clingon:make-option
:enum
:key :sort-field
:description "sort field"
:short-name #\l
:long-name "sort-field"
:items '(("name" . :name)
("path" . :path)
("deletion-date" . :deletion-date))
:initial-value "deletion-date")))
(defun sort-trashinfos-for-cmd (trashinfos cmd)
"Sort the TRASHINFOS according to options passed to CMD."
(multiple-value-bind (pred-fun key-fun)
(case (clingon:getopt cmd :sort-field)
(:name (values #'string-lessp
(lambda (info) (file-or-dir-namestring
(trashinfo-original-path info)))))
(:path (values #'string-lessp #'trashinfo-original-path))
(:deletion-date (values
#'< (lambda (info) (local-time:timestamp-to-unix
(trashinfo-deletion-date info))))))
(sort trashinfos
(if (clingon:getopt cmd :reverse-sort)
(complement pred-fun)
pred-fun)
:key key-fun)))
;; List command
(defun list/handler (cmd)
"Toplevel for the \"list\" subcommand."
(if (clingon:getopt cmd :print-format-info)
(print-format-info t)
(let ((format (process-format-string (or (clingon:getopt cmd :format)
"%t %o\\n"))))
(dolist (info (sort-trashinfos-for-cmd
(list-trashinfos-for-cmd cmd) cmd))
(format-trashinfo t format info)))))
(defun list/options ()
"Return options for the \"list\" subcommand."
(append
(clingon-filtering-options)
(clingon-sort-options)))
(defun list/command ()
"Return the Clingon command for the \"list\" subcommand."
(clingon:make-command
:name "list"
:description "list files in trash directories"
:usage "[pattern]"
:options (list/options)
:handler #'list/handler))
;; Toplevel command
(defun toplevel/options ()
"Return the toplevel options list."
(list
(clingon:make-option
:list
:key :ignored-trashes
:description "ignore the given trash directory"
:long-name "ignore-trash"
:persistent t)))
(defun toplevel/command ()
"Return the toplevel command."
(clingon:make-command
:name "clash"
:description "command line interface to the XDG trashcan"
:version "0.1.0"
:license "GPL3"
:authors '("Alexander Rosenberg <zanderpkg@pm.me>")
:options (toplevel/options)
:sub-commands (list (list/command))
:handler #'(lambda (cmd)
(clingon:print-usage-and-exit cmd t))))
(defparameter *toplevel/help-option*
(clingon:make-option
:flag
:key :clingon.help.flag
:description "display usage information, then exit"
:short-name #\h
:long-name "help"
:persistent t)
"Help option to replace the default Clingon one.")
(defun toplevel (&optional (args () argsp))
"Program entry point.
Args can be supplied to facilitate testing in SLIME."
(let ((clingon:*default-options* (list clingon:*default-version-flag*
clingon:*default-bash-completions-flag*
*toplevel/help-option*)))
(if argsp
(clingon:run (toplevel/command) args)
(clingon:run (toplevel/command)))))