mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-01 11:14:55 +00:00
Code Issues Releases Activity

Handle modifiers during Haiku DND wheel movement

Browse Source 
* lisp/term/haiku-win.el (haiku-dnd-modifier-mask)
(haiku-dnd-wheel-modifier-type): New functions.
(haiku-handle-drag-wheel): Use them.
* lisp/x-dnd.el (x-dnd-modifier-mask): Remove outdated comment.
* src/haikuselect.c (haiku_note_drag_wheel): Pass modifiers to
wheel function.
(syms_of_haikuselect): Update doc strings.
This commit is contained in:
Po Lu 2022-07-26 05:41:25 +00:00
parent f6040018c5
commit 2bc6d82831
3 changed files with 63 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lisp/term/haiku-win.el
View File

@ -489,19 +489,56 @@ Return the number of clicks that were made in quick succession."
(defvar haiku-drag-wheel-function)
(defun haiku-handle-drag-wheel (frame x y horizontal up)
(defun haiku-dnd-modifier-mask (mods)
"Return the internal modifier mask for the Emacs modifier state MODS.
MODS is a single symbol, or a list of symbols such as `shift' or
`control'."
(let ((mask 0))
(unless (consp mods)
(setq mods (list mods)))
(dolist (modifier mods)
(cond ((eq modifier 'shift)
(setq mask (logior mask ?\S-\0)))
((eq modifier 'control)
(setq mask (logior mask ?\C-\0)))
((eq modifier 'meta)
(setq mask (logior mask ?\M-\0)))
((eq modifier 'hyper)
(setq mask (logior mask ?\H-\0)))
((eq modifier 'super)
(setq mask (logior mask ?\s-\0)))
((eq modifier 'alt)
(setq mask (logior mask ?\A-\0)))))
mask))
(defun haiku-dnd-wheel-modifier-type (flags)
"Return the modifier type of an internal modifier mask.
FLAGS is the internal modifier mask of a turn of the mouse wheel."
(let ((modifiers (logior ?\M-\0 ?\C-\0 ?\S-\0
?\H-\0 ?\s-\0 ?\A-\0)))
(catch 'type
(dolist (modifier mouse-wheel-scroll-amount)
(when (and (consp modifier)
(eq (haiku-dnd-modifier-mask (car modifier))
(logand flags modifiers)))
(throw 'type (cdr modifier))))
nil)))
(defun haiku-handle-drag-wheel (frame x y horizontal up modifiers)
"Handle wheel movement during drag-and-drop.
FRAME is the frame on top of which the wheel moved.
X and Y are the frame-relative coordinates of the wheel movement.
HORIZONTAL is whether or not the wheel movement was horizontal.
UP is whether or not the wheel moved up (or left)."
UP is whether or not the wheel moved up (or left).
MODIFIERS is the internal modifier mask of the wheel movement."
(when (not (equal haiku-last-wheel-direction
(cons horizontal up)))
(setq haiku-last-wheel-direction
(cons horizontal up))
(when (consp haiku-dnd-wheel-count)
(setcar haiku-dnd-wheel-count 0)))
(let ((function (cond
(let ((type (haiku-dnd-wheel-modifier-type modifiers))
(function (cond
((and (not horizontal) (not up))
mwheel-scroll-up-function)
((not horizontal)
@ -512,14 +549,27 @@ UP is whether or not the wheel moved up (or left)."
(t (if mouse-wheel-flip-direction
mwheel-scroll-left-function
mwheel-scroll-right-function))))
(timestamp (time-convert nil 1000)))
(timestamp (time-convert nil 1000))
(amt 1))
(cond ((and (eq type 'hscroll)
(not horizontal))
(setq function (if (not up)
mwheel-scroll-left-function
mwheel-scroll-right-function)))
((and (eq type 'global-text-scale))
(setq function 'global-text-scale-adjust
amt (if up 1 -1)))
((and (eq type 'text-scale))
(setq function 'text-scale-adjust
amt (if up 1 -1))))
(when function
(let ((posn (posn-at-x-y x y frame)))
(when (windowp (posn-window posn))
(with-selected-window (posn-window posn)
(funcall function
(or (and (not mouse-wheel-progressive-speed) 1)
(haiku-note-wheel-click (car timestamp))))))))))
(* amt
(or (and (not mouse-wheel-progressive-speed) 1)
(haiku-note-wheel-click (car timestamp)))))))))))
(setq haiku-drag-wheel-function #'haiku-handle-drag-wheel)

1
lisp/x-dnd.el
View File

@ -708,7 +708,6 @@ MODS is a single symbol, or a list of symbols such as `shift' or
(unless (consp mods)
(setq mods (list mods)))
(dolist (modifier mods)
;; TODO: handle virtual modifiers such as Meta and Hyper.
(cond ((eq modifier 'shift)
(setq mask (logior mask 1))) ; ShiftMask
((eq modifier 'control)

13
src/haikuselect.c
View File

@ -1062,8 +1062,9 @@ haiku_note_drag_wheel (struct input_event *ie)
if (!NILP (Vhaiku_drag_wheel_function)
&& (haiku_dnd_allow_same_frame
|| XFRAME (ie->frame_or_window) != haiku_dnd_frame))
safe_call (6, Vhaiku_drag_wheel_function, ie->frame_or_window,
ie->x, ie->y, horizontal ? Qt : Qnil, up ? Qt : Qnil);
safe_call (7, Vhaiku_drag_wheel_function, ie->frame_or_window,
ie->x, ie->y, horizontal ? Qt : Qnil, up ? Qt : Qnil,
make_int (ie->modifiers));
redisplay_preserve_echo_area (35);
}
@ -1149,12 +1150,12 @@ These are only called if a connection to the Haiku display was opened. */);
DEFVAR_LISP ("haiku-drag-wheel-function", Vhaiku_drag_wheel_function,
doc: /* Function called upon wheel movement while dragging a message.
If non-nil, it is called with 5 arguments when the mouse wheel moves
If non-nil, it is called with 6 arguments when the mouse wheel moves
while a drag-and-drop operation is in progress: the frame where the
mouse moved, the frame-relative X and Y positions where the mouse
moved, whether or not the wheel movement was horizontal, and whether
or not the wheel moved up (or left, if the movement was
horizontal). */);
moved, whether or not the wheel movement was horizontal, whether or
not the wheel moved up (or left, if the movement was horizontal), and
keyboard modifiers currently held down. */);
Vhaiku_drag_wheel_function = Qnil;
DEFSYM (QSECONDARY, "SECONDARY");