procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement dragging and resizing of tty child frames

Browse source 
* 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).
This commit is contained in:
Martin Rudalics 2025-03-17 09:50:19 +01:00
parent 7e71b0a2c9
commit 86be9431ae
8 changed files with 269 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lisp/faces.el
View file

@ -1766,7 +1766,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'

24
lisp/mouse.el
View file

@ -1111,7 +1111,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)
@ -1119,7 +1122,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))
@ -1228,10 +1233,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))
@ -1247,7 +1255,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))

48
lisp/xt-mouse.el
View file

@ -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)

41
src/frame.c
View file

@ -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);

29
src/frame.h
View file

@ -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

104
src/keyboard.c
View file

@ -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;

61
src/term.c
View file

@ -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));
}

7
src/window.c
View file

@ -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);