;; 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.65 2006-09-13 10:54:49 espen Exp $
+;; $Id: gtk.lisp,v 1.69 2007-01-14 23:22:16 espen Exp $
(in-package "GTK")
;; When running in Slime we need to hook into the Swank server
;; to handle events asynchronously
(if (find-package "SWANK")
- (let ((read-from-emacs (find-symbol "READ-FROM-EMACS" "SWANK"))
+ (let ((read-from-emacs (symbol-function (find-symbol "READ-FROM-EMACS" "SWANK")))
(stream (funcall (find-symbol "CONNECTION.SOCKET-IO" "SWANK") (symbol-value (find-symbol "*EMACS-CONNECTION*" "SWANK")))))
(setf (symbol-function (find-symbol "READ-FROM-EMACS" "SWANK"))
#'(lambda ()
(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
(defmethod activate-radio-widget ((button radio-button))
(signal-emit button 'clicked))
+(defgeneric add-activate-callback (action function &key object after))
+
(defmethod add-activate-callback ((button radio-button) function &key object after)
(%add-activate-callback button 'clicked function object after))
(defbinding %window-set-default-icon () nil
(icons (glist gdk:pixbuf)))
+(defgeneric (setf window-default-icon) (icon))
+
(defmethod (setf window-default-icon) ((icon gdk:pixbuf))
(%window-set-default-icon icon)
icon)
+(defgeneric (setf window-group) (group window))
+
(defmethod (setf window-group) ((group window-group) (window window))
(window-group-add-window group window)
group)
(defmethod allocate-foreign ((plug plug) &key id)
(%plug-new (or id 0)))
+
+
+;;;; New stuff in Gtk+ 2.10
+
+;;; Link button
+
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
+(progn
+ (define-callback-marshal %link-button-uri-callback nil (link-button (link string)))
+
+ (defbinding link-button-set-uri-hook (function) pointer
+ (%link-button-uri-callback callback)
+ ((register-callback-function function) unsigned-int)
+ (user-data-destroy-callback callback)))