Finish all features (for now)
This commit is contained in:
384
clash/format.lisp
Normal file
384
clash/format.lisp
Normal file
@ -0,0 +1,384 @@
|
||||
(defpackage clash/format
|
||||
(:documentation "Formatters for trashinfos and trash directories.")
|
||||
(:import-from #:cl-xdg-trash/mountpoints
|
||||
#:file-or-dir-namestring)
|
||||
(:import-from #:cl-xdg-trash/directorysizes
|
||||
#:trashed-file-size)
|
||||
(:import-from #:cl-xdg-trash/trashinfo
|
||||
#:trashinfo-trash-directory
|
||||
#:trashinfo-name
|
||||
#:trashinfo-deletion-date
|
||||
#:trashinfo-original-path
|
||||
#:trashinfo-info-file
|
||||
#:trashinfo-trashed-file)
|
||||
(:use #:cl)
|
||||
(:export #:trashinfo-size
|
||||
#:format-size
|
||||
#:parse-format-string
|
||||
#:option-format-string
|
||||
#:option-format-string-directives
|
||||
#:format-object
|
||||
#:format-list
|
||||
#:print-format-info
|
||||
#:*trashinfo-formatters*
|
||||
#:*directory-formatters*
|
||||
#:print-clash-format-info
|
||||
#:*missing-file-formatters*))
|
||||
|
||||
(in-package :clash/format)
|
||||
|
||||
(defvar *trashinfo-size-cache* (make-hash-table :test #'eq)
|
||||
"Cache for trashinfo sizes.")
|
||||
|
||||
(defun trashinfo-size (trashinfo)
|
||||
"Return the size of TRASHINFO and cache it."
|
||||
(let ((res (gethash trashinfo *trashinfo-size-cache* :none)))
|
||||
(if (eq res :none)
|
||||
(setf (gethash trashinfo *trashinfo-size-cache*)
|
||||
(trashed-file-size (trashinfo-trash-directory trashinfo)
|
||||
(trashinfo-name trashinfo)))
|
||||
res)))
|
||||
|
||||
(defun format-size (count &optional base-two (places 2))
|
||||
"Pretty print COUNT, which is a number of bytes. This will append metric
|
||||
suffixes as necessary. If BASE-TWO is non-nil, use MiB, GiB, etc. suffixes
|
||||
instead."
|
||||
(if (not count)
|
||||
"N/A" ;; if finding the size failed
|
||||
(let* ((base (if base-two 1024 1000))
|
||||
(power (min 10 (floor (if (zerop count) 0 (log count base))))))
|
||||
(if (zerop power)
|
||||
(format nil "~DB" count)
|
||||
(format nil "~,VF~[~:[k~;K~]~:*~;M~;G~;T~;P~;E~;Z~;Y~;R~;Q~]~@[i~]B"
|
||||
places (/ count (expt base power))
|
||||
(1- power) base-two)))))
|
||||
|
||||
(defclass format-code ()
|
||||
((name :reader format-code-name
|
||||
:type character
|
||||
:initarg :name
|
||||
:documentation "The character used to invoke this formatter.")
|
||||
(action :reader format-code-action
|
||||
:type (function (stream t) t)
|
||||
:initarg :action
|
||||
:documentation "The function to call to use this formatter.")
|
||||
(padder :reader format-code-padder
|
||||
:type (or null
|
||||
(function (stream (member nil :left :right) string t) t))
|
||||
:initarg :padder
|
||||
:initform nil
|
||||
:documentation
|
||||
"An optional function to pad the result of the action.")
|
||||
(doc :reader format-code-doc
|
||||
:type (or null string)
|
||||
:initarg :doc
|
||||
:initform nil
|
||||
:documentation "The documentation for this format code."))
|
||||
(:documentation "A single format escape sequence."))
|
||||
|
||||
(defmethod print-object ((obj format-code) stream)
|
||||
(print-unreadable-object (obj stream :type t :identity t)
|
||||
(with-slots (name padder) obj
|
||||
(format stream "%~A~@[ (supports padding)~]" name padder))))
|
||||
|
||||
(defun make-format-code (&rest args)
|
||||
(apply #'make-instance 'format-code args))
|
||||
|
||||
(defun parse-format-string (format-string directives)
|
||||
"Parse 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* ((start-i i)
|
||||
(next-c (aref format-string (1+ i)))
|
||||
(pad-type (case next-c (#\< :left) (#\> :right) (t nil))))
|
||||
(when pad-type
|
||||
(ensure-next-char (1+ i) "substitution")
|
||||
(setq next-c (aref format-string (+ i 2)))
|
||||
(incf i)
|
||||
(incf start))
|
||||
(setq start (+ i 2)
|
||||
i (1+ i))
|
||||
(case next-c
|
||||
(#\% (push-string "%"))
|
||||
(#\# (push-thing (if pad-type
|
||||
(cons :index pad-type)
|
||||
:index)))
|
||||
(t (let ((code (find next-c directives :key #'format-code-name)))
|
||||
(unless (typep code 'format-code)
|
||||
(unknown start-i "substitution"))
|
||||
(unless (or (not pad-type) (format-code-padder code))
|
||||
(error "Format code %~A does not support padding" next-c))
|
||||
(push-thing (if pad-type (cons code pad-type) code)))))))
|
||||
(#\\
|
||||
(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)))
|
||||
|
||||
(defclass option-format-string (clingon:option)
|
||||
((directives :accessor option-format-string-directives
|
||||
:type list
|
||||
:initarg :directives
|
||||
:documentation "The format directives to use when parsing.")
|
||||
(format-string :accessor option-format-string-format-string
|
||||
:type string
|
||||
:initform ""
|
||||
:documentation "The used-passed format string."))
|
||||
(:default-initargs :parameter "FORMAT-CONTROL")
|
||||
(:documentation "Option that takes a format string."))
|
||||
|
||||
(defmethod clingon:initialize-option ((option option-format-string) &key)
|
||||
(setf (option-format-string-format-string option)
|
||||
(clingon:option-initial-value option))
|
||||
(call-next-method))
|
||||
|
||||
(defmethod clingon:derive-option-value ((option option-format-string) arg &key)
|
||||
(setf (option-format-string-format-string option) arg))
|
||||
|
||||
(defmethod clingon:finalize-option ((option option-format-string) &key)
|
||||
(parse-format-string (option-format-string-format-string option)
|
||||
(option-format-string-directives option)))
|
||||
|
||||
(defmethod clingon:make-option ((kind (eql :format-string)) &rest args)
|
||||
(apply #'make-instance 'option-format-string args))
|
||||
|
||||
(defun number-length (n &optional (base 10))
|
||||
"Return the number of digits in N when represented in BASE. If N is ngeative,
|
||||
add one to the result."
|
||||
(if (zerop n)
|
||||
1
|
||||
(+ (floor (log (abs n) base)) (if (minusp n) 2 1))))
|
||||
|
||||
(defun format-object (stream control-obj obj
|
||||
&key (index 1) (max-index 1)
|
||||
(max-index-length (number-length max-index)))
|
||||
"Format the object OBJ to STREAM according to CONTROL-OBJECT (which is from
|
||||
parse-format-string)."
|
||||
(dolist (part control-obj)
|
||||
(cond
|
||||
((eq :index part)
|
||||
(format stream "~A" index))
|
||||
((and (consp part) (eq :index (car part)))
|
||||
(case (car part)
|
||||
(:left (format stream "~VD" max-index-length index))
|
||||
(:right (format stream "~V@<~D~>" max-index-length index))
|
||||
(t (format stream "~A" index))))
|
||||
((stringp part)
|
||||
(format stream "~A" part))
|
||||
((and (consp part))
|
||||
(with-slots (padder action) (car part)
|
||||
(funcall padder stream (cdr part)
|
||||
(with-output-to-string (tmp-output)
|
||||
(funcall action tmp-output obj))
|
||||
obj)))
|
||||
(t (funcall (format-code-action part) stream obj)))))
|
||||
|
||||
(defun format-list (stream control-obj objs &optional (indices t) extra-action)
|
||||
"Format a list of objects OBJS with format-object."
|
||||
(if (eq t indices)
|
||||
(loop with max-index = (length objs)
|
||||
with max-index-length = (number-length max-index)
|
||||
for obj in objs
|
||||
for i upfrom 1
|
||||
do (format-object stream control-obj obj :index i
|
||||
:max-index max-index
|
||||
:max-index-length
|
||||
max-index-length)
|
||||
when extra-action
|
||||
do (funcall extra-action obj))
|
||||
(loop with max-index = (reduce #'max indices :initial-value 0)
|
||||
with max-index-length = (number-length max-index)
|
||||
with objs-arr = (coerce objs 'vector)
|
||||
for index in indices
|
||||
do (format-object stream control-obj (aref objs-arr index)
|
||||
:index (1+ index) :max-index max-index
|
||||
:max-index-length max-index-length)
|
||||
when extra-action
|
||||
do (funcall extra-action (aref objs-arr index)))))
|
||||
|
||||
(defun print-format-info (stream &rest name-directive-pairs)
|
||||
(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~%~%")
|
||||
(loop for (name directive . rest) = name-directive-pairs then rest
|
||||
for first = t then nil
|
||||
while name
|
||||
when first
|
||||
do (format stream "~
|
||||
(Sequences with a \"*\" before them support padding by putting a < or > after
|
||||
the initial % character)~%")
|
||||
do (format stream "~
|
||||
The recognized printf-style sequences for ~A are:
|
||||
\"%%\" - a literal %
|
||||
*\"%#\" - the index of the current item (used when prompting)~%" name)
|
||||
do (dolist (code (sort (copy-list directive) #'char-lessp
|
||||
:key #'format-code-name))
|
||||
(with-slots (name doc padder) code
|
||||
(format stream " ~:[ ~;*~]\"%~A\"~@[ - ~A~]~%"
|
||||
padder name doc)))
|
||||
when rest
|
||||
do (terpri stream)))
|
||||
|
||||
(defun make-fixed-with-padder (width)
|
||||
"Return a padder (for a format-code)"
|
||||
(lambda (stream pad-type text obj)
|
||||
(declare (ignore obj))
|
||||
(case pad-type
|
||||
(:left (format stream "~V@<~A~>" width text))
|
||||
(:right (format stream "~V<~A~>" width text))
|
||||
(t (format stream "~A" text)))))
|
||||
|
||||
(defparameter *trashinfo-formatters*
|
||||
(list
|
||||
(make-format-code
|
||||
:name #\o
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-original-path info :resolve t)))
|
||||
:doc "the (o)riginal path (always absolute)")
|
||||
(make-format-code
|
||||
:name #\O
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-original-path info :normalize t)))
|
||||
:doc "the (o)riginal path (possibly relative)")
|
||||
(make-format-code
|
||||
:name #\n
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (file-or-dir-namestring
|
||||
(trashinfo-original-path info))))
|
||||
:doc "the original (n)ame")
|
||||
(make-format-code
|
||||
:name #\d
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-trash-directory info)))
|
||||
:doc "the trash (d)irectory")
|
||||
(make-format-code
|
||||
:name #\i
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-info-file info)))
|
||||
:doc "the trash(i)nfo file path")
|
||||
(make-format-code
|
||||
:name #\c
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-trashed-file info)))
|
||||
:doc "the (c)urrent (trashed) path")
|
||||
(make-format-code
|
||||
:name #\u
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (local-time:timestamp-to-unix
|
||||
(trashinfo-deletion-date info))))
|
||||
:doc "the time the file was trashed (in (u)TC seconds)")
|
||||
(make-format-code
|
||||
:name #\t
|
||||
:action (lambda (stream info)
|
||||
(local-time:format-timestring
|
||||
stream (trashinfo-deletion-date info)
|
||||
:format local-time:+asctime-format+))
|
||||
:doc "the (t)ime the file was trashed (pretty-printed local time)")
|
||||
(make-format-code
|
||||
:name #\s
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A" (trashinfo-size info)))
|
||||
:doc "the file's (s)size in bytes")
|
||||
(make-format-code
|
||||
:name #\h
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A"
|
||||
(format-size (trashinfo-size info))))
|
||||
:padder (make-fixed-with-padder 9)
|
||||
:doc "the file's size with a (h)uman readable suffix (powers of 10)")
|
||||
(make-format-code
|
||||
:name #\H
|
||||
:action (lambda (stream info)
|
||||
(format stream "~A"
|
||||
(format-size (trashinfo-size info) t)))
|
||||
:padder (make-fixed-with-padder 10)
|
||||
:doc "the file's size with a (H)uman readable suffix (power of 2)")))
|
||||
|
||||
(defun trashinfo-list-size (infos)
|
||||
"Return the sum of the sizes of each trashinfo in INFOS."
|
||||
(loop for info in infos
|
||||
summing (or (trashinfo-size info) 0)))
|
||||
|
||||
(defparameter *directory-formatters*
|
||||
(list
|
||||
(make-format-code
|
||||
:name #\p
|
||||
:action (lambda (stream path-and-infos)
|
||||
(format stream "~A" (uiop:native-namestring
|
||||
(uiop:ensure-directory-pathname
|
||||
(car path-and-infos)))))
|
||||
:doc "the directory's (p)ath (with a trailing slash)")
|
||||
(make-format-code
|
||||
:name #\s
|
||||
:action (lambda (stream path-and-infos)
|
||||
(format stream "~D" (trashinfo-list-size (cdr path-and-infos))))
|
||||
:doc "the directory's (s)ize (in bytes)")
|
||||
(make-format-code
|
||||
:name #\h
|
||||
:action (lambda (stream path-and-infos)
|
||||
(format stream "~A" (format-size
|
||||
(trashinfo-list-size (cdr path-and-infos)))))
|
||||
:padder (make-fixed-with-padder 9)
|
||||
:doc "the directory's size with a (h)uman readable suffix (powers of 10)")
|
||||
(make-format-code
|
||||
:name #\H
|
||||
:action (lambda (stream path-and-infos)
|
||||
(format stream "~A"
|
||||
(format-size (trashinfo-list-size (cdr path-and-infos)) t)))
|
||||
:padder (make-fixed-with-padder 10)
|
||||
:doc "the directory's size with a (H)uman readable suffix (powers of 2)")
|
||||
(make-format-code
|
||||
:name #\c
|
||||
:action (lambda (stream path-and-infos)
|
||||
(format stream "~D" (length (cdr path-and-infos))))
|
||||
:doc "the (c)ount of files trashed in the directory")
|
||||
(make-format-code
|
||||
:name #\m
|
||||
:action (lambda (stream path-and-infos)
|
||||
(let ((infos (cdr path-and-infos)))
|
||||
(format stream "~@[s~]" (or (null infos) (cdr infos)))))
|
||||
:doc "nothing if only one file was found in this directory, otherwise \"s\"")))
|
||||
|
||||
(defun print-clash-format-info (&optional (print-dir t) (stream t))
|
||||
"Print format string information for clash to STREAM."
|
||||
(apply #'print-format-info
|
||||
stream
|
||||
"trashed files" *trashinfo-formatters*
|
||||
(when print-dir
|
||||
(list "trash directories" *directory-formatters*))))
|
||||
Reference in New Issue
Block a user