(in-package :gtk)
+(define-condition gtk-call-aborted (error)
+ ((condition :initarg :condition :reader gtk-call-aborted-condition))
+ (:report (lambda (c stream)
+ (format stream "Call within main loop aborted because of error:~%~A" (gtk-call-aborted-condition c)))))
+
(defun call-within-main-loop-and-wait (fn)
(let ((lock (bt:make-lock))
(cv (bt:make-condition-variable))
+ error
result)
(bt:with-lock-held (lock)
(within-main-loop
- (setf result (multiple-value-list (funcall fn)))
+ (handler-case
+ (setf result (multiple-value-list (funcall fn)))
+ (error (e) (setf error e)))
(bt:with-lock-held (lock)
(bt:condition-notify cv)))
(bt:condition-wait cv lock)
- (values-list result))))
+ (if error
+ (error 'gtk-call-aborted :condition error)
+ (values-list result)))))
(export 'call-within-main-loop-and-wait)
(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))
(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
(export 'with-progress-bar-action)
(defun test-progress ()
- (with-progress-bar ("Snowball" 4)
+ (with-progress-bar ("Snowball" 10)
(loop
- repeat 4
+ repeat 10
do (with-progress-bar-action
(with-progress-bar ("Texts" 10)
(loop
repeat 10
- do (with-progress-bar-action (sleep 1))))))))
\ No newline at end of file
+ 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)