X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/00485707ad4f321c6a3e73533ff397d549a0efbf..d07ed2eeb8c69fb4ee75247bb8f22660f0313e9f:/gtk/gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index ed1a2dc..11afe7e 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.84 2007-10-17 16:59:12 espen Exp $
+;; $Id: gtk.lisp,v 1.89 2008-01-11 14:44:28 espen Exp $
 
 
 (in-package "GTK")
@@ -103,7 +103,7 @@ (defun %init-async-event-handling (display)
     (when (and 
 	   (find-package "SWANK")
 	   (not (eq (symbol-value (find-symbol "*COMMUNICATION-STYLE*" "SWANK")) style)))
-      (error "When running clg in Slime, the communication style ~A must be used in combination with asynchronous event handling on this platform. See the README file and <http://common-lisp.net/project/slime/doc/html/slime_45.html> for more information." style)))
+      (error "When running clg in Slime, the communication style ~S must be used in combination with asynchronous event handling on this platform. See the README file and <http://common-lisp.net/project/slime/doc/html/slime_45.html> for more information." style)))
 
   #?(or (featurep :cmu) (sbcl< 1 0 6))
   (progn
@@ -129,15 +129,19 @@ (defun %init-async-event-handling (display)
   #?-(or (featurep :cmu) (sbcl< 1 0 6))
   ;; When running in Slime we need to hook into the Swank server
   ;; to handle events asynchronously.
-  (if (find-package "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 ()
-	     (loop
-	      (case (socket-status (cons stream :input) 0 *event-poll-interval*)
-		((:input :eof) (return (funcall read-from-emacs)))
-		(otherwise (main-iterate-all)))))))
+  (unless (and
+	   (find-package "SWANK")
+	   (let ((connection (symbol-value (find-symbol "*EMACS-CONNECTION*" "SWANK"))))
+	     (when connection
+	       (let ((read-from-emacs (symbol-function (find-symbol "READ-FROM-EMACS" "SWANK")))
+		     (stream (funcall (find-symbol "CONNECTION.SOCKET-IO" "SWANK") connection)))
+		 (setf (symbol-function (find-symbol "READ-FROM-EMACS" "SWANK"))
+		  #'(lambda ()
+		      (loop
+		       (case (socket-status (cons stream :input) 0 
+			      *event-poll-interval*)
+			 ((:input :eof) (return (funcall read-from-emacs)))
+			 (otherwise (main-iterate-all))))))))))
     #-(and clisp readline)
     (warn "Asynchronous event handling not supported on this platform. An explicit main loop has to be started."))
 
@@ -205,9 +209,12 @@   (defun %init-multi-threaded-event-handling (display)
     ;; We need to hook into the Swank server to protect calls to GDK properly.
     ;; This will *only* protect code entered directly in the REPL.
     (when (find-package "SWANK")
-      (push #'(lambda (form) 
- 		(within-main-loop (eval form)))
-       (symbol-value (find-symbol "*SLIME-REPL-EVAL-HOOKS*" "SWANK"))))))
+      (let ((repl-eval-hook (find-symbol "*SLIME-REPL-EVAL-HOOKS*" "SWANK")))
+	(if repl-eval-hook
+	    (push #'(lambda (form) 
+		      (within-main-loop (eval form)))
+	     (symbol-value (find-symbol "*SLIME-REPL-EVAL-HOOKS*" "SWANK")))
+	  (warn "Your version of Slime does not have *SLIME-REPL-EVAL-HOOKS* so all calls to Gtk+ functions have to be explicit protected by wrapping them in a WITHIN-MAIN-LOOP form"))))))
 
 #-sb-thread
 (defmacro within-main-loop (&body body)
@@ -703,10 +710,13 @@ (defbinding check-menu-item-toggled () nil
 
 ;;; Color selection
 
-(defbinding (color-selection-is-adjusting-p
-	     "gtk_color_selection_is_adjusting") () boolean
+(defbinding color-selection-is-adjusting-p () boolean
   (colorsel color-selection))
 
+(defbinding (color-selection-previous-color
+	     "gtk_color_selection_get_previous_color") () nil
+  (colorsel color-selection)
+  ((make-instance 'gdk:color) gdk:color :in/return))
 
 
 ;;; Color selection dialog -- no functions
@@ -876,6 +886,7 @@ (defun dialog-add-action-widget (dialog widget &optional (response widget)
     (when (functionp response)
        (signal-connect dialog signal response :object object :after after))
     (when default
+      (setf (widget-can-default-p widget) t)
       (%dialog-set-default-response dialog id))
     widget))
 
@@ -968,6 +979,10 @@ (defbinding entry-completion-set-match-func (completion function) nil
 (defbinding entry-completion-complete () nil
   (completion entry-completion))
 
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0")
+(defbinding entry-completion-get-completion-prefix () string
+  (completion entry-completion))
+
 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 (defbinding entry-completion-insert-prefix () nil
   (completion entry-completion))