From afuchs at common-lisp.net  Thu May 22 09:52:56 2008
From: afuchs at common-lisp.net (afuchs)
Date: Thu, 22 May 2008 05:52:56 -0400 (EDT)
Subject: [beirc-cvs] CVS beirc
Message-ID: <20080522095256.964C81B026@common-lisp.net>

Update of /project/beirc/cvsroot/beirc
In directory clnet:/tmp/cvs-serv9260

Modified Files:
	application.lisp 
Log Message:
Apply patch by Troels Henriksen to not handle events twice in some situations.


--- /project/beirc/cvsroot/beirc/application.lisp	2007/09/05 22:27:53	1.92
+++ /project/beirc/cvsroot/beirc/application.lisp	2008/05/22 09:52:56	1.93
@@ -1032,38 +1032,40 @@
   read-frame-command will handle it and save the input line."))
 
 #+mcclim
-(defmethod frame-input-context-button-press-handler :around ((frame beirc) stream event)
+(defmethod frame-input-context-button-press-handler ((frame beirc) stream event)
   "Unportable method for saving the current input buffer in case
 the user invokes a command while typing."
   (let* ((x (pointer-event-x event))
          (y (pointer-event-y event))
          (window (event-sheet event))
          (presentation (frame-find-innermost-applicable-presentation frame *input-context* stream x y :event event)))
-    (when presentation
-      (multiple-value-bind (p translator context)
-          (climi::find-innermost-presentation-match *input-context*
-                                                    presentation
-                                                    *application-frame*
-                                                    (event-sheet event)
-                                                    x y
-                                                    event
-                                                    0
-                                                    nil)
-        (when p
-          (multiple-value-bind (object ptype options)
-              (call-presentation-translator translator
-                                            p
-                                            (input-context-type context)
-                                            *application-frame*
-                                            event
-                                            window
-                                            x y)
-            (declare (ignore object options))
-            (when (and ptype (presentation-subtypep ptype 'command)
-                       (boundp 'climi::*current-input-stream*) climi::*current-input-stream*)
-              (restart-case (signal 'invoked-command-by-clicking)
-                (acknowledged ()))))))))
-  (call-next-method))
+    (if presentation
+        (multiple-value-bind (p translator context)
+            (climi::find-innermost-presentation-match *input-context*
+                                                      presentation
+                                                      *application-frame*
+                                                      (event-sheet event)
+                                                      x y
+                                                      event
+                                                      0
+                                                      nil)
+          (if p
+              (multiple-value-bind (object ptype options)
+                  (call-presentation-translator translator
+                                                p
+                                                (input-context-type context)
+                                                *application-frame*
+                                                event
+                                                window
+                                                x y)
+                (when ptype
+                  (when (and (presentation-subtypep ptype 'command)
+                             (boundp 'climi::*current-input-stream*) climi::*current-input-stream*)
+                    (restart-case (signal 'invoked-command-by-clicking)
+                      (acknowledged ())))
+                  (funcall (cdr context) object ptype event options)))
+              (call-next-method)))
+        (call-next-method))))
 
 (defmethod read-frame-command ((frame beirc) &key (stream *standard-input*))
   (let ((bad-input nil))
@@ -1108,14 +1110,15 @@
                                         (simple-completion-error (c)
                                           #+mcclim
                                           (let ((preliminary-line (save-input-line stream frame)))
-                                            (setf (incomplete-input (current-receiver frame))
-                                                  (subseq preliminary-line 0
-                                                          (search (climi::completion-error-input-so-far c)
-                                                                  preliminary-line))
-                                                  bad-input (subseq preliminary-line
-                                                                    (search (climi::completion-error-input-so-far c)
-                                                                            preliminary-line))
-                                                  force-restore-input-state t))
+                                            (when (current-receiver frame)
+                                             (setf (incomplete-input (current-receiver frame))
+                                                   (subseq preliminary-line 0
+                                                           (search (climi::completion-error-input-so-far c)
+                                                                   preliminary-line))
+                                                   bad-input (subseq preliminary-line
+                                                                     (search (climi::completion-error-input-so-far c)
+                                                                             preliminary-line))
+                                                   force-restore-input-state t)))
                                           (beep)
                                           nil)))
                                      (t