Add a macro to display a progress indicator to looping process

This commit is contained in:
Renaud Casenave-Péré 2015-04-21 17:15:24 +02:00
parent a26b19be1b
commit 7ba21e011c

View file

@ -11,6 +11,7 @@
:safe-first :safe-list :safe-first :safe-list
:group :group
:restartable :restartable
:loop-with-progress
:add-hook :remove-hook :run-hook :add-hook :remove-hook :run-hook
:update-current-time :get-delta-time :update-current-time :get-delta-time
:make-clock :clock-time :clock-delta :make-clock :clock-time :clock-delta
@ -63,6 +64,20 @@
,@body) ,@body)
(continue () :report "Continue")))) (continue () :report "Continue"))))
(defmacro loop-with-progress (msg &body body)
"Allow a looping process to display feedback."
`(macrolet ((progress-step ()
`(progn
(when (> progress-index progress-max-columns)
(format t "~%")
(setf progress-index 0))
(format t "."))))
(let ((progress-max-columns 80))
(format t ,msg)
(loop for progress-index upfrom ,(length msg)
,@body)
(format t "~%"))))
(defmacro add-hook (hook fun &optional append) (defmacro add-hook (hook fun &optional append)
"Setup `fun' to be called within specified `hook'." "Setup `fun' to be called within specified `hook'."
`(unless (member ,fun ,hook) `(unless (member ,fun ,hook)