[alexandria-devel] format-mixed-radix-number, format-duration
Michael Weber
michaelw+alexandria at foldr.org
Thu Jan 24 19:08:44 UTC 2008
Hi,
wonder whether the functions below are candidates for alexandria:
;;; Examples
(format-duration nil 86401.5) => "1d0h0m1.50s"
(format-duration nil 86401 :format '(" ~,2F second~:P" " ~D
minute~:P" " ~D hour~:P" " ~D day~:P")) => " 1 day 0 hours 0 minutes
1.00 second"
;;; Code:
(defun format-mixed-radix-number (stream number radix-list format-list
&key lsb-first leading-zeros
(trailing-zeros t))
"Prints NUMBER to STREAM in mixed-radix RADIX.
representation-LIST is a list of radixes, least-significant first.
FORMAT-LIST is a list of format directives, one for each digit.
When LSB-FIRST is nil (default), print most-significant digit first,
otherwise least-significant digit first.
When LEADING-ZEROS and TRAILING-ZEROS are nil, leading and
trailing zero digits are not printed, respectively. \(default: remove
leading zeros, keep trailing zeros)"
(let ((format-pairs
(loop with digit and fraction
initially (setf (values number fraction)
(truncate number))
for f-list on format-list
and r-list = radix-list then (rest r-list)
collect (list (first f-list)
(cond ((endp r-list)
(shiftf number 0))
((rest f-list)
(setf (values number digit)
(truncate number (first r-
list)))
digit)
(t number)))
into list
finally (progn
(incf (cadar list) fraction)
(return (nreverse list))))))
(unless trailing-zeros
(setf format-pairs (member-if #'plusp format-pairs :key
#'second)))
(when lsb-first
(setf format-pairs (nreverse format-pairs)))
(unless leading-zeros
(setf format-pairs (member-if #'plusp format-pairs :key
#'second)))
(format stream "~{~{~@?~}~}" format-pairs)))
(defvar *duration-format-string* '("~4,2Fs" "~Dm" "~Dh" "~Dd" "~Dy")
"Default format for `format-duration'.
Least-significant digit first.")
(defun format-duration (stream duration &rest args
&key (format *duration-format-string*)
leading-zeros trailing-zeros
&allow-other-keys)
"Prints DURATION (a time duration in seconds) to STREAM
according to FORMAT \(default: *DURATION-FORMAT-STRING*).
\(See also `format-mixed-radix-number'.)"
(declare (ignore leading-zeros trailing-zeros))
(alexandria:remove-from-plistf args :format)
(apply #'format-mixed-radix-number stream duration
'(60 60 24 365) format args))
More information about the alexandria-devel
mailing list