chiark
/
gitweb
/
~mdw
/
clg
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Minor changes for win32
[clg]
/
gtk
/
gtkwidget.lisp
diff --git
a/gtk/gtkwidget.lisp
b/gtk/gtkwidget.lisp
index 154771648caa863f70c7cf66cb8bee51d9961745..692b155469acfaf7daa87ec74248df00f53b8138 100644
(file)
--- a/
gtk/gtkwidget.lisp
+++ b/
gtk/gtkwidget.lisp
@@
-20,7
+20,7
@@
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;; 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.2
5 2006/09/27 08:44:44
espen Exp $
+;; $Id: gtkwidget.lisp,v 1.2
7 2007/02/19 14:29:33
espen Exp $
(in-package "GTK")
(in-package "GTK")
@@
-67,12
+67,13
@@
(defmethod slot-unbound ((class gobject-class) (object widget)
((call-next-method))))
((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)
(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)
;; Delay until parent is set
(signal-connect widget 'parent-set
#'(lambda (old-parent)
@@
-80,10
+81,10
@@
(defmethod compute-signal-function ((widget widget) signal function object)
(let ((*signal-stop-emission*
#'(lambda ()
(warn "Ignoring emission stop in delayed signal handler"))))
(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")
:remove t)
; (warn "Widget has no parent -- ignoring signal")
- ))
+ ))
)
(call-next-method)))
(defun child-property-value (widget slot)
(call-next-method)))
(defun child-property-value (widget slot)
@@
-411,9
+412,9
@@
(defbinding widget-queue-draw-area () nil
(defbinding widget-reset-shapes () nil
(widget widget))
(defbinding widget-reset-shapes () nil
(widget widget))
-
;;
(defbinding widget-set-double-buffered () nil
-
;;
(widget widget)
-
;;
(double-buffered boolean))
+(defbinding widget-set-double-buffered () nil
+ (widget widget)
+ (double-buffered boolean))
;; (defbinding widget-set-redraw-on-allocate () nil
;; (widget widget)
;; (defbinding widget-set-redraw-on-allocate () nil
;; (widget widget)