Skip to content
Browse files

Handle selection-notify-events in the text gadget and input editor.

For communicating with the input editor, signal and handle a
selection-notify condition from the lower level event handler (I can't
think of a better approach to communicating across the layers). Disable
the old default of pasting by synthesizing keypress events, but make it
available via paste-as-keypress-mixin.
  • Loading branch information...
1 parent 9c3be6f commit 7af7d656cac2f10e65d625b079c89783966a5487 Andy Hefner committed
Showing with 66 additions and 40 deletions.
  1. +20 −7 Drei/drei-clim.lisp
  2. +7 −0 Drei/input-editor.lisp
  3. +11 −11 panes.lisp
  4. +4 −1 regions.lisp
  5. +24 −21 text-selection.lisp
View
27 Drei/drei-clim.lisp
@@ -292,6 +292,15 @@ corresponds to a useful gesture that should be handled. A useful
gesture is, for example, one that is not simply a click on a
modifier key."))
+(defun propagate-changed-value (drei)
+ (when (modified-p (view drei))
+ (when (gadget-value-changed-callback drei)
+ (value-changed-callback drei
+ (gadget-client drei)
+ (gadget-id drei)
+ (gadget-value drei)))
+ (setf (modified-p (view drei)) nil)))
+
(defmethod handle-gesture ((drei drei-gadget-pane) gesture)
(let ((*command-processor* drei)
(*abort-gestures* *esa-abort-gestures*)
@@ -303,13 +312,7 @@ modifier key."))
(abort-gesture ()
(display-message "Aborted")))
(display-drei drei :redisplay-minibuffer t)
- (when (modified-p (view drei))
- (when (gadget-value-changed-callback drei)
- (value-changed-callback drei
- (gadget-client drei)
- (gadget-id drei)
- (gadget-value drei)))
- (setf (modified-p (view drei)) nil)))))
+ (propagate-changed-value drei))))
;;; This is the method that functions as the entry point for all Drei
;;; gadget logic.
@@ -321,6 +324,16 @@ modifier key."))
(with-bound-drei-special-variables (gadget :prompt (format nil "~A " (gesture-name gesture)))
(handle-gesture gadget gesture)))))))
+(defmethod handle-event ((gadget drei-gadget-pane)
+ (event clim-backend:selection-notify-event))
+ ;; Cargo-culted from above:
+ (unless (and (currently-processing-p gadget) (directly-processing-p gadget))
+ (letf (((currently-processing-p gadget) t))
+ (insert-sequence (point (view gadget))
+ (clim-backend:get-selection-from-event (port gadget) event))
+ (display-drei gadget :redisplay-minibuffer t)
+ (propagate-changed-value gadget))))
+
(defmethod handle-event :before
((gadget drei-gadget-pane) (event pointer-button-press-event))
(let ((previous (stream-set-input-focus gadget)))
View
7 Drei/input-editor.lisp
@@ -586,6 +586,13 @@ if stuff is inserted after the insertion pointer."
finally (return 0))
t t)
(handler-case (process-gestures-or-command drei)
+ (climi::selection-notify (c)
+ (let* ((event (climi::event-of c))
+ (sheet (event-sheet event))
+ (port (port sheet)))
+ (when (eq *standard-input* sheet)
+ (insert-sequence (point (view drei))
+ (clim-backend:get-selection-from-event port event)))))
(unbound-gesture-sequence (c)
(display-message "~A is unbound" (gesture-name (gestures c))))
(abort-gesture (c)
View
22 panes.lisp
@@ -27,7 +27,7 @@
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
-;;; $Id: panes.lisp,v 1.194 2008/12/19 08:58:14 ahefner Exp $
+;;; $Id: panes.lisp,v 1.195 2009/06/03 20:33:16 ahefner Exp $
(in-package :clim-internals)
@@ -2597,7 +2597,7 @@ to computed distance to scroll in response to mouse wheel events."))
(setf (cursor-position cursor) (values 0 0))))
(scroll-extent pane 0 0)
(change-space-requirements pane :width 0 :height 0))
-
+
(defmethod window-refresh ((pane clim-stream-pane))
(with-bounding-rectangle* (x1 y1 x2 y2) (sheet-region pane)
@@ -2684,9 +2684,9 @@ to computed distance to scroll in response to mouse wheel events."))
;;; INTERACTOR PANES
-(defclass interactor-pane (clim-stream-pane
- cut-and-paste-mixin
- mouse-wheel-scroll-mixin)
+(defclass interactor-pane (cut-and-paste-mixin
+ mouse-wheel-scroll-mixin
+ clim-stream-pane)
()
(:default-initargs :display-time nil
:end-of-line-action :scroll
@@ -2714,9 +2714,9 @@ to computed distance to scroll in response to mouse wheel events."))
;;; APPLICATION PANES
-(defclass application-pane (clim-stream-pane
- cut-and-paste-mixin
- mouse-wheel-scroll-mixin)
+(defclass application-pane (cut-and-paste-mixin
+ mouse-wheel-scroll-mixin
+ clim-stream-pane)
()
(:default-initargs :display-time :command-loop
:scroll-bars t))
@@ -2838,9 +2838,9 @@ current background message was set."))
;;; 29.4.5 Creating a Standalone CLIM Window
-(defclass window-stream (clim-stream-pane
- cut-and-paste-mixin
- mouse-wheel-scroll-mixin)
+(defclass window-stream (cut-and-paste-mixin
+ mouse-wheel-scroll-mixin
+ clim-stream-pane)
())
(defmethod close ((stream window-stream)
View
5 regions.lisp
@@ -4,7 +4,7 @@
;;; Created: 1998-12-02 19:26
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LGPL (See file COPYING for details).
-;;; $Id: regions.lisp,v 1.38 2008/01/23 22:37:08 thenriksen Exp $
+;;; $Id: regions.lisp,v 1.39 2009/06/03 20:33:16 ahefner Exp $
;;; --------------------------------------------------------------------------------------
;;; (c) copyright 1998,1999,2001 by Gilbert Baumann
;;; (c) copyright 2001 by Arnaud Rouanet (rouanet@emi.u-bordeaux.fr)
@@ -89,6 +89,9 @@
(defvar +everywhere+ (make-instance 'everywhere-region))
(defvar +nowhere+ (make-instance 'nowhere-region))
+(defmethod bounding-rectangle* ((x nowhere-region))
+ (values 0 0 0 0))
+
;; 2.5.1.1 Region Predicates in CLIM
(defgeneric region-equal (region1 region2))
View
45 text-selection.lisp
@@ -60,7 +60,7 @@
"Background ink to use for marked stuff.")
-;;;; Text Selection "Protocol"
+;;;; Text Selection Protocol
(defgeneric release-selection (port &optional time)
(:documentation "Relinquish ownership of the selection."))
@@ -153,7 +153,12 @@ the incoming selection."))
(point-1-y :initform nil)
(point-2-x :initform nil)
(point-2-y :initform nil)
- (dragging-p :initform nil) ))
+ (dragging-p :initform nil)))
+
+(defclass paste-as-keypress-mixin ()
+ ()
+ (:documentation "Implements the old McCLIM behavior of pasting via a
+ sequence of key press events. You couldn't possibly want this."))
(defmethod handle-repaint :around ((pane cut-and-paste-mixin) region)
(with-slots (markings) pane
@@ -174,29 +179,23 @@ the incoming selection."))
((medium-background medium) *marked-background*))
(call-next-method pane R))))))))))
-
-(defmethod bounding-rectangle* ((x (eql +nowhere+)))
- (values 0 0 0 0))
-
-
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane cut-and-paste-mixin)
(event pointer-button-press-event))
(if (eql (event-modifier-state event) +shift-key+)
(eos/shift-click pane event)
(call-next-method)))
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane cut-and-paste-mixin)
(event pointer-button-release-event))
(if (eql (event-modifier-state event) +shift-key+)
(eos/shift-release pane event)
(call-next-method)))
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane cut-and-paste-mixin)
(event pointer-motion-event))
(with-slots (point-1-x dragging-p) pane
(if (and (eql (event-modifier-state event) +shift-key+))
- (when dragging-p
- (eos/shift-drag pane event))
+ (when dragging-p (eos/shift-drag pane event))
(call-next-method))))
@@ -283,7 +282,7 @@ the incoming selection."))
(rotatef bx1 bx2))
(let ((*lines* nil)
(*all-lines* nil))
- (map-over-text record ;(stream-output-history stream)
+ (map-over-text record
(lambda (x y string ts record full-record)
(let ((q (assoc y *lines*)))
(unless q
@@ -311,7 +310,6 @@ the incoming selection."))
(let ((start-i 0)
(start-record (fifth (cadar *lines*)))
(end-i 0)
- ; end-record
(end-record (fifth (cadar (last *lines*)))))
(loop for chunk in (cdr (first *lines*)) do
@@ -323,8 +321,10 @@ the incoming selection."))
(setf start-i i
start-record record)))))
- ;; Finally in the last line find the index farthest to the left which still is greater than bx2.
- ;; Or put differently: Search from the left and while we are still in bounds maintain end-i and end-record.
+ ;; Finally in the last line find the index farthest to the left
+ ;; which still is greater than bx2. Or put differently: Search
+ ;; from the left and while we are still in bounds maintain end-i
+ ;; and end-record.
(loop for chunk in (cdr (car (last *lines*))) do
(destructuring-bind (x y string ts record full-record) chunk
(declare (ignorable x y string ts record full-record))
@@ -375,21 +375,24 @@ the incoming selection."))
;;;; Selections Events
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane cut-and-paste-mixin)
(event selection-clear-event))
(pane-clear-markings pane (event-timestamp event)))
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane cut-and-paste-mixin)
(event selection-request-event))
(send-selection (port pane) event (fetch-selection pane)))
+(define-condition selection-notify ()
+ ((event :reader event-of :initarg :event)))
+(defmethod handle-event ((pane cut-and-paste-mixin)
+ (event selection-notify-event))
+ (signal 'selection-notify :event event))
-(defmethod dispatch-event :around ((pane cut-and-paste-mixin #|extended-output-stream|#)
+(defmethod dispatch-event :around ((pane paste-as-keypress-mixin)
(event selection-notify-event))
(let ((matter (get-selection-from-event (port pane) event)))
- #+NIL
- (format *trace-output* "Got ~S.~%" matter)
(loop for c across matter do
(dispatch-event pane
(make-instance 'key-press-event

0 comments on commit 7af7d65

Please sign in to comment.
Something went wrong with that request. Please try again.