mouse.el patch to flash yank position and highlight line

[Drew Adams]

The mouse.el patch below adds a couple commands:

* `mouse-flash-position' highlights the character under the mouse pointer.

* `mouse-scan-lines' highlights the line at the mouse position.

This highlighting remains, even as you drag. These are to be bound to mouse
`down' events; the end of dragging (at the `up' event) removes the
highlighting.

The idea behind `mouse-flash-position' is to help make it clear exactly
where a `yank' will occur when you use `mouse-2'.  When you press `mouse-2'
(i.e. `down-mouse-2'), if the highlighted position is not exactly what you
want, just keep `mouse-2' held while you move to the right location. The
yank is bound to `mouse-2' (the up event), so the only difference you see is
a brief indication of the position, while the button is depressed.

The idea behind `mouse-scan-lines' is to help you visually align entries
that are in the same row (line), in buffers such as Dired that use tabular
data (tables with columns). Just hold Shift with `mouse-2' and drag over
table rows - the row under the mouse stays highlighted. This needs nothing
built into the buffer (e.g. Dired); it is always available.

There are versions of these commands that have enhanced behavior in the echo
area, where yanking is impossible anyway:

* `mouse-flash-position-or-M-x' - `mouse-flash-position', except same as
`M-x' if in echo area.

*  `mouse-scan-lines-or-M-:' - `mouse-scan-lines', except same as `M-:' if
in echo area.

This means that you can click `mouse-2' in the echo area to get the `M-x'
prompt, and `S-mouse-2' to get the `M-:' prompt. This does not interfere
with standard behavior, because the echo area is read-only (currently,
`mouse-2' there just says that the minibuffer is not active).

The patch also makes these changes:

* A fix to `mouse-yank-secondary', so you get a reasonable error message if
the secondary selection is not yet defined (instead of "Wrong type argument:
char-or-string-p, nil").

* `mouse-tear-off-window' does not try to delete the window if it is the
only one in its frame. Instead, it clones the frame and window. That is, it
does a "tear-off" at the frame level, instead of the window level.

If others agree about this patch, then I'll send NEWS and Change log
updates.

If we agree about the patch, then there's also the question of bindings.
Users could make the following bindings themselves, but I propose that we
make these the default bindings:

* `down-mouse-2' - `mouse-flash-position-or-M-x'
* `S-down-mouse-2' - `mouse-scan-lines-or-M-:'

These would be in addition to the standard `mouse-2' binding for yanking.
WDOT?

You can see more description of these enhancements here:
http://www.emacswiki.org/cgi-bin/wiki/MousePlus.

------------8<------------------------------------

*** mouse-CVS-2007-07-13.el     Fri Jul 13 14:49:54 2007
--- mouse-CVS-patched-2007-07-13.el     Fri Jul 13 15:19:50 2007
***************
*** 38,43 ****
--- 38,71 ----
  ;;; Indent track-mouse like progn.
  (put 'track-mouse 'lisp-indent-function 0)

+ (defface mouse-scan-lines '((t (:background "Yellow")))
+   "*Face used to temporarily highlight line at mouse position."
+   :group 'mouse)
+
+ (defface mouse-flash-position '((t (:background "Yellow")))
+   "*Face used to highlight mouse position temporarily."
+   :group 'mouse)
+
+ (defconst mouse-scan-lines-overlay
+     ;; Create and immediately delete, to get "overlay in no buffer".
+     (let ((ol (make-overlay (point-min) (point-min))))
+       (delete-overlay ol)
+       (overlay-put ol 'face       'mouse-scan-lines)
+       (overlay-put ol 'mouse-face 'mouse-scan-lines)
+       (overlay-put ol 'priority   1000000)
+       ol)
+   "Overlay to highlight line at mouse position.")
+
+ (defconst mouse-flash-posn-overlay
+     ;; Create and immediately delete, to get "overlay in no buffer".
+   (let ((ol (make-overlay (point-min) (point-min))))
+     (delete-overlay ol)
+     (overlay-put ol 'face 'mouse-flash-position)
+     (overlay-put ol 'mouse-face 'mouse-flash-position)
+     (overlay-put ol 'priority 1000000)
+     ol)
+   "Overlay to highlight current mouse position.")
+
  (defcustom mouse-yank-at-point nil
    "*If non-nil, mouse yank commands yank at point instead of at click."
    :type 'boolean
***************
*** 305,311 ****
        (set-mouse-position (selected-frame) (1- (frame-width)) 0))))

  (defun mouse-tear-off-window (click)
!   "Delete the window clicked on, and create a new frame displaying its
buffer."
    (interactive "e")
    (mouse-minibuffer-check click)
    (let* ((window (posn-window (event-start click)))
--- 333,341 ----
        (set-mouse-position (selected-frame) (1- (frame-width)) 0))))

  (defun mouse-tear-off-window (click)
!   "Create a new frame displaying buffer of clicked window.
! If window is not the only one in frame, then delete it.
! Otherwise, this command effectively clones the frame and window."
    (interactive "e")
    (mouse-minibuffer-check click)
    (let* ((window (posn-window (event-start click)))
***************
*** 313,319 ****
         (frame (make-frame)))
      (select-frame frame)
      (switch-to-buffer buf)
!     (delete-window window)))

  (defun mouse-delete-other-windows ()
    "Delete all windows except the one you click on."
--- 343,350 ----
         (frame (make-frame)))
      (select-frame frame)
      (switch-to-buffer buf)
!     (save-window-excursion (select-window window)
!                            (unless (one-window-p) (delete-window
window)))))

  (defun mouse-delete-other-windows ()
    "Delete all windows except the one you click on."
***************
*** 1631,1637 ****
    ;; Give temporary modes such as isearch a chance to turn off.
    (run-hooks 'mouse-leave-buffer-hook)
    (or mouse-yank-at-point (mouse-set-point click))
!   (insert (x-get-selection 'SECONDARY)))

  (defun mouse-kill-secondary ()
    "Kill the text in the secondary selection.
--- 1662,1671 ----
    ;; Give temporary modes such as isearch a chance to turn off.
    (run-hooks 'mouse-leave-buffer-hook)
    (or mouse-yank-at-point (mouse-set-point click))
!   (let ((secondary (x-get-selection 'SECONDARY)))
!     (if secondary
!         (insert (x-get-selection 'SECONDARY))
!       (error "No secondary selection"))))

  (defun mouse-kill-secondary ()
    "Kill the text in the secondary selection.
***************
*** 2424,2429 ****
--- 2458,2640 ----
        (if (null font)
            (error "Font not found")))))
  
+ (defun mouse-scan-lines-or-M-: (start-event)
+   "In echo area, `M-:'.  Else, highlight current line, tracking pointer."
+   (interactive "e")
+   (let ((win (posn-window (event-start start-event)))
+         (bufs (buffer-list))
+         (M-:-cmd (key-binding "\M-:" t)))
+     (cond ((and (window-minibuffer-p win) (not (minibuffer-window-active-p
win)) M-:-cmd)
+            (read-event)                 ; Ignore mouse up event.
+            (while (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name
(car bufs)))
+              (pop bufs))
+            (when bufs (set-buffer (car bufs)))
+            (switch-to-buffer-other-window (current-buffer))
+            (call-interactively M-:-cmd nil [(meta ?:)]))
+           (t
+            (mouse-scan-lines start-event)))))
+
+ (defun mouse-M-: (start-event)
+   "In the echo area, do `M-:'.  Otherwise, do nothing."
+   (interactive "e")
+   (let ((win (posn-window (event-start start-event)))
+         (bufs (buffer-list))
+         (M-:-cmd (key-binding "\M-:" t)))
+     (cond ((and (window-minibuffer-p win) (not (minibuffer-window-active-p
win)) M-:-cmd)
+            (read-event)                 ; Ignore mouse up event.
+            (while (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name
(car bufs)))
+              (pop bufs))
+            (when bufs (set-buffer (car bufs)))
+            (switch-to-buffer-other-window (current-buffer))
+            (call-interactively M-:-cmd nil [(meta ?:)]))
+           (t
+            (run-hooks 'mouse-leave-buffer-hook))))) ; Let temp modes like
isearch turn off.
+
+ (defun mouse-scan-lines (start-event)
+   "Track mouse drags, highlighting the line under the pointer."
+   (interactive "e")
+   (save-excursion
+     (run-hooks 'mouse-leave-buffer-hook) ; Let temporary modes like
isearch turn off.
+     (let* ((original-window (selected-window))
+            (echo-keystrokes 0)
+            (start-posn (event-start start-event))
+            (start-point (posn-point start-posn))
+            (start-window (posn-window start-posn)))
+       (move-overlay mouse-scan-lines-overlay
+                     (save-excursion (goto-char start-point)
(beginning-of-line) (point))
+                     (save-excursion (goto-char start-point) (end-of-line)
(point)))
+       (let (event end end-point)
+         (track-mouse
+           (while (progn (setq event (read-event))
+                         (or (mouse-movement-p event)
+                             (memq (car-safe event) '(switch-frame
select-window))))
+             (unless (memq (car-safe event) '(switch-frame select-window))
+               (setq end (event-end event) end-point (posn-point end))
+               (when (and (eq (posn-window end) start-window)
(integer-or-marker-p end-point))
+                 (move-overlay
+                  mouse-scan-lines-overlay
+                  (save-excursion (goto-char end-point) (beginning-of-line)
(point))
+                  (save-excursion (goto-char end-point) (end-of-line)
(point)))))))
+         (delete-overlay mouse-scan-lines-overlay)))))
+
+ (defun mouse-move-flash-posn-overlay (ol start end)
+   "Move `mouse-flash-posn-overlay' to position END.
+ START is the position of the start of the current drag operation."
+   (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)
+     (setq end (point)))
+   (move-overlay ol end (min (point-max) (1+ end))))
+
+ (defun mouse-flash-position-or-M-x (start-event)
+   "In the echo area, do `M-x'.  Otherwise, do `mouse-flash-position'."
+   (interactive "e")
+   (let ((win (posn-window (event-start start-event)))
+         (bufs (buffer-list))
+         (M-x-cmd (key-binding "\M-x" t)))
+     (cond ((and (window-minibuffer-p win) (not (minibuffer-window-active-p
win)) M-x-cmd)
+            (read-event)                 ; Ignore mouse up event.
+            (while (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name
(car bufs)))
+              (pop bufs))
+            (when bufs (set-buffer (car bufs)))
+            (switch-to-buffer-other-window (current-buffer))
+            (call-interactively M-x-cmd nil [(meta ?x)]))
+           (t
+            (run-hooks 'mouse-leave-buffer-hook) ; Let temporary modes like
isearch turn off.
+            (mouse-flash-posn-track start-event)))))
+
+ (defun mouse-flash-position (start-event)
+   "Highlight the mouse position as you drag the mouse.
+ This must be bound to a button-down mouse event.  If you bind this to
+ `down-mouse-2', and `mouse-2' is bound to `mouse-yank-at-click' (the
+ default), then the yank occurs just before the highlighted character.
+
+ If you want to prevent the `mouse-2' up-button yank from taking place,
+ perhaps because you changed your mind, you can press and hold `C-g'
+ while releasing the mouse button (press `mouse-2'; drag; press `C-g';
+ release `mouse-2'; release `C-g')."
+   (interactive "e")
+   (run-hooks 'mouse-leave-buffer-hook)  ; Let temporary modes such as
isearch turn off.
+   (mouse-flash-posn-track start-event))
+
+ (defun mouse-flash-posn-track (start-event)
+   "Track mouse drags by highlighting the mouse position"
+   (mouse-minibuffer-check start-event)
+   (let* ((original-window (selected-window))
+          (echo-keystrokes 0)
+        (start-posn (event-start start-event))
+        (start-point (posn-point start-posn))
+        (start-window (posn-window start-posn))
+        (start-window-start (window-start start-window))
+        (start-hscroll (window-hscroll start-window))
+        (bounds (window-edges start-window))
+        (make-cursor-line-fully-visible nil)
+        (top (nth 1 bounds))
+        (bottom (if (window-minibuffer-p start-window)
+                    (nth 3 bounds)
+                  (1- (nth 3 bounds))))) ; 1-: Don't count the mode line.
+     (mouse-move-flash-posn-overlay mouse-flash-posn-overlay start-point
start-point)
+     (overlay-put mouse-flash-posn-overlay 'window start-window)
+     (deactivate-mark)
+     (unwind-protect
+          (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))))
+                (unless (memq (car-safe event) '(switch-frame
select-window))
+                  (setq end (event-end event)
+                        end-point (posn-point end))
+                  (when (numberp end-point) (setq last-end-point
end-point))
+                  (cond
+                    ((and (eq (posn-window end) start-window) ; Moving
within original window.
+                          (integer-or-marker-p end-point))
+                     (mouse-move-flash-posn-overlay
mouse-flash-posn-overlay
+                                                    start-point end-point))
+                    (t
+                     (let ((mouse-row (cddr (mouse-position))))
+                       (cond
+                         ((null mouse-row))
+                         ((< mouse-row top)
+                          (mouse-scroll-subr start-window (- mouse-row top)
+                                             mouse-flash-posn-overlay
start-point))
+                         ((>= mouse-row bottom)
+                          (mouse-scroll-subr start-window (1+ (- mouse-row
bottom))
+                                             mouse-flash-posn-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)  end-point (posn-point
end))
+                       (eq (posn-window end) start-window)
+                       (integer-or-marker-p end-point))
+              (mouse-move-flash-posn-overlay mouse-flash-posn-overlay
start-point end-point))
+            (when (consp event)          ; Handle the terminating event.
+              (let ((fun (key-binding (vector (car event)))))
+                ;; Run the binding of the terminating up-event, if
possible.
+                (let* ((stop-point (if (numberp (posn-point (event-end
event)))
+                                       (posn-point (event-end event))
+                                     last-end-point))
+                       (drag-end (if (and stop-point (< stop-point
start-point))
+                                     (overlay-start
mouse-flash-posn-overlay)
+                                   (overlay-end mouse-flash-posn-overlay)))
+                       (drag-start (- (+ (overlay-end
mouse-flash-posn-overlay)
+                                         (overlay-start
mouse-flash-posn-overlay))
+                                      drag-end))
+                       last-command this-command)
+                  (delete-overlay mouse-flash-posn-overlay)
+                  (when (and (= start-hscroll (window-hscroll
start-window))
+                             (or end-point
+                                 (= (window-start start-window)
start-window-start)))
+                    (setq unread-command-events (cons event
unread-command-events)))))))
+       (delete-overlay mouse-flash-posn-overlay))))
+ 
  ;;; Bindings for mouse commands.

  (define-key global-map [down-mouse-1] 'mouse-drag-region)