;; 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.66 2006-09-14 11:52:40 espen Exp $
+;; $Id: gtk.lisp,v 1.67 2007-01-07 20:23:22 espen Exp $
(in-package "GTK")
(container-add bin child)
child)
-(defmethod compute-signal-function ((bin bin) signal function object)
+(defmethod compute-signal-function ((bin bin) signal function object args)
(declare (ignore signal))
(if (eq object :child)
- #'(lambda (&rest args)
- (apply function (bin-child bin) (rest args)))
+ #'(lambda (&rest emission-args)
+ (apply function (bin-child bin) (nconc (rest emission-args) args)))
(call-next-method)))
(ensure-signal-id 'response dialog)
(call-next-method)))
-(defmethod compute-signal-function ((dialog dialog) signal function object)
- (declare (ignore function object))
+(defmethod compute-signal-function ((dialog dialog) signal function object args)
+ (declare (ignore function object args))
(let ((callback (call-next-method))
(id (dialog-response-id dialog signal)))
(if id
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtkcontainer.lisp,v 1.21 2006-04-26 12:31:34 espen Exp $
+;; $Id: gtkcontainer.lisp,v 1.22 2007-01-07 20:23:22 espen Exp $
(in-package "GTK")
initargs :child :children))
-(defmethod compute-signal-function ((container container) signal function object)
+(defmethod compute-signal-function ((container container) signal function object args)
(declare (ignore signal))
(if (eq object :children)
- #'(lambda (&rest args)
- (container-foreach container
- #'(lambda (child)
- (apply function child (rest args)))))
+ #'(lambda (&rest emission-args)
+ (let ((all-args (nconc (rest emission-args) args)))
+ (container-foreach container
+ #'(lambda (child)
+ (apply function child all-args)))))
(call-next-method)))
(gethash (class-of container) *container-to-child-class-mappings*)
:parent container :child widget args))))
+(defmethod container-add ((container container) (widgets list) &rest args)
+ (dolist (widget widgets)
+ (apply #'container-add container widget args)))
+
(defbinding %container-remove () nil
(container container)
(widget widget))
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtkwidget.lisp,v 1.25 2006-09-27 08:44:44 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.26 2007-01-07 20:23:22 espen Exp $
(in-package "GTK")
((call-next-method))))
-(defmethod compute-signal-function ((widget widget) signal function object)
+(defmethod compute-signal-function ((widget widget) signal function object args)
(declare (ignore signal))
(if (eq object :parent)
- #'(lambda (&rest args)
- (if (slot-boundp widget 'parent)
- (apply function (widget-parent widget) (rest args))
+ #'(lambda (&rest emission-args)
+ (let ((all-args (nconc (rest emission-args) args)))
+ (if (slot-boundp widget 'parent)
+ (apply function (widget-parent widget) all-args)
;; Delay until parent is set
(signal-connect widget 'parent-set
#'(lambda (old-parent)
(let ((*signal-stop-emission*
#'(lambda ()
(warn "Ignoring emission stop in delayed signal handler"))))
- (apply function (widget-parent widget) (rest args))))
+ (apply function (widget-parent widget) all-args)))
:remove t)
; (warn "Widget has no parent -- ignoring signal")
- ))
+ )))
(call-next-method)))
(defun child-property-value (widget slot)