-;; (define-standard-dialog create-tooltips "Tooltips"
-;; (setf
-;; (window-allow-grow-p window) t
-;; (window-allow-shrink-p window) nil
-;; (window-auto-shrink-p window) t
-;; (widget-width window) 200
-;; (container-border-width main-box) 10
-;; (box-spacing main-box) 10)
-
-;; (let ((tooltips (tooltips-new)))
-;; (flet ((create-button (label tip-text tip-private)
-;; (let ((button (make-instance 'toggle-button
-;; :label label :parent main-box)))
-;; (tooltips-set-tip tooltips button tip-text tip-private)
-;; button)))
-;; (create-button "button1" "This is button 1" "ContextHelp/button/1")
-;; (create-button "button2" "This is button 2. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly." "ContextHelp/button/2")
-
-;; (let* ((toggle (create-button "Override TipSQuery Label"
-;; "Toggle TipsQuery view" "Hi msw! ;)"))
-;; (box (make-instance 'v-box
-;; :homogeneous nil :spacing 5 :border-width 5
-;; :parent (make-instance 'frame
-;; :label "ToolTips Inspector"
-;; :label-xalign 0.5 :border-width 0
-;; :parent main-box)))
-;; (button (make-instance 'button :label "[?]" :parent box))
-;; (tips-query (make-instance 'tips-query
-;; :caller button :parent box)))
-
-;; (signal-connect
-;; button 'clicked #'tips-query-start-query :object tips-query)
-
-;; (signal-connect
-;; tips-query 'widget-entered
-;; #'(lambda (widget tip-text tip-private)
-;; (declare (ignore widget tip-private))
-;; (when (toggle-button-active-p toggle)
-;; (setf
-;; (label-label tips-query)
-;; (if tip-text
-;; "There is a Tip!"
-;; "There is no Tip!"))
-;; (signal-emit-stop tips-query 'widget-entered))))
-
-;; (signal-connect
-;; tips-query 'widget-selected
-;; #'(lambda (widget tip-text tip-private event)
-;; (declare (ignore tip-text event))
-;; (when widget
-;; (format
-;; t "Help ~S requested for ~S~%"
-;; (or tip-private "None") (type-of widget)))
-;; t))
-
-;; (tooltips-set-tip
-;; tooltips button "Start the Tooltip Inspector" "ContextHelp/buttons/?")
-;; (tooltips-set-tip
-;; tooltips close-button "Push this button to close window"
-;; "ContextHelp/buttons/Close")))))
+(define-simple-dialog create-tooltips (dialog "Tooltips" :default-width 200)
+ (let ((tooltips (make-instance 'tooltips)))
+ (flet ((create-button (label tip-text tip-private)
+ (let ((button (make-instance 'toggle-button :label label)))
+ (tooltips-set-tip tooltips button tip-text tip-private)
+ button)))
+ (make-instance 'v-box
+ :parent dialog :border-width 10 :spacing 10
+ :child (create-button "button1" "This is button 1" "ContextHelp/button/1")
+ :child (create-button "button2" "This is button 2. This is also has a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly." "ContextHelp/button/2")))))
+
+
+;;; UI Manager
+
+(defvar *ui-description*
+ '((:menubar "MenuBar"
+ (:menu "FileMenu"
+ (:menuitem "New")
+ (:menuitem "Open")
+ (:menuitem "Save")
+ (:menuitem "SaveAs")
+ :separator
+ (:menuitem "Quit"))
+ (:menu "PreferencesMenu"
+ (:menu "ColorMenu"
+ (:menuitem "Red")
+ (:menuitem "Green")
+ (:menuitem "Blue"))
+ (:menu "ShapeMenu"
+ (:menuitem "Square")
+ (:menuitem "Rectangle")
+ (:menuitem "Oval"))
+ (:menuitem "Bold"))
+ (:menu "HelpMenu"
+ (:menuitem "About")))
+ (:toolbar "ToolBar"
+ (:toolitem "Open")
+ (:toolitem "Quit")
+ :separator
+ (:toolitem "Logo"))))
+
+(define-toplevel create-ui-manager (window "UI Manager")
+ (let ((ui (make-instance 'ui-manager)))
+ (window-add-accel-group window (ui-manager-accel-group ui))
+ (ui-manager-insert-action-group ui
+ (make-instance 'action-group :name "Actions"
+ :action (make-instance 'action :name "FileMenu" :label "_File")
+ :action (make-instance 'action :name "PreferencesMenu" :label "_Preferences")
+ :action (make-instance 'action :name "ColorMenu" :label "_Color")
+ :action (make-instance 'action :name "ShapeMenu" :label "_Shape")
+ :action (make-instance 'action :name "HelpMenu" :label "_Help")
+ :action (make-instance 'action
+ :name "New" :stock-id "gtk-new" :label "_New"
+ :accelerator "<control>N" :tooltip "Create a new file")
+ :action (make-instance 'action
+ :name "Open" :stock-id "gtk-open" :label "_Open"
+ :accelerator "<control>O" :tooltip "Open a file"
+ :callback #'create-file-chooser)
+ :action (make-instance 'action
+ :name "Save" :stock-id "gtk-save" :label "_Save"
+ :accelerator "<control>S" :tooltip "Save current file")
+ :action (make-instance 'action
+ :name "SaveAs" :stock-id "gtk-save" :label "Save _As..."
+ :tooltip "Save to a file")
+ :action (make-instance 'action
+ :name "Quit" :stock-id "gtk-quit" :label "_Quit"
+ :accelerator "<control>Q" :tooltip "Quit"
+ :callback (list #'widget-destroy :object window))
+ :action (make-instance 'action
+ :name "About" :label "_About"
+ :accelerator "<control>A" :tooltip "About")
+ :action (make-instance 'action
+ :name "Logo" :stock-id "demo-gtk-logo" :tooltip "GTK+")
+ :action (make-instance 'toggle-action
+ :name "Bold" :stock-id "gtk-bold" :label "_Bold"
+ :accelerator "<control>B" :tooltip "Bold" :active t)
+ :actions (make-radio-group 'radio-action
+ '((:name "Red" :value :red :label "_Red"
+ :accelerator "<control>R" :tooltip "Blood")
+ (:name "Green" :value :green :label "_Green"
+ :accelerator "<control>G" :tooltip "Grass" :active t)
+ (:name "Blue" :value :blue :label "_Blue"
+ :accelerator "<control>B" :tooltip "Sky"))
+ #'(lambda (active) (print active)))
+ :actions (make-radio-group 'radio-action
+ '((:name "Square" :value :square :label "_Square"
+ :accelerator "<control>S" :tooltip "Square")
+ (:name "Rectangle" :value :rectangle :label "_Rectangle"
+ :accelerator "<control>R" :tooltip "Rectangle")
+ (:name "Oval" :value :oval :label "_Oval"
+ :accelerator "<control>O" :tooltip "Egg"))
+ #'(lambda (active) (print active)))))
+
+ (ui-manager-add-ui ui *ui-description*)
+
+ (make-instance 'v-box
+ :parent window
+ :child (list
+ (ui-manager-get-widget ui "/MenuBar")
+ :expand nil :fill nil)
+ :child (list
+ (ui-manager-get-widget ui "/ToolBar")
+ :expand nil :fill nil)
+ :child (make-instance 'label
+ :label "Type Ctrl+Q to quit"
+ :xalign 0.5 :yalign 0.5
+ :width-request 200 :height-request 200))))