diff --git a/doc/changes/12386.md b/doc/changes/12386.md new file mode 100644 index 00000000000..2c87a3626c8 --- /dev/null +++ b/doc/changes/12386.md @@ -0,0 +1 @@ +- Added the ability to scroll horizontally in TUI. (#12386, @Alizter) diff --git a/src/dune_tui/dune_tui.ml b/src/dune_tui/dune_tui.ml index 159dad9821e..fa8cd846fdd 100644 --- a/src/dune_tui/dune_tui.ml +++ b/src/dune_tui/dune_tui.ml @@ -203,13 +203,7 @@ module Message_viewer = struct `Handled | _ -> `Unhandled in - let mouse_handler ~x:_ ~y:_ = function - | `Scroll dir -> - vscroll ~dir; - `Handled - | _ -> `Unhandled - in - ui |> Ui.keyboard_area keyboard_handler |> Ui.mouse_area mouse_handler + ui |> Ui.keyboard_area keyboard_handler ;; end diff --git a/src/dune_tui/widgets/scrollbox.ml b/src/dune_tui/widgets/scrollbox.ml index 35392cc7cef..bdf9cb044fd 100644 --- a/src/dune_tui/widgets/scrollbox.ml +++ b/src/dune_tui/widgets/scrollbox.ml @@ -26,8 +26,8 @@ let scrollbar_wheel_step = 8 (* Wheel event scrolls 1/8th of the screen *) let scroll visible offset ~set ~dir = let dir = match dir with - | `Down -> 1 - | `Up -> -1 + | `Down | `Right -> 1 + | `Up | `Left -> -1 in set (offset + (dir * max 1 (visible / scrollbar_wheel_step))) ;; @@ -153,12 +153,14 @@ let make (state_var : State.t Lwd.var) t = and+ size = Lwd.get state_var in (* Render final box *) let box, vscroll, hscroll = compose_bars ui size in - let hscroll ~dir = - hscroll - ~dir: - (match dir with - | `Right -> `Down - | `Left -> `Up) + let mouse_handler ~x:_ ~y:_ = function + | `Scroll ((`Up | `Down) as dir) -> + vscroll ~dir; + `Handled + | `Scroll ((`Left | `Right) as dir) -> + hscroll ~dir; + `Handled + | _ -> `Unhandled in - { ui = measure_size box; vscroll; hscroll } + { ui = measure_size box |> Ui.mouse_area mouse_handler; vscroll; hscroll } ;; diff --git a/vendor/notty/src/notty.ml b/vendor/notty/src/notty.ml index 3592bcdf76c..094a16ae59f 100644 --- a/vendor/notty/src/notty.ml +++ b/vendor/notty/src/notty.ml @@ -641,7 +641,7 @@ module Unescape = struct | `Function of int ] - type button = [ `Left | `Middle | `Right | `Scroll of [ `Up | `Down ] ] + type button = [ `Left | `Middle | `Right | `Scroll of [ `Up | `Down | `Left | `Right ] ] type mods = [ `Meta | `Ctrl | `Shift ] list @@ -725,9 +725,9 @@ module Unescape = struct | 0 -> `Left | 1 when bit 6 p -> `Scroll `Down | 1 -> `Middle - | 2 when bit 6 p -> `ALL (* `Scroll `Left *) + | 2 when bit 6 p -> `Scroll `Left | 2 -> `Right - | 3 when bit 6 p -> `ALL (* `Scroll `Right *) + | 3 when bit 6 p -> `Scroll `Right | _ -> `ALL and drag = bit 5 p and mods = diff --git a/vendor/notty/src/notty.mli b/vendor/notty/src/notty.mli index a3ed5ae139b..7e7eb2bf8d4 100644 --- a/vendor/notty/src/notty.mli +++ b/vendor/notty/src/notty.mli @@ -464,7 +464,7 @@ module Unescape : sig ] (** A selection of extra keys on the keyboard. *) - type button = [ `Left | `Middle | `Right | `Scroll of [ `Up | `Down ] ] + type button = [ `Left | `Middle | `Right | `Scroll of [ `Up | `Down | `Left | `Right ] ] (** Mouse buttons. *) type mods = [ `Meta | `Ctrl | `Shift ] list @@ -510,7 +510,8 @@ module Unescape : sig {b Note} Every [`Press (`Left|`Middle|`Right)] generates a corresponding [`Release], but there is no portable way to detect which button was - released. [`Scroll (`Up|`Down)] presses are not followed by releases. + released. [`Scroll (`Up|`Down|`Left|`Right)] presses are not followed + by releases. } {- [`Paste (`Start|`End)] are {e bracketed paste} events, signalling the diff --git a/vendor/update-notty.sh b/vendor/update-notty.sh index 540774f592f..51ea525b709 100755 --- a/vendor/update-notty.sh +++ b/vendor/update-notty.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=83aad282853bc35564114db72b65a087acf82ccf +version=54b14f0dc25316a5b64206c55598442ec9d43325 set -e -o pipefail