X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.high-level.lisp;h=1e84c6f56fdd618b883f8425cfa65af269f638f8;hb=121c3776fdb34f9415c9e7c0f950d2ec930d0316;hp=a4f6fa9340fb91e5762fb852c52f5fd698f3e54d;hpb=9096c37a1caaf430e1e6a11ace984484295e4b2e;p=cl-gtk2.git

diff --git a/gtk/gtk.high-level.lisp b/gtk/gtk.high-level.lisp
index a4f6fa9..1e84c6f 100644
--- a/gtk/gtk.high-level.lisp
+++ b/gtk/gtk.high-level.lisp
@@ -74,6 +74,13 @@
   (let ((root (progress-display-root bar)))
     (within-main-loop-and-wait (container-remove (progress-window-box root) (progress-display-bar bar)))))
 
+(defun format-duration (stream seconds colon-modifier-p at-sign-modifier-p)
+  (declare (ignore colon-modifier-p at-sign-modifier-p))
+  (let ((seconds (mod (truncate seconds) 60))
+        (minutes (mod (truncate seconds 60) 60))
+        (hours (truncate seconds 3600)))
+    (format stream "~2,'0D:~2,'0D:~2,'0D" hours minutes seconds)))
+
 (defun update-progress-bar-text (bar &optional (lower-frac 0.0))
   (let* ((elapsed (coerce (/ (- (get-internal-real-time)
                                 (progress-display-time-started bar))
@@ -82,7 +89,7 @@
          (process-rate (coerce (/ elapsed (+ lower-frac (progress-display-current bar))) 'double-float))
          (total-time (coerce (* (progress-display-count bar) process-rate) 'double-float)))
     (setf (progress-bar-text (progress-display-bar bar))
-          (format nil "~A (~$ of ETA ~$)" (progress-display-name bar) elapsed total-time))))
+          (format nil "~A (~/gtk::format-duration/; ETA ~/gtk::format-duration/)" (progress-display-name bar) elapsed total-time))))
 
 (defun update-progress-bar-texts (bar &optional (lower-frac 0.0))
   (when bar
@@ -118,9 +125,23 @@
 (export 'with-progress-bar-action)
 
 (defun test-progress ()
-  (with-progress-bar ("Snowball" 4)
-    (iter (repeat 4)
-          (with-progress-bar-action
+  (with-progress-bar ("Snowball" 10)
+    (loop
+       repeat 10
+       do (with-progress-bar-action
             (with-progress-bar ("Texts" 10)
-              (iter (repeat 10)
-                    (with-progress-bar-action (sleep 1))))))))
\ No newline at end of file
+              (loop
+                 repeat 10
+                 do (with-progress-bar-action (sleep 1))))))))
+
+(defun show-message (message &key (buttons :ok) (message-type :info) (use-markup nil))
+  (let ((dialog (make-instance 'message-dialog
+                               :text message
+                               :buttons buttons
+                               :message-type message-type
+                               :use-markup use-markup)))
+    (prog1
+        (dialog-run dialog)
+      (object-destroy dialog))))
+
+(export 'show-message)