Unified API for all types of radio objects.

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index 57e4b4fb57e0329b61963c4b26fb598fc9abc831..d972163775c249d9d888ecbd6677d19aa0f797ee 100644 (file)
--- a/gtk/gtk.lisp
+++ b/gtk/gtk.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: gtk.lisp,v 1.40 2005/04/17 21:39:04 espen Exp $
+;; $Id: gtk.lisp,v 1.41 2005/04/19 08:11:39 espen Exp $
 
 
 (in-package "GTK")
@@ -44,7 +44,7 @@ (defbinding get-default-language () (copy-of pango:language))
 
 ;;;; Initalization
 
-(defbinding (gtk-init "gtk_parse_args") () nil
+(defbinding (gtk-init "gtk_parse_args") () boolean
   "Initializes the library without opening the display."
   (nil null)
   (nil null))
@@ -53,7 +53,8 @@ (defun clg-init (&optional display)
   "Initializes the system and starts the event handling"
   (unless (gdk:display-get-default)
     (gdk:gdk-init)
-    (gtk-init)
+    (unless (gtk-init)
+      (error "Initialization of GTK+ failed."))
     (prog1
        (gdk:display-open display)
       (add-fd-handler (gdk:display-connection-number) :input #'main-iterate-all)
@@ -187,6 +188,8 @@ (defbinding accel-label-refetch () boolean
 
 ;;; Accel map
 
+;(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
+
 (defbinding %accel-map-add-entry () nil
   (path string)
   (key unsigned-int)
@@ -888,6 +891,25 @@ (defmethod add-to-radio-group ((button1 radio-button) (button2 radio-button))
   "Add BUTTON1 to the group which BUTTON2 belongs to."
   (%radio-button-set-group button1 (%radio-button-get-group button2)))
 
+(defun %add-activate-callback (widget signal function object after)
+  (if object
+      (signal-connect widget signal
+       #'(lambda (object)
+          (when (slot-value widget 'active)
+            (funcall function object (slot-value widget 'value))))
+       :object object :after after)
+    (signal-connect widget signal 
+     #'(lambda ()
+        (when (slot-value widget 'active)
+          (funcall function (slot-value widget 'value))))
+     :after after)))
+
+(defmethod activate-radio-widget ((button radio-button))
+  (signal-emit button 'clicked))
+
+(defmethod add-activate-callback ((button radio-button) function &key object after)
+  (%add-activate-callback button 'clicked function object after))
+
 (defmethod initialize-instance ((button radio-button) &key group)
   (prog1
       (call-next-method)
@@ -1013,10 +1035,16 @@ (defbinding %radio-menu-item-set-group () nil
   (radio-menu-item radio-menu-item)
   (group pointer))
 
+(defmethod activate-radio-widget ((item radio-menu-item))
+  (menu-item-activate item))
+
 (defmethod add-to-radio-group ((item1 radio-menu-item) (item2 radio-menu-item))
   "Add ITEM1 to the group which ITEM2 belongs to."
   (%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2)))
 
+(defmethod add-activate-callback ((item radio-menu-item) function &key object after)
+  (%add-activate-callback item 'activate function object after))
+
 (defmethod initialize-instance ((item radio-menu-item) &key group)
   (prog1
       (call-next-method)
@@ -1034,22 +1062,14 @@ (defbinding %radio-tool-button-set-group () nil
   (radio-tool-button radio-tool-button)
   (group pointer))
 
+(defmethod activate-radio-widget ((button radio-tool-button))
+  (signal-emit button 'clicked))
+
 (defmethod add-to-radio-group ((button1 radio-tool-button) (button2 radio-tool-button))
   "Add BUTTON1 to the group which BUTTON2 belongs to."
   (%radio-tool-button-set-group button1 (%radio-tool-button-get-group button2)))
-
-(defmethod add-activate-callback ((widget widget) function &key object after)
-  (if object
-      (signal-connect widget 'clicked
-       #'(lambda (object)
-          (when (slot-value widget 'active)
-            (funcall function object (slot-value widget 'value))))
-       :object object :after after)
-    (signal-connect widget 'clicked 
-     #'(lambda ()
-        (when (slot-value widget 'active)
-          (funcall function (slot-value widget 'value))))
-     :after after)))
+(defmethod add-activate-callback ((button radio-tool-button) function &key object after)
+  (%add-activate-callback button 'clicked function object after))
 
 (defmethod initialize-instance ((button radio-tool-button) &key group)
   (prog1

diff --git a/gtk/gtkaction.lisp b/gtk/gtkaction.lisp
index 0b321db9f5b098500fedbbeb2e27dfabfff49959..f6ba6dc04de4f28bed21a54f190b408f8b0a08aa 100644 (file)
--- a/gtk/gtkaction.lisp
+++ b/gtk/gtkaction.lisp
@@ -15,16 +15,17 @@
 ;; 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: gtkaction.lisp,v 1.3 2005/02/03 23:09:09 espen Exp $
+;; $Id: gtkaction.lisp,v 1.4 2005/04/19 08:11:39 espen Exp $
 
 
 (in-package "GTK")
 
 ;;; Action
 
-(defmethod initialize-instance ((action action) &key accelerator)
+(defmethod initialize-instance ((action action) &key callback)
   (call-next-method)
-  (setf (object-data action 'accelerator) accelerator))
+  (when callback
+    (apply #'signal-connect action 'activate (mklist callback))))
 
 (defmethod action-accelerator ((action action))
   (object-data action 'accelerator))
@@ -46,7 +47,7 @@ (defmethod initialize-instance ((action-group action-group) &rest initargs
   (declare (ignore action actions))
   (prog1
       (call-next-method)
-    (initial-add action-group #'action-group-add-action 
+    (initial-add action-group #'action-group-add-action
      initargs :action :actions)))
 
 (defbinding action-group-get-action () action
@@ -66,11 +67,9 @@ (defbinding %action-group-add-action-with-accel () nil
   (accelerator (or null string)))
 
 (defun action-group-add-action (action-group action)
-  (multiple-value-bind (accelerator accelerator-p) 
-      (object-data action 'accelerator)
-    (if accelerator-p
-       (%action-group-add-action-with-accel action-group action accelerator)
-      (%action-group-add-action action-group action))))
+  (if (slot-boundp action 'accelerator)
+      (%action-group-add-action-with-accel action-group action (action-accelerator action))
+    (%action-group-add-action action-group action)))
 
 (defbinding action-group-remove-action () nil
   (action-group action-group)
@@ -79,15 +78,11 @@ (defbinding action-group-remove-action () nil
 
 ;;; Radio Action
 
-(defmethod initialize-instance ((action radio-action) &key group value)
+(defmethod initialize-instance ((action radio-action) &key group)
   (call-next-method)
-  (setf (slot-value action '%value) (sap-int (proxy-location action)))
-  (setf (object-data action 'radio-action-value) value)
+  (setf (slot-value action 'self) (sap-int (proxy-location action)))
   (when group
-    (radio-action-add-to-group action group)))
-
-(defmethod radio-value-action ((action radio-action))
-  (object-data action 'radio-action-value))
+    (add-to-radio-group action group)))
 
 (defbinding %radio-action-get-group () pointer
   (radio-action radio-action))
@@ -96,12 +91,19 @@ (defbinding %radio-action-set-group () nil
   (radio-button radio-button)
   (group pointer))
 
-(defun radio-action-add-to-group (action1 action2)
+(defmethod add-to-radio-group ((action1 radio-action) (action2 radio-action))
   "Add ACTION1 to the group which ACTION2 belongs to."
   (%radio-action-set-group action1 (%radio-action-get-group action2)))
 
+(defmethod activate-radio-widget ((action radio-action))
+  (action-activate action))
+
+(defmethod add-activate-callback ((action radio-action) function &key object after)
+  (%add-activate-callback action 'activate function object after))
+
 (defbinding (radio-action-get-current "gtk_radio_action_get_current_value") 
     () radio-action
+  "Returns the current active radio action in the group the give radio action belongs to."
   (radio-action radio-action))
 
 (defun radio-action-get-current-value (action)
@@ -111,11 +113,25 @@ (defun radio-action-get-current-value (action)
 
 ;;; Toggle Action
 
+(defmethod initialize-instance ((action toggle-action) &rest initargs &key callback)
+  (remf initargs :callback)
+  (apply #'call-next-method action initargs)
+  (when callback
+    (destructuring-bind (function &key object after) (mklist callback)
+      (signal-connect action 'activate
+       (if object 
+          #'(lambda (object)
+              (funcall function object (toggle-action-active-p action)))
+        #'(lambda ()
+            (funcall function (toggle-action-active-p action))))
+       :object object :after after)))
+  (when (toggle-action-active-p action)
+    (action-activate action)))
+
 (defbinding toggle-action-toggled () nil
   (toggle-action toggle-action))
 
 
-
 ;;; UI Manager
 
 (defmethod initialize-instance ((ui-manager ui-manager) &rest initargs 
@@ -202,6 +218,9 @@ (defvar *valid-ui-elements*
     (:separator)
     (:accelerator)))
 
+(defvar *anonymous-element-counter* 0)
+(internal *anonymous-element-counter*)
+
 (defmethod ui-manager-add-ui ((ui-manager ui-manager) (ui-spec list))
   (let ((id (%ui-manager-new-merge-id ui-manager)))
     (labels 
@@ -219,7 +238,12 @@ (defmethod ui-manager-add-ui ((ui-manager ui-manager) (ui-spec list))
                                (not (keywordp (first rest))))
                           (values (first rest) (rest rest))
                         (values name rest))
-                    (%ui-manager-add-ui ui-manager id (or path "/") name action type nil)
+                    (%ui-manager-add-ui ui-manager 
+                     id (or path "/") 
+                     (or name (format nil "~A~D" 
+                               (string-capitalize type) 
+                               (incf *anonymous-element-counter*)))
+                     action type nil)
                     (when children
                       (parse-ui-spec (concatenate 'string path "/" name) 
                                      children type)))))))))

diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp
index fca5efdf27b59fdfedcb561cbcebda14576039ab..84f19e9b71442855d16c6de3ca34e33a4b220859 100644 (file)
--- a/gtk/gtktypes.lisp
+++ b/gtk/gtktypes.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: gtktypes.lisp,v 1.35 2005/03/13 18:10:14 espen Exp $
+;; $Id: gtktypes.lisp,v 1.36 2005/04/19 08:11:39 espen Exp $
 
 (in-package "GTK")
 
@@ -933,11 +933,11 @@     (default-height :merge t :unbound -1)))
   ("GtkUIManagerItemType"
    :type ui-manager-item-type)
 
-  ("GtkToggle"
+  ("GtkAction"
    :slots
    ((accelerator
-     :allocation :virtual
-     :getter action-accelerator)))
+     :allocation :user-data :initarg :accelerator 
+     :reader action-accelerator)))
 
   ("GtkToggleAction"
    :slots
@@ -956,12 +956,11 @@     (default-height :merge t :unbound -1)))
      :getter "gtk_radio_button_get_group"
      :reader radio-action-group
      :type (copy-of (gslist widget)))
-    (%value
-     :allocation :property  :pname "value"
-     :readable nil :type int)
+    (self
+     :allocation :property :pname "value" :type int
+     :documentation "A hack so we can use the alien function gtk_radio_action_get_current_value to retrieve the active radio action in a group.")
     (value 
-     :allocation :virtual
-     :getter radio-action-value)))
+     :allocation :user-data :initarg :value :accessor radio-action-value)))
 
   ("GtkColorSelection"
    :slots