From: espen Date: Wed, 13 Sep 2006 10:54:49 +0000 (+0000) Subject: Changes to the init functions X-Git-Tag: clg-0-93~243 X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/commitdiff_plain/92afacae4374e695b1cbcddab5f124496d7a9a88 Changes to the init functions --- diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index a9d333e..abae2e3 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.64 2006/06/30 10:57:21 espen Exp $ +;; $Id: gtk.lisp,v 1.65 2006/09/13 10:54:49 espen Exp $ (in-package "GTK") @@ -65,6 +65,11 @@ (defun clg-init (&optional display) (error "When running clg in Slime the communication style :spawn can not be used. See the README file and for more information.")) (unless (gdk:display-get-default) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") + (progn + #+sbcl(sb-int:set-floating-point-modes :traps nil) + #+cmu(ext:set-floating-point-modes :traps nil)) + (gdk:gdk-init) (unless (gtk-init) (error "Initialization of GTK+ failed.")) @@ -82,20 +87,27 @@ (defun clg-init (&optional display) #+clisp ;; When running in Slime we need to hook into the Swank server ;; to handle events asynchronously - (if (find-symbol "WAIT-UNTIL-READABLE" "SWANK") - (setf (symbol-function 'swank::wait-until-readable) - #'(lambda (stream) - (loop - (case (socket:socket-status (cons stream :input) 0 *event-poll-interval*) - (:input (return t)) - (:eof (read-char stream)) - (otherwise (main-iterate-all)))))) + (if (find-package "SWANK") + (let ((read-from-emacs (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:socket-status (cons stream :input) 0 *event-poll-interval*) + (:input (return (funcall read-from-emacs))) + (:eof (read-char stream)) + (otherwise (main-iterate-all))))))) #-readline(warn "Not running in Slime and Readline support is missing, so the Gtk main loop has to be invoked explicit."))))) #+sbcl (defun clg-init-with-threading (&optional display) "Initializes the system and starts the event handling" (unless (gdk:display-get-default) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") + (progn + #+sbcl(sb-int:set-floating-point-modes :traps nil) + #+cmu(ext:set-floating-point-modes :traps nil)) + (gdk:gdk-init) (gdk:threads-set-lock-functions) (unless (gtk-init)