[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Thu May 22 09:52:56 UTC 2008
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
More information about the Beirc-cvs
mailing list