X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/b049d554bf8ce408641df9a48ad012706905a900..79c7839653d89bae3d5d7ef490ef32dd5d248b30:/gtk/gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index bf7c8cd..5ba1626 100644
--- 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.49 2006-02-06 19:16:17 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
@@ -1457,9 +1461,6 @@ (defbinding decorated-window-move-resize-window () nil
   (width int)
   (heigth int))
 
-(defbinding %window-get-icon-list () (glist (copy-of gdk:pixbuf))
-  (window window))
-
 
 ;;; Window group
 
@@ -1775,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)))
@@ -1792,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)))
  
@@ -1820,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)