Theme the tray menu, move tabs with Ctrl + scroll and smooth wheel switching

README.md

@@ -38,13 +38,14 @@ the top edge to show them, or set **Auto-hide tabs** to **Never**.
 | Search tabs | Ctrl + Alt + T |
 | New window of the current app | Ctrl + Alt + N |
 | Switch tabs with the mouse | Scroll over the tab bar, or Shift + scroll over the window |
+| Move the current tab | Ctrl + scroll over the tab bar |
 | Close a tab | Middle-click |
 
 Change any shortcut under **Settings → Shortcuts**. If Ctrl/Alt + number conflicts
 with an app, turn it off for that app from the tab's right-click menu.
 
 **Optional, off by default:** switch on hover, a leader key to pick tabs by letter
-(Alt + S, then the key on the tab), automatic tab colors, and an Alt+Tab replacement.
+(Alt + F, then the key on the tab), automatic tab colors, and an Alt+Tab replacement.
 
 Drag files onto a tab and pause to bring that window forward. On a **File Explorer**
 tab, let go to drop them into its folder as Explorer would: Ctrl copies, Shift moves,

WtProgram/DesktopPlugins/NotifyIconPlugin.fs

@@ -8,38 +8,47 @@ type NotifyIconPlugin() =
     let mutable languageSubscription : IDisposable option = None
     let mutable errorSubscription : IDisposable option = None
     let mutable errorNoticeShown = false
+    /// The menu the icon opens next; one that has been shown disposes itself once closed.
+    let mutable menu : ThemedContextMenu option = None
     let invoker = InvokerService.invoker
 
     member this.icon = Cell.cacheProp this <| fun() ->
         let notifyIcon = new NotifyIcon()
         notifyIcon.Visible <- true
         notifyIcon.Text <- "WindowTabs " + Services.program.version
         notifyIcon.Icon <- Services.openIcon(ThemeService.appIconName)
-        notifyIcon.ContextMenu <- new ContextMenu()
         notifyIcon.MouseClick.Add <| fun e ->
             if e.Button = MouseButtons.Left then Services.managerView.show()
+        // Built as the button goes down, so the menu the icon shows on release is in the
+        // current theme and language.
+        notifyIcon.MouseDown.Add <| fun e ->
+            if e.Button = MouseButtons.Right then this.prepareMenu true
         // The only balloon WindowTabs shows is the error notice, so a click opens the crash log.
         notifyIcon.BalloonTipClicked.Add <| fun _ ->
             RuntimeDiagnostics.crashLogPath() |> Option.iter(fun path ->
                 try Diagnostics.Process.Start("explorer.exe",sprintf "/select,\"%s\"" path) |> ignore with _ -> ())
         notifyIcon
 
-    member this.contextMenuItems = this.icon.ContextMenu.MenuItems
-
-    member this.addItem(text, handler) =
-        this.contextMenuItems.Add(text, EventHandler(fun obj (e:EventArgs) -> handler())) |> ignore
-
-    member private this.buildMenu() =
-        this.contextMenuItems.Clear()
-        this.addItem(tr Strings.TabMenu.settings, fun() -> Services.managerView.show())
-        this.contextMenuItems.Add("-").ignore
-        this.addItem(tr Strings.Tray.exit, fun() -> Services.program.shutdown())
+    /// The same themed menu as the tabs', in place of the system's light one. A menu that has just
+    /// closed still has its chosen command to run and disposes itself; only one never shown is
+    /// disposed here. After a close the next is ready for the keyboard, which opens it with no click.
+    member private this.prepareMenu(replaceIdle:bool) =
+        if not disposed then
+            let item text run = CmiRegular { text=text; image=None; click=run; flags=List2() }
+            let items = List2([ item (tr Strings.TabMenu.settings) (fun () -> Services.managerView.show())
+                                CmiSeparator
+                                item (tr Strings.Tray.exit) (fun () -> Services.program.shutdown()) ])
+            let next = new ThemedContextMenu(items,fun () -> invoker.asyncInvoke(fun () -> this.prepareMenu false))
+            let previous = menu
+            menu <- Some next
+            this.icon.ContextMenuStrip <- next
+            if replaceIdle then previous |> Option.iter(fun idle -> if not idle.Visible then idle.Dispose())
 
     interface IPlugin with
         member this.init() =
-            this.buildMenu()
+            this.prepareMenu true
             languageSubscription <- Some(Services.settings.notifyValue "language" (fun _ ->
-                invoker.asyncInvoke(fun () -> if not disposed then this.buildMenu())))
+                invoker.asyncInvoke(fun () -> this.prepareMenu true)))
             // Once per session: later errors go to the same log without another notice.
             errorSubscription <- Some(RuntimeDiagnostics.errorLogged.Subscribe(fun () ->
                 invoker.asyncInvoke(fun () ->
@@ -53,6 +62,7 @@ type NotifyIconPlugin() =
                 disposed <- true
                 languageSubscription |> Option.iter (fun subscription -> subscription.Dispose())
                 errorSubscription |> Option.iter (fun subscription -> subscription.Dispose())
+                menu |> Option.iter(fun idle -> if not idle.Visible then idle.Dispose())
                 let icon = this.icon.Icon
                 this.icon.Dispose()
                 if not (isNull icon) then icon.Dispose()

WtProgram/GroupPlugins/MouseScrollPlugin.fs

@@ -3,26 +3,85 @@ open System
 open System.Runtime.InteropServices
 
 type MouseScrollPlugin() as this =
-
+    let clock = Diagnostics.Stopwatch.StartNew()
+    let mutable lastWheel = -1000L
+    let mutable lastAction = ""
+    let mutable wheelRest = 0
+    /// Every notch is a step, taken one at a time so each tab is shown on the way.
+    let mutable pendingSteps = 0
+    let mutable stepping = false
+    /// The first step of a new turn starts from the window in front.
+    let mutable restart = true
+    /// Where scrolling has got to. Further steps go on from here rather than from the window
+    /// in front, which follows a moment later, so none is lost or counted twice.
+    let mutable scrollTarget : IntPtr option = None
+    let stepTimer = new System.Windows.Forms.Timer(Interval=TabNavigation.scrollStepInterval)
+
     member this.wtGroup = Services.get<WindowGroup>()
     member this.settings = Services.get<ISettings>()
 
+    /// Ctrl + scroll over the tabs carries the current tab along them, down to the right as
+    /// scrolling switches tabs, and stops at either end.
+    member private this.moveCurrentTab(right) =
+        let group = this.wtGroup
+        TabNavigation.moveTarget group.lorder.list (OS().foreground.hwnd) (Some group.topWindow) right
+        |> Option.iter(fun (hwnd,index) -> group.ts.moveTab(Tab(hwnd),index))
+
+    /// One tab along, shown at once.
+    member private this.scrollTab(next, fresh) =
+        let group = this.wtGroup
+        let order = group.lorder.list
+        if order.Length > 1 then
+            let from =
+                match scrollTarget with
+                | Some hwnd when not fresh && List.contains hwnd order -> hwnd
+                | _ -> OS().foreground.hwnd
+            scrollTarget <- TabNavigation.stepTarget order from (Some group.topWindow) 1 next
+            scrollTarget |> Option.iter(fun hwnd -> group.tabActivate(Tab(hwnd), true))
+
+    /// One step now and the next once this tab has been drawn; wheel events meanwhile add their
+    /// own steps, so a quick turn passes visibly through every tab it covers and ends on the last.
+    member private this.step() =
+        if pendingSteps=0 then stepping <- false
+        else
+            stepping <- true
+            let next = pendingSteps < 0
+            pendingSteps <- pendingSteps + (if next then 1 else -1)
+            if lastAction="move" then this.moveCurrentTab(next)
+            else this.scrollTab(next, restart)
+            restart <- false
+            stepTimer.Start()
+
     member this.onMouseLL(msg, pt, data:IntPtr) =
         match msg with
         | WindowMessages.WM_MOUSEWHEEL ->
-            let wheelDelta = data.hiword
             let enableShiftScroll = this.settings.getValue("enableShiftScroll") :?> bool
-            let doSwitch =
-                if enableShiftScroll && Win32Helper.IsKeyPressed(VirtualKeyCodes.VK_SHIFT) then
-                    this.wtGroup.isPointInGroup(pt)
-                else
-                    this.wtGroup.isPointInTs(pt)
-            if doSwitch then
-                let next = wheelDelta < int16(0)
-                this.wtGroup.switchWindow(next, true)
+            let enableCtrlScroll = this.settings.getValue("enableCtrlScroll") :?> bool
+            let action =
+                if enableCtrlScroll && Win32Helper.IsKeyPressed(VirtualKeyCodes.VK_CONTROL) then
+                    if this.wtGroup.isPointInTs(pt) then "move" else ""
+                elif enableShiftScroll && Win32Helper.IsKeyPressed(VirtualKeyCodes.VK_SHIFT) then
+                    if this.wtGroup.isPointInGroup(pt) then "switch" else ""
+                elif this.wtGroup.isPointInTs(pt) then "switch"
+                else ""
+            if action<>"" then
+                let now = clock.ElapsedMilliseconds
+                let fresh = now-lastWheel > 400L || action<>lastAction
+                if action<>lastAction then pendingSteps <- 0
+                // Steps still being shown carry on from where they got to.
+                if fresh && not stepping then restart <- true
+                lastWheel <- now
+                lastAction <- action
+                let notches,rest = TabNavigation.wheelNotches wheelRest (int data.hiword) fresh
+                wheelRest <- rest
+                if notches<>0 then
+                    pendingSteps <- TabNavigation.addSteps pendingSteps notches
+                    if not stepping then this.step()
 
         | _ ->()
 
     interface IPlugin with
         member x.init() =
+            stepTimer.Tick.Add(fun _ -> stepTimer.Stop(); this.step())
             this.wtGroup.mouseLL.Add this.onMouseLL
+            this.wtGroup.exited.Add(fun _ -> stepTimer.Dispose())

WtProgram/ManagerViewService/Views/BehaviorView.fs → WtProgram/ManagerViewService/Views/HotKeyView.fs

@@ -42,6 +42,21 @@ type HotKeyView() =
             let update() = for row in rows do row.Collapsed <- not toggle.Checked
             update()
             toggle.CheckedChanged.Add(fun _ -> update())
+        let numericEnabled = SettingsBindings.settingToggle "enableCtrlNumberHotKey"
+        SettingsUi.settingRow keyboard "switch-tabs-by-number" numericEnabled
+        let numericChoice = SettingsBindings.choiceRow keyboard "number-shortcut"
+                                [|tr Strings.Settings.numberShortcutCtrl;tr Strings.Settings.numberShortcutAlt|]
+        // Switched off, an app enabled from the tab menu still uses the modifier, so it stays.
+        let numericRow = numericChoice.Parent :?> SettingsRow
+        SettingsUi.indentDependentRow numericRow
+        let updateNumeric() =
+            let appsEnabled = (Services.settings.getValue("enabledNumberShortcutPaths") :?> Set2<string>).items.list.IsEmpty |> not
+            numericRow.Collapsed <- not numericEnabled.Checked && not appsEnabled
+        updateNumeric()
+        numericEnabled.CheckedChanged.Add(fun _ -> updateNumeric())
+        let appsSubscription = Services.settings.notifyValue "enabledNumberShortcutPaths" (fun _ ->
+            if not numericRow.IsDisposed then updateNumeric())
+        numericRow.Disposed.Add(fun _ -> appsSubscription.Dispose())
         let leaderEnabled = SettingsBindings.settingToggle "enableNumberLeader"
         SettingsUi.settingRow keyboard "enable-number-leader" leaderEnabled
         let leaderEditor = editors |> List.find(fun (key,_) -> key="numberLeader") |> snd
@@ -91,21 +106,6 @@ type HotKeyView() =
             button :> Control)
         SettingsUi.settingRowWithActions keyboard "leader-keys" keysEditor presets |> ignore
         dependOn leaderEnabled [leaderEditor.Parent :?> SettingsRow;keysEditor.Parent :?> SettingsRow]
-        let numericEnabled = SettingsBindings.settingToggle "enableCtrlNumberHotKey"
-        SettingsUi.settingRow keyboard "switch-tabs-by-number" numericEnabled
-        let numericChoice = SettingsBindings.choiceRow keyboard "number-shortcut"
-                                [|tr Strings.Settings.numberShortcutCtrl;tr Strings.Settings.numberShortcutAlt|]
-        // Switched off, an app enabled from the tab menu still uses the modifier, so it stays.
-        let numericRow = numericChoice.Parent :?> SettingsRow
-        SettingsUi.indentDependentRow numericRow
-        let updateNumeric() =
-            let appsEnabled = (Services.settings.getValue("enabledNumberShortcutPaths") :?> Set2<string>).items.list.IsEmpty |> not
-            numericRow.Collapsed <- not numericEnabled.Checked && not appsEnabled
-        updateNumeric()
-        numericEnabled.CheckedChanged.Add(fun _ -> updateNumeric())
-        let appsSubscription = Services.settings.notifyValue "enabledNumberShortcutPaths" (fun _ ->
-            if not numericRow.IsDisposed then updateNumeric())
-        numericRow.Disposed.Add(fun _ -> appsSubscription.Dispose())
         // Offered only while a shortcut differs from its default; otherwise it would do nothing.
         let updateRestore() =
             restore.Offered <- editors |> List.exists(fun (key,editor) -> editor.Shortcut<>SettingsCatalog.shortcutDefault key)
@@ -115,6 +115,7 @@ type HotKeyView() =
         let pointer = SettingsUi.sectionCard table (tr Strings.Shortcuts.mouse)
         SettingsBindings.toggleRow pointer "activate-on-hover"
         SettingsBindings.toggleRow pointer "shift-scroll"
+        SettingsBindings.toggleRow pointer "ctrl-scroll"
     interface ISettingsView with
         member _.key = SettingsViewType.HotKeySettings
         member _.title = tr Strings.Pages.shortcuts

WtProgram/Settings.fs

@@ -142,6 +142,7 @@ type Settings(isStandAlone, ?saveDelay:int) as this =
                             if settingsJson.getBool("minimalMode").def(false) then false
                             else SettingsCatalog.toggleDefault "showTabsOnSwitch" hasExistingSettings)
                         enableShiftScroll = settingsJson.getBool("enableShiftScroll").def(SettingsCatalog.toggleDefault "enableShiftScroll" hasExistingSettings)
+                        enableCtrlScroll = settingsJson.getBool("enableCtrlScroll").def(SettingsCatalog.toggleDefault "enableCtrlScroll" hasExistingSettings)
                         version = settingsJson.getString("version").def(String.Empty)
                         alignment = settingsJson.getString("alignment").def(SettingsCatalog.choiceDefault "alignment") |> SettingsCatalog.normalizeChoice "alignment"
                         switcherStyle = settingsJson.getString("switcherStyle").def(SettingsCatalog.choiceDefault "switcherStyle") |> SettingsCatalog.normalizeChoice "switcherStyle"
@@ -223,6 +224,7 @@ type Settings(isStandAlone, ?saveDelay:int) as this =
             settingsJson.Remove("licenseKey") |> ignore
             settingsJson.Remove("ticket") |> ignore
             settingsJson.setBool("enableShiftScroll", settings.enableShiftScroll)
+            settingsJson.setBool("enableCtrlScroll", settings.enableCtrlScroll)
             settingsJson.setStringArray("includedPaths", settings.includedPaths.items)
             settingsJson.setStringArray("excludedPaths", settings.excludedPaths.items)
             settingsJson.setStringArray("autoGroupingPaths", settings.autoGroupingPaths.items)

WtProgram/Shared/ProgramTypes.fs

@@ -36,6 +36,8 @@ type SettingsRec = {
     /// Expand auto-hidden tabs for a moment after switching tabs.
     showTabsOnSwitch: bool
     enableShiftScroll: bool
+    /// Ctrl + scroll over the tabs moves the current tab.
+    enableCtrlScroll: bool
     /// "Icons" (large icons in a row) or "List" (window titles in a column).
     switcherStyle: string
     alignment: string

WtProgram/Shared/SettingsCatalog.fs

@@ -39,12 +39,13 @@ module SettingsCatalog =
         { id="search-tabs"; page=HotKeySettings; text=Strings.Settings.searchTabs; binding=Shortcut("searchTabs",1620) }
         { id="new-tab"; page=HotKeySettings; text=Strings.Settings.newTab; binding=Shortcut("newTab",1614) }
         { id="switch-tabs-by-number"; page=HotKeySettings; text=Strings.Settings.switchTabsByNumber; binding=Toggle("enableCtrlNumberHotKey",true,true) }
+        { id="number-shortcut"; page=HotKeySettings; text=Strings.Settings.numberShortcut; binding=Choice("numberHotKeyModifier",["Ctrl";"Alt"],"Ctrl") }
         { id="enable-number-leader"; page=HotKeySettings; text=Strings.Settings.enableNumberLeader; binding=Toggle("enableNumberLeader",false,false) }
-        { id="number-leader"; page=HotKeySettings; text=Strings.Settings.numberLeader; binding=Shortcut("numberLeader",1107) }
+        { id="number-leader"; page=HotKeySettings; text=Strings.Settings.numberLeader; binding=Shortcut("numberLeader",1094) }
         { id="leader-keys"; page=HotKeySettings; text=Strings.Settings.leaderKeys; binding=Text("numberLeaderKeys","123456789") }
-        { id="number-shortcut"; page=HotKeySettings; text=Strings.Settings.numberShortcut; binding=Choice("numberHotKeyModifier",["Ctrl";"Alt"],"Ctrl") }
         { id="activate-on-hover"; page=HotKeySettings; text=Strings.Settings.activateOnHover; binding=Toggle("enableHoverActivate",false,false) }
         { id="shift-scroll"; page=HotKeySettings; text=Strings.Settings.shiftScroll; binding=Toggle("enableShiftScroll",true,true) }
+        { id="ctrl-scroll"; page=HotKeySettings; text=Strings.Settings.ctrlScroll; binding=Toggle("enableCtrlScroll",true,true) }
         { id="tabTextColor"; page=AppearanceSettings; text=Strings.Settings.tabTextColor; binding=Colour }
         { id="tabNormalBgColor"; page=AppearanceSettings; text=Strings.Settings.tabNormalBgColor; binding=Colour }
         { id="tabActiveBgColor"; page=AppearanceSettings; text=Strings.Settings.tabActiveBgColor; binding=Colour }