diff options
| author | Martin Rudalics | 2020-04-06 09:46:24 +0200 |
|---|---|---|
| committer | Martin Rudalics | 2020-04-06 09:46:24 +0200 |
| commit | 981cea9b624f61de3bc84226d19303ff3f8cbd8b (patch) | |
| tree | ebdf5604f5ae159e200a8423a7f293f46bd94dd5 | |
| parent | 24c3fa96077a5fec6d8ba65d7c49ff1a731be32f (diff) | |
| download | emacs-981cea9b624f61de3bc84226d19303ff3f8cbd8b.tar.gz emacs-981cea9b624f61de3bc84226d19303ff3f8cbd8b.zip | |
Fix problems when dragging frames with the mouse
Re-implement 'mouse-drag-frame' via two new functions -
'mouse-drag-frame-resize' and 'mouse-drag-frame-move'. This is
needed because with some toolkits the notifications for frame
movement and resizing arrive asynchronously, breaking any
calculations using intermediate frame sizes and positions.
* lisp/mouse.el (mouse-drag-mode-line, mouse-drag-left-edge)
(mouse-drag-top-left-corner, mouse-drag-top-edge)
(mouse-drag-top-right-corner, mouse-drag-right-edge)
(mouse-drag-bottom-right-corner, mouse-drag-bottom-edge)
(mouse-drag-bottom-left-corner): Call 'mouse-drag-frame-resize'
instead of 'mouse-drag-frame'.
(mouse-drag-frame): Split into two new functions -
'mouse-drag-frame-move' and 'mouse-drag-frame-resize'.
(mouse-drag-frame-resize, mouse-drag-frame-move): New functions
to implement functionality of the removed 'mouse-drag-frame'.
| -rw-r--r-- | lisp/mouse.el | 526 |
1 files changed, 292 insertions, 234 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el index e58a2e6da18..9703d957d57 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -552,7 +552,7 @@ frame instead." | |||
| 552 | (not (eq (window-frame minibuffer-window) frame)))) | 552 | (not (eq (window-frame minibuffer-window) frame)))) |
| 553 | ;; Drag frame when the window is on the bottom of its frame and | 553 | ;; Drag frame when the window is on the bottom of its frame and |
| 554 | ;; there is no minibuffer window below. | 554 | ;; there is no minibuffer window below. |
| 555 | (mouse-drag-frame start-event 'move))))) | 555 | (mouse-drag-frame-move start-event))))) |
| 556 | 556 | ||
| 557 | (defun mouse-drag-header-line (start-event) | 557 | (defun mouse-drag-header-line (start-event) |
| 558 | "Change the height of a window by dragging on its header line. | 558 | "Change the height of a window by dragging on its header line. |
| @@ -569,7 +569,7 @@ the frame instead." | |||
| 569 | (mouse-drag-line start-event 'header) | 569 | (mouse-drag-line start-event 'header) |
| 570 | (let ((frame (window-frame window))) | 570 | (let ((frame (window-frame window))) |
| 571 | (when (frame-parameter frame 'drag-with-header-line) | 571 | (when (frame-parameter frame 'drag-with-header-line) |
| 572 | (mouse-drag-frame start-event 'move)))))) | 572 | (mouse-drag-frame-move start-event)))))) |
| 573 | 573 | ||
| 574 | (defun mouse-drag-vertical-line (start-event) | 574 | (defun mouse-drag-vertical-line (start-event) |
| 575 | "Change the width of a window by dragging on a vertical line. | 575 | "Change the width of a window by dragging on a vertical line. |
| @@ -577,46 +577,7 @@ START-EVENT is the starting mouse event of the drag action." | |||
| 577 | (interactive "e") | 577 | (interactive "e") |
| 578 | (mouse-drag-line start-event 'vertical)) | 578 | (mouse-drag-line start-event 'vertical)) |
| 579 | 579 | ||
| 580 | (defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move) | 580 | (defun mouse-drag-frame-resize (start-event part) |
| 581 | "Helper function for `mouse-drag-frame'." | ||
| 582 | (let* ((frame-x-y (frame-position frame)) | ||
| 583 | (frame-x (car frame-x-y)) | ||
| 584 | (frame-y (cdr frame-x-y)) | ||
| 585 | alist) | ||
| 586 | (if (> x-diff 0) | ||
| 587 | (when x-move | ||
| 588 | (setq x-diff (min x-diff frame-x)) | ||
| 589 | (setq x-move (- frame-x x-diff))) | ||
| 590 | (let* ((min-width (frame-windows-min-size frame t nil t)) | ||
| 591 | (min-diff (max 0 (- (frame-inner-width frame) min-width)))) | ||
| 592 | (setq x-diff (max x-diff (- min-diff))) | ||
| 593 | (when x-move | ||
| 594 | (setq x-move (+ frame-x (- x-diff)))))) | ||
| 595 | |||
| 596 | (if (> y-diff 0) | ||
| 597 | (when y-move | ||
| 598 | (setq y-diff (min y-diff frame-y)) | ||
| 599 | (setq y-move (- frame-y y-diff))) | ||
| 600 | (let* ((min-height (frame-windows-min-size frame nil nil t)) | ||
| 601 | (min-diff (max 0 (- (frame-inner-height frame) min-height)))) | ||
| 602 | (setq y-diff (max y-diff (- min-diff))) | ||
| 603 | (when y-move | ||
| 604 | (setq y-move (+ frame-y (- y-diff)))))) | ||
| 605 | |||
| 606 | (unless (zerop x-diff) | ||
| 607 | (when x-move | ||
| 608 | (push `(left . ,x-move) alist)) | ||
| 609 | (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff))) | ||
| 610 | alist)) | ||
| 611 | (unless (zerop y-diff) | ||
| 612 | (when y-move | ||
| 613 | (push `(top . ,y-move) alist)) | ||
| 614 | (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff))) | ||
| 615 | alist)) | ||
| 616 | (when alist | ||
| 617 | (modify-frame-parameters frame alist)))) | ||
| 618 | |||
| 619 | (defun mouse-drag-frame (start-event part) | ||
| 620 | "Drag a frame or one of its edges with the mouse. | 581 | "Drag a frame or one of its edges with the mouse. |
| 621 | START-EVENT is the starting mouse event of the drag action. Its | 582 | START-EVENT is the starting mouse event of the drag action. Its |
| 622 | position window denotes the frame that will be dragged. | 583 | position window denotes the frame that will be dragged. |
| @@ -635,9 +596,144 @@ frame with the mouse." | |||
| 635 | (frame (if (window-live-p window) | 596 | (frame (if (window-live-p window) |
| 636 | (window-frame window) | 597 | (window-frame window) |
| 637 | window)) | 598 | window)) |
| 638 | (width (frame-native-width frame)) | 599 | ;; Initial "first" frame position and size. While dragging we |
| 639 | (height (frame-native-height frame)) | 600 | ;; base all calculations against that size and position. |
| 640 | ;; PARENT is the parent frame of FRAME or, if FRAME is a | 601 | (first-pos (frame-position frame)) |
| 602 | (first-left (car first-pos)) | ||
| 603 | (first-top (cdr first-pos)) | ||
| 604 | (first-width (frame-text-width frame)) | ||
| 605 | (first-height (frame-text-height frame)) | ||
| 606 | ;; Don't let FRAME become less large than the size needed to | ||
| 607 | ;; fit all of its windows. | ||
| 608 | (min-text-width | ||
| 609 | (+ (frame-windows-min-size frame t nil t) | ||
| 610 | (- (frame-inner-width frame) first-width))) | ||
| 611 | (min-text-height | ||
| 612 | (+ (frame-windows-min-size frame nil nil t) | ||
| 613 | (- (frame-inner-height frame) first-height))) | ||
| 614 | ;; PARENT is the parent frame of FRAME or, if FRAME is a | ||
| 615 | ;; top-level frame, FRAME's workarea. | ||
| 616 | (parent (frame-parent frame)) | ||
| 617 | (parent-edges | ||
| 618 | (if parent | ||
| 619 | (frame-edges parent) | ||
| 620 | (let* ((attributes | ||
| 621 | (car (display-monitor-attributes-list))) | ||
| 622 | (workarea (assq 'workarea attributes))) | ||
| 623 | (and workarea | ||
| 624 | `(,(nth 1 workarea) ,(nth 2 workarea) | ||
| 625 | ,(+ (nth 1 workarea) (nth 3 workarea)) | ||
| 626 | ,(+ (nth 2 workarea) (nth 4 workarea))))))) | ||
| 627 | (parent-left (and parent-edges (nth 0 parent-edges))) | ||
| 628 | (parent-top (and parent-edges (nth 1 parent-edges))) | ||
| 629 | (parent-right (and parent-edges (nth 2 parent-edges))) | ||
| 630 | (parent-bottom (and parent-edges (nth 3 parent-edges))) | ||
| 631 | ;; Drag types. drag-left/drag-right and drag-top/drag-bottom | ||
| 632 | ;; are mutually exclusive. | ||
| 633 | (drag-left (memq part '(bottom-left left top-left))) | ||
| 634 | (drag-top (memq part '(top-left top top-right))) | ||
| 635 | (drag-right (memq part '(top-right right bottom-right))) | ||
| 636 | (drag-bottom (memq part '(bottom-right bottom bottom-left))) | ||
| 637 | ;; Initial "first" mouse position. While dragging we base all | ||
| 638 | ;; calculations against that position. | ||
| 639 | (first-x-y (mouse-absolute-pixel-position)) | ||
| 640 | (first-x (car first-x-y)) | ||
| 641 | (first-y (cdr first-x-y)) | ||
| 642 | (exitfun nil) | ||
| 643 | (move | ||
| 644 | (lambda (event) | ||
| 645 | (interactive "e") | ||
| 646 | (when (consp event) | ||
| 647 | (let* ((last-x-y (mouse-absolute-pixel-position)) | ||
| 648 | (last-x (car last-x-y)) | ||
| 649 | (last-y (cdr last-x-y)) | ||
| 650 | (left (- last-x first-x)) | ||
| 651 | (top (- last-y first-y)) | ||
| 652 | alist) | ||
| 653 | ;; We never want to warp the mouse position here. When | ||
| 654 | ;; moving the mouse leftward or upward, then with a wide | ||
| 655 | ;; border the calculated left or top position of the | ||
| 656 | ;; frame could drop to a value less than zero depending | ||
| 657 | ;; on where precisely the mouse within the border. We | ||
| 658 | ;; guard against this by never allowing the frame to | ||
| 659 | ;; move to a position less than zero here. No such | ||
| 660 | ;; precautions are used for the right and bottom borders | ||
| 661 | ;; so with a large internal border parts of that border | ||
| 662 | ;; may disappear. | ||
| 663 | (when (and drag-left (>= last-x parent-left) | ||
| 664 | (>= (- first-width left) min-text-width)) | ||
| 665 | (push `(left . ,(max (+ first-left left) 0)) alist) | ||
| 666 | (push `(width . (text-pixels . ,(- first-width left))) | ||
| 667 | alist)) | ||
| 668 | (when (and drag-top (>= last-y parent-top) | ||
| 669 | (>= (- first-height top) min-text-height)) | ||
| 670 | (push `(top . ,(max 0 (+ first-top top))) alist) | ||
| 671 | (push `(height . (text-pixels . ,(- first-height top))) | ||
| 672 | alist)) | ||
| 673 | (when (and drag-right (<= last-x parent-right) | ||
| 674 | (>= (+ first-width left) min-text-width)) | ||
| 675 | (push `(width . (text-pixels . ,(+ first-width left))) | ||
| 676 | alist)) | ||
| 677 | (when (and drag-bottom (<= last-y parent-bottom) | ||
| 678 | (>= (+ first-height top) min-text-height)) | ||
| 679 | (push `(height . (text-pixels . ,(+ first-height top))) | ||
| 680 | alist)) | ||
| 681 | (modify-frame-parameters frame alist))))) | ||
| 682 | (old-track-mouse track-mouse)) | ||
| 683 | ;; Start tracking. The special value 'dragging' signals the | ||
| 684 | ;; display engine to freeze the mouse pointer shape for as long | ||
| 685 | ;; as we drag. | ||
| 686 | (setq track-mouse 'dragging) | ||
| 687 | ;; Loop reading events and sampling the position of the mouse. | ||
| 688 | (setq exitfun | ||
| 689 | (set-transient-map | ||
| 690 | (let ((map (make-sparse-keymap))) | ||
| 691 | (define-key map [switch-frame] #'ignore) | ||
| 692 | (define-key map [select-window] #'ignore) | ||
| 693 | (define-key map [scroll-bar-movement] #'ignore) | ||
| 694 | (define-key map [mouse-movement] move) | ||
| 695 | ;; Swallow drag-mouse-1 events to avoid selecting some other window. | ||
| 696 | (define-key map [drag-mouse-1] | ||
| 697 | (lambda () (interactive) (funcall exitfun))) | ||
| 698 | ;; Some of the events will of course end up looked up | ||
| 699 | ;; with a mode-line, header-line or vertical-line prefix ... | ||
| 700 | (define-key map [mode-line] map) | ||
| 701 | (define-key map [header-line] map) | ||
| 702 | (define-key map [vertical-line] map) | ||
| 703 | ;; ... and some maybe even with a right- or bottom-divider | ||
| 704 | ;; prefix. | ||
| 705 | (define-key map [right-divider] map) | ||
| 706 | (define-key map [bottom-divider] map) | ||
| 707 | map) | ||
| 708 | t (lambda () (setq track-mouse old-track-mouse)))))) | ||
| 709 | |||
| 710 | (defun mouse-drag-frame-move (start-event) | ||
| 711 | "Drag a frame or one of its edges with the mouse. | ||
| 712 | START-EVENT is the starting mouse event of the drag action. Its | ||
| 713 | position window denotes the frame that will be dragged. | ||
| 714 | |||
| 715 | PART specifies the part that has been dragged and must be one of | ||
| 716 | the symbols `left', `top', `right', `bottom', `top-left', | ||
| 717 | `top-right', `bottom-left', `bottom-right' to drag an internal | ||
| 718 | border or edge. If PART equals `move', this means to move the | ||
| 719 | frame with the mouse." | ||
| 720 | ;; Give temporary modes such as isearch a chance to turn off. | ||
| 721 | (run-hooks 'mouse-leave-buffer-hook) | ||
| 722 | (let* ((echo-keystrokes 0) | ||
| 723 | (start (event-start start-event)) | ||
| 724 | (window (posn-window start)) | ||
| 725 | ;; FRAME is the frame to drag. | ||
| 726 | (frame (if (window-live-p window) | ||
| 727 | (window-frame window) | ||
| 728 | window)) | ||
| 729 | (native-width (frame-native-width frame)) | ||
| 730 | (native-height (frame-native-height frame)) | ||
| 731 | ;; Initial "first" frame position and size. While dragging we | ||
| 732 | ;; base all calculations against that size and position. | ||
| 733 | (first-pos (frame-position frame)) | ||
| 734 | (first-left (car first-pos)) | ||
| 735 | (first-top (cdr first-pos)) | ||
| 736 | ;; PARENT is the parent frame of FRAME or, if FRAME is a | ||
| 641 | ;; top-level frame, FRAME's workarea. | 737 | ;; top-level frame, FRAME's workarea. |
| 642 | (parent (frame-parent frame)) | 738 | (parent (frame-parent frame)) |
| 643 | (parent-edges | 739 | (parent-edges |
| @@ -654,19 +750,16 @@ frame with the mouse." | |||
| 654 | (parent-top (and parent-edges (nth 1 parent-edges))) | 750 | (parent-top (and parent-edges (nth 1 parent-edges))) |
| 655 | (parent-right (and parent-edges (nth 2 parent-edges))) | 751 | (parent-right (and parent-edges (nth 2 parent-edges))) |
| 656 | (parent-bottom (and parent-edges (nth 3 parent-edges))) | 752 | (parent-bottom (and parent-edges (nth 3 parent-edges))) |
| 657 | ;; `pos-x' and `pos-y' record the x- and y-coordinates of the | 753 | ;; Initial "first" mouse position. While dragging we base all |
| 658 | ;; last sampled mouse position. Note that we sample absolute | 754 | ;; calculations against that position. |
| 659 | ;; mouse positions to avoid that moving the mouse from one | 755 | (first-x-y (mouse-absolute-pixel-position)) |
| 660 | ;; frame into another gets into our way. `last-x' and `last-y' | 756 | (first-x (car first-x-y)) |
| 661 | ;; records the x- and y-coordinates of the previously sampled | 757 | (first-y (cdr first-x-y)) |
| 662 | ;; position. The differences between `last-x' and `pos-x' as | 758 | ;; `snap-width' (maybe also a yet to be provided `snap-height') |
| 663 | ;; well as `last-y' and `pos-y' determine the amount the mouse | 759 | ;; could become floats to handle proportionality wrt PARENT. |
| 664 | ;; has been dragged between the last two samples. | 760 | ;; We don't do any checks on this parameter so far. |
| 665 | pos-x-y pos-x pos-y | 761 | (snap-width (frame-parameter frame 'snap-width)) |
| 666 | (last-x-y (mouse-absolute-pixel-position)) | 762 | ;; `snap-x' and `snap-y' record the x- and y-coordinates of the |
| 667 | (last-x (car last-x-y)) | ||
| 668 | (last-y (cdr last-x-y)) | ||
| 669 | ;; `snap-x' and `snap-y' record the x- and y-coordinates of the | ||
| 670 | ;; mouse position when FRAME snapped. As soon as the | 763 | ;; mouse position when FRAME snapped. As soon as the |
| 671 | ;; difference between `pos-x' and `snap-x' (or `pos-y' and | 764 | ;; difference between `pos-x' and `snap-x' (or `pos-y' and |
| 672 | ;; `snap-y') exceeds the value of FRAME's `snap-width' | 765 | ;; `snap-y') exceeds the value of FRAME's `snap-width' |
| @@ -678,176 +771,141 @@ frame with the mouse." | |||
| 678 | (lambda (event) | 771 | (lambda (event) |
| 679 | (interactive "e") | 772 | (interactive "e") |
| 680 | (when (consp event) | 773 | (when (consp event) |
| 681 | (setq pos-x-y (mouse-absolute-pixel-position)) | 774 | (let* ((last-x-y (mouse-absolute-pixel-position)) |
| 682 | (setq pos-x (car pos-x-y)) | 775 | (last-x (car last-x-y)) |
| 683 | (setq pos-y (cdr pos-x-y)) | 776 | (last-y (cdr last-x-y)) |
| 684 | (cond | 777 | (left (- last-x first-x)) |
| 685 | ((eq part 'left) | 778 | (top (- last-y first-y)) |
| 686 | (mouse-resize-frame frame (- last-x pos-x) 0 t)) | 779 | right bottom) |
| 687 | ((eq part 'top) | 780 | (setq left (+ first-left left)) |
| 688 | (mouse-resize-frame frame 0 (- last-y pos-y) nil t)) | 781 | (setq top (+ first-top top)) |
| 689 | ((eq part 'right) | 782 | ;; Docking and constraining. |
| 690 | (mouse-resize-frame frame (- pos-x last-x) 0)) | 783 | (when (and (numberp snap-width) parent-edges) |
| 691 | ((eq part 'bottom) | 784 | (cond |
| 692 | (mouse-resize-frame frame 0 (- pos-y last-y))) | 785 | ;; Docking at the left parent edge. |
| 693 | ((eq part 'top-left) | 786 | ((< last-x first-x) |
| 694 | (mouse-resize-frame | ||
| 695 | frame (- last-x pos-x) (- last-y pos-y) t t)) | ||
| 696 | ((eq part 'top-right) | ||
| 697 | (mouse-resize-frame | ||
| 698 | frame (- pos-x last-x) (- last-y pos-y) nil t)) | ||
| 699 | ((eq part 'bottom-left) | ||
| 700 | (mouse-resize-frame | ||
| 701 | frame (- last-x pos-x) (- pos-y last-y) t)) | ||
| 702 | ((eq part 'bottom-right) | ||
| 703 | (mouse-resize-frame | ||
| 704 | frame (- pos-x last-x) (- pos-y last-y))) | ||
| 705 | ((eq part 'move) | ||
| 706 | (let* ((old-position (frame-position frame)) | ||
| 707 | (old-left (car old-position)) | ||
| 708 | (old-top (cdr old-position)) | ||
| 709 | (left (+ old-left (- pos-x last-x))) | ||
| 710 | (top (+ old-top (- pos-y last-y))) | ||
| 711 | right bottom | ||
| 712 | ;; `snap-width' (maybe also a yet to be provided | ||
| 713 | ;; `snap-height') could become floats to handle | ||
| 714 | ;; proportionality wrt PARENT. We don't do any | ||
| 715 | ;; checks on this parameter so far. | ||
| 716 | (snap-width (frame-parameter frame 'snap-width))) | ||
| 717 | ;; Docking and constraining. | ||
| 718 | (when (and (numberp snap-width) parent-edges) | ||
| 719 | (cond | 787 | (cond |
| 720 | ;; Docking at the left parent edge. | 788 | ((and (> left parent-left) |
| 721 | ((< pos-x last-x) | 789 | (<= (- left parent-left) snap-width)) |
| 722 | (cond | 790 | ;; Snap when the mouse moved leftward and FRAME's |
| 723 | ((and (> left parent-left) | 791 | ;; left edge would end up within `snap-width' |
| 724 | (<= (- left parent-left) snap-width)) | 792 | ;; pixels from PARENT's left edge. |
| 725 | ;; Snap when the mouse moved leftward and | 793 | (setq snap-x last-x) |
| 726 | ;; FRAME's left edge would end up within | 794 | (setq left parent-left)) |
| 727 | ;; `snap-width' pixels from PARENT's left edge. | 795 | ((and (<= left parent-left) |
| 728 | (setq snap-x pos-x) | 796 | (<= (- parent-left left) snap-width) |
| 729 | (setq left parent-left)) | 797 | snap-x (<= (- snap-x last-x) snap-width)) |
| 730 | ((and (<= left parent-left) | 798 | ;; Stay snapped when the mouse moved leftward but |
| 731 | (<= (- parent-left left) snap-width) | 799 | ;; not more than `snap-width' pixels from the time |
| 732 | snap-x (<= (- snap-x pos-x) snap-width)) | 800 | ;; FRAME snapped. |
| 733 | ;; Stay snapped when the mouse moved leftward | 801 | (setq left parent-left)) |
| 734 | ;; but not more than `snap-width' pixels from | 802 | (t |
| 735 | ;; the time FRAME snapped. | 803 | ;; Unsnap when the mouse moved more than |
| 736 | (setq left parent-left)) | 804 | ;; `snap-width' pixels leftward from the time |
| 737 | (t | 805 | ;; FRAME snapped. |
| 738 | ;; Unsnap when the mouse moved more than | 806 | (setq snap-x nil)))) |
| 739 | ;; `snap-width' pixels leftward from the time | 807 | ((> last-x first-x) |
| 740 | ;; FRAME snapped. | 808 | (setq right (+ left native-width)) |
| 741 | (setq snap-x nil)))) | ||
| 742 | ((> pos-x last-x) | ||
| 743 | (setq right (+ left width)) | ||
| 744 | (cond | ||
| 745 | ((and (< right parent-right) | ||
| 746 | (<= (- parent-right right) snap-width)) | ||
| 747 | ;; Snap when the mouse moved rightward and | ||
| 748 | ;; FRAME's right edge would end up within | ||
| 749 | ;; `snap-width' pixels from PARENT's right edge. | ||
| 750 | (setq snap-x pos-x) | ||
| 751 | (setq left (- parent-right width))) | ||
| 752 | ((and (>= right parent-right) | ||
| 753 | (<= (- right parent-right) snap-width) | ||
| 754 | snap-x (<= (- pos-x snap-x) snap-width)) | ||
| 755 | ;; Stay snapped when the mouse moved rightward | ||
| 756 | ;; but not more more than `snap-width' pixels | ||
| 757 | ;; from the time FRAME snapped. | ||
| 758 | (setq left (- parent-right width))) | ||
| 759 | (t | ||
| 760 | ;; Unsnap when the mouse moved rightward more | ||
| 761 | ;; than `snap-width' pixels from the time FRAME | ||
| 762 | ;; snapped. | ||
| 763 | (setq snap-x nil))))) | ||
| 764 | |||
| 765 | (cond | 809 | (cond |
| 766 | ((< pos-y last-y) | 810 | ((and (< right parent-right) |
| 767 | (cond | 811 | (<= (- parent-right right) snap-width)) |
| 768 | ((and (> top parent-top) | 812 | ;; Snap when the mouse moved rightward and FRAME's |
| 769 | (<= (- top parent-top) snap-width)) | 813 | ;; right edge would end up within `snap-width' |
| 770 | ;; Snap when the mouse moved upward and FRAME's | 814 | ;; pixels from PARENT's right edge. |
| 771 | ;; top edge would end up within `snap-width' | 815 | (setq snap-x last-x) |
| 772 | ;; pixels from PARENT's top edge. | 816 | (setq left (- parent-right native-width))) |
| 773 | (setq snap-y pos-y) | 817 | ((and (>= right parent-right) |
| 774 | (setq top parent-top)) | 818 | (<= (- right parent-right) snap-width) |
| 775 | ((and (<= top parent-top) | 819 | snap-x (<= (- last-x snap-x) snap-width)) |
| 776 | (<= (- parent-top top) snap-width) | 820 | ;; Stay snapped when the mouse moved rightward but |
| 777 | snap-y (<= (- snap-y pos-y) snap-width)) | 821 | ;; not more more than `snap-width' pixels from the |
| 778 | ;; Stay snapped when the mouse moved upward but | 822 | ;; time FRAME snapped. |
| 779 | ;; not more more than `snap-width' pixels from | 823 | (setq left (- parent-right native-width))) |
| 780 | ;; the time FRAME snapped. | 824 | (t |
| 781 | (setq top parent-top)) | 825 | ;; Unsnap when the mouse moved rightward more than |
| 782 | (t | 826 | ;; `snap-width' pixels from the time FRAME |
| 783 | ;; Unsnap when the mouse moved upward more than | 827 | ;; snapped. |
| 784 | ;; `snap-width' pixels from the time FRAME | 828 | (setq snap-x nil))))) |
| 785 | ;; snapped. | 829 | (cond |
| 786 | (setq snap-y nil)))) | 830 | ((< last-y first-y) |
| 787 | ((> pos-y last-y) | 831 | (cond |
| 788 | (setq bottom (+ top height)) | 832 | ((and (> top parent-top) |
| 789 | (cond | 833 | (<= (- top parent-top) snap-width)) |
| 790 | ((and (< bottom parent-bottom) | 834 | ;; Snap when the mouse moved upward and FRAME's |
| 791 | (<= (- parent-bottom bottom) snap-width)) | 835 | ;; top edge would end up within `snap-width' |
| 792 | ;; Snap when the mouse moved downward and | 836 | ;; pixels from PARENT's top edge. |
| 793 | ;; FRAME's bottom edge would end up within | 837 | (setq snap-y last-y) |
| 794 | ;; `snap-width' pixels from PARENT's bottom | 838 | (setq top parent-top)) |
| 795 | ;; edge. | 839 | ((and (<= top parent-top) |
| 796 | (setq snap-y pos-y) | 840 | (<= (- parent-top top) snap-width) |
| 797 | (setq top (- parent-bottom height))) | 841 | snap-y (<= (- snap-y last-y) snap-width)) |
| 798 | ((and (>= bottom parent-bottom) | 842 | ;; Stay snapped when the mouse moved upward but |
| 799 | (<= (- bottom parent-bottom) snap-width) | 843 | ;; not more more than `snap-width' pixels from the |
| 800 | snap-y (<= (- pos-y snap-y) snap-width)) | 844 | ;; time FRAME snapped. |
| 801 | ;; Stay snapped when the mouse moved downward | 845 | (setq top parent-top)) |
| 802 | ;; but not more more than `snap-width' pixels | 846 | (t |
| 803 | ;; from the time FRAME snapped. | 847 | ;; Unsnap when the mouse moved upward more than |
| 804 | (setq top (- parent-bottom height))) | 848 | ;; `snap-width' pixels from the time FRAME |
| 805 | (t | 849 | ;; snapped. |
| 806 | ;; Unsnap when the mouse moved downward more | 850 | (setq snap-y nil)))) |
| 807 | ;; than `snap-width' pixels from the time FRAME | 851 | ((> last-y first-y) |
| 808 | ;; snapped. | 852 | (setq bottom (+ top native-height)) |
| 809 | (setq snap-y nil)))))) | 853 | (cond |
| 810 | 854 | ((and (< bottom parent-bottom) | |
| 811 | ;; If requested, constrain FRAME's draggable areas to | 855 | (<= (- parent-bottom bottom) snap-width)) |
| 812 | ;; PARENT's edges. The `top-visible' parameter should | 856 | ;; Snap when the mouse moved downward and FRAME's |
| 813 | ;; be set when FRAME has a draggable header-line. If | 857 | ;; bottom edge would end up within `snap-width' |
| 814 | ;; set to a number, it ascertains that the top of | 858 | ;; pixels from PARENT's bottom edge. |
| 815 | ;; FRAME is always constrained to the top of PARENT | 859 | (setq snap-y last-y) |
| 816 | ;; and that at least as many pixels of FRAME as | 860 | (setq top (- parent-bottom native-height))) |
| 817 | ;; specified by that number are visible on each of the | 861 | ((and (>= bottom parent-bottom) |
| 818 | ;; three remaining sides of PARENT. | 862 | (<= (- bottom parent-bottom) snap-width) |
| 819 | ;; | 863 | snap-y (<= (- last-y snap-y) snap-width)) |
| 820 | ;; The `bottom-visible' parameter should be set when | 864 | ;; Stay snapped when the mouse moved downward but |
| 821 | ;; FRAME has a draggable mode-line. If set to a | 865 | ;; not more more than `snap-width' pixels from the |
| 822 | ;; number, it ascertains that the bottom of FRAME is | 866 | ;; time FRAME snapped. |
| 823 | ;; always constrained to the bottom of PARENT and that | 867 | (setq top (- parent-bottom native-height))) |
| 824 | ;; at least as many pixels of FRAME as specified by | 868 | (t |
| 825 | ;; that number are visible on each of the three | 869 | ;; Unsnap when the mouse moved downward more than |
| 826 | ;; remaining sides of PARENT. | 870 | ;; `snap-width' pixels from the time FRAME |
| 827 | (let ((par (frame-parameter frame 'top-visible)) | 871 | ;; snapped. |
| 828 | bottom-visible) | 872 | (setq snap-y nil)))))) |
| 829 | (unless par | 873 | |
| 830 | (setq par (frame-parameter frame 'bottom-visible)) | 874 | ;; If requested, constrain FRAME's draggable areas to |
| 831 | (setq bottom-visible t)) | 875 | ;; PARENT's edges. The `top-visible' parameter should |
| 832 | (when (and (numberp par) parent-edges) | 876 | ;; be set when FRAME has a draggable header-line. If |
| 833 | (setq left | 877 | ;; set to a number, it ascertains that the top of FRAME |
| 834 | (max (min (- parent-right par) left) | 878 | ;; is always constrained to the top of PARENT and that |
| 835 | (+ (- parent-left width) par))) | 879 | ;; at least as many pixels of FRAME as specified by that |
| 836 | (setq top | 880 | ;; number are visible on each of the three remaining |
| 837 | (if bottom-visible | 881 | ;; sides of PARENT. |
| 838 | (min (max top (- parent-top (- height par))) | 882 | ;; |
| 839 | (- parent-bottom height)) | 883 | ;; The `bottom-visible' parameter should be set when |
| 840 | (min (max top parent-top) | 884 | ;; FRAME has a draggable mode-line. If set to a number, |
| 841 | (- parent-bottom par)))))) | 885 | ;; it ascertains that the bottom of FRAME is always |
| 842 | 886 | ;; constrained to the bottom of PARENT and that at least | |
| 843 | ;; Use `modify-frame-parameters' since `left' and | 887 | ;; as many pixels of FRAME as specified by that number |
| 844 | ;; `top' may want to move FRAME out of its PARENT. | 888 | ;; are visible on each of the three remaining sides of |
| 845 | (modify-frame-parameters | 889 | ;; PARENT. |
| 846 | frame | 890 | (let ((par (frame-parameter frame 'top-visible)) |
| 847 | `((left . (+ ,left)) (top . (+ ,top))))))) | 891 | bottom-visible) |
| 848 | (setq last-x pos-x) | 892 | (unless par |
| 849 | (setq last-y pos-y)))) | 893 | (setq par (frame-parameter frame 'bottom-visible)) |
| 850 | (old-track-mouse track-mouse)) | 894 | (setq bottom-visible t)) |
| 895 | (when (and (numberp par) parent-edges) | ||
| 896 | (setq left | ||
| 897 | (max (min (- parent-right par) left) | ||
| 898 | (+ (- parent-left native-width) par))) | ||
| 899 | (setq top | ||
| 900 | (if bottom-visible | ||
| 901 | (min (max top (- parent-top (- native-height par))) | ||
| 902 | (- parent-bottom native-height)) | ||
| 903 | (min (max top parent-top) | ||
| 904 | (- parent-bottom par)))))) | ||
| 905 | ;; Use `modify-frame-parameters' since `left' and `top' | ||
| 906 | ;; may want to move FRAME out of its PARENT. | ||
| 907 | (modify-frame-parameters frame `((left . (+ ,left)) (top . (+ ,top)))))))) | ||
| 908 | (old-track-mouse track-mouse)) | ||
| 851 | ;; Start tracking. The special value 'dragging' signals the | 909 | ;; Start tracking. The special value 'dragging' signals the |
| 852 | ;; display engine to freeze the mouse pointer shape for as long | 910 | ;; display engine to freeze the mouse pointer shape for as long |
| 853 | ;; as we drag. | 911 | ;; as we drag. |
| @@ -879,49 +937,49 @@ frame with the mouse." | |||
| 879 | "Drag left edge of a frame with the mouse. | 937 | "Drag left edge of a frame with the mouse. |
| 880 | START-EVENT is the starting mouse event of the drag action." | 938 | START-EVENT is the starting mouse event of the drag action." |
| 881 | (interactive "e") | 939 | (interactive "e") |
| 882 | (mouse-drag-frame start-event 'left)) | 940 | (mouse-drag-frame-resize start-event 'left)) |
| 883 | 941 | ||
| 884 | (defun mouse-drag-top-left-corner (start-event) | 942 | (defun mouse-drag-top-left-corner (start-event) |
| 885 | "Drag top left corner of a frame with the mouse. | 943 | "Drag top left corner of a frame with the mouse. |
| 886 | START-EVENT is the starting mouse event of the drag action." | 944 | START-EVENT is the starting mouse event of the drag action." |
| 887 | (interactive "e") | 945 | (interactive "e") |
| 888 | (mouse-drag-frame start-event 'top-left)) | 946 | (mouse-drag-frame-resize start-event 'top-left)) |
| 889 | 947 | ||
| 890 | (defun mouse-drag-top-edge (start-event) | 948 | (defun mouse-drag-top-edge (start-event) |
| 891 | "Drag top edge of a frame with the mouse. | 949 | "Drag top edge of a frame with the mouse. |
| 892 | START-EVENT is the starting mouse event of the drag action." | 950 | START-EVENT is the starting mouse event of the drag action." |
| 893 | (interactive "e") | 951 | (interactive "e") |
| 894 | (mouse-drag-frame start-event 'top)) | 952 | (mouse-drag-frame-resize start-event 'top)) |
| 895 | 953 | ||
| 896 | (defun mouse-drag-top-right-corner (start-event) | 954 | (defun mouse-drag-top-right-corner (start-event) |
| 897 | "Drag top right corner of a frame with the mouse. | 955 | "Drag top right corner of a frame with the mouse. |
| 898 | START-EVENT is the starting mouse event of the drag action." | 956 | START-EVENT is the starting mouse event of the drag action." |
| 899 | (interactive "e") | 957 | (interactive "e") |
| 900 | (mouse-drag-frame start-event 'top-right)) | 958 | (mouse-drag-frame-resize start-event 'top-right)) |
| 901 | 959 | ||
| 902 | (defun mouse-drag-right-edge (start-event) | 960 | (defun mouse-drag-right-edge (start-event) |
| 903 | "Drag right edge of a frame with the mouse. | 961 | "Drag right edge of a frame with the mouse. |
| 904 | START-EVENT is the starting mouse event of the drag action." | 962 | START-EVENT is the starting mouse event of the drag action." |
| 905 | (interactive "e") | 963 | (interactive "e") |
| 906 | (mouse-drag-frame start-event 'right)) | 964 | (mouse-drag-frame-resize start-event 'right)) |
| 907 | 965 | ||
| 908 | (defun mouse-drag-bottom-right-corner (start-event) | 966 | (defun mouse-drag-bottom-right-corner (start-event) |
| 909 | "Drag bottom right corner of a frame with the mouse. | 967 | "Drag bottom right corner of a frame with the mouse. |
| 910 | START-EVENT is the starting mouse event of the drag action." | 968 | START-EVENT is the starting mouse event of the drag action." |
| 911 | (interactive "e") | 969 | (interactive "e") |
| 912 | (mouse-drag-frame start-event 'bottom-right)) | 970 | (mouse-drag-frame-resize start-event 'bottom-right)) |
| 913 | 971 | ||
| 914 | (defun mouse-drag-bottom-edge (start-event) | 972 | (defun mouse-drag-bottom-edge (start-event) |
| 915 | "Drag bottom edge of a frame with the mouse. | 973 | "Drag bottom edge of a frame with the mouse. |
| 916 | START-EVENT is the starting mouse event of the drag action." | 974 | START-EVENT is the starting mouse event of the drag action." |
| 917 | (interactive "e") | 975 | (interactive "e") |
| 918 | (mouse-drag-frame start-event 'bottom)) | 976 | (mouse-drag-frame-resize start-event 'bottom)) |
| 919 | 977 | ||
| 920 | (defun mouse-drag-bottom-left-corner (start-event) | 978 | (defun mouse-drag-bottom-left-corner (start-event) |
| 921 | "Drag bottom left corner of a frame with the mouse. | 979 | "Drag bottom left corner of a frame with the mouse. |
| 922 | START-EVENT is the starting mouse event of the drag action." | 980 | START-EVENT is the starting mouse event of the drag action." |
| 923 | (interactive "e") | 981 | (interactive "e") |
| 924 | (mouse-drag-frame start-event 'bottom-left)) | 982 | (mouse-drag-frame-resize start-event 'bottom-left)) |
| 925 | 983 | ||
| 926 | (defcustom mouse-select-region-move-to-beginning nil | 984 | (defcustom mouse-select-region-move-to-beginning nil |
| 927 | "Effect of selecting a region extending backward from double click. | 985 | "Effect of selecting a region extending backward from double click. |