floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixup loop-with-progress

Browse source
This commit is contained in:
Renaud Casenave-Péré 2015-05-05 13:27:41 +02:00
parent 7a8f3117ed
commit 2fda251cd7
1 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/utils.lisp
View file

@ -11,6 +11,7 @@
:safe-first :safe-list :safe-first :safe-list
:group :group
:restartable :restartable
:progress-step
:loop-with-progress :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
@ -66,13 +67,13 @@
(defmacro loop-with-progress (msg &body body) (defmacro loop-with-progress (msg &body body)
"Allow a looping process to display feedback." "Allow a looping process to display feedback."
`(macrolet ((progress-step () `(let ((progress-max-columns 80))
`(progn (symbol-macrolet ((progress-step
(when (> progress-index progress-max-columns) (progn
(format t "~%") (when (> progress-index progress-max-columns)
(setf progress-index 0)) (format t "~%")
(format t ".")))) (setf progress-index 0))
(let ((progress-max-columns 80)) (format t "."))))
(format t ,msg) (format t ,msg)
(loop for progress-index upfrom ,(length msg) (loop for progress-index upfrom ,(length msg)
,@body) ,@body)