360 lines
13 KiB
Common Lisp
360 lines
13 KiB
Common Lisp
(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)))))
|