[mcclim-cvs] CVS mcclim
ahefner
ahefner at common-lisp.net
Wed Jun 3 20:33:16 UTC 2009
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 at 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 at 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
More information about the Mcclim-cvs
mailing list