[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