Commit e07b9a6d authored by Martin Rudalics's avatar Martin Rudalics
Browse files

Fix and improve mouse-dragging of horizontal/vertical lines.

* mouse.el (mouse-drag-window-above)
(mouse-drag-move-window-bottom, mouse-drag-move-window-top)
(mouse-drag-mode-line-1, mouse-drag-header-line)
(mouse-drag-vertical-line-rightward-window): Remove.
(mouse-drag-line): New function.
(mouse-drag-mode-line, mouse-drag-header-line)
(mouse-drag-vertical-line): Call mouse-drag-line.
* window.el (window-at-side-p, windows-at-side): New functions.
parent 7e1361d9
2011-10-21 Martin Rudalics <rudalics@gmx.at>
* mouse.el (mouse-drag-window-above)
(mouse-drag-move-window-bottom, mouse-drag-move-window-top)
(mouse-drag-mode-line-1, mouse-drag-header-line)
(mouse-drag-vertical-line-rightward-window): Remove.
(mouse-drag-line): New function.
(mouse-drag-mode-line, mouse-drag-header-line)
(mouse-drag-vertical-line): Call mouse-drag-line.
* window.el (window-at-side-p, windows-at-side): New functions.
2011-10-21 Ulrich Mueller <ulm@gentoo.org> 2011-10-21 Ulrich Mueller <ulm@gentoo.org>
* tar-mode.el (tar-grind-file-mode): * tar-mode.el (tar-grind-file-mode):
......
...@@ -372,300 +372,164 @@ This command must be bound to a mouse click." ...@@ -372,300 +372,164 @@ This command must be bound to a mouse click."
(split-window-horizontally (split-window-horizontally
(min (max new-width first-col) last-col)))))) (min (max new-width first-col) last-col))))))
(defun mouse-drag-window-above (window) ;; `mouse-drag-line' is now the common routine for handling all line
"Return the (or a) window directly above WINDOW. ;; dragging events combining the earlier `mouse-drag-mode-line-1' and
That means one whose bottom edge is at the same height as WINDOW's top edge." ;; `mouse-drag-vertical-line'. It should improve the behavior of line
(let ((start-top (nth 1 (window-edges window))) ;; dragging wrt Emacs 23 as follows:
(start-left (nth 0 (window-edges window)))
(start-right (nth 2 (window-edges window))) ;; (1) Gratuitous error messages and restrictions have been (hopefully)
(start-window window) ;; removed. (The help-echo that dragging the mode-line can resize a
above-window) ;; one-window-frame's window will still show through via bindings.el.)
(setq window (previous-window window 0))
(while (and (not above-window) (not (eq window start-window))) ;; (2) No gratuitous selection of other windows should happen. (This
(let ((left (nth 0 (window-edges window))) ;; has not been completely fixed for mouse-autoselected windows yet.)
(right (nth 2 (window-edges window))))
(when (and (= (+ (window-height window) (nth 1 (window-edges window))) ;; (3) Mouse clicks below a scroll-bar should pass through via unread
start-top) ;; command events.
(or (and (<= left start-left) (<= start-right right))
(and (<= start-left left) (<= left start-right)) ;; Note that `window-in-direction' replaces `mouse-drag-window-above'
(and (<= start-left right) (<= right start-right)))) ;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
(setq above-window window))) (defun mouse-drag-line (start-event line)
(setq window (previous-window window))) "Drag some line with the mouse.
above-window)) START-EVENT is the starting mouse-event of the drag action. LINE
must be one of the symbols header, mode, or vertical."
(defun mouse-drag-move-window-bottom (window growth)
"Move the bottom of WINDOW up or down by GROWTH lines.
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."
(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.
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."
;; Moving the top of WINDOW is actually moving the bottom of the
;; window above.
(let ((window-above (mouse-drag-window-above window)))
(and window-above
(mouse-drag-move-window-bottom window-above (- growth)))))
(defun mouse-drag-mode-line-1 (start-event mode-line-p)
"Change the height of a window by dragging on the mode or header line.
START-EVENT is the starting mouse-event of the drag action.
MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
;; Give temporary modes such as isearch a chance to turn off. ;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook) (run-hooks 'mouse-leave-buffer-hook)
(let* ((done nil) (let* ((echo-keystrokes 0)
(echo-keystrokes 0)
(start (event-start start-event)) (start (event-start start-event))
(start-event-window (posn-window start)) (window (posn-window start))
(start-event-frame (window-frame start-event-window)) (frame (window-frame window))
(start-nwindows (count-windows t)) (minibuffer-window (minibuffer-window frame))
(on-link (and mouse-1-click-follows-link (on-link (and mouse-1-click-follows-link
(or mouse-1-click-in-non-selected-windows (or mouse-1-click-in-non-selected-windows
(eq (posn-window start) (selected-window))) (eq window (selected-window)))
(mouse-on-link-p start))) (mouse-on-link-p start)))
(minibuffer (frame-parameter nil 'minibuffer)) (enlarge-minibuffer
should-enlarge-minibuffer event mouse y top bot edges wconfig growth) (and (eq line 'mode)
(eq (window-frame minibuffer-window) frame)
(not (one-window-p t frame))
(= (nth 1 (window-edges minibuffer-window))
(nth 3 (window-edges window)))))
(which-side
(and (eq line 'vertical)
(or (cdr (assq 'vertical-scroll-bars (frame-parameters frame)))
'right)))
done event mouse growth dragged)
(cond
((eq line 'header)
;; Check whether header-line can be dragged at all.
(when (window-at-side-p window 'top)
(setq done t)))
((eq line 'mode)
;; Check whether mode-line can be dragged at all.
(when (window-at-side-p window 'bottom)
(setq done t)))
((eq line 'vertical)
;; Get the window to adjust for the vertical case.
(setq window
(if (eq which-side 'right)
;; If the scroll bar is on the window's right or there's
;; no scroll bar at all, adjust the window where the
;; start-event occurred.
window
;; If the scroll bar is on the start-event window's left,
;; adjust the window on the left of it.
(window-in-direction 'left window)))))
;; Start tracking.
(track-mouse (track-mouse
(progn ;; Loop reading events and sampling the position of the mouse.
;; if this is the bottommost ordinary window, then to (while (not done)
;; move its modeline the minibuffer must be enlarged. (setq event (read-event))
(setq should-enlarge-minibuffer (setq mouse (mouse-position))
(and minibuffer ;; Do nothing if
mode-line-p ;; - there is a switch-frame event.
(not (one-window-p t)) ;; - the mouse isn't in the frame that we started in
(= (nth 1 (window-edges minibuffer)) ;; - the mouse isn't in any Emacs frame
(nth 3 (window-edges start-event-window))))) ;; Drag if
;; - there is a mouse-movement event
;; loop reading events and sampling the position of ;; - there is a scroll-bar-movement event (??)
;; the mouse. ;; (same as mouse movement for our purposes)
(while (not done) ;; Quit if
(setq event (read-event) ;; - there is a keyboard event or some other unknown event.
mouse (mouse-position)) (cond
((not (consp event))
;; do nothing if (setq done t))
;; - there is a switch-frame event. ((memq (car event) '(switch-frame select-window))
;; - the mouse isn't in the frame that we started in nil)
;; - the mouse isn't in any Emacs frame ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
;; drag if (when (consp event)
;; - there is a mouse-movement event ;; Do not unread a drag-mouse-1 event to avoid selecting
;; - there is a scroll-bar-movement event ;; some other window. For vertical line dragging do not
;; (same as mouse movement for our purposes) ;; unread mouse-1 events either (but only if we dragged at
;; quit if ;; least once to allow mouse-1 clicks get through.
;; - there is a keyboard event or some other unknown event. (unless (and dragged
(cond ((not (consp event)) (if (eq line 'vertical)
(setq done t)) (memq (car event) '(drag-mouse-1 mouse-1))
(eq (car event) 'drag-mouse-1)))
((memq (car event) '(switch-frame select-window)) (push event unread-command-events)))
nil) (setq done t))
((or (not (eq (car mouse) frame)) (null (car (cdr mouse))))
((not (memq (car event) '(mouse-movement scroll-bar-movement))) nil)
(when (consp event) ((eq line 'vertical)
;; Do not unread a drag-mouse-1 event since it will cause the ;; Drag vertical divider (the calculations below are those
;; selection of the window above when dragging the modeline ;; from Emacs 23).
;; above the selected window. (setq growth
(unless (eq (car event) 'drag-mouse-1) (- (- (cadr mouse)
(push event unread-command-events))) (if (eq which-side 'right) 0 2))
(setq done t)) (nth 2 (window-edges window))
-1))
((not (eq (car mouse) start-event-frame)) (unless (zerop growth)
nil) ;; Remember that we dragged.
(setq dragged t))
((null (car (cdr mouse))) (adjust-window-trailing-edge window growth t))
nil) (t
;; Drag horizontal divider (the calculations below are those
(t ;; from Emacs 23).
(setq y (cdr (cdr mouse)) (setq growth
edges (window-edges start-event-window) (if (eq line 'mode)
top (nth 1 edges) (- (cddr mouse) (nth 3 (window-edges window)) -1)
bot (nth 3 edges)) ;; The window's top includes the header line!
(- (nth 3 (window-edges window)) (cddr mouse))))
;; compute size change needed
(cond (mode-line-p (unless (zerop growth)
(setq growth (- y bot -1))) ;; Remember that we dragged.
(t ; header line (setq dragged t))
(when (< (- bot y) window-min-height)
(setq y (- bot window-min-height))) (cond
;; The window's top includes the header line! (enlarge-minibuffer
(setq growth (- top y)))) (adjust-window-trailing-edge window growth))
(setq wconfig (current-window-configuration)) ((eq line 'mode)
(adjust-window-trailing-edge window growth))
;; Check for an error case. (t
(when (and (/= growth 0) (adjust-window-trailing-edge window (- growth)))))))
(not minibuffer)
(one-window-p t)) ;; Presumably, if this was just a click, the last event should be
(error "Attempt to resize sole window")) ;; `mouse-1', whereas if this did move the mouse, it should be a
;; `drag-mouse-1'. `dragged' nil tells us that we never dragged
;; If we ever move, make sure we don't mistakenly treat ;; and `on-link' tells us that there is a link to follow.
;; some unexpected `mouse-1' final event as a sign that (when (and on-link (not dragged)
;; this whole drag was nothing more than a click. (eq 'mouse-1 (car-safe (car unread-command-events))))
(if (/= growth 0) (setq on-link nil)) ;; If mouse-2 has never been done by the user, it doesn't
;; have the necessary property to be interpreted correctly.
;; grow/shrink minibuffer? (put 'mouse-2 'event-kind 'mouse-click)
(if should-enlarge-minibuffer (setcar unread-command-events
(unless resize-mini-windows (cons 'mouse-2 (cdar unread-command-events)))))))
(mouse-drag-move-window-bottom start-event-window growth))
;; no. grow/shrink the selected window
;(message "growth = %d" growth)
(if mode-line-p
(mouse-drag-move-window-bottom start-event-window growth)
(mouse-drag-move-window-top start-event-window growth)))
;; if this window's growth caused another
;; window to be deleted because it was too
;; short, rescind the change.
;;
;; if size change caused space to be stolen
;; from a window above this one, rescind the
;; change, but only if we didn't grow/shrink
;; the minibuffer. minibuffer size changes
;; can cause all windows to shrink... no way
;; around it.
(when (or (/= start-nwindows (count-windows t))
(and (not should-enlarge-minibuffer)
(> growth 0)
mode-line-p
(/= top
(nth 1 (window-edges
;; Choose right window.
start-event-window)))))
(set-window-configuration wconfig)))))
;; Presumably if this was just a click, the last event should
;; be `mouse-1', whereas if this did move the mouse, it should be
;; a `drag-mouse-1'. In any case `on-link' would have been nulled
;; above if there had been any significant mouse movement.
(when (and on-link
(eq 'mouse-1 (car-safe (car unread-command-events))))
;; If mouse-2 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)
(setcar unread-command-events
(cons 'mouse-2 (cdar unread-command-events))))))))
(defun mouse-drag-mode-line (start-event) (defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line." "Change the height of a window by dragging on the mode line."
(interactive "e") (interactive "e")
(mouse-drag-mode-line-1 start-event t)) (mouse-drag-line start-event 'mode))
(defun mouse-drag-header-line (start-event) (defun mouse-drag-header-line (start-event)
"Change the height of a window by dragging on the header line. "Change the height of a window by dragging on the header line."
Windows whose header-lines are at the top of the frame cannot be
resized by dragging their header-line."
(interactive "e") (interactive "e")
;; Changing the window's size by dragging its header-line when the (mouse-drag-line start-event 'header))
;; header-line is at the top of the frame is somewhat strange,
;; because the header-line doesn't move, so don't do it.
(let* ((start (event-start start-event))
(window (posn-window start))
(frame (window-frame window))
(first-window (frame-first-window frame)))
(unless (or (eq window first-window)
(= (nth 1 (window-edges window))
(nth 1 (window-edges first-window))))
(mouse-drag-mode-line-1 start-event nil))))
(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) (defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on the vertical line." "Change the width of a window by dragging on the vertical line."
(interactive "e") (interactive "e")
;; Give temporary modes such as isearch a chance to turn off. (mouse-drag-line start-event 'vertical))
(run-hooks 'mouse-leave-buffer-hook)
(let* ((done nil)
(echo-keystrokes 0)
(start-event-frame (window-frame (car (car (cdr start-event)))))
(start-event-window (car (car (cdr start-event))))
event mouse x left right edges growth
(which-side
(or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame)))
'right)))
(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
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
(setq event (read-event)
mouse (mouse-position))
;; do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; - the mouse isn't in any Emacs frame
;; drag if
;; - there is a mouse-movement event
;; - 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)
(setq done t))
((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
(if (consp event)
(setq unread-command-events
(cons event unread-command-events)))
(setq done t))
((not (eq (car mouse) start-event-frame))
nil)
((null (car (cdr mouse)))
nil)
(t
(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 window)
left (nth 0 edges)
right (nth 2 edges))
;; scale back a move that would make the
;; window too thin.
(if (< (- x left -1) window-min-width)
(setq x (+ left window-min-width -1)))
;; compute size change needed
(setq growth (- x right -1))
(condition-case nil
(adjust-window-trailing-edge window growth t)
(error nil))))))))))
(defun mouse-set-point (event) (defun mouse-set-point (event)
"Move point to the position clicked on with the mouse. "Move point to the position clicked on with the mouse.
......
...@@ -1084,6 +1084,35 @@ regardless of whether that buffer is current or not." ...@@ -1084,6 +1084,35 @@ regardless of whether that buffer is current or not."
(goto-char pos)) (goto-char pos))
(set-window-point window pos))) (set-window-point window pos)))
(defun window-at-side-p (&optional window side)
"Return t if WINDOW is at SIDE of its containing frame.
WINDOW can be any window and defaults to the selected one. SIDE
can be any of the symbols `left', `top', `right' or `bottom'.
The default value nil is handled like `bottom'."
(setq window (window-normalize-any-window window))
(let ((edge
(cond
((eq side 'left) 0)
((eq side 'top) 1)
((eq side 'right) 2)
((memq side '(bottom nil)) 3))))
(= (nth edge (window-edges window))
(nth edge (window-edges (frame-root-window window))))))
(defun windows-at-side (&optional frame side)
"Return list of all windows on SIDE of FRAME.
FRAME must be a live frame and defaults to the selected frame.
SIDE can be any of the symbols `left', `top', `right' or
`bottom'. The default value nil is handled like `bottom'."
(setq frame (window-normalize-frame frame))
(let (windows)
(walk-window-tree
(lambda (window)
(when (window-at-side-p window side)
(setq windows (cons window windows))))
frame)
(nreverse windows)))
(defun window-in-direction-2 (window posn &optional horizontal) (defun window-in-direction-2 (window posn &optional horizontal)
"Support function for `window-in-direction'." "Support function for `window-in-direction'."
(if horizontal (if horizontal
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment