-;; Common Lisp bindings for GTK+ v2.0
-;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
+;; Common Lisp bindings for GTK+ v2.x
+;; Copyright 1999-2005 Espen S. Johnsen <espen@users.sf.net>
;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2 of the License, or (at your option) any later version.
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
;;
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; Lesser General Public License for more details.
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
;;
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtk.lisp,v 1.39 2005-03-13 18:08:44 espen Exp $
+;; $Id: gtk.lisp,v 1.42 2005-04-23 16:48:51 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)
(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
~mdw / clg / blobdiff