;;; mouse.el --- window system-independent mouse support
;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; default to the edit menu.
(newmap (if ancestor
(make-sparse-keymap (concat mode-name " Mode"))
- menu-bar-edit-menu)))
+ menu-bar-edit-menu))
+ uniq)
(if ancestor
;; Make our menu inherit from the desired keymap which we want
;; to display as the menu now.
- (set-keymap-parent newmap ancestor))
+ ;; Sometimes keymaps contain duplicate menu code, leading to
+ ;; duplicates in the popped-up menu. Avoid this by simply
+ ;; taking the first of any identically-named menus.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00469.html
+ (set-keymap-parent newmap
+ (progn
+ (dolist (e ancestor)
+ (unless (and (listp e)
+ (assoc (car e) uniq))
+ (setq uniq (append uniq (list e)))))
+ uniq)))
(popup-menu newmap event prefix)))
(cons 'keymap
(cons (concat
(capitalize (subst-char-in-string
- ?- ?\ (symbol-name
+ ?- ?\s (symbol-name
minor-mode)))
" Menu")
(cdr menu)))))
(defun mouse-drag-window-above (window)
"Return the (or a) window directly above WINDOW.
That means one whose bottom edge is at the same height as WINDOW's top edge."
- (let ((top (nth 1 (window-edges window)))
+ (let ((start-top (nth 1 (window-edges window)))
+ (start-left (nth 0 (window-edges window)))
+ (start-right (nth 2 (window-edges window)))
(start-window window)
above-window)
(setq window (previous-window window 0))
(while (and (not above-window) (not (eq window start-window)))
- (if (= (+ (window-height window) (nth 1 (window-edges window)))
- top)
- (setq above-window window))
+ (let ((left (nth 0 (window-edges window)))
+ (right (nth 2 (window-edges window))))
+ (when (and (= (+ (window-height window) (nth 1 (window-edges window)))
+ start-top)
+ (or (and (<= left start-left) (<= start-right right))
+ (and (<= start-left left) (<= left start-right))
+ (and (<= start-left right) (<= right start-right))))
+ (setq above-window window)))
(setq window (previous-window window)))
above-window))
should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
(track-mouse
(progn
- ;; enlarge-window only works on the selected window, so
- ;; we must select the window where the start event originated.
- ;; unwind-protect will restore the old selected window later.
- (select-window start-event-window)
-
;; if this is the bottommost ordinary window, then to
;; move its modeline the minibuffer must be enlarged.
(setq should-enlarge-minibuffer
mode-line-p
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
- (nth 3 (window-edges)))))
+ (nth 3 (window-edges start-event-window)))))
;; loop reading events and sampling the position of
;; the mouse.
;; - there is a scroll-bar-movement event
;; (same as mouse movement for our purposes)
;; quit if
- ;; - there is a keyboard event or some other unknown event
- ;; unknown event.
- (cond ((integerp event)
+ ;; - there is a keyboard event or some other unknown event.
+ (cond ((not (consp event))
(setq done t))
((memq (car event) '(switch-frame select-window))
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
(when (consp event)
- (push event unread-command-events))
+ ;; Do not unread a drag-mouse-1 event since it will cause the
+ ;; selection of the window above when dragging the modeline
+ ;; above the selected window.
+ (unless (eq (car event) 'drag-mouse-1)
+ (push event unread-command-events)))
(setq done t))
((not (eq (car mouse) start-event-frame))
(t
(setq y (cdr (cdr mouse))
- edges (window-edges)
+ edges (window-edges start-event-window)
top (nth 1 edges)
bot (nth 3 edges))
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
- (progn
- ;; yes. briefly select minibuffer so
- ;; enlarge-window will affect the
- ;; correct window.
- (select-window minibuffer)
- ;; scale back shrinkage if it would
- ;; make the minibuffer less than 1
- ;; line tall.
- (if (and (> growth 0)
- (< (- (window-height minibuffer)
- growth)
- 1))
- (setq growth (1- (window-height minibuffer))))
- (enlarge-window (- growth))
- (select-window start-event-window))
+ (unless resize-mini-windows
+ (mouse-drag-move-window-bottom start-event-window growth))
;; no. grow/shrink the selected window
;(message "growth = %d" growth)
(if mode-line-p
(and (not should-enlarge-minibuffer)
(> growth 0)
mode-line-p
- (/= top (nth 1 (window-edges)))))
+ (/= top
+ (nth 1 (window-edges
+ ;; Choose right window.
+ start-event-window)))))
(set-window-configuration wconfig)))))))))
(defun mouse-drag-mode-line (start-event)
(mouse-drag-mode-line-1 start-event nil))))
\f
+(defun mouse-drag-vertical-line-rightward-window (window)
+ "Return a window that is immediately to the right of WINDOW, or nil."
+ (let ((bottom (nth 3 (window-inside-edges window)))
+ (left (nth 0 (window-inside-edges window)))
+ best best-right
+ (try (previous-window window)))
+ (while (not (eq try window))
+ (let ((try-top (nth 1 (window-inside-edges try)))
+ (try-bottom (nth 3 (window-inside-edges try)))
+ (try-right (nth 2 (window-inside-edges try))))
+ (if (and (< try-top bottom)
+ (>= try-bottom bottom)
+ (< try-right left)
+ (or (null best-right) (> try-right best-right)))
+ (setq best-right try-right best try)))
+ (setq try (previous-window try)))
+ best))
+
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on the vertical line."
(interactive "e")
(echo-keystrokes 0)
(start-event-frame (window-frame (car (car (cdr start-event)))))
(start-event-window (car (car (cdr start-event))))
- (start-nwindows (count-windows t))
- event mouse x left right edges wconfig growth
+ event mouse x left right edges growth
(which-side
(or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame)))
'right)))
- (if (one-window-p t)
- (error "Attempt to resize sole ordinary window"))
- (if (eq which-side 'right)
- (if (= (nth 2 (window-edges start-event-window))
- (frame-width start-event-frame))
- (error "Attempt to drag rightmost scrollbar"))
- (if (= (nth 0 (window-edges start-event-window)) 0)
- (error "Attempt to drag leftmost scrollbar")))
+ (cond
+ ((one-window-p t)
+ (error "Attempt to resize sole ordinary window"))
+ ((and (eq which-side 'right)
+ (>= (nth 2 (window-inside-edges start-event-window))
+ (frame-width start-event-frame)))
+ (error "Attempt to drag rightmost scrollbar"))
+ ((and (eq which-side 'left)
+ (= (nth 0 (window-inside-edges start-event-window)) 0))
+ (error "Attempt to drag leftmost scrollbar")))
(track-mouse
(progn
- ;; enlarge-window only works on the selected window, so
- ;; we must select the window where the start event originated.
- ;; unwind-protect will restore the old selected window later.
- (select-window start-event-window)
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
((null (car (cdr mouse)))
nil)
(t
- (save-selected-window
- ;; If the scroll bar is on the window's left,
- ;; adjust the window on the left.
- (unless (eq which-side 'right)
- (select-window (previous-window)))
+ (let ((window
+ ;; If the scroll bar is on the window's left,
+ ;; adjust the window on the left.
+ (if (eq which-side 'right)
+ start-event-window
+ (mouse-drag-vertical-line-rightward-window
+ start-event-window))))
(setq x (- (car (cdr mouse))
(if (eq which-side 'right) 0 2))
- edges (window-edges)
+ edges (window-edges window)
left (nth 0 edges)
right (nth 2 edges))
;; scale back a move that would make the
(if (< (- x left -1) window-min-width)
(setq x (+ left window-min-width -1)))
;; compute size change needed
- (setq growth (- x right -1)
- wconfig (current-window-configuration))
- (enlarge-window growth t)
- ;; if this window's growth caused another
- ;; window to be deleted because it was too
- ;; thin, rescind the change.
- ;;
- ;; if size change caused space to be stolen
- ;; from a window to the left of this one,
- ;; rescind the change.
- (if (or (/= start-nwindows (count-windows t))
- (/= left (nth 0 (window-edges))))
- (set-window-configuration wconfig))))))))))
+ (setq growth (- x right -1))
+ (condition-case nil
+ (adjust-window-trailing-edge window growth t)
+ (error nil))))))))))
\f
(defun mouse-set-point (event)
"Move point to the position clicked on with the mouse.
(display-buffer (current-buffer)))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (mouse-drag-region-1 start-event))))
-
+ (mouse-drag-track start-event t))))
+
+
+(defun mouse-posn-property (pos property)
+ "Look for a property at click position.
+POS may be either a buffer position or a click position like
+those returned from `event-start'. If the click position is on
+a string, the text property PROPERTY is examined.
+If this is nil or the click is not on a string, then
+the corresponding buffer position is searched for PROPERTY.
+If PROPERTY is encountered in one of those places,
+its value is returned."
+ (if (consp pos)
+ (let ((w (posn-window pos)) (pt (posn-point pos))
+ (str (posn-string pos)))
+ (or (and str
+ (get-text-property (cdr str) property (car str)))
+ (and pt
+ (get-char-property pt property w))))
+ (get-char-property pos property)))
(defun mouse-on-link-p (pos)
"Return non-nil if POS is on a link in the current buffer.
-POS must be a buffer position in the current buffer or an mouse
-event location in the selected window, see `event-start'.
+POS must be a buffer position in the current buffer or a mouse
+event location in the selected window (see `event-start').
However, if `mouse-1-click-in-non-selected-windows' is non-nil,
POS may be a mouse event location in any window.
- If the value is a function, FUNC, POS is inside a link if
the call \(FUNC POS) returns non-nil. Return the return value
-from that call. Arg is \(posn-point POS) if POS is a mouse event,
+from that call. Arg is \(posn-point POS) if POS is a mouse event.
- Otherwise, return the value itself.
- Otherwise, the mouse-1 event is translated into a mouse-2 event
at the same position."
- (let ((w (and (consp pos) (posn-window pos))))
- (if (consp pos)
- (setq pos (and (or mouse-1-click-in-non-selected-windows
- (eq (selected-window) w))
- (posn-point pos))))
- (when pos
- (with-current-buffer (window-buffer w)
- (let ((action
- (or (get-char-property pos 'follow-link)
- (save-excursion
- (goto-char pos)
- (key-binding [follow-link] nil t)))))
- (cond
- ((eq action 'mouse-face)
- (and (get-char-property pos 'mouse-face) t))
- ((functionp action)
- (funcall action pos))
- (t action)))))))
+ (let ((action
+ (and (or (not (consp pos))
+ mouse-1-click-in-non-selected-windows
+ (eq (selected-window) (posn-window pos)))
+ (or (mouse-posn-property pos 'follow-link)
+ (key-binding [follow-link] nil t pos)))))
+ (cond
+ ((eq action 'mouse-face)
+ (and (mouse-posn-property pos 'mouse-face) t))
+ ((functionp action)
+ ;; FIXME: This seems questionable if the click is not in a buffer.
+ ;; Should we instead decide that `action' takes a `posn'?
+ (if (consp pos)
+ (with-current-buffer (window-buffer (posn-window pos))
+ (funcall action (posn-point pos)))
+ (funcall action pos)))
+ (t action))))
(defun mouse-fixup-help-message (msg)
"Fix help message MSG for `mouse-1-click-follows-link'."
(let ((range (mouse-start-end start end mode)))
(move-overlay ol (car range) (nth 1 range))))
-(defun mouse-drag-region-1 (start-event)
+(defun mouse-drag-track (start-event &optional
+ do-mouse-drag-region-post-process)
+ "Track mouse drags by highlighting area between point and cursor.
+The region will be defined with mark and point, and the overlay
+will be deleted after return. DO-MOUSE-DRAG-REGION-POST-PROCESS
+should only be used by mouse-drag-region."
(mouse-minibuffer-check start-event)
(setq mouse-selection-click-count-buffer (current-buffer))
(let* ((original-window (selected-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)))
+ (mouse-on-link-p start-posn)))
(click-count (1- (event-click-count start-event)))
(remap-double-click (and on-link
(eq mouse-1-click-follows-link 'double)
- (= click-count 1))))
+ (= click-count 1)))
+ ;; Suppress automatic hscrolling, because that is a nuisance
+ ;; when setting point near the right fringe (but see below).
+ (automatic-hscrolling-saved automatic-hscrolling)
+ (automatic-hscrolling nil))
(setq mouse-selection-click-count click-count)
;; 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.
(memq (car-safe event) '(switch-frame select-window))))
(if (memq (car-safe event) '(switch-frame select-window))
nil
+ ;; Automatic hscrolling did not occur during the call to
+ ;; `read-event'; but if the user subsequently drags the
+ ;; mouse, go ahead and hscroll.
+ (let ((automatic-hscrolling automatic-hscrolling-saved))
+ (redisplay))
(setq end (event-end event)
end-point (posn-point end))
(if (numberp end-point)
(integer-or-marker-p end-point))
(mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
+ ;; Handle the terminating event
(if (consp event)
(let* ((fun (key-binding (vector (car event))))
(do-multi-click (and (> (event-click-count event) 0)
(functionp fun)
- (not (memq fun '(mouse-set-point mouse-set-region))))))
- ;; Run the binding of the terminating up-event, if possible.
+ (not (memq fun
+ '(mouse-set-point
+ mouse-set-region))))))
+ ;; Run the binding of the terminating up-event, if possible.
(if (and (not (= (overlay-start mouse-drag-overlay)
(overlay-end mouse-drag-overlay)))
(not do-multi-click))
;; 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))))
+ (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)
+ (when (eq transient-mark-mode 'identity)
+ ;; Reset `transient-mark-mode' to avoid expanding the region
+ ;; while scrolling (compare thread on "Erroneous selection
+ ;; extension ..." on bug-gnu-emacs from 2007-06-10).
+ (setq transient-mark-mode nil))
+ (push-mark region-commencement t t)
+ (goto-char region-termination)
+ (if (not do-mouse-drag-region-post-process)
+ ;; Skip all post-event handling, return immediately.
+ (delete-overlay mouse-drag-overlay)
+ ;; 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)))))
;; Run the binding of the terminating up-event.
;; If a multiple click is not bound to mouse-set-point,
;; cancel the effects of mouse-move-drag-overlay to
(if do-multi-click (goto-char start-point))
(delete-overlay mouse-drag-overlay)
(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))))))))
- (if (or (vectorp on-link) (stringp on-link))
- (setq event (aref on-link 0))
- (setcar event 'mouse-2)))
+ (= 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)))
+ (when (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)
+ (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))))))))
+ ;; If we rebind to mouse-2, reselect previous selected window,
+ ;; so that the mouse-2 event runs in the same
+ ;; situation as if user had clicked it directly.
+ ;; Fixes the bug reported by juri@jurta.org on 2005-12-27.
+ (if (or (vectorp on-link) (stringp on-link))
+ (setq event (aref on-link 0))
+ (select-window original-window)
+ (setcar event 'mouse-2)
+ ;; If this mouse click has never been done by
+ ;; the user, it doesn't have the necessary
+ ;; property to be interpreted correctly.
+ (put 'mouse-2 'event-kind 'mouse-click)))
(push event unread-command-events))))
;; Case where the end-event is not a cons cell (it's just a boring
(unless ignore
;; For certain special keys, delete the region.
(if (member key mouse-region-delete-keys)
- (delete-region (mark t) (point))
+ (progn
+ ;; Since notionally this is a separate command,
+ ;; run all the hooks that would be run if it were
+ ;; executed separately.
+ (run-hooks 'post-command-hook)
+ (setq last-command this-command)
+ (setq this-original-command 'delete-region)
+ (setq this-command (or (command-remapping this-original-command)
+ this-original-command))
+ (run-hooks 'pre-command-hook)
+ (call-interactively this-command))
;; Otherwise, unread the key so it gets executed normally.
(setq unread-command-events
(nconc events unread-command-events))))
(with-current-buffer (window-buffer (posn-window posn))
(if (numberp (posn-point posn))
(setq beg (posn-point posn)))
- (move-overlay mouse-secondary-overlay beg (posn-point end)))))
+ (move-overlay mouse-secondary-overlay beg (posn-point end))
+ (x-set-selection
+ 'SECONDARY
+ (buffer-substring (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))))
(defun mouse-drag-secondary (start-event)
"Set the secondary selection to the text that the mouse is dragged over.
;; 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)))
+ (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.
(setq tail buffers)
(while tail
(let ((elt (car tail)))
- (if (/= (aref (buffer-name elt) 0) ?\ )
+ (if (/= (aref (buffer-name elt) 0) ?\s)
(setq head
(cons
(cons
(format
- (format "%%%ds %%s%%s %%s" maxlen)
+ (format "%%-%ds %%s%%s %%s" maxlen)
(buffer-name elt)
(if (buffer-modified-p elt) "*" " ")
(save-excursion
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
- (setq choice (buffer-substring beg end)))))
+ (setq choice (buffer-substring-no-properties beg end)))))
(let ((owindow (selected-window)))
(select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
"X fonts suitable for use in Emacs.")
(defun mouse-set-font (&rest fonts)
- "Select an emacs font from a list of known good fonts and fontsets."
+ "Select an Emacs font from a list of known good fonts and fontsets."
(interactive
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
(global-set-key [right-fringe mouse-1] 'mouse-set-point)
(global-set-key [mouse-2] 'mouse-yank-at-click)
+;; Allow yanking also when the corresponding cursor is "in the fringe".
+(global-set-key [right-fringe mouse-2] 'mouse-yank-at-click)
+(global-set-key [left-fringe mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
+(global-set-key [right-fringe mouse-3] 'mouse-save-then-kill)
+(global-set-key [left-fringe mouse-3] 'mouse-save-then-kill)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.