+(defmethod create-callback-function ((widget widget) function arg1)
+ (if (eq arg1 :parent)
+ #'(lambda (&rest args)
+ (if (slot-boundp widget 'parent)
+ (apply function (widget-parent widget) (rest args))
+ (signal-connect widget 'parent-set
+ #'(lambda (old-parent)
+ (declare (ignore old-parent))
+ (let ((*signal-stop-emission*
+ #'(lambda ()
+ (warn "Ignoring emission stop in delayed signal handler"))))
+ (apply function (widget-parent widget) (rest args))))
+ :remove t)
+; (warn "Widget has no parent -- ignoring signal")
+ ))
+ (call-next-method)))
+