Merge branch 'master' into scratch/org-mode-merge

1 files changed, 410 insertions, 23 deletions

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9b6b169e568..e0794435d7a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -380,7 +380,7 @@ This command must be bound to a mouse click."
 
 (defun mouse-drag-line (start-event line)
   "Drag a mode line, header line, or vertical line with the mouse.
-START-EVENT is the starting mouse-event of the drag action.  LINE
+START-EVENT is the starting mouse event of the drag action.  LINE
 must be one of the symbols `header', `mode', or `vertical'."
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
@@ -405,29 +405,15 @@ must be one of the symbols `header', `mode', or `vertical'."
     ;; window's edge we drag.
     (cond
      ((eq line 'header)
-      (if (window-at-side-p window 'top)
-          ;; We can't drag the header line of a topmost window.
-          (setq draggable nil)
-        ;; Drag bottom edge of window above the header line.
-        (setq window (window-in-direction 'above window t))))
-     ((eq line 'mode)
-      (if (and (window-at-side-p window 'bottom)
-               ;; Allow resizing the minibuffer window if it's on the
-               ;; same frame as and immediately below `window', and it's
-               ;; either active or `resize-mini-windows' is nil.
-               (let ((minibuffer-window (minibuffer-window frame)))
-                 (not (and (eq (window-frame minibuffer-window) frame)
-                           (or (not resize-mini-windows)
-                               (eq minibuffer-window
-                                   (active-minibuffer-window)))))))
-          (setq draggable nil)))
+      ;; Drag bottom edge of window above the header line.
+      (setq window (window-in-direction 'above window t)))
+     ((eq line 'mode))
      ((eq line 'vertical)
       (let ((divider-width (frame-right-divider-width frame)))
         (when (and (or (not (numberp divider-width))
                        (zerop divider-width))
                    (eq (frame-parameter frame 'vertical-scroll-bars) 'left))
           (setq window (window-in-direction 'left window t))))))
-
     (let* ((exitfun nil)
            (move
             (lambda (event) (interactive "e")
@@ -530,20 +516,405 @@ must be one of the symbols `header', `mode', or `vertical'."
              t (lambda () (setq track-mouse old-track-mouse)))))))
 
 (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 its mode line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a mode line on the bottom of a frame and
+that frame's `drag-with-mode-line' parameter is non-nil, drag the
+frame instead."
   (interactive "e")
-  (mouse-drag-line start-event 'mode))
+  (let* ((start (event-start start-event))
+         (window (posn-window start))
+         (frame (window-frame window)))
+    (cond
+     ((not (window-live-p window)))
+     ((or (not (window-at-side-p window 'bottom))
+          ;; Allow resizing the minibuffer window if it's on the
+          ;; same frame as and immediately below `window', and it's
+          ;; either active or `resize-mini-windows' is nil.
+          (let ((minibuffer-window (minibuffer-window frame)))
+            (and (eq (window-frame minibuffer-window) frame)
+                 (or (not resize-mini-windows)
+                     (eq minibuffer-window
+                         (active-minibuffer-window))))))
+      (mouse-drag-line start-event 'mode))
+     ((and (frame-parameter frame 'drag-with-mode-line)
+           (window-at-side-p window 'bottom)
+           (let ((minibuffer-window (minibuffer-window frame)))
+             (not (eq (window-frame minibuffer-window) frame))))
+      ;; Drag frame when the window is on the bottom of its frame and
+      ;; there is no minibuffer window below.
+      (mouse-drag-frame start-event 'move)))))
 
 (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 its header line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a header line on the top of a frame and
+that frame's `drag-with-header-line' parameter is non-nil, drag
+the frame instead."
   (interactive "e")
-  (mouse-drag-line start-event 'header))
+  (let* ((start (event-start start-event))
+         (window (posn-window start)))
+    (if (and (window-live-p window)
+             (not (window-at-side-p window 'top)))
+        (mouse-drag-line start-event 'header)
+      (let ((frame (window-frame window)))
+        (when (frame-parameter frame 'drag-with-header-line)
+          (mouse-drag-frame start-event 'move))))))
 
 (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 a vertical line.
+START-EVENT is the starting mouse event of the drag action."
   (interactive "e")
   (mouse-drag-line start-event 'vertical))
 
+(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
+  "Helper function for `mouse-drag-frame'."
+  (let* ((frame-x-y (frame-position frame))
+         (frame-x (car frame-x-y))
+         (frame-y (cdr frame-x-y))
+         alist)
+    (if (> x-diff 0)
+        (when x-move
+          (setq x-diff (min x-diff frame-x))
+          (setq x-move (- frame-x x-diff)))
+      (let* ((min-width (frame-windows-min-size frame t nil t))
+             (min-diff (max 0 (- (frame-inner-width frame) min-width))))
+        (setq x-diff (max x-diff (- min-diff)))
+        (when x-move
+          (setq x-move (+ frame-x (- x-diff))))))
+
+    (if (> y-diff 0)
+        (when y-move
+          (setq y-diff (min y-diff frame-y))
+          (setq y-move (- frame-y y-diff)))
+      (let* ((min-height (frame-windows-min-size frame nil nil t))
+             (min-diff (max 0 (- (frame-inner-height frame) min-height))))
+        (setq y-diff (max y-diff (- min-diff)))
+        (when y-move
+          (setq y-move (+ frame-y (- y-diff))))))
+
+    (unless (zerop x-diff)
+      (when x-move
+        (push `(left . ,x-move) alist))
+      (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
+            alist))
+    (unless (zerop y-diff)
+      (when y-move
+        (push `(top . ,y-move) alist))
+      (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
+            alist))
+    (when alist
+      (modify-frame-parameters frame alist))))
+
+(defun mouse-drag-frame (start-event part)
+  "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action.  Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols 'left', 'top', 'right', 'bottom', 'top-left',
+'top-right', 'bottom-left', 'bottom-right' to drag an internal
+border or edge.  If PART equals 'move', this means to move the
+frame with the mouse."
+  ;; Give temporary modes such as isearch a chance to turn off.
+  (run-hooks 'mouse-leave-buffer-hook)
+  (let* ((echo-keystrokes 0)
+         (start (event-start start-event))
+         (window (posn-window start))
+         ;; FRAME is the frame to drag.
+         (frame (if (window-live-p window)
+                    (window-frame window)
+                  window))
+         (width (frame-native-width frame))
+         (height (frame-native-height frame))
+         ;; PARENT is the parent frame of FRAME or, if FRAME is a
+         ;; top-level frame, FRAME's workarea.
+         (parent (frame-parent frame))
+         (parent-edges
+          (if parent
+              `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
+            (let* ((attributes
+                    (car (display-monitor-attributes-list)))
+                   (workarea (assq 'workarea attributes)))
+              (and workarea
+                   `(,(nth 1 workarea) ,(nth 2 workarea)
+                     ,(+ (nth 1 workarea) (nth 3 workarea))
+                     ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+         (parent-left (and parent-edges (nth 0 parent-edges)))
+         (parent-top (and parent-edges (nth 1 parent-edges)))
+         (parent-right (and parent-edges (nth 2 parent-edges)))
+         (parent-bottom (and parent-edges (nth 3 parent-edges)))
+         ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
+         ;; last sampled mouse position.  Note that we sample absolute
+         ;; mouse positions to avoid that moving the mouse from one
+         ;; frame into another gets into our way.  `last-x' and `last-y'
+         ;; records the x- and y-coordinates of the previously sampled
+         ;; position.  The differences between `last-x' and `pos-x' as
+         ;; well as `last-y' and `pos-y' determine the amount the mouse
+         ;; has been dragged between the last two samples.
+         pos-x-y pos-x pos-y
+         (last-x-y (mouse-absolute-pixel-position))
+         (last-x (car last-x-y))
+         (last-y (cdr last-x-y))
+         ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+         ;; mouse position when FRAME snapped.  As soon as the
+         ;; difference between `pos-x' and `snap-x' (or `pos-y' and
+         ;; `snap-y') exceeds the value of FRAME's `snap-width'
+         ;; parameter, unsnap FRAME (at the respective side).  `snap-x'
+         ;; and `snap-y' nil mean FRAME is curerntly not snapped.
+         snap-x snap-y
+         (exitfun nil)
+         (move
+          (lambda (event)
+            (interactive "e")
+            (when (consp event)
+              (setq pos-x-y (mouse-absolute-pixel-position))
+              (setq pos-x (car pos-x-y))
+              (setq pos-y (cdr pos-x-y))
+              (cond
+               ((eq part 'left)
+                (mouse-resize-frame frame (- last-x pos-x) 0 t))
+               ((eq part 'top)
+                (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
+               ((eq part 'right)
+                (mouse-resize-frame frame (- pos-x last-x) 0))
+               ((eq part 'bottom)
+                (mouse-resize-frame frame 0 (- pos-y last-y)))
+               ((eq part 'top-left)
+                (mouse-resize-frame
+                 frame (- last-x pos-x) (- last-y pos-y) t t))
+               ((eq part 'top-right)
+                (mouse-resize-frame
+                 frame (- pos-x last-x) (- last-y pos-y) nil t))
+               ((eq part 'bottom-left)
+                (mouse-resize-frame
+                 frame (- last-x pos-x) (- pos-y last-y) t))
+               ((eq part 'bottom-right)
+                (mouse-resize-frame
+                 frame (- pos-x last-x) (- pos-y last-y)))
+               ((eq part 'move)
+                (let* ((old-position (frame-position frame))
+                       (old-left (car old-position))
+                       (old-top (cdr old-position))
+                       (left (+ old-left (- pos-x last-x)))
+                       (top (+ old-top (- pos-y last-y)))
+                       right bottom
+                       ;; `snap-width' (maybe also a yet to be provided
+                       ;; `snap-height') could become floats to handle
+                       ;; proportionality wrt PARENT.  We don't do any
+                       ;; checks on this parameter so far.
+                       (snap-width (frame-parameter frame 'snap-width)))
+                  ;; Docking and constraining.
+                  (when (and (numberp snap-width) parent-edges)
+                    (cond
+                     ;; Docking at the left parent edge.
+                     ((< pos-x last-x)
+                      (cond
+                       ((and (> left parent-left)
+                             (<= (- left parent-left) snap-width))
+                        ;; Snap when the mouse moved leftward and
+                        ;; FRAME's left edge would end up within
+                        ;; `snap-width' pixels from PARENT's left edge.
+                        (setq snap-x pos-x)
+                        (setq left parent-left))
+                       ((and (<= left parent-left)
+                             (<= (- parent-left left) snap-width)
+                             snap-x (<= (- snap-x pos-x) snap-width))
+                        ;; Stay snapped when the mouse moved leftward
+                        ;; but not more than `snap-width' pixels from
+                        ;; the time FRAME snapped.
+                        (setq left parent-left))
+                       (t
+                        ;; Unsnap when the mouse moved more than
+                        ;; `snap-width' pixels leftward from the time
+                        ;; FRAME snapped.
+                        (setq snap-x nil))))
+                     ((> pos-x last-x)
+                      (setq right (+ left width))
+                      (cond
+                       ((and (< right parent-right)
+                             (<= (- parent-right right) snap-width))
+                        ;; Snap when the mouse moved rightward and
+                        ;; FRAME's right edge would end up within
+                        ;; `snap-width' pixels from PARENT's right edge.
+                        (setq snap-x pos-x)
+                        (setq left (- parent-right width)))
+                       ((and (>= right parent-right)
+                             (<= (- right parent-right) snap-width)
+                             snap-x (<= (- pos-x snap-x) snap-width))
+                        ;; Stay snapped when the mouse moved rightward
+                        ;; but not more more than `snap-width' pixels
+                        ;; from the time FRAME snapped.
+                        (setq left (- parent-right width)))
+                       (t
+                        ;; Unsnap when the mouse moved rightward more
+                        ;; than `snap-width' pixels from the time FRAME
+                        ;; snapped.
+                        (setq snap-x nil)))))
+
+                    (cond
+                     ((< pos-y last-y)
+                      (cond
+                       ((and (> top parent-top)
+                             (<= (- top parent-top) snap-width))
+                        ;; Snap when the mouse moved upward and FRAME's
+                        ;; top edge would end up within `snap-width'
+                        ;; pixels from PARENT's top edge.
+                        (setq snap-y pos-y)
+                        (setq top parent-top))
+                       ((and (<= top parent-top)
+                             (<= (- parent-top top) snap-width)
+                             snap-y (<= (- snap-y pos-y) snap-width))
+                        ;; Stay snapped when the mouse moved upward but
+                        ;; not more more than `snap-width' pixels from
+                        ;; the time FRAME snapped.
+                        (setq top parent-top))
+                       (t
+                        ;; Unsnap when the mouse moved upward more than
+                        ;; `snap-width' pixels from the time FRAME
+                        ;; snapped.
+                        (setq snap-y nil))))
+                     ((> pos-y last-y)
+                      (setq bottom (+ top height))
+                      (cond
+                       ((and (< bottom parent-bottom)
+                             (<= (- parent-bottom bottom) snap-width))
+                        ;; Snap when the mouse moved downward and
+                        ;; FRAME's bottom edge would end up within
+                        ;; `snap-width' pixels from PARENT's bottom
+                        ;; edge.
+                        (setq snap-y pos-y)
+                        (setq top (- parent-bottom height)))
+                       ((and (>= bottom parent-bottom)
+                             (<= (- bottom parent-bottom) snap-width)
+                             snap-y (<= (- pos-y snap-y) snap-width))
+                        ;; Stay snapped when the mouse moved downward
+                        ;; but not more more than `snap-width' pixels
+                        ;; from the time FRAME snapped.
+                        (setq top (- parent-bottom height)))
+                       (t
+                        ;; Unsnap when the mouse moved downward more
+                        ;; than `snap-width' pixels from the time FRAME
+                        ;; snapped.
+                        (setq snap-y nil))))))
+
+                  ;; If requested, constrain FRAME's draggable areas to
+                  ;; PARENT's edges.  The `top-visible' parameter should
+                  ;; be set when FRAME has a draggable header-line.  If
+                  ;; set to a number, it ascertains that the top of
+                  ;; FRAME is always constrained to the top of PARENT
+                  ;; and that at least as many pixels of FRAME as
+                  ;; specified by that number are visible on each of the
+                  ;; three remaining sides of PARENT.
+                  ;;
+                  ;; The `bottom-visible' parameter should be set when
+                  ;; FRAME has a draggable mode-line.  If set to a
+                  ;; number, it ascertains that the bottom of FRAME is
+                  ;; always constrained to the bottom of PARENT and that
+                  ;; at least as many pixels of FRAME as specified by
+                  ;; that number are visible on each of the three
+                  ;; remaining sides of PARENT.
+                  (let ((par (frame-parameter frame 'top-visible))
+                        bottom-visible)
+                    (unless par
+                      (setq par (frame-parameter frame 'bottom-visible))
+                      (setq bottom-visible t))
+                    (when (and (numberp par) parent-edges)
+                      (setq left
+                            (max (min (- parent-right par) left)
+                                 (+ (- parent-left width) par)))
+                      (setq top
+                            (if bottom-visible
+                                (min (max top (- parent-top (- height par)))
+                                     (- parent-bottom height))
+                              (min (max top parent-top)
+                                   (- parent-bottom par))))))
+
+                  ;; Use `modify-frame-parameters' since `left' and
+                  ;; `top' may want to move FRAME out of its PARENT.
+                  (modify-frame-parameters
+                   frame
+                   `((left . (+ ,left)) (top . (+ ,top)))))))
+              (setq last-x pos-x)
+              (setq last-y pos-y))))
+         (old-track-mouse track-mouse))
+    ;; Start tracking.  The special value 'dragging' signals the
+    ;; display engine to freeze the mouse pointer shape for as long
+    ;; as we drag.
+    (setq track-mouse 'dragging)
+    ;; Loop reading events and sampling the position of the mouse.
+    (setq exitfun
+          (set-transient-map
+           (let ((map (make-sparse-keymap)))
+             (define-key map [switch-frame] #'ignore)
+             (define-key map [select-window] #'ignore)
+             (define-key map [scroll-bar-movement] #'ignore)
+             (define-key map [mouse-movement] move)
+             ;; Swallow drag-mouse-1 events to avoid selecting some other window.
+             (define-key map [drag-mouse-1]
+               (lambda () (interactive) (funcall exitfun)))
+             ;; Some of the events will of course end up looked up
+             ;; with a mode-line, header-line or vertical-line prefix ...
+             (define-key map [mode-line] map)
+             (define-key map [header-line] map)
+             (define-key map [vertical-line] map)
+             ;; ... and some maybe even with a right- or bottom-divider
+             ;; prefix.
+             (define-key map [right-divider] map)
+             (define-key map [bottom-divider] map)
+             map)
+           t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-left-edge (start-event)
+  "Drag left edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'left))
+
+(defun mouse-drag-top-left-corner (start-event)
+  "Drag top left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'top-left))
+
+(defun mouse-drag-top-edge (start-event)
+  "Drag top edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'top))
+
+(defun mouse-drag-top-right-corner (start-event)
+  "Drag top right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'top-right))
+
+(defun mouse-drag-right-edge (start-event)
+  "Drag right edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'right))
+
+(defun mouse-drag-bottom-right-corner (start-event)
+  "Drag bottom right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'bottom-right))
+
+(defun mouse-drag-bottom-edge (start-event)
+  "Drag bottom edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'bottom))
+
+(defun mouse-drag-bottom-left-corner (start-event)
+  "Drag bottom left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+  (interactive "e")
+  (mouse-drag-frame start-event 'bottom-left))
+
 (defcustom mouse-select-region-move-to-beginning nil
   "Effect of selecting a region extending backward from double click.
 Nil means keep point at the position clicked (region end);
@@ -2078,6 +2449,22 @@ is copied instead of being cut."
 (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
 (global-set-key [bottom-divider mouse-1] 'ignore)
 (global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
+(global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
+(global-set-key [left-edge mouse-1] 'ignore)
+(global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
+(global-set-key [top-left-corner mouse-1] 'ignore)
+(global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
+(global-set-key [top-edge mouse-1] 'ignore)
+(global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
+(global-set-key [top-right-corner mouse-1] 'ignore)
+(global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
+(global-set-key [right-edge mouse-1] 'ignore)
+(global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
+(global-set-key [bottom-right-corner mouse-1] 'ignore)
+(global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
+(global-set-key [bottom-edge mouse-1] 'ignore)
+(global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
+(global-set-key [bottom-left-corner mouse-1] 'ignore)
 
 (provide 'mouse)