Download
(require 'mouse)
(require 'second-sel nil t)
(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
(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
(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.")
(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)
(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)
(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)))))
(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* ((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))
(inhibit-field-text-motion t))
(move-overlay mouse-scan-lines-overlay
(save-excursion (goto-char start-point) (line-beginning-position))
(save-excursion (goto-char start-point) (line-end-position)))
(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) (line-beginning-position))
(save-excursion (goto-char end-point) (line-end-position)))))))
(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)
(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)
(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)
(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-primary' or `mouse-yank-at-click' (defaults for Emacs 24
and earlier, respectively), 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)
(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)))))
(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)
(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)))))))))
(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)
(let ((fun (key-binding (vector (car event)))))
(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))))
(defun mouse-tear-off-window (event)
"Create a new frame displaying buffer of window clicked on.
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 event)
(let* ((window (posn-window (event-start event)))
(buf (window-buffer window))
(frame (make-frame)))
(select-frame frame)
(switch-to-buffer buf)
(save-window-excursion (select-window window)
(unless (one-window-p) (delete-window window)))))
(when (> emacs-major-version 21)
(defun mouse-drag-region (start-event)
"Set the region to the text that the mouse is dragged over.
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event.
In Transient Mark mode, the highlighting remains as long as the mark
remains active. Otherwise, it remains until the next input event.
If the click is in the echo area, then:
If buffer `*Messages' is not displayed, display it.
Else run the command bound to `M-x'."
(interactive "e")
(let ((w (posn-window (event-start start-event))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w)))
(let* ((Messages-buf (get-buffer-create "*Messages*"))
(Messages-win (get-buffer-window Messages-buf 'visible)))
(if Messages-win
(let ((M-x-cmd (or (key-binding "\M-x" t) 'execute-extended-command))
(bufs (buffer-list)))
(read-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))
(delete-window Messages-win)
(call-interactively M-x-cmd nil [(meta ?x)]))
(save-excursion
(read-event)
(set-buffer Messages-buf)
(goto-char (point-max))
(display-buffer (current-buffer)))))
(run-hooks 'mouse-leave-buffer-hook)
(mouse-drag-track start-event t)))))
(defun mouse-yank-secondary (click arg)
"Insert the secondary selection at the position clicked on.
Move point to the end of the inserted text.
If `mouse-yank-at-point' is non-nil, insert at point regardless of
where you click.
If command `yank-secondary' is defined (see library `second-sel.el'),
then a prefix arg N means insert the Nth most recent secondary
selection."
(interactive "e\nP")
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
(setq mouse-selection-click-count 0)
(if (not (fboundp 'yank-secondary))
(let ((secondary (x-get-selection 'SECONDARY)))
(unless secondary (error "No secondary selection"))
(funcall (if (fboundp 'insert-for-yank) 'insert-for-yank 'insert) secondary))
(setq this-command 'yank-secondary)
(yank-secondary arg)))
(put 'mouse-yank-secondary 'delete-selection 'yank)
(provide 'mouse+)