-(define-test-window create-spins "Spin buttons"
- (let ((main-vbox (vbox-new nil 5)))
- (setf (container-border-width main-vbox) 10)
- (container-add window main-vbox)
-
- (let ((frame (frame-new "Not accelerated"))
- (vbox (vbox-new nil 0))
- (hbox (hbox-new nil 0)))
- (box-pack-start main-vbox frame t t 0)
- (setf (container-border-width vbox) 5)
- (container-add frame vbox)
- (box-pack-start vbox hbox t t 5)
-
- (let* ((vbox2 (vbox-new nil 0))
- (label (label-new "Day :"))
- (spinner (spin-button-new
- (adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0) 0.0 0)))
- (box-pack-start hbox vbox2 t t 5)
- (setf (misc-xalign label) 0.0)
- (setf (misc-yalign label) 0.5)
- (box-pack-start vbox2 label nil t 0)
- (setf (spin-button-wrap-p spinner) t)
- (setf (spin-button-shadow-type spinner) :out)
- (box-pack-start vbox2 spinner nil t 0))
-
- (let* ((vbox2 (vbox-new nil 0))
- (label (label-new "Month :"))
- (spinner (spin-button-new
- (adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0) 0.0 0)))
- (box-pack-start hbox vbox2 t t 5)
- (setf (misc-xalign label) 0.0)
- (setf (misc-yalign label) 0.5)
- (box-pack-start vbox2 label nil t 0)
- (setf (spin-button-wrap-p spinner) t)
- (setf (spin-button-shadow-type spinner) :etched-in)
- (box-pack-start vbox2 spinner nil t 0))
-
- (let* ((vbox2 (vbox-new nil 0))
- (label (label-new "Year :"))
- (spinner (spin-button-new
- (adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0)
- 0.0 0)))
- (box-pack-start hbox vbox2 t t 5)
- (setf (misc-xalign label) 0.0)
- (setf (misc-yalign label) 0.5)
- (box-pack-start vbox2 label nil t 0)
- (setf (spin-button-wrap-p spinner) t)
- (setf (spin-button-shadow-type spinner) :in)
- (box-pack-start vbox2 spinner nil t 0)))
-
- (let* ((frame (frame-new "Accelerated"))
- (vbox (vbox-new nil 0))
- (hbox (hbox-new nil 0))
- (spinner1 (spin-button-new
- (adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
- 1.0 2))
- (adj (adjustment-new 2.0 1.0 5.0 1.0 1.0 0.0))
- (spinner2 (spin-button-new adj 1.0 0)))
-
- (box-pack-start main-vbox frame t t 0)
- (setf (container-border-width vbox) 5)
- (container-add frame vbox)
- (box-pack-start vbox hbox nil t 5)
-
- (let* ((vbox2 (vbox-new nil 0))
- (label (label-new "Value :")))
- (box-pack-start hbox vbox2 t t 5)
- (setf (misc-xalign label) 0.0)
- (setf (misc-yalign label) 0.5)
- (box-pack-start vbox2 label nil t 0)
- (setf (spin-button-wrap-p spinner1) t)
- (setf (widget-width spinner1) 100)
- (setf (widget-height spinner1) 0)
- (box-pack-start vbox2 spinner1 nil t 0))
-
- (let* ((vbox2 (vbox-new nil 0))
- (label (label-new "Digits :")))
- (box-pack-start hbox vbox2 t t 5)
- (setf (misc-xalign label) 0.0)
- (setf (misc-yalign label) 0.5)
- (box-pack-start vbox2 label nil t 0)
- (setf (spin-button-wrap-p spinner2) t)
- (signal-connect adj 'value-changed
- #'(lambda ()
- (setf
- (spin-button-digits spinner1)
- (floor (spin-button-value spinner2)))))
- (box-pack-start vbox2 spinner2 nil t 0))
-
- (let ((button (check-button-new "Snap to 0.5-ticks")))
- (signal-connect button 'clicked
- #'(lambda ()
- (setf
- (spin-button-snap-to-ticks-p spinner1)
- (toggle-button-active-p button))))
- (box-pack-start vbox button t t 0)
- (setf (toggle-button-active-p button) t))
-
- (let ((button (check-button-new "Numeric only input mode")))
- (signal-connect button 'clicked
- #'(lambda ()
- (setf
- (spin-button-numeric-p spinner1)
- (toggle-button-active-p button))))
- (box-pack-start vbox button t t 0)
- (setf (toggle-button-active-p button) t))
-
- (let ((val-label (label-new "0"))
- (hbox (hbox-new nil 0)))
- (box-pack-start vbox hbox nil t 5)
- (let ((button (button-new "Value as Int")))
- (signal-connect
- button 'clicked
- #'(lambda ()
- (setf
- (label-label val-label)
- (format nil "~D" (spin-button-value-as-int spinner1)))))
- (box-pack-start hbox button t t 5))
-
- (let ((button (button-new "Value as Float")))
- (signal-connect
- button 'clicked
- #'(lambda ()
- (setf
- (label-label val-label)
- (format nil
- (format nil "~~,~DF" (spin-button-digits spinner1))
- (spin-button-value spinner1)))))
- (box-pack-start hbox button t t 5))
-
- (box-pack-start vbox val-label t t 0)))
-
- (let ((hbox (hbox-new nil 0))
- (button (button-new "Close")))
- (signal-connect button 'clicked #'(lambda () (widget-destroy window)))
- (box-pack-start main-vbox hbox nil t 0)
- (box-pack-start hbox button t t 5))))
-
-
+(define-simple-dialog create-spins (dialog "Spin buttons" :has-separator nil)
+ (let ((main (make-instance 'v-box
+ :spacing 5 :border-width 10 :parent dialog)))
+
+ (flet ((create-date-spinner (label adjustment shadow-type)
+ (declare (ignore shadow-type))
+ (make-instance 'v-box
+ :child-args '(:expand nil)
+ :child (make-instance 'label
+ :label label :xalign 0.0 :yalign 0.5)
+ :child (make-instance 'spin-button
+ :adjustment adjustment :wrap t))))
+ (make-instance 'frame
+ :label "Not accelerated" :parent main
+ :child (make-instance 'h-box
+ :border-width 10
+ :child-args '(:padding 5)
+ :child (create-date-spinner "Day : "
+ (adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0) :out)
+ :child (create-date-spinner "Month : "
+ (adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0) :etched-in)
+ :child (create-date-spinner "Year : "
+ (adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0) :in))))
+
+ (let ((spinner1 (make-instance 'spin-button
+ :adjustment (adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
+ :climb-rate 1.0 :digits 2 :wrap t :width-request 100))
+ (spinner2 (make-instance 'spin-button
+ :adjustment (adjustment-new 2.0 1.0 5.0 1.0 1.0 0.0)
+ :climb-rate 1.0 :wrap t))
+ (value-label (make-instance 'label :label "0")))
+ (signal-connect (spin-button-adjustment spinner2) 'value-changed
+ #'(lambda ()
+ (setf
+ (spin-button-digits spinner1)
+ (floor (spin-button-value spinner2)))))
+
+ (make-instance 'frame
+ :label "Accelerated" :parent main
+ :child (make-instance 'v-box
+ :border-width 5
+ :child (list
+ (make-instance 'h-box
+ :child-args '(:padding 5)
+ :child (make-instance 'v-box
+ :child (make-instance 'label
+ :label "Value :"
+ :xalign 0.0 :yalign 0.5)
+ :child spinner1)
+ :child (make-instance 'v-box
+ :child (make-instance 'label
+ :label "Digits :"
+ :xalign 0.0 :yalign 0.5)
+ :child spinner2))
+ :expand nil :padding 5)
+ :child (make-instance 'check-button
+ :label "Snap to 0.5-ticks" :active t
+ :signal (list 'clicked
+ #'(lambda (button)
+ (setf
+ (spin-button-snap-to-ticks-p spinner1)
+ (toggle-button-active-p button)))
+ :object t))
+ :child (make-instance 'check-button
+ :label "Numeric only input mode" :active t
+ :signal (list 'clicked
+ #'(lambda (button)
+ (setf
+ (spin-button-numeric-p spinner1)
+ (toggle-button-active-p button)))
+ :object t))
+ :child value-label
+ :child (list
+ (make-instance 'h-box
+ :child-args '(:padding 5)
+ :child (make-instance 'button
+ :label "Value as Int"
+ :signal (list 'clicked
+ #'(lambda ()
+ (setf
+ (label-label value-label)
+ (format nil "~D"
+ (spin-button-value-as-int
+ spinner1))))))
+ :child (make-instance 'button
+ :label "Value as Float"
+ :signal (list 'clicked
+ #'(lambda ()
+ (setf
+ (label-label value-label)
+ (format nil
+ (format nil "~~,~DF"
+ (spin-button-digits spinner1))
+ (spin-button-value spinner1)))))))
+ :padding 5 :expand nil))))
+ (widget-show-all main)))