;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gcallback.lisp,v 1.49 2008-04-11 20:51:45 espen Exp $
+;; $Id: gcallback.lisp,v 1.50 2008-05-06 00:04:42 espen Exp $
(in-package "GLIB")
:REMOVE is non NIL, the handler will be removed after beeing invoked
once. ARGS is a list of additional arguments passed to the callback
function."
-(let* ((signal-id (compute-signal-id gobject signal))
- (detail-quark (if detail (quark-intern detail) 0))
- (signal-stop-emission
- #'(lambda ()
- (%signal-stop-emission gobject signal-id detail-quark)))
- (callback (compute-signal-function gobject signal function object args))
- (wrapper #'(lambda (&rest args)
- (let ((*signal-stop-emission* signal-stop-emission))
- (apply callback args)))))
- (multiple-value-bind (closure-id callback-id)
- (make-callback-closure wrapper signal-handler-marshal)
- (let ((handler-id (%signal-connect-closure-by-id
- gobject signal-id detail-quark closure-id after)))
- (when remove
- (update-user-data callback-id
- #'(lambda (&rest args)
+ (let* ((signal-id (compute-signal-id gobject signal))
+ (detail-quark (if detail (quark-intern detail) 0))
+ (callback
+ (compute-signal-function gobject signal function object args))
+ (wrapper
+ #'(lambda (&rest args)
+ (let ((*signal-stop-emission*
+ #'(lambda ()
+ (%signal-stop-emission (first args)
+ signal-id detail-quark))))
+ (apply callback args)))))
+ (multiple-value-bind (closure-id callback-id)
+ (make-callback-closure wrapper signal-handler-marshal)
+ (let ((handler-id (%signal-connect-closure-by-id
+ gobject signal-id detail-quark closure-id after)))
+ (when remove
+ (update-user-data callback-id
+ #'(lambda (&rest args)
+ (let ((gobject (first args)))
(unwind-protect
- (let ((*signal-stop-emission* signal-stop-emission))
- (apply callback args))
+ (let ((*signal-stop-emission*
+ #'(lambda ()
+ (%signal-stop-emission gobject
+ signal-id detail-quark))))
+ (apply callback args))
(when (signal-handler-is-connected-p gobject handler-id)
- (signal-handler-disconnect gobject handler-id))))))
- handler-id))))
+ (signal-handler-disconnect gobject handler-id)))))))
+ handler-id))))
;;;; Signal emission
;; 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.93 2008-04-14 19:10:41 espen Exp $
+;; $Id: gtk.lisp,v 1.94 2008-05-06 00:04:42 espen Exp $
(in-package "GTK")
(defmethod compute-signal-function ((bin bin) signal function object args)
(declare (ignore signal))
(if (eq object :child)
- #'(lambda (&rest emission-args)
- (apply function (bin-child bin) (nconc (rest emission-args) args)))
+ #'(lambda (bin &rest emission-args)
+ (apply function (bin-child bin) (nconc emission-args args)))
(call-next-method)))
;; 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.25 2008-03-06 22:02:08 espen Exp $
+;; $Id: gtkcontainer.lisp,v 1.26 2008-05-06 00:04:42 espen Exp $
(in-package "GTK")
(defmethod compute-signal-function ((container container) signal function object args)
(declare (ignore signal))
(if (eq object :children)
- #'(lambda (&rest emission-args)
- (let ((all-args (nconc (rest emission-args) args)))
+ #'(lambda (container &rest emission-args)
+ (let ((all-args (nconc emission-args args)))
(container-foreach container
#'(lambda (child)
(apply function child all-args)))))
;; 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.30 2008-04-11 18:42:40 espen Exp $
+;; $Id: gtkwidget.lisp,v 1.31 2008-05-06 00:04:42 espen Exp $
(in-package "GTK")
(defmethod compute-signal-function ((widget widget) signal function object args)
(let ((wrapper
(if (eq object :parent)
- #'(lambda (&rest emission-args)
- (let ((all-args (nconc (rest emission-args) args)))
+ #'(lambda (widget &rest emission-args)
+ (let ((all-args (nconc 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)
(declare (ignore old-parent))
- (apply #'signal-emit widget signal (rest emission-args)))
+ (apply #'signal-emit widget signal emission-args))
:remove t))))
(call-next-method))))
(if *widget-display-as-default-in-signal-handler-p*
- #'(lambda (&rest args)
+ #'(lambda (widget &rest args)
(let ((display (when (slot-boundp widget 'window)
(gdk:drawable-display (widget-window widget)))))
(gdk:with-default-display (display)
- (apply wrapper args))))
+ (apply wrapper widget args))))
wrapper)))