X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/e69138cc4765ff17951dc3166c5ca3bcac57368c..f84e7a8ef0f8b855decb2160a8c4c5c5f20a410e:/gtk/gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index 2b117e5..35fd7f5 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.44 2005/04/25 18:20:00 espen Exp $
+;; $Id: gtk.lisp,v 1.54 2006/02/19 19:31:14 espen Exp $
 
 
 (in-package "GTK")
@@ -45,7 +45,7 @@
       (format nil "Gtk+ v~A.~A.~A" major minor micro))))
 
 (defun clg-version ()
-  "clg CVS version")
+  "clg 0.91 version")
 
 
 ;;;; Initalization
@@ -57,6 +57,11 @@
 
 (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 @@
 
 #+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-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)
@@ -701,6 +704,16 @@
 	new-order) (vector int)))
 
 
+#+gtk2.8
+(progn
+  (defbinding %dialog-get-response-for-widget () int
+    (dialog dialog)
+    (widget widget))
+
+  (defun dialog-get-response-for-widget (dialog widget)
+    (dialog-find-response dialog (dialog-get-response-for-widget dialog widget))))
+
+
 (defmethod container-add ((dialog dialog) (child widget) &rest args)
   (apply #'container-add (dialog-vbox dialog) child args))
 
@@ -733,14 +746,14 @@
 
 ;;; 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))
@@ -877,14 +890,14 @@
 (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))
@@ -925,6 +938,11 @@
     ((or list vector) (make-instance 'image :pixmap source))
     (gdk:pixmap (make-instance 'image :pixmap source :mask mask))))
 
+#+gtk2.8
+(defbinding image-clear () nil
+  (image image))
+
+
 
 ;;; Image menu item
 
@@ -1076,13 +1094,14 @@
 
 ;;; 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
@@ -1270,9 +1289,24 @@
   (window window)
   (event gdk:key-event))
 
+#-gtk2.8
 (defbinding window-present () nil
   (window window))
 
+#+gtk2.8
+(progn
+  (defbinding %window-present () nil
+    (window window))
+
+  (defbinding %window-present-with-time () nil
+    (window window)
+    (timespamp unsigned-int))
+
+  (defun window-present (window &optional timestamp)
+    (if timestamp
+	(%window-present-with-time window timestamp)
+      (%window-present window))))
+
 (defbinding window-iconify () nil
   (window window))
 
@@ -1336,7 +1370,7 @@
   (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
@@ -1556,7 +1590,7 @@
 (defbinding notebook-reorder-child (notebook child position) nil
   (notebook notebook)
   (child widget)
-  ((%notebook-position notebook position) int))
+  ((%ensure-notebook-position notebook position) int))
 
 (defbinding notebook-popup-enable () nil
   (notebook notebook))
@@ -1623,7 +1657,7 @@
 
 (defbinding notebook-query-tab-label-packing (notebook page) nil
   (notebook notebook)
-  ((%notebook-child notebook page) widget)
+  ((%ensure-notebook-child notebook page) widget)
   (expand boolean :out)
   (fill boolean :out)
   (pack-type pack-type :out))
@@ -1631,7 +1665,7 @@
 (defbinding notebook-set-tab-label-packing
     (notebook page expand fill pack-type) nil
   (notebook notebook)
-  ((%notebook-child notebook page) widget)
+  ((%ensure-notebook-child notebook page) widget)
   (expand boolean)
   (fill boolean)
   (pack-type pack-type))
@@ -1742,13 +1776,14 @@
   (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)))
@@ -1759,7 +1794,7 @@
       (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)))
  
@@ -1787,13 +1822,13 @@
   (%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)
@@ -2201,7 +2236,7 @@
 
 (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)))