X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fwidgets-gtk.el;h=06b74d740caa0e8d85778050138300d0d0a38fb8;hp=38a151a27e488c915836198274a0e9cbd130e08d;hb=ee38d21b330f5001b47a577cefb5ba7b82a3b7d3;hpb=79d2db7d65205bc85d471590726d0cf3af5598e0

diff --git a/lisp/widgets-gtk.el b/lisp/widgets-gtk.el
index 38a151a..06b74d7 100644
--- a/lisp/widgets-gtk.el
+++ b/lisp/widgets-gtk.el
@@ -30,18 +30,34 @@
 
 (defvar foo)
 
-(defun gtk-widget-instantiate-button-internal (plist callback)
+(defun gtk-widget-get-callback (widget plist instance)
+  (let ((cb (plist-get plist :callback))
+	(ex (plist-get plist :callback-ex))
+	(real-cb nil))
+    (cond
+     (ex
+      (gtk-signal-connect widget 'button-release-event
+			  (lambda (widget event data)
+			    (put widget 'last-event event)))
+      `(lambda (widget &rest ignored)
+	 (funcall ,ex ,instance (get widget 'last-event))))
+     (cb
+      `(lambda (widget &rest ignored)
+	 (if (functionp ,real-cb)
+	     (funcall ,real-cb)
+	   (eval ,real-cb))))
+     (t
+      nil))))
+
+(defun gtk-widget-instantiate-button-internal (plist instance)
   (let* ((type (or (plist-get plist :style) 'button))
 	 (label (or (plist-get plist :descriptor) (symbol-name type)))
 	 (widget nil))
     (case type
       (button
        (setq widget (gtk-button-new-with-label label))
-       (gtk-signal-connect widget 'clicked (lambda (wid real-cb)
-					     (if (functionp real-cb)
-						 (funcall real-cb)
-					       (eval real-cb)))
-			   callback))
+       (gtk-signal-connect widget 'clicked
+			   (gtk-widget-get-callback widget plist instance)))
       (radio
        (let ((aux nil)
 	     (selected-p (plist-get plist :selected)))
@@ -51,33 +67,25 @@
 		    "bogus sibling"))
 	 (gtk-toggle-button-set-active widget (eval selected-p))
 	 (gtk-signal-connect widget 'toggled
-			     (lambda (wid data)
-			       ;; data is (real-cb . sibling)
-			       )
-			     (cons callback aux))))
+			     (gtk-widget-get-callback widget plist instance) aux)))
       (otherwise
        ;; Check boxes
        (setq widget (gtk-check-button-new-with-label label))
        (gtk-toggle-button-set-active widget
 				     (eval (plist-get plist :selected)))
        (gtk-signal-connect widget 'toggled
-			   (lambda (wid real-cb)
-			     (if (functionp real-cb)
-				 (funcall real-cb)
-			       (eval real-cb)))
-			   callback)))
-
+			   (gtk-widget-get-callback widget plist instance))))
     (gtk-widget-show-all widget)
     widget))
 
 (defun gtk-widget-instantiate-notebook-internal (plist callback)
   (let ((widget (gtk-notebook-new))
 	(items (plist-get plist :items)))
-    (while items
-      (gtk-notebook-append-page widget
-				(gtk-vbox-new nil 3)
-				(gtk-label-new (aref (car items) 0)))
-      (setq items (cdr items)))
+;     (while items
+;       (gtk-notebook-append-page widget
+; 				(gtk-vbox-new nil 3)
+; 				(gtk-label-new (aref (car items) 0)))
+;       (setq items (cdr items)))
     widget))
 
 (defun gtk-widget-instantiate-progress-internal (plist callback)
@@ -117,12 +125,12 @@
   (let* ((type (aref instantiator 0))
 	 (plist (cdr (map 'list 'identity instantiator)))
 	 (widget (funcall (or (get type 'instantiator) 'ignore)
-			  plist (or (plist-get plist :callback) 'ignore))))
-    (add-timeout 0.1 (lambda (obj)
-		       (gtk-widget-set-style obj
-					     (gtk-widget-get-style
-					      (frame-property nil 'text-widget))))
-		 widget)
+			  plist instance)))
+;     (add-timeout 0.1 (lambda (obj)
+; 		       (gtk-widget-set-style obj
+; 					     (gtk-widget-get-style
+; 					      (frame-property nil 'text-widget))))
+; 		 widget)
     (setq x widget)
     widget))