From 4ea1303500a59d61d755399e8df1af84241c7d7c Mon Sep 17 00:00:00 2001 From: espen Date: Tue, 19 Apr 2005 08:17:06 +0000 Subject: [PATCH] Improved UI manager demo --- examples/testgtk.lisp | 121 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 72 insertions(+), 49 deletions(-) diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp index d30ccb9..ab95809 100644 --- a/examples/testgtk.lisp +++ b/examples/testgtk.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: testgtk.lisp,v 1.27 2005-04-18 10:39:32 espen Exp $ +;; $Id: testgtk.lisp,v 1.28 2005-04-19 08:17:06 espen Exp $ (defpackage "TESTGTK" (:use "COMMON-LISP" "GTK")) @@ -1547,23 +1547,25 @@ This one is underlined ( (let* ((actions (make-instance 'action-group - :action (create-toggle-action - "Bold" "gtk-bold" "Bold" "B" "Bold" nil - (create-toggle-callback "Bold")) - :action (create-toggle-action - "Italic" "gtk-italic" "Italic" "I" "Italic" nil - (create-toggle-callback "Italic")) - :action (create-toggle-action - "Underline" "gtk-underline" "Underline" "U" "Underline" nil - (create-toggle-callback "Underline")))) - (ui (make-instance 'ui-manager))) - - (ui-manager-insert-action-group ui actions) - (ui-manager-add-ui ui - '((:toolbar "ToolBar" - (:toolitem "Bold") - (:toolitem "Italic") - (:toolitem "Underline")))) + :action (make-instance 'toggle-action + :name "Bold" :stock-id "gtk-bold" :label "Bold" + :accelerator "B" :tooltip "Bold" + :callback (create-toggle-callback "Bold")) + :action (make-instance 'toggle-action + :name "Italic" :stock-id "gtk-italic" :label "Italic" + :accelerator "I" :tooltip "Italic" + :callback (create-toggle-callback "Italic")) + :action (make-instance 'toggle-action + :name "Underline" :stock-id "gtk-underline" + :label "Underline" :accelerator "U" + :tooltip "Underline" + :callback (create-toggle-callback "Underline")))) + (ui (make-instance 'ui-manager + :action-group actions + :ui '((:toolbar "ToolBar" + (:toolitem "Bold") + (:toolitem "Italic") + (:toolitem "Underline")))))) ;; Callback to activate/deactivate toolbar buttons when cursor ;; is moved @@ -1769,42 +1771,63 @@ This one is underlined ( (:toolbar "ToolBar" (:toolitem "Open") (:toolitem "Quit") - (:separator "Sep1") + :separator (:toolitem "Logo")))) (define-toplevel create-ui-manager (window "UI Manager") - (let ((actions - (make-instance 'action-group - :name "Actions" - :action (create-action "FileMenu" nil "_File") - :action (create-action "PreferencesMenu" nil "_Preferences") - :action (create-action "ColorMenu" nil "_Color") - :action (create-action "ShapeMenu" nil "_Shape") - :action (create-action "HelpMenu" nil "_Help") - :action (create-action "New" "gtk-new" "_New" "N" "Create a new file") - :action (create-action "Open" "gtk-open" "_Open" "O" "Open a file" #'create-file-chooser) - :action (create-action "Save" "gtk-save" "_Save" "S" "Save current file") - :action (create-action "SaveAs" "gtk-save" "Save _As..." "" "Save to a file") - :action (create-action "Quit" "gtk-quit" "_Quit" "Q" "Quit" (list #'widget-destroy :object window)) - :action (create-action "About" nil "_About" "A" "About") - :action (create-action "Logo" "demo-gtk-logo" "" nil "GTK+") - :action (create-toggle-action "Bold" "gtk-bold" "_Bold" "B" "Bold" t) - :actions (create-radio-actions - '(("Red" nil "_Red" "R" "Blood") - ("Green" nil "_Green" "G" "Grass") - ("Blue" nil "_Blue" "B" "Sky")) - "Green") - :actions (create-radio-actions - '(("Square" nil "_Square" "S" "Square") - ("Rectangle" nil "_Rectangle" "R" "Rectangle") - ("Oval" nil "_Oval" "O" "Egg"))))) - (ui (make-instance 'ui-manager))) - - (ui-manager-insert-action-group ui actions) + (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 "N" :tooltip "Create a new file") + :action (make-instance 'action + :name "Open" :stock-id "gtk-open" :label "_Open" + :accelerator "O" :tooltip "Open a file" + :callback #'create-file-chooser) + :action (make-instance 'action + :name "Save" :stock-id "gtk-save" :label "_Save" + :accelerator "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 "Q" :tooltip "Quit" + :callback (list #'widget-destroy :object window)) + :action (make-instance 'action + :name "About" :label "_About" + :accelerator "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 "B" :tooltip "Bold" :active t) + :actions (make-radio-group 'radio-action + '((:name "Red" :value :red :label "_Red" + :accelerator "R" :tooltip "Blood") + (:name "Green" :value :green :label "_Green" + :accelerator "G" :tooltip "Grass" :active t) + (:name "Blue" :value :blue :label "_Blue" + :accelerator "B" :tooltip "Sky")) + #'(lambda (active) (print active))) + :actions (make-radio-group 'radio-action + '((:name "Square" :value :square :label "_Square" + :accelerator "S" :tooltip "Square") + (:name "Rectangle" :value :rectangle :label "_Rectangle" + :accelerator "R" :tooltip "Rectangle") + (:name "Oval" :value :oval :label "_Oval" + :accelerator "O" :tooltip "Egg")) + #'(lambda (active) (print active))))) + (ui-manager-add-ui ui *ui-description*) - (window-add-accel-group window (ui-manager-accel-group ui)) - (make-instance 'v-box :parent window :child (list -- 2.11.0