C callbacks cleaned up and ported to new API

[clg] / gtk / gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index f06dd563a19c4caeb6cbf8296a42bf13a084849d..35fd7f57b091fb2094983ec93cd8499ee9315cc3 100644 (file)
--- a/gtk/gtk.lisp
+++ b/gtk/gtk.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.
 
-;; $Id: gtk.lisp,v 1.47 2005/11/15 10:08:13 espen Exp $
+;; $Id: gtk.lisp,v 1.54 2006/02/19 19:31:14 espen Exp $
 
 
 (in-package "GTK")
@@ -57,6 +57,11 @@ (defbinding (gtk-init "gtk_parse_args") () boolean
 
 (defun clg-init (&optional display)
   "Initializes the system and starts the event handling"
+  #+sbcl(when (and 
+              (find-package "SWANK")
+              (eq (symbol-value (find-symbol "*COMMUNICATION-STYLE*" "SWANK")) :spawn))
+         (error "When running clg in Slime the communication style :spawn can not be used. See the README file and <http://common-lisp.net/project/slime/doc/html/slime_45.html> for more information."))
+
   (unless (gdk:display-get-default)
     (gdk:gdk-init)
     (unless (gtk-init)
@@ -86,18 +91,18 @@ (defbinding get-default-language () (copy-of pango:language))
 
 #+gtk2.6
 (progn
-  (def-callback-marshal %about-dialog-activate-link-func 
-    (nil (dialog about-dialog) (link (copy-of string))))
+  (define-callback-marshal %about-dialog-activate-link-callback nil
+    (about-dialog (link string)))
 
   (defbinding about-dialog-set-email-hook (function) nil
-    ((callback %about-dialog-activate-link-func) pointer)
+    (%about-dialog-activate-link-callback callback)
     ((register-callback-function function) unsigned-int)
-    ((callback user-data-destroy-func) pointer))
+    (user-data-destroy-callback callback))
   
   (defbinding about-dialog-set-url-hook (function) nil
-    ((callback %about-dialog-activate-link-func) pointer)
+    (%about-dialog-activate-link-callback callback)
     ((register-callback-function function) unsigned-int)
-    ((callback user-data-destroy-func) pointer)))
+    (user-data-destroy-callback callback)))
 
 
 ;;; Acccel group
@@ -284,19 +289,17 @@ (defbinding accel-map-load () nil
 (defbinding accel-map-save () nil
   (filename pathname))
 
-(defcallback %accel-map-foreach-func 
-    (nil
-     (callback-id unsigned-int) (accel-path (copy-of string)) 
-     (key unsigned-int) (modifiers gdk:modifier-type) (changed boolean))
-  (invoke-callback callback-id nil accel-path key modifiers changed))
+(define-callback-marshal %accel-map-foreach-callback nil
+  ((accel-path string) (key unsigned-int) 
+   (modifiers gdk:modifier-type) (changed boolean)) :callback-id :first)
 
 (defbinding %accel-map-foreach (callback-id) nil
   (callback-id unsigned-int)
-  (%accel-map-foreach-func callback))
+  (%accel-map-foreach-callback callback))
 
 (defbinding %accel-map-foreach-unfiltered (callback-id) nil
   (callback-id unsigned-int)
-  (%accel-map-foreach-func callback))
+  (%accel-map-foreach-callback callback))
 
 (defun accel-map-foreach (function &optional (filter-p t))
   (with-callback-function (id function)
@@ -743,14 +746,14 @@ (defbinding entry-text-index-to-layout-index () int
 
 ;;; Entry Completion
 
-(def-callback-marshal %entry-completion-match-func
-    (boolean entry-completion string (copy-of tree-iter)))
+(define-callback-marshal %entry-completion-match-callback boolean 
+  (entry-completion string tree-iter))
 
 (defbinding entry-completion-set-match-func (completion function) nil
   (completion entry-completion)
-  ((callback %entry-completion-match-func) pointer)
+  (%entry-completion-match-callback callback)
   ((register-callback-function function) unsigned-int)
-  ((callback user-data-destroy-func) pointer))
+  (user-data-destroy-callback callback))
 
 (defbinding entry-completion-complete () nil
   (completion entry-completion))
@@ -887,14 +890,14 @@ (defbinding file-filter-add-pattern () nil
 (defbinding file-filter-add-pixbuf-formats () nil
   (filter file-filter))
 
-(def-callback-marshal %file-filter-func (boolean file-filter-info))
+(define-callback-marshal %file-filter-callback boolean (file-filter-info))
 
 (defbinding file-filter-add-custom (filter needed function) nil
   (filter file-filter)
   (needed file-filter-flags)
-  ((callback %file-filter-func) pointer)
+  (%file-filter-callback callback)
   ((register-callback-function function) unsigned-int)
-  ((callback user-data-destroy-func) pointer))
+  (user-data-destroy-callback callback))
 
 (defbinding file-filter-get-needed () file-filter-flags
   (filter file-filter))
@@ -1091,13 +1094,14 @@ (defbinding menu-tool-button-set-arrow-tooltip () nil
 
 ;;; Message dialog
 
-(defmethod initialize-instance ((dialog message-dialog)
-                               &key (message-type :info) (buttons :close)
-                               flags text #+gtk 2.6 secondary-text 
-                               transient-parent)
-  (setf 
-   (slot-value dialog 'location)
-   (%message-dialog-new transient-parent flags message-type buttons))
+(defmethod allocate-foreign ((dialog message-dialog) &key (message-type :info)
+                            (buttons :close) flags transient-parent)
+  (%message-dialog-new transient-parent flags message-type buttons))
+
+
+(defmethod shared-initialize ((dialog message-dialog) names
+                             &key text #+gtk 2.6 secondary-text)
+  (declare (ignore names))
   (when text
     (message-dialog-set-markup dialog text))
   #+gtk2.6
@@ -1366,7 +1370,7 @@ (defbinding window-get-frame-dimensions () nil
   (window window)
   (left int :out) (top int :out) (rigth int :out) (bottom int :out))
 
-(defbinding %window-get-icon-list () (glist gdk:pixbuf)
+(defbinding %window-get-icon-list () (glist (copy-of gdk:pixbuf))
   (window window))
 
 (defbinding window-get-position () nil
@@ -1772,13 +1776,14 @@ (defbinding menu-attach () nil
   (top-attach unsigned-int)
   (bottom-attach unsigned-int))
 
-(def-callback-marshal %menu-position-func (nil (menu menu) (x int) (y int) (push-in boolean)))
+(define-callback-marshal %menu-position-callback nil 
+  (menu (x int) (y int) (push-in boolean)))
 
 (defbinding %menu-popup () nil
   (menu menu)
   (parent-menu-shell (or null menu-shell))
   (parent-menu-item (or null menu-item))
-  (callback-func (or null pointer))
+  (callback (or null callback))
   (callback-id unsigned-int)
   (button unsigned-int)
   (activate-time (unsigned 32)))
@@ -1789,7 +1794,7 @@ (defun menu-popup (menu button activate-time &key callback parent-menu-shell
       (with-callback-function (id callback)
        (%menu-popup 
         menu parent-menu-shell parent-menu-item 
-        (callback %menu-position-func) id button activate-time))
+        %menu-position-callback id button activate-time))
     (%menu-popup
      menu parent-menu-shell parent-menu-item nil 0 button activate-time)))
  
@@ -1817,13 +1822,13 @@ (defun (setf menu-active) (menu child)
   (%menu-set-active menu (%menu-position menu child))
   child)
   
-(defcallback %menu-detach-func (nil (widget widget) (menu menu))
+(define-callback %menu-detach-callback nil ((widget widget) (menu menu))
   (funcall (object-data menu 'detach-func) widget menu))
 
 (defbinding %menu-attach-to-widget () nil
   (menu menu)
   (widget widget)
-  ((callback %menu-detach-func) pointer))
+  (%menu-detach-callback callback))
 
 (defun menu-attach-to-widget (menu widget function)
   (setf (object-data menu 'detach-func) function)
@@ -2231,7 +2236,7 @@ (defbinding %stock-lookup () boolean
 
 (defun stock-lookup (stock-id)
   (let ((location 
-        (allocate-memory (proxy-instance-size (find-class 'stock-item)))))
+        (allocate-memory (foreign-size (find-class 'stock-item)))))
     (unwind-protect
        (when (%stock-lookup stock-id location)
          (ensure-proxy-instance 'stock-item (%stock-item-copy location)))