;; Copyright (C) 2016  Tommi Höynälänmaa

(define-body (gnome-examples theme-d-gnome-demo button-box)

  (import (gnome gtk)
	  (gnome gobject)
	  (standard-library list-utilities))

  (define-simple-proc create-button-box
      (((horiz? <boolean>) (str-title <string>) (i-spacing <integer>)
	(s-layout <symbol>))
       <gtk-frame>
       nonpure)
    (let ((frame (gtk-frame-create str-title))
	  (buttonbox (if horiz?
			 (gtk-hbutton-box-create)
			 (gtk-vbutton-box-create))))
      (set-layout buttonbox s-layout)
      (set-spacing buttonbox i-spacing)
      (set-border-width buttonbox 5)

      (add frame buttonbox)

      (for-each1 (lambda (((s <symbol>)) <none> nonpure)
		   (add buttonbox
			(gtk-button-create-from-stock
			 (gtk-stock-id s))))
		 '(ok cancel help))

      frame))

  (define-simple-proc run-button-box-demo (((window-parent <gtk-window>))
				      <none> nonpure)

    (let ((window (gtk-window-create 'toplevel))
	  (vbox-main (gtk-vbox-create #f 0))
	  (frame-horiz (gtk-frame-create "Horizontal Button Boxes"))
	  (vbox (gtk-vbox-create #f 0))
	  (frame-vert (gtk-frame-create "Vertical Button Boxes"))
	  (hbox (gtk-hbox-create #f 0)))
      (set-title window "Button Boxes")
      (set-border-width window 10)
      (set-border-width vbox 10)
      (set-border-width hbox 10)

      (add window vbox-main)

      (pack-start vbox-main frame-horiz #t #t 10)
      (add frame-horiz vbox)
      (pack-start vbox
		  (create-button-box #t "Spread" 40 'spread)
		  #t #t 0)
      (pack-start vbox
		  (create-button-box #t "Edge" 40 'edge)
		  #t #t 5)
      (pack-start vbox
		  (create-button-box #t "Start" 40 'start)
		  #t #t 5)
      (pack-start vbox
		  (create-button-box #t "End" 40 'end)
		  #t #t 5)

      (pack-start vbox-main frame-vert #t #t 10)
      (add frame-vert hbox)
      (pack-start hbox
		  (create-button-box #f "Spread" 30 'spread)
		  #t #t 0)
      (pack-start hbox
		  (create-button-box #f "Edge" 30 'edge)
		  #t #t 5)
      (pack-start hbox
		  (create-button-box #f "Start" 30 'start)
		  #t #t 5)
      (pack-start hbox
		  (create-button-box #f "End" 30 'end)
		  #t #t 5)

      (set-modal window #t)
      (set-transient-for window window-parent)

      (show-all window)))


  (define-simple-proc get-button-box-demo (() <demo> force-pure)
    (let* ((str-name "Button Boxes")
	   (str-module-name "button-box")
	   (str-desc
	    "The Button Box widgets are used to arrange buttons with padding.")
	   (demo (make <demo> str-name str-module-name str-desc "" ""
		       run-button-box-demo)))
      (demo-compute-source demo)
      demo)))
