- (let ((toolbar (make-instance 'toolbar :parent window)))
-
- ;; Insert a stock item
- (toolbar-append toolbar "gtk-quit"
- :tooltip-text "Destroy toolbar"
- :tooltip-private-text "Toolbar/Quit"
- :callback #'(lambda () (widget-destroy window)))
-
- ;; Image widge as icon
- (toolbar-append toolbar "Horizontal"
- :icon (make-instance 'image :file #p"clg:examples;test.xpm")
- :tooltip-text "Horizontal toolbar layout"
- :tooltip-private-text "Toolbar/Horizontal"
- :callback #'(lambda () (setf (toolbar-orientation toolbar) :horizontal)))
-
- ;; Icon from file
- (toolbar-append toolbar "Vertical"
- :icon #p"clg:examples;test.xpm"
- :tooltip-text "Vertical toolbar layout"
- :tooltip-private-text "Toolbar/Vertical"
- :callback #'(lambda () (setf (toolbar-orientation toolbar) :vertical)))
-
- (toolbar-append toolbar :space)
-
- ;; Stock icon
- (toolbar-append toolbar "Icons"
- :icon "gtk-execute"
- :tooltip-text "Only show toolbar icons"
- :tooltip-private-text "Toolbar/IconsOnly"
- :callback #'(lambda () (setf (toolbar-style toolbar) :icons)))
-
- ;; Icon from pixmap data
- (toolbar-append toolbar "Text"
- :icon gtk-mini-xpm
- :tooltip-text "Only show toolbar text"
- :tooltip-private-text "Toolbar/TextOnly"
- :callback #'(lambda () (setf (toolbar-style toolbar) :text)))
-
- (toolbar-append toolbar "Both"
- :tooltip-text "Show toolbar icons and text"
- :tooltip-private-text "Toolbar/Both"
- :callback #'(lambda () (setf (toolbar-style toolbar) :both)))
-
- (toolbar-append toolbar :space)
-
- (toolbar-append toolbar (make-instance 'entry)
- :tooltip-text "This is an unusable GtkEntry"
- :tooltip-private-text "Hey don't click me!")
-
- (toolbar-append toolbar :space)
-
-;; (toolbar-append-item
-;; toolbar "Small" ;(pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Use small spaces"
-;; :tooltip-private-text "Toolbar/Small"
-;; :callback #'(lambda () (setf (toolbar-space-size toolbar) 5)))
-
-;; (toolbar-append-item
-;; toolbar "Big" ;(pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Use big spaces"
-;; :tooltip-private-text "Toolbar/Big"
-;; :callback #'(lambda () (setf (toolbar-space-size toolbar) 10)))
-
-;; (toolbar-append toolbar :space)
-
- (toolbar-append
- toolbar "Enable"
- :tooltip-text "Enable tooltips"
- :callback #'(lambda () (toolbar-enable-tooltips toolbar)))
-
- (toolbar-append
- toolbar "Disable"
- :tooltip-text "Disable tooltips"
- :callback #'(lambda () (toolbar-disable-tooltips toolbar)))
-
- (toolbar-append toolbar :space)
-
-;; (toolbar-append-item
-;; toolbar "Borders" (pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Show borders"
-;; :callback #'(lambda () (setf (toolbar-relief toolbar) :normal)))
-
-;; (toolbar-append-item
-;; toolbar
-;; "Borderless" (pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Hide borders"
-;; :callback #'(lambda () (setf (toolbar-relief toolbar) :none)))
-
-;; (toolbar-append toolbar :space)
-
-;; (toolbar-append-item
-;; toolbar "Empty" (pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Empty spaces"
-;; :callback #'(lambda () (setf (toolbar-space-style toolbar) :empty)))
-
-;; (toolbar-append-item
-;; toolbar "Lines" (pixmap-new "clg:examples;test.xpm")
-;; :tooltip-text "Lines in spaces"
-;; :callback #'(lambda () (setf (toolbar-space-style toolbar) :line)))
-
- ))
+ (make-instance 'toolbar
+ :show-tooltips t :show-arrow nil :parent window
+
+ ;; Insert a stock item
+ :child (make-instance 'tool-button
+ :stock "gtk-quit"
+ :tip-text "Destroy toolbar"
+ :tip-private "Toolbar/Quit"
+ :signal (list 'clicked #'(lambda () (widget-destroy window))))
+
+ :child (make-instance 'separator-tool-item)
+
+ :child (make-instance 'tool-button
+ :label "Horizontal" :stock "gtk-go-forward"
+ :tip-text "Horizontal toolbar layout"
+ :tip-private "Toolbar/Horizontal"
+ :signal (list 'clicked
+ #'(lambda (toolbar)
+ (setf (toolbar-orientation toolbar) :horizontal))
+ :object :parent))
+
+ :child (make-instance 'tool-button
+ :label "Vertical" :stock "gtk-go-down"
+ :tip-text "Vertical toolbar layout"
+ :tip-private "Toolbar/Vertical"
+ :signal (list 'clicked
+ #'(lambda (toolbar)
+ (setf (toolbar-orientation toolbar) :vertical))
+ :object :parent))
+
+ :child (make-instance 'separator-tool-item)
+
+ :children (make-radio-group 'radio-tool-button
+ '((:label "Icons" :stock "gtk-justify-left"
+ :tip-text "Only show toolbar icons"
+ :tip-private "Toolbar/IconsOnly"
+ :value :icons)
+ (:label "Both" :stock "gtk-justify-center"
+ :tip-text "Show toolbar icons and text"
+ :tip-private "Toolbar/Both"
+ :value :both :active t)
+ (:label "Text" :stock "gtk-justify-right"
+ :tip-text "Show toolbar text"
+ :tip-private "Toolbar/TextOnly"
+ :value :text))
+ (list
+ #'(lambda (toolbar style)
+ (setf (toolbar-style toolbar) style))
+ :object :parent))
+
+ :child (make-instance 'separator-tool-item)
+
+ :child (make-instance 'tool-item
+ :child (make-instance 'entry)
+ :tip-text "This is an unusable GtkEntry"
+ :tip-private "Hey don't click me!")
+
+ :child (make-instance 'separator-tool-item)
+
+ :child (make-instance 'tool-button
+ :label "Enable" :stock "gtk-add"
+ :tip-text "Enable tooltips"
+ :tip-private "Toolbar/EnableTooltips"
+ :signal (list 'clicked
+ #'(lambda (toolbar)
+ (setf (toolbar-show-tooltips-p toolbar) t))
+ :object :parent))
+
+ :child (make-instance 'tool-button
+ :label "Disable" :stock "gtk-remove"
+ :tip-text "Disable tooltips"
+ :tip-private "Toolbar/DisableTooltips"
+ :signal (list 'clicked
+ #'(lambda (toolbar)
+ (setf (toolbar-show-tooltips-p toolbar) nil))
+ :object :parent))
+
+;; :child (make-instance 'separator-tool-item)
+
+;; :child (make-instance 'tool-button
+;; :label "GTK" :icon #p"clg:examples;gtk.png"
+;; :tip-text "GTK+ Logo"
+;; :tip-private "Toolbar/GTK+")
+ ))