;; 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.38 2005-02-27 12:37:01 espen Exp $
+;; $Id: gtk.lisp,v 1.41 2005-04-19 08:11:39 espen Exp $
(in-package "GTK")
;;;; 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))
"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)
;;; Accel map
+;(defbinding (accel-map-init "_gtk_accel_map_init") () nil)
+
(defbinding %accel-map-add-entry () nil
(path string)
(key unsigned-int)
;;; Label
+(defmethod shared-initialize ((label label) names &key pattern)
+ (declare (ignore names))
+ (call-next-method)
+ (when pattern
+ (setf (label-pattern label) pattern)))
+
(defbinding label-get-layout-offsets () nil
(label label)
(x int :out)
"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)
;;; Message dialog
-(defmethod initialize-instance ((dialog message-dialog) &rest initargs
- &key (type :info) (buttons :close) ; or :ok?
- flags message parent)
- (remf initargs :parent)
+(defmethod initialize-instance ((dialog message-dialog)
+ &key (message-type :info) (buttons :close)
+ flags text #+gtk 2.6 secondary-text
+ transient-parent)
(setf
(slot-value dialog 'location)
- (%message-dialog-new parent flags type buttons nil))
- (message-dialog-set-markup dialog message)
- (apply #'call-next-method dialog initargs))
+ (%message-dialog-new transient-parent flags message-type buttons))
+ (when text
+ (message-dialog-set-markup dialog text))
+ #+gtk2.6
+ (when secondary-text
+ (message-dialog-format-secondary-markup dialog secondary-text))
+ (call-next-method))
(defbinding %message-dialog-new () pointer
(flags dialog-flags)
(type message-type)
(buttons buttons-type)
- (message (or null string)))
-
-(defbinding %message-dialog-new-with-markup () pointer
- (parent (or null window))
- (flags dialog-flags)
- (type message-type)
- (buttons buttons-type)
- (message string))
+ (nil null))
(defbinding message-dialog-set-markup () nil
(message-dialog message-dialog)
(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)
(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
(scrolled-window scrolled-window)
(child widget))
-(defmethod initialize-instance ((window scrolled-window) &rest initargs
- &key policy)
- (if policy
- (apply #'call-next-method window
- :vscrollbar-policy policy :hscrollbar-policy policy initargs)
- (call-next-method)))
+(defmethod shared-initialize ((window scrolled-window) names &key policy)
+ (declare (ignore names))
+ (when policy
+ (setf (slot-value window 'hscrollbar-policy) policy)
+ (setf (slot-value window 'vscrollbar-policy) policy))
+ (call-next-method))
;;; Statusbar