;;; 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 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
(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))
Move it down if GROWTH is positive, or up if GROWTH is negative.
If this would make WINDOW too short,
shrink the window or windows above it to make room."
- (let ((excess (- window-min-height (+ (window-height window) growth))))
- ;; EXCESS is the number of lines we need to take from windows above.
- (if (> excess 0)
- ;; This can recursively shrink windows all the way up.
- (let ((window-above (mouse-drag-window-above window)))
- (if window-above
- (mouse-drag-move-window-bottom window-above (- excess))))))
- (save-selected-window
- (select-window window)
- (enlarge-window growth nil (> growth 0))))
+ (condition-case nil
+ (adjust-window-trailing-edge window growth nil)
+ (error nil)))
(defsubst mouse-drag-move-window-top (window growth)
"Move the top of WINDOW up or down by GROWTH lines.
;; 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
(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
(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
((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)
+ (selected-window)
+ (previous-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.
;; If mark is highlighted, no need to bounce the cursor.
;; On X, we highlight while dragging, thus once again no need to bounce.
(or transient-mark-mode
- (memq (framep (selected-frame)) '(x pc w32))
+ (memq (framep (selected-frame)) '(x pc w32 mac))
(sit-for 1))
(push-mark)
(set-mark (point))
(save-excursion
;; Swallow the up-event.
(read-event)
- (set-buffer "*Messages*")
+ (set-buffer (get-buffer-create "*Messages*"))
(goto-char (point-max))
(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-on-link-p (pos)
(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))
(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 (eq fun 'mouse-set-point)))))
- ;; 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)
+ (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)
+ (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 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
(forward-char 1))))))
(defun mouse-start-end (start end mode)
-"Return a list of region bounds based on START and END according to MODE.
+ "Return a list of region bounds based on START and END according to MODE.
If MODE is 0 then set point to (min START END), mark to (max START END).
If MODE is 1 then set point to start of word at (min START END),
mark to end of word at (max START END).
;; Momentarily show where the mark is, if highlighting doesn't show it.
-(defvar mouse-region-delete-keys '([delete] [deletechar])
- "List of keys which shall cause the mouse region to be deleted.")
+(defcustom mouse-region-delete-keys '([delete] [deletechar] [backspace])
+ "List of keys that should cause the mouse region to be deleted."
+ :group 'mouse
+ :type '(repeat key-sequence))
(defun mouse-show-mark ()
(let ((inhibit-quit t)
(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)