From c05a0fec91b6cbbb33ddcb9335d9936e20c549ff Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 17 Mar 2025 09:50:19 +0100 Subject: [PATCH] Implement dragging and resizing of tty child frames * lisp/faces.el (face-spec-recalc): Don't set scroll-bar-foreground and scroll-bar-background parameters on ttys. * lisp/mouse.el (mouse-drag-frame-resize) (mouse-drag-frame-move): On ttys call 'mouse-position-in-root-frame' to get position of child frame to resize or drag. * lisp/xt-mouse.el (xterm-mouse-event): Handle events on child frame decorations as if they happened on the internal border to find out whether a user wants to drag or resize a child frame. * src/frame.c (frame_internal_border_part): Define for ttys too. (Fmouse_position_in_root_frame): New function. * src/frame.h (internal_border_part): Define for ttys too. * src/keyboard.c (internal_border_parts): Define for ttys too. (frame_border_side): New enum. (make_lispy_position): Handle events on tty child frames. (Fposn_at_x_y): Accept -1 for Y so we can handle a position on the top decoration of a tty child frame. * src/term.c (tty_frame_at): Handle case where X and Y denote a position on a tty child frame's decoration. * src/window.c (Fwindow_at): Handle case where X and Y denote a position on the decoration of a tty child frame which we pretend as belonging to that child frame (and not to its root). (cherry picked from commit 86be9431ae88126387ed8402cb4953963ebba6f8) --- lisp/faces.el | 3 +- lisp/mouse.el | 24 +++++++---- lisp/xt-mouse.el | 48 ++++++++++++++++------ src/frame.c | 41 +++++++++++++++++-- src/frame.h | 29 ++++++------- src/keyboard.c | 104 +++++++++++++++++++++++++++++++++++++++++++---- src/term.c | 61 ++++++++++++++++++++++++++- src/window.c | 7 ++++ 8 files changed, 269 insertions(+), 48 deletions(-) diff --git a/lisp/faces.el b/lisp/faces.el index d8f1368e049..f092c927617 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1813,7 +1813,8 @@ The following sources are applied in this order: (list :extend (cadr tail)))))) (setq face-attrs (face-spec-choose (get face 'face-override-spec) frame)) (face-spec-set-2 face frame face-attrs) - (when (and (fboundp 'set-frame-parameter) ; This isn't available + (when (and (not (eq (framep frame) t)) + (fboundp 'set-frame-parameter) ; This isn't available ; during loadup. (eq face 'scroll-bar)) ;; Set the `scroll-bar-foreground' and `scroll-bar-background' diff --git a/lisp/mouse.el b/lisp/mouse.el index 4307fd86cb9..5839562bffb 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1095,7 +1095,10 @@ frame with the mouse." (drag-bottom (memq part '(bottom-right bottom bottom-left))) ;; Initial "first" mouse position. While dragging we base all ;; calculations against that position. - (first-x-y (mouse-absolute-pixel-position)) + (tty (tty-type frame)) + (first-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (first-x (car first-x-y)) (first-y (cdr first-x-y)) (exitfun nil) @@ -1103,7 +1106,9 @@ frame with the mouse." (lambda (event) (interactive "e") (when (consp event) - (let* ((last-x-y (mouse-absolute-pixel-position)) + (let* ((last-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (last-x (car last-x-y)) (last-y (cdr last-x-y)) (left (- last-x first-x)) @@ -1212,10 +1217,13 @@ frame with the mouse." (parent-bottom (and parent-edges (nth 3 parent-edges))) ;; Initial "first" mouse position. While dragging we base all ;; calculations against that position. - (first-x-y (mouse-absolute-pixel-position)) - (first-x (car first-x-y)) - (first-y (cdr first-x-y)) - ;; `snap-width' (maybe also a yet to be provided `snap-height') + (tty (tty-type frame)) + (first-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) + (first-x (car first-x-y)) + (first-y (cdr first-x-y)) + ;; `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)) @@ -1231,7 +1239,9 @@ frame with the mouse." (lambda (event) (interactive "e") (when (consp event) - (let* ((last-x-y (mouse-absolute-pixel-position)) + (let* ((last-x-y (if tty + (mouse-position-in-root-frame) + (mouse-absolute-pixel-position))) (last-x (car last-x-y)) (last-y (cdr last-x-y)) (left (- last-x first-x)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 94b3f08de96..89f9bbab608 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -306,19 +306,41 @@ which is the \"1006\" extension implemented in Xterm >= 277." (x (or (nth 1 frame-and-xy) x)) (y (or (nth 2 frame-and-xy) y)) (w (window-at x y frame)) - (ltrb (window-edges w)) - (left (nth 0 ltrb)) - (top (nth 1 ltrb)) - (posn (if w - (posn-at-x-y (- x left) (- y top) w t) - (append (list nil (if (and tab-bar-mode - (or (not menu-bar-mode) - ;; The tab-bar is on the - ;; second row below menu-bar - (eq y 1))) - 'tab-bar - 'menu-bar)) - (nthcdr 2 (posn-at-x-y x y (selected-frame)))))) + (posn + (if w + (let* ((ltrb (window-edges w)) + (left (nth 0 ltrb)) + (top (nth 1 ltrb))) + (posn-at-x-y (- x left) (- y top) w t)) + (let* ((frame-has-menu-bar + (not (zerop (frame-parameter frame 'menu-bar-lines)))) + (frame-has-tab-bar + (not (zerop (frame-parameter frame 'tab-bar-lines)))) + (item + (cond + ((and frame-has-menu-bar (eq y 0)) + 'menu-bar) + ((and frame-has-tab-bar + (or (and frame-has-menu-bar + (eq y 1)) + (eq y 0))) + 'tab-bar) + ((eq x -1) + (cond + ((eq y -1) 'top-left-corner) + ((eq y (frame-height frame)) 'bottom-left-corner) + (t 'left-edge))) + ((eq x (frame-width frame)) + (cond + ((eq y -1) 'top-right-corner) + ((eq y (frame-height frame)) 'bottom-right-corner) + (t 'right-edge))) + ((eq y -1) 'top-edge) + (t 'bottom-edge)))) + (append (list (unless (memq item '(menu-bar tab-bar)) + frame) + item) + (nthcdr 2 (posn-at-x-y x y (selected-frame))))))) (event (list type posn))) (setcar (nthcdr 3 posn) timestamp) diff --git a/src/frame.c b/src/frame.c index b3a92ce463b..a7b09482df9 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2897,7 +2897,7 @@ The functions are run with one argument, the frame to be deleted. */) return delete_frame (frame, !NILP (force) ? Qt : Qnil); } -#ifdef HAVE_WINDOW_SYSTEM + /** * frame_internal_border_part: * @@ -2920,7 +2920,11 @@ The functions are run with one argument, the frame to be deleted. */) enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y) { - int border = FRAME_INTERNAL_BORDER_WIDTH (f); + int border = (FRAME_INTERNAL_BORDER_WIDTH (f) + ? FRAME_INTERNAL_BORDER_WIDTH (f) + : (is_tty_child_frame (f) && !FRAME_UNDECORATED (f)) + ? 1 + : 0); int offset = FRAME_LINE_HEIGHT (f); int width = FRAME_PIXEL_WIDTH (f); int height = FRAME_PIXEL_HEIGHT (f); @@ -2989,7 +2993,7 @@ frame_internal_border_part (struct frame *f, int x, int y) return part; } -#endif + /* Return mouse position in character cell units. */ @@ -6549,6 +6553,36 @@ selected frame. This is useful when `make-pointer-invisible' is set. */) return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt; } +DEFUN ("mouse-position-in-root-frame", Fmouse_position_in_root_frame, + Smouse_position_in_root_frame, 0, 0, 0, + doc: /* Return mouse position in selected frame's root frame. +Return the position of `mouse-position' in coordinates of the root frame +of the frame returned by 'mouse-position'. */) + (void) +{ + Lisp_Object pos = mouse_position (true); + Lisp_Object frame = XCAR (pos); + struct frame *f = XFRAME (frame); + int x = XFIXNUM (XCAR (XCDR (pos))) + f->left_pos; + int y = XFIXNUM (XCDR (XCDR (pos))) + f->top_pos; + + if (!FRAMEP (frame)) + return Qnil; + else + { + f = FRAME_PARENT_FRAME (f); + + while (f) + { + x = x + f->left_pos; + y = y + f->top_pos; + f = FRAME_PARENT_FRAME (f); + } + + return Fcons (make_fixnum (x), make_fixnum (y)); + } +} + DEFUN ("frame--set-was-invisible", Fframe__set_was_invisible, Sframe__set_was_invisible, 2, 2, 0, doc: /* Set FRAME's was-invisible flag if WAS-INVISIBLE is non-nil. @@ -7334,6 +7368,7 @@ allow `make-frame' to show the current buffer even if its hidden. */); defsubr (&Sframe_position); defsubr (&Sset_frame_position); defsubr (&Sframe_pointer_visible_p); + defsubr (&Smouse_position_in_root_frame); defsubr (&Sframe__set_was_invisible); defsubr (&Sframe_window_state_change); defsubr (&Sset_frame_window_state_change); diff --git a/src/frame.h b/src/frame.h index a70d9caf5df..62b2edcb315 100644 --- a/src/frame.h +++ b/src/frame.h @@ -31,6 +31,19 @@ enum vertical_scroll_bar_type vertical_scroll_bar_right }; +enum internal_border_part + { + INTERNAL_BORDER_NONE, + INTERNAL_BORDER_LEFT_EDGE, + INTERNAL_BORDER_TOP_LEFT_CORNER, + INTERNAL_BORDER_TOP_EDGE, + INTERNAL_BORDER_TOP_RIGHT_CORNER, + INTERNAL_BORDER_RIGHT_EDGE, + INTERNAL_BORDER_BOTTOM_RIGHT_CORNER, + INTERNAL_BORDER_BOTTOM_EDGE, + INTERNAL_BORDER_BOTTOM_LEFT_CORNER, + }; + #ifdef HAVE_WINDOW_SYSTEM enum fullscreen_type @@ -53,19 +66,6 @@ enum z_group z_group_above_suspended, }; -enum internal_border_part - { - INTERNAL_BORDER_NONE, - INTERNAL_BORDER_LEFT_EDGE, - INTERNAL_BORDER_TOP_LEFT_CORNER, - INTERNAL_BORDER_TOP_EDGE, - INTERNAL_BORDER_TOP_RIGHT_CORNER, - INTERNAL_BORDER_RIGHT_EDGE, - INTERNAL_BORDER_BOTTOM_RIGHT_CORNER, - INTERNAL_BORDER_BOTTOM_EDGE, - INTERNAL_BORDER_BOTTOM_LEFT_CORNER, - }; - #ifdef NS_IMPL_COCOA enum ns_appearance_type { @@ -1862,7 +1862,6 @@ extern Lisp_Object gui_display_get_resource (Display_Info *, extern void set_frame_menubar (struct frame *f, bool deep_p); extern void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y); extern void free_frame_menubar (struct frame *); -extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y); #if defined HAVE_X_WINDOWS extern void x_wm_set_icon_position (struct frame *, int, int); @@ -1888,6 +1887,8 @@ gui_set_bitmap_icon (struct frame *f) #endif /* !HAVE_NS */ #endif /* HAVE_WINDOW_SYSTEM */ +extern enum internal_border_part frame_internal_border_part (struct frame *f, + int x, int y); extern bool frame_ancestor_p (struct frame *af, struct frame *df); INLINE void diff --git a/src/keyboard.c b/src/keyboard.c index bef499869e6..e12013e13b7 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5553,7 +5553,6 @@ static short const scroll_bar_parts[] = { SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) }; -#ifdef HAVE_WINDOW_SYSTEM /* An array of symbol indexes of internal border parts, indexed by an enum internal_border_part value. Note that Qnil corresponds to internal_border_part_none and should not appear in Lisp events. */ @@ -5564,7 +5563,6 @@ static short const internal_border_parts[] = { SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge), SYMBOL_INDEX (Qbottom_left_corner) }; -#endif /* A vector, indexed by button number, giving the down-going location of currently depressed buttons, both scroll bar and non-scroll bar. @@ -5599,6 +5597,90 @@ static Time button_down_time; static int double_click_count; +enum frame_border_side +{ + ON_LEFT, + ON_TOP, + ON_RIGHT, + ON_BOTTOM, + ON_NONE +}; + +/* Handle make_lispy_event when a tty child frame's decorations shall be + used in lieu of internal borders. R denotes the root frame under + investigation, MX and MY are the positions of the mouse relative to + R. WINDOW_OR_FRAME denotes the frame previously reported as the + frame under (MX, MY). Note: The decorations of a child frame are + always drawn outside the child frame, so WINDOW_OR_FRAME is certainly + not the frame we are looking for. Neither is R. A candidate frame + is any frame but WINDOW_OR_FRAME and R whose root is R, which is not + decorated and has a 'drag-internal-border' parameter. If we find a + suitable frame, set WINDOW_OR_FRAME to it and POSN to the part of the + internal border corresponding to (MX, MY) on the frame found. */ + +static void +make_lispy_tty_position (struct frame *r, int mx, int my, + Lisp_Object *window_or_frame, Lisp_Object *posn) +{ + enum frame_border_side side = ON_NONE; + struct frame *f = NULL; + Lisp_Object tail, frame; + int ix, iy = 0; + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + + int left = f->left_pos; + int top = f->top_pos; + int right = left + f->pixel_width; + int bottom = top + f->pixel_height; + + if (root_frame (f) == r && f != r + && !FRAME_UNDECORATED (f) + && !NILP (get_frame_param (f, Qdrag_internal_border))) + { + if (left == mx + 1 && my >= top && my <= bottom) + { + side = ON_LEFT; + ix = -1; + iy = my - top + 1; + break; + } + else if (right == mx && my >= top && my <= bottom) + { + side = ON_RIGHT; + ix = f->pixel_width; + iy = my - top + 1; + break; + } + else if (top == my + 1 && mx >= left && mx <= right) + { + side = ON_TOP; + ix = mx - left + 1; + iy = -1; + break; + } + else if (bottom == my && mx >= left && mx <= right) + { + side = ON_BOTTOM; + ix = mx - left + 1; + iy = f->pixel_height; + break; + } + } + } + + if (side != ON_NONE) + { + enum internal_border_part part + = frame_internal_border_part (f, ix, iy); + + XSETFRAME (*window_or_frame, f); + *posn = builtin_lisp_symbol (internal_border_parts[part]); + } +} + /* X and Y are frame-relative coordinates for a click or wheel event. Return a Lisp-style event list. */ @@ -5677,7 +5759,14 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, window_or_frame = Qnil; /* see above */ } - if (WINDOWP (window_or_frame)) + if (WINDOWP (window_or_frame) && is_tty_frame (f) + && (is_tty_root_frame_with_visible_child (f) + || is_tty_child_frame (f))) + make_lispy_tty_position (root_frame (f), mx, my, &window_or_frame, &posn); + + if (!NILP (posn)) + ; + else if (WINDOWP (window_or_frame)) { /* It's a click in window WINDOW at frame coordinates (X,Y) */ struct window *w = XWINDOW (window_or_frame); @@ -5880,9 +5969,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, xret = mx; yret = my; -#ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (f) - && FRAME_LIVE_P (f) + if (FRAME_LIVE_P (f) && NILP (posn) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 && !NILP (get_frame_param (f, Qdrag_internal_border))) @@ -5892,7 +5979,6 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, posn = builtin_lisp_symbol (internal_border_parts[part]); } -#endif } else { @@ -12572,7 +12658,9 @@ The `posn-' functions access elements of such lists. */) into the left fringe. */ if (XFIXNUM (x) != -1) CHECK_FIXNAT (x); - CHECK_FIXNAT (y); + CHECK_FIXNUM (y); + if (XFIXNUM (y) != -1) + CHECK_FIXNAT (y); if (NILP (frame_or_window)) frame_or_window = selected_window; diff --git a/src/term.c b/src/term.c index bc7a9c78f0d..e15b7a0887e 100644 --- a/src/term.c +++ b/src/term.c @@ -2676,12 +2676,68 @@ tty_frame_at (int x, int y, int *cx, int *cy) Lisp_Object frame = Fcar (frames); struct frame *f = XFRAME (frame); int fx, fy; + bool on_border = false; + root_xy (f, 0, 0, &fx, &fy); - if ((fx <= x && x < fx + f->pixel_width) - && (fy <= y && y < fy + f->pixel_height)) + if (!FRAME_UNDECORATED (f) && FRAME_PARENT_FRAME (f)) + { + if (fy - 1 <= y && y <= fy + f->pixel_height + 1) + { + if (fx == x + 1) + { + *cx = -1; + on_border = true; + } + else if (fx + f->pixel_width == x) + { + *cx = f->pixel_width; + on_border = true; + } + + if (on_border) + { + *cy = y - fy; + + return frame; + } + } + + if (fx - 1 <= x && x <= fx + f->pixel_width + 1) + { + if (fy == y + 1) + { + *cy = -1; + on_border = true; + } + else if (fy + f->pixel_height == y) + { + *cy = f->pixel_height; + on_border = true; + } + + if (on_border) + { + *cx = x - fx; + + return frame; + } + } + + + if ((fx <= x && x <= fx + f->pixel_width) + && (fy <= y && y <= fy + f->pixel_height)) + { + child_xy (XFRAME (frame), x, y, cx, cy); + + return frame; + } + } + else if ((fx <= x && x <= fx + f->pixel_width) + && (fy <= y && y <= fy + f->pixel_height)) { child_xy (XFRAME (frame), x, y, cx, cy); + return frame; } } @@ -2705,6 +2761,7 @@ relative to FRAME. */) Lisp_Object frame = tty_frame_at (XFIXNUM (x), XFIXNUM (y), &cx, &cy); if (NILP (frame)) return Qnil; + return list3 (frame, make_fixnum (cx), make_fixnum (cy)); } diff --git a/src/window.c b/src/window.c index 330a95a716f..1ac004af5e0 100644 --- a/src/window.c +++ b/src/window.c @@ -1758,6 +1758,13 @@ function returns nil. */) { struct frame *f = decode_live_frame (frame); + CHECK_INTEGER (x); + CHECK_INTEGER (y); + + if (XFIXNUM (x) < 0 || XFIXNUM (x) > FRAME_PIXEL_WIDTH (f) + || XFIXNUM (y) < 0 || XFIXNUM (y) > FRAME_PIXEL_HEIGHT (f)) + return Qnil; + CHECK_NUMBER (x); CHECK_NUMBER (y); -- 2.39.5