Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv19226
Modified Files: panes.lisp regions.lisp text-selection.lisp Log Message: 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.
--- /project/mcclim/cvsroot/mcclim/panes.lisp 2008/12/19 08:58:14 1.194 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2009/06/03 20:33:16 1.195 @@ -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 @@ (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 @@
;;; 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 @@
;;; 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 @@
;;; 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) --- /project/mcclim/cvsroot/mcclim/regions.lisp 2008/01/23 22:37:08 1.38 +++ /project/mcclim/cvsroot/mcclim/regions.lisp 2009/06/03 20:33:16 1.39 @@ -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)) --- /project/mcclim/cvsroot/mcclim/text-selection.lisp 2005/11/28 13:04:55 1.7 +++ /project/mcclim/cvsroot/mcclim/text-selection.lisp 2009/06/03 20:33:16 1.8 @@ -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 @@ (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 @@ ((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 @@ (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 @@ (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 @@ (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 @@
;;;; 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
-
ahefner