anchor.diff:  ;; License along with this library; if not, write to the Free Software
   ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   
  -;; $Id: gcallback.lisp,v 1.21 2005-02-14 00:41:54 espen Exp $
  +;; $Id: gcallback.lisp,v 1.22 2005-02-22 17:29:38 espen Exp $
   
   (in-package "GLIB")
   
  
positive.code:       (callback user-data-destroy-func))
       callback-id)))
  
  (defgeneric create-callback-function (gobject function arg1))
  
  (defmethod create-callback-function ((gobject gobject) function arg1)
    (cond
     ((or (eq arg1 t) (eq arg1 gobject)) function)
     ((not arg1)
      #'(lambda (&rest args) (apply function (rest args))))
     (t
      #'(lambda (&rest args) (apply function arg1 (rest args))))))
  
  (defgeneric signal-connect (gobject signal function &key))
  
  (defmethod signal-connect ((gobject gobject) signal function
  			   &key (detail 0) after object remove)
  "Connects a callback function to a signal for a particular object. If
  :OBJECT is T, the object connected to is passed as the first argument
  to the callback function, or if :OBJECT is any other non NIL value, it
  
negative.code: handler will be called after the default handler for the signal. If
  :REMOVE is non NIL, the handler will be removed after beeing invoked
  once."
  (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))
         (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)
  	(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)
  