Mercurial > emacs
changeset 65640:906677409870
(mouse-move-drag-overlay): New function.
(mouse-drag-region-1): Use it.
Try to simplify a bit the state handling. Handle clicks on links
inside intangible areas.
(mouse-save-then-kill): Minor simplification.
(mouse-secondary-overlay): Make it always non-nil instead of
recreating it each time.
(mouse-start-secondary, mouse-set-secondary, mouse-drag-secondary)
(mouse-kill-secondary, mouse-secondary-save-then-kill):
Simplify accordingly.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Wed, 21 Sep 2005 20:24:00 +0000 |
| parents | f552d54d9430 |
| children | b10c339a6f5a |
| files | lisp/mouse.el |
| diffstat | 1 files changed, 144 insertions(+), 149 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mouse.el Wed Sep 21 18:53:07 2005 +0000 +++ b/lisp/mouse.el Wed Sep 21 20:24:00 2005 +0000 @@ -743,9 +743,11 @@ (goto-char opoint)))) ;; Create an overlay and immediately delete it, to get "overlay in no buffer". -(defvar mouse-drag-overlay (make-overlay 1 1)) -(delete-overlay mouse-drag-overlay) -(overlay-put mouse-drag-overlay 'face 'region) +(defconst mouse-drag-overlay + (let ((ol (make-overlay (point-min) (point-min)))) + (delete-overlay ol) + (overlay-put ol 'face 'region) + ol)) (defvar mouse-selection-click-count 0) @@ -856,9 +858,29 @@ "mouse-1" (substring msg 7))))))) msg) +(defun mouse-move-drag-overlay (ol start end mode) + (unless (= start end) + ;; Go to START first, so that when we move to END, if it's in the middle + ;; of intangible text, point jumps in the direction away from START. + ;; Don't do it if START=END otherwise a single click risks selecting + ;; a region if it's on intangible text. This exception was originally + ;; only applied on entry to mouse-drag-region, which had the problem + ;; that a tiny move during a single-click would cause the intangible + ;; text to be selected. + (goto-char start) + (goto-char end)) + (let ((range (mouse-start-end start (point) mode))) + (move-overlay ol (car range) (nth 1 range)))) + (defun mouse-drag-region-1 (start-event) (mouse-minibuffer-check start-event) - (let* ((echo-keystrokes 0) + (setq mouse-selection-click-count-buffer (current-buffer)) + (let* ((original-window (selected-window)) + ;; We've recorded what we needed from the current buffer and + ;; window, now let's jump to the place of the event, where things + ;; are happening. + (_ (mouse-set-point start-event)) + (echo-keystrokes 0) (start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) @@ -873,36 +895,34 @@ (1- (nth 3 bounds)))) (on-link (and mouse-1-click-follows-link (or mouse-1-click-in-non-selected-windows - (eq start-window (selected-window))))) - remap-double-click - (click-count (1- (event-click-count start-event)))) + (eq start-window original-window)) + ;; Use start-point before the intangibility + ;; treatment, in case we click on a link inside an + ;; intangible text. + (mouse-on-link-p start-point))) + (click-count (1- (event-click-count start-event))) + (remap-double-click (and on-link + (eq mouse-1-click-follows-link 'double) + (= click-count 1)))) (setq mouse-selection-click-count click-count) - (setq mouse-selection-click-count-buffer (current-buffer)) - (mouse-set-point start-event) ;; In case the down click is in the middle of some intangible text, ;; use the end of that text, and put it in START-POINT. (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) - (setq on-link (and on-link - (mouse-on-link-p start-point))) - (setq remap-double-click (and on-link - (eq mouse-1-click-follows-link 'double) - (= click-count 1))) - (if remap-double-click ;; Don't expand mouse overlay in links + (if remap-double-click ;; Don't expand mouse overlay in links (setq click-count 0)) - (let ((range (mouse-start-end start-point start-point click-count))) - (move-overlay mouse-drag-overlay (car range) (nth 1 range) - (window-buffer start-window)) - (overlay-put mouse-drag-overlay 'window (selected-window))) + (mouse-move-drag-overlay mouse-drag-overlay start-point start-point + click-count) + (overlay-put mouse-drag-overlay 'window start-window) (deactivate-mark) (let (event end end-point last-end-point) (track-mouse (while (progn (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (if (memq (car-safe event) '(switch-frame select-window)) + (or (mouse-movement-p event) + (memq (car-safe event) '(switch-frame select-window)))) + (if (memq (car-safe event) '(switch-frame select-window)) nil (setq end (event-end event) end-point (posn-point end)) @@ -913,45 +933,33 @@ ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (let ((range (mouse-start-end start-point (point) click-count))) - (move-overlay mouse-drag-overlay (car range) (nth 1 range)))) + (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count)) (t (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - mouse-drag-overlay start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - mouse-drag-overlay start-point))))))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + mouse-drag-overlay start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + mouse-drag-overlay start-point))))))))) ;; In case we did not get a mouse-motion event ;; for the final move of the mouse before a drag event ;; pretend that we did get one. (when (and (memq 'drag (event-modifiers (car-safe event))) - (setq end (event-end event) + (setq end (event-end event) end-point (posn-point end)) (eq (posn-window end) start-window) (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (let ((range (mouse-start-end start-point (point) click-count))) - (move-overlay mouse-drag-overlay (car range) (nth 1 range)))) + (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count)) (if (consp event) (let ((fun (key-binding (vector (car event))))) - ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, + ;; Run the binding of the terminating up-event, if possible. + ;; In the case of a multiple click, it gives the wrong results, ;; because it would fail to set up a region. (if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) @@ -962,74 +970,75 @@ ;; The end that comes from where we ended the drag. ;; Point goes here. (region-termination - (if (and stop-point (< stop-point start-point)) - (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay))) - ;; The end that comes from where we started the drag. - ;; Mark goes there. - (region-commencement - (- (+ (overlay-end mouse-drag-overlay) - (overlay-start mouse-drag-overlay)) - region-termination)) - last-command this-command) - (push-mark region-commencement t t) - (goto-char region-termination) - ;; Don't let copy-region-as-kill set deactivate-mark. - (when mouse-drag-copy-region - (let (deactivate-mark) - (copy-region-as-kill (point) (mark t)))) - (let ((buffer (current-buffer))) - (mouse-show-mark) - ;; mouse-show-mark can call read-event, - ;; and that means the Emacs server could switch buffers - ;; under us. If that happened, - ;; avoid trying to use the region. - (and (mark t) mark-active - (eq buffer (current-buffer)) - (mouse-set-region-1)))) - (delete-overlay mouse-drag-overlay) - ;; Run the binding of the terminating up-event. - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the - ;; window start changed in a redisplay after - ;; the mouse-set-point for the down-mouse - ;; event at the beginning of this function. - ;; When the window start has changed, the - ;; up-mouse event will contain a different - ;; position due to the new window contents, - ;; and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (if (and on-link - (or (not end-point) (= end-point start-point)) - (consp event) - (or remap-double-click - (and - (not (eq mouse-1-click-follows-link 'double)) - (= click-count 0) - (= (event-click-count event) 1) - (not (input-pending-p)) - (or (not (integerp mouse-1-click-follows-link)) - (let ((t0 (posn-timestamp (event-start start-event))) - (t1 (posn-timestamp (event-end event)))) - (and (integerp t0) (integerp t1) - (if (> mouse-1-click-follows-link 0) - (<= (- t1 t0) mouse-1-click-follows-link) - (< (- t0 t1) mouse-1-click-follows-link))))) - (or (not double-click-time) - (sit-for 0 (if (integerp double-click-time) - double-click-time 500) t))))) + (if (and stop-point (< stop-point start-point)) + (overlay-start mouse-drag-overlay) + (overlay-end mouse-drag-overlay))) + ;; The end that comes from where we started the drag. + ;; Mark goes there. + (region-commencement + (- (+ (overlay-end mouse-drag-overlay) + (overlay-start mouse-drag-overlay)) + region-termination)) + last-command this-command) + (push-mark region-commencement t t) + (goto-char region-termination) + ;; Don't let copy-region-as-kill set deactivate-mark. + (when mouse-drag-copy-region + (let (deactivate-mark) + (copy-region-as-kill (point) (mark t)))) + (let ((buffer (current-buffer))) + (mouse-show-mark) + ;; mouse-show-mark can call read-event, + ;; and that means the Emacs server could switch buffers + ;; under us. If that happened, + ;; avoid trying to use the region. + (and (mark t) mark-active + (eq buffer (current-buffer)) + (mouse-set-region-1)))) + (delete-overlay mouse-drag-overlay) + ;; Run the binding of the terminating up-event. + (when (and (functionp fun) + (= start-hscroll (window-hscroll start-window)) + ;; Don't run the up-event handler if the + ;; window start changed in a redisplay after + ;; the mouse-set-point for the down-mouse + ;; event at the beginning of this function. + ;; When the window start has changed, the + ;; up-mouse event will contain a different + ;; position due to the new window contents, + ;; and point is set again. + (or end-point + (= (window-start start-window) + start-window-start))) + (if (and on-link + (or (not end-point) (= end-point start-point)) + (consp event) + (or remap-double-click + (and + (not (eq mouse-1-click-follows-link 'double)) + (= click-count 0) + (= (event-click-count event) 1) + (not (input-pending-p)) + (or (not (integerp mouse-1-click-follows-link)) + (let ((t0 (posn-timestamp (event-start start-event))) + (t1 (posn-timestamp (event-end event)))) + (and (integerp t0) (integerp t1) + (if (> mouse-1-click-follows-link 0) + (<= (- t1 t0) mouse-1-click-follows-link) + (< (- t0 t1) mouse-1-click-follows-link))))) + (or (not double-click-time) + (sit-for 0 (if (integerp double-click-time) + double-click-time 500) t))))) (if (or (vectorp on-link) (stringp on-link)) (setq event (aref on-link 0)) (setcar event 'mouse-2))) - (setq unread-command-events - (cons event unread-command-events))))) + (push event unread-command-events)))) + + ;; Case where the end-event is not a cons cell (it's just a boring + ;; char-key-press). (delete-overlay mouse-drag-overlay))))) ;; Commands to handle xterm-style multiple clicks. - (defun mouse-skip-word (dir) "Skip over word, over whitespace, or over identical punctuation. If DIR is positive skip forward; if negative, skip backward." @@ -1338,8 +1347,8 @@ ;; Don't let a subsequent kill command append to this one: ;; prevent setting this-command to kill-region. (this-command this-command)) - (if (and (save-excursion - (set-buffer (window-buffer (posn-window (event-start click)))) + (if (and (with-current-buffer + (window-buffer (posn-window (event-start click))) (and (mark t) (> (mod mouse-selection-click-count 3) 0) ;; Don't be fooled by a recent click in some other buffer. (eq mouse-selection-click-count-buffer @@ -1402,15 +1411,14 @@ (goto-char new) (set-mark new)) (setq deactivate-mark nil))) - (kill-new (buffer-substring (point) (mark t)) t) - (mouse-show-mark)) + (kill-new (buffer-substring (point) (mark t)) t)) ;; Set the mark where point is, then move where clicked. (mouse-set-mark-fast click) (if before-scroll (goto-char before-scroll)) - (exchange-point-and-mark) - (kill-new (buffer-substring (point) (mark t))) - (mouse-show-mark)) + (exchange-point-and-mark) ;Why??? --Stef + (kill-new (buffer-substring (point) (mark t)))) + (mouse-show-mark) (mouse-set-region-1) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn))))))) @@ -1421,10 +1429,13 @@ (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill) (global-set-key [M-mouse-2] 'mouse-yank-secondary) -;; An overlay which records the current secondary selection -;; or else is deleted when there is no secondary selection. -;; May be nil. -(defvar mouse-secondary-overlay nil) +(defconst mouse-secondary-overlay + (let ((ol (make-overlay (point-min) (point-min)))) + (delete-overlay ol) + (overlay-put ol 'face 'secondary-selection) + ol) + "An overlay which records the current secondary selection. +It is deleted when there is no secondary selection.") (defvar mouse-secondary-click-count 0) @@ -1439,11 +1450,9 @@ (interactive "e") (mouse-minibuffer-check click) (let ((posn (event-start click))) - (save-excursion - (set-buffer (window-buffer (posn-window posn))) + (with-current-buffer (window-buffer (posn-window posn)) ;; Cancel any preexisting secondary selection. - (if mouse-secondary-overlay - (delete-overlay mouse-secondary-overlay)) + (delete-overlay mouse-secondary-overlay) (if (numberp (posn-point posn)) (progn (or mouse-secondary-start @@ -1458,14 +1467,10 @@ (let ((posn (event-start click)) beg (end (event-end click))) - (save-excursion - (set-buffer (window-buffer (posn-window posn))) + (with-current-buffer (window-buffer (posn-window posn)) (if (numberp (posn-point posn)) (setq beg (posn-point posn))) - (if mouse-secondary-overlay - (move-overlay mouse-secondary-overlay beg (posn-point end)) - (setq mouse-secondary-overlay (make-overlay beg (posn-point end)))) - (overlay-put mouse-secondary-overlay 'face 'secondary-selection)))) + (move-overlay mouse-secondary-overlay beg (posn-point end))))) (defun mouse-drag-secondary (start-event) "Set the secondary selection to the text that the mouse is dragged over. @@ -1485,20 +1490,16 @@ ;; Don't count the mode line. (1- (nth 3 bounds)))) (click-count (1- (event-click-count start-event)))) - (save-excursion - (set-buffer (window-buffer start-window)) + (with-current-buffer (window-buffer start-window) (setq mouse-secondary-click-count click-count) - (or mouse-secondary-overlay - (setq mouse-secondary-overlay - (make-overlay (point) (point)))) - (overlay-put mouse-secondary-overlay 'face 'secondary-selection) (if (> (mod click-count 3) 0) ;; Double or triple press: make an initial selection ;; of one word or line. (let ((range (mouse-start-end start-point start-point click-count))) (set-marker mouse-secondary-start nil) - (move-overlay mouse-secondary-overlay 1 1 - (window-buffer start-window)) + ;; Why the double move? --Stef + ;; (move-overlay mouse-secondary-overlay 1 1 + ;; (window-buffer start-window)) (move-overlay mouse-secondary-overlay (car range) (nth 1 range) (window-buffer start-window))) ;; Single-press: cancel any preexisting secondary selection. @@ -1583,13 +1584,12 @@ (current-buffer))) (error "Select or click on the buffer where the secondary selection is"))) (let (this-command) - (save-excursion - (set-buffer (overlay-buffer mouse-secondary-overlay)) + (with-current-buffer (overlay-buffer mouse-secondary-overlay) (kill-region (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))) (delete-overlay mouse-secondary-overlay) ;;; (x-set-selection 'SECONDARY nil) - (setq mouse-secondary-overlay nil)) + ) (defun mouse-secondary-save-then-kill (click) "Save text to point in kill ring; the second time, kill the text. @@ -1612,13 +1612,11 @@ ;; prevent setting this-command to kill-region. (this-command this-command)) (or (eq (window-buffer (posn-window posn)) - (or (and mouse-secondary-overlay - (overlay-buffer mouse-secondary-overlay)) + (or (overlay-buffer mouse-secondary-overlay) (if mouse-secondary-start (marker-buffer mouse-secondary-start)))) (error "Wrong buffer")) - (save-excursion - (set-buffer (window-buffer (posn-window posn))) + (with-current-buffer (window-buffer (posn-window posn)) (if (> (mod mouse-secondary-click-count 3) 0) (if (not (and (eq last-command 'mouse-secondary-save-then-kill) (equal click-posn @@ -1697,10 +1695,7 @@ ;; so put the other end here. (let ((start (+ 0 mouse-secondary-start))) (kill-ring-save start click-posn) - (if mouse-secondary-overlay - (move-overlay mouse-secondary-overlay start click-posn) - (setq mouse-secondary-overlay (make-overlay start click-posn))) - (overlay-put mouse-secondary-overlay 'face 'secondary-selection)))) + (move-overlay mouse-secondary-overlay start click-posn)))) (setq mouse-save-then-kill-posn (list (car kill-ring) (point) click-posn)))) (if (overlay-buffer mouse-secondary-overlay)