From a5522de52c8dcd65783339b80de07c3413d61ffa Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Tue, 19 Apr 2005 08:11:39 +0000 Subject: [PATCH] Unified API for all types of radio objects. Organization: Straylight/Edgeware From: espen --- gtk/gtk.lisp | 52 ++++++++++++++++++++++++++------------ gtk/gtkaction.lisp | 62 ++++++++++++++++++++++++++++++++-------------- gtk/gtktypes.lisp | 17 ++++++------- 3 files changed, 87 insertions(+), 44 deletions(-) diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index ca8965b..6d0c9ef 100644 --- 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 ae5043b..0ecd265 100644 --- 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 a6cfa19..c949d5e 100644 --- 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 -- [mdw]