diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index e32bd3f8..5e0bcccd 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -62,7 +62,7 @@ jobs:
matrix:
include:
- group: architecture
- suites: 'Architecture,StartupGrouping,WindowIcon'
+ suites: 'Architecture,SplitView,StartupGrouping,WindowIcon'
- group: operations
suites: 'GroupOperations,SettingsEditors'
- group: ui
diff --git a/AGENTS.md b/AGENTS.md
index 39c5c648..4a98734d 100644
--- a/AGENTS.md
+++ b/AGENTS.md
@@ -22,7 +22,9 @@ powershell -NoProfile -ExecutionPolicy Bypass -Command "& ./tests/Run-Tests.ps1
a later build), so build without exiting first. Starting any copy asks the running one to
exit as from its tray menu and takes over.
- New suites must be added to the `$Suites` default in `tests/Run-Tests.ps1`, start
- with `TestInit.run main`, and reference the app as `#r "Debug/WindowTabs.exe"`.
+ with `TestInit.run main`, and reference the app as `#r "Debug/WindowTabs.exe"`. A suite
+ that moves the real pointer, such as `SplitViewDesktop`, goes in the `ValidateSet` only
+ and runs on request with `-VisibleDesktop` (see [docs/testing.md](docs/testing.md)).
- Desktop E2E (`tests/Run-DesktopE2E.ps1`) drives real input and takes over the
desktop; only run it when asked. See [docs/desktop-e2e.md](docs/desktop-e2e.md).
- CI (`.github/workflows/build.yml`) runs Release checks and three regression
@@ -83,6 +85,8 @@ powershell -NoProfile -ExecutionPolicy Bypass -Command "& ./tests/Run-Tests.ps1
## Style
+- Documents committed to the repository (`docs/`, `README.md`, this file) are written in
+ English; user-visible text in other languages lives only in `Shared/Strings.fs`.
- Match the surrounding F#: short `///` comments that say why, not what; no banner
comments; existing helpers (`List2`, `Set2`, `Map2`, `Cell`) where the file uses them.
- Commit subjects are imperative, sentence case, describe the user-visible effect and
diff --git a/README.md b/README.md
index b8a59b5d..f55222ef 100644
--- a/README.md
+++ b/README.md
@@ -58,9 +58,16 @@ right-drag asks, and **Ctrl + Z** in Explorer undoes it.
- **App rules:** choose which running apps get tabs and which group automatically.
Under **Groups across apps**, create named groups so windows of different apps join
one group. Groups made by dragging tabs are remembered and listed there too.
+- **Split view:** show two or more of a group's windows side by side or stacked, as in a
+ browser or editor. Right-click a tab → **Split view** and pick a window for each side, or
+ drag a tab to a window's edge. Drag the bar between the panes to resize them, right-click
+ it to swap, equalize, switch direction or end the split. Shortcuts for a window on the right
+ or below and for moving the focus between panes are under **Settings → Shortcuts**, unset by
+ default.
- **Workspaces:** save groups and window positions, then restore them onto open windows;
apps that are not running can be launched and their windows restored.
-- **Taskbar:** optionally combine each group into one taskbar button.
+- **Taskbar:** optionally combine each group into one taskbar button, which shows every
+ app in the group.
- **Languages:** English, 中文, 日本語.
diff --git a/Win32/DwmApi.cs b/Win32/DwmApi.cs
index 10a99d9f..cec38324 100755
--- a/Win32/DwmApi.cs
+++ b/Win32/DwmApi.cs
@@ -72,6 +72,8 @@ public sealed class DwmApi
public static extern int DwmRegisterThumbnail(IntPtr dest, IntPtr src, out IntPtr thumb);
[DllImport("dwmapi.dll")]
public static extern int DwmUpdateThumbnailProperties(IntPtr hThumbnail, ref DWM_THUMBNAIL_PROPERTIES props);
+ [DllImport("dwmapi.dll")]
+ public static extern int DwmUnregisterThumbnail(IntPtr hThumbnail);
[DllImport("dwmapi.dll", EntryPoint = "#113", SetLastError = true)]
public static extern uint DwmpActivateLivePreview(bool doPeek, IntPtr hWnd, IntPtr hwndTop, bool unknown);
diff --git a/Win32/Win32Helper.cs b/Win32/Win32Helper.cs
index 5708681b..6f877e92 100755
--- a/Win32/Win32Helper.cs
+++ b/Win32/Win32Helper.cs
@@ -161,6 +161,22 @@ private static IntPtr QueryWindowIcon(IntPtr handle, int iconType)
return icon;
}
+ ///
+ /// The smallest size the window lets itself be sized to, its invisible borders included;
+ /// an empty size when it does not answer in time.
+ ///
+ public static Size GetMinTrackSize(IntPtr handle)
+ {
+ var info = new MINMAXINFO();
+ info.ptMaxTrackSize = new SIZE(int.MaxValue, int.MaxValue);
+ IntPtr result;
+ // Foreign windows can be busy or hung. Never block the group on one.
+ if (WinUserApi.SendMessageTimeout(handle, WindowMessages.WM_GETMINMAXINFO, IntPtr.Zero, ref info,
+ SendMessageTimeoutFlags.SMTO_ABORTIFHUNG, 100, out result) == IntPtr.Zero)
+ return Size.Empty;
+ return new Size(Math.Max(0, info.ptMinTrackSize.cx), Math.Max(0, info.ptMinTrackSize.cy));
+ }
+
public static IntPtr GetWindowIcon(IntPtr handle, int iconType)
{
bool small = iconType != IconTypeCodes.ICON_BIG;
@@ -503,6 +519,63 @@ public static void FlashWindow(IntPtr hwnd, uint flags, int count)
WinUserApi.FlashWindowEx(ref fInfo);
}
}
+ ///
+ /// A per-pixel layered window's picture kept between frames: drawn once per size into a
+ /// memory DC, so each frame only moves the window and sets its opacity. Drawn again at every
+ /// frame of a fade, a window the size of a pane cost a few milliseconds each time.
+ ///
+ public sealed class LayeredSurface : IDisposable
+ {
+ IntPtr dc;
+ IntPtr bitmap;
+ IntPtr original;
+ Size size;
+
+ public Size Size { get { return size; } }
+
+ public void Render(Bitmap picture)
+ {
+ Release();
+ dc = WinGdiApi.CreateCompatibleDC(IntPtr.Zero);
+ bitmap = picture.GetHbitmap(Color.FromArgb(0));
+ original = WinGdiApi.SelectObject(dc, bitmap);
+ size = picture.Size;
+ }
+
+ public void Update(IntPtr hwnd, Point location, byte alpha)
+ {
+ if (dc == IntPtr.Zero) return;
+ BLENDFUNCTION blend = new BLENDFUNCTION();
+ blend.BlendOp = AlphaChannelFlags.AC_SRC_OVER;
+ blend.BlendFlags = 0;
+ blend.AlphaFormat = AlphaChannelFlags.AC_SRC_ALPHA;
+ blend.SourceConstantAlpha = alpha;
+ POINT srcLocation = new POINT();
+ POINT dstLocation = POINT.FromPoint(location);
+ SIZE dstSize = SIZE.FromSize(size);
+ WinUserApi.UpdateLayeredWindow(hwnd, IntPtr.Zero, ref dstLocation, ref dstSize, dc, ref srcLocation, 0, ref blend, UpdateLayeredWindowFlags.ULW_ALPHA);
+ }
+
+ void Release()
+ {
+ if (dc != IntPtr.Zero)
+ {
+ WinGdiApi.SelectObject(dc, original);
+ WinGdiApi.DeleteObject(bitmap);
+ WinGdiApi.DeleteDC(dc);
+ dc = IntPtr.Zero;
+ bitmap = IntPtr.Zero;
+ original = IntPtr.Zero;
+ size = Size.Empty;
+ }
+ }
+
+ public void Dispose()
+ {
+ Release();
+ }
+ }
+
public static class ResourceExtractor
{
public static void ExtractResourceToFile(string resourceName, string filename)
diff --git a/Win32/WinUser.cs b/Win32/WinUser.cs
index 60d6b072..27db9a3b 100755
--- a/Win32/WinUser.cs
+++ b/Win32/WinUser.cs
@@ -2742,6 +2742,8 @@ public static IntPtr GetClassLong(IntPtr hWnd, int nIndex)
[DllImport("user32.dll", CharSet = CharSet.Auto)]
public static extern IntPtr SendMessageTimeout(IntPtr hWnd, int message, IntPtr wParam, IntPtr lParam, int flags, int timeout, IntPtr result);
[DllImport("user32.dll", CharSet = CharSet.Auto)]
+ public static extern IntPtr SendMessageTimeout(IntPtr hWnd, int message, IntPtr wParam, ref MINMAXINFO minMaxInfo, int flags, int timeout, out IntPtr result);
+ [DllImport("user32.dll", CharSet = CharSet.Auto)]
public static extern IntPtr SendMessageTimeout(IntPtr hWnd, int message, int wParam, StringBuilder buffer, int flags, int timeout, out IntPtr result);
[DllImport("user32.dll", CharSet = CharSet.Auto)]
public static extern IntPtr SendMessage(IntPtr hWnd, int message, IntPtr wParam, StringBuilder lParam);
diff --git a/WtProgram/Desktop.fs b/WtProgram/Desktop.fs
index 3fc894d6..7b070f58 100755
--- a/WtProgram/Desktop.fs
+++ b/WtProgram/Desktop.fs
@@ -65,8 +65,9 @@ type GroupInfo(enableSuperBar, settings:ISettings, desktopDispatcher:IDispatcher
windowsCell.map <| fun l -> l.where((<>) hwnd)
member this.invokeGroup = invoker.asyncInvoke
- /// Complete on the main STA, including when the group exits before its queued read.
- member this.captureTabLayout(callback:GroupTabLayout option -> unit) =
+ /// The group's tab layout and its split, read on the group's thread. Complete on the main
+ /// STA, including when the group exits before its queued read.
+ member this.captureLayout(callback:(GroupTabLayout * (bool * Rect * (IntPtr * SavedPane) list) option) option -> unit) =
let mutable completed = false
let mutable subscription : IDisposable option = None
let complete result =
@@ -77,9 +78,12 @@ type GroupInfo(enableSuperBar, settings:ISettings, desktopDispatcher:IDispatcher
subscription <- Some(_group.exited.Subscribe(fun () -> desktopDispatcher.Post(fun () -> complete None)))
if this.isExited then complete None
else this.invokeGroup(fun () ->
- let layout = _group.tabLayout
+ let layout = _group.tabLayout,_group.savedSplit
desktopDispatcher.Post(fun () -> complete (Some layout)))
+ member this.captureTabLayout(callback:GroupTabLayout option -> unit) =
+ this.captureLayout(fun captured -> callback (captured |> Option.map fst))
+
member this.isSuperBarEnabled = enableSuperBar
/// The group's tab menu chose whether to combine its taskbar icons, so the setting leaves it alone. Main thread only.
member val isTaskbarChosen = false with get, set
@@ -110,7 +114,9 @@ type GroupInfo(enableSuperBar, settings:ISettings, desktopDispatcher:IDispatcher
windowsCell.map(fun windows -> windows.where((<>)hwnd))
this.invokeGroup <| fun() -> this.group.removeWindow(hwnd)
/// Stage main-thread membership, then attach only after the source STA has finished cleanup.
- member this.addAfterDetaching(source:GroupInfo, hwnd:IntPtr) =
+ /// `afterAdd` runs on the group's thread once the window is a member, or with false once
+ /// it is known it will not be: gone meanwhile, or taken back.
+ member this.addAfterDetaching(source:GroupInfo, hwnd:IntPtr, ?afterAdd:bool -> unit) =
if not(windowsCell.value.contains((=)hwnd)) then windowsCell.map(fun windows -> windows.append hwnd)
let token = obj()
stagedAdds.[hwnd] <- token
@@ -124,9 +130,11 @@ type GroupInfo(enableSuperBar, settings:ISettings, desktopDispatcher:IDispatcher
| true,current when obj.ReferenceEquals(current,token) ->
stagedAdds.Remove hwnd |> ignore
this.invokeGroup(fun () ->
- if not this.isExited && WinUserApi.IsWindow hwnd then this.group.addWindow(hwnd,false)
- else desktopDispatcher.Post(fun () -> windowsCell.map(fun windows -> windows.where((<>)hwnd))))
- | _ -> ()
+ let added = not this.isExited && WinUserApi.IsWindow hwnd
+ if added then this.group.addWindow(hwnd,false)
+ else desktopDispatcher.Post(fun () -> windowsCell.map(fun windows -> windows.where((<>)hwnd)))
+ afterAdd |> Option.iter(fun action -> action added))
+ | _ -> afterAdd |> Option.iter(fun action -> this.invokeGroup(fun () -> action false))
subscription <- Some(source.exited.Subscribe(fun () -> desktopDispatcher.Post attach))
if source.isExited then attach()
else source.invokeGroup(fun () ->
@@ -143,6 +151,8 @@ type GroupInfo(enableSuperBar, settings:ISettings, desktopDispatcher:IDispatcher
member x.addWindow(hwnd, delay) = this.addWindow(hwnd, delay)
member x.removeWindow hwnd = this.removeWindow hwnd
member x.switchWindow(next,force) = this.switchWindow(next, force)
+ member x.executeSplit command = this.invokeGroup <| fun() -> this.group.execute command
+ member x.pickPane(axis,side) = this.invokeGroup <| fun() -> this.group.requestPick(axis,side)
type IDesktopNotification =
abstract member dragDrop : IntPtr -> unit
@@ -158,11 +168,26 @@ type Desktop(notify:IDesktopNotification, settings:ISettings, dispatcher:IDispat
let removedEvent = Event<_>()
let changedEvent = Event<_>()
let _dd = DragDropController(this :> IDragDropParent) :> IDragDrop
-
- do
+ /// A window being moved by its own title bar: the window, its frame and whether it was maximized.
+ let mutable nativeMove : (IntPtr * Rect * bool) option = None
+
+ do
Services.register(_dd)
Services.register(DispatchedDesktop(this :> IDesktop, dispatcher) :> IDesktop)
settings.notifyValue "combineIconsInTaskbar" (fun value -> this.combineTaskbarIcons(unbox value)) |> ignore
+ // Windows dragged by their title bar can be let go over a group's empty pane.
+ os.setSingleWinEvent WinEvent.EVENT_SYSTEM_MOVESIZESTART (fun hwnd ->
+ nativeMove <-
+ if WinUserApi.IsWindow hwnd && WinUserApi.GetAsyncKeyState(VirtualKeyCodes.VK_LBUTTON)<0s then
+ let window = os.windowFromHwnd(hwnd)
+ Some(hwnd,window.visibleBounds,window.isMaximized)
+ else None) |> ignore
+ os.setSingleWinEvent WinEvent.EVENT_SYSTEM_MOVESIZEEND (fun hwnd ->
+ match nativeMove with
+ | Some(source,initial,maximized) when source=hwnd ->
+ nativeMove <- None
+ this.dropNativeWindow(hwnd,initial,maximized)
+ | _ -> nativeMove <- None) |> ignore
member private this.groups : List2 = groupCell.value.items
member _.retainedGroupCount = groupCell.value.count
@@ -201,6 +226,8 @@ type Desktop(notify:IDesktopNotification, settings:ISettings, dispatcher:IDispat
old.isRetiring <- true
old.invokeGroup <| fun() ->
let choices = old.group.menuChoices
+ let layout = old.group.layout
+ let frame = old.group.layoutFrame
dispatcher.Post <| fun() ->
let group = old.cast()
let enableSuperBar = wanted()
@@ -213,8 +240,17 @@ type Desktop(notify:IDesktopNotification, settings:ISettings, dispatcher:IDispat
newGroup.awaitsGroupingDesktop <- old.awaitsGroupingDesktop
newGroup.group.groupToken <- old.group.groupToken
newGroup.invokeGroup(fun() -> newGroup.group.applyMenuChoices choices)
+ // The split comes back once every window has arrived or is known not to:
+ // waiting for the old count, a window gone meanwhile kept it from ever coming.
+ let remaining = ref group.windows.count
+ let attached _ =
+ remaining.Value <- remaining.Value-1
+ if remaining.Value=0 then
+ match layout with
+ | GroupLayout.Single -> ()
+ | _ -> newGroup.group.restoreLayout(layout,frame)
group.windows.iter <| fun hwnd ->
- newGroup.addAfterDetaching(old,hwnd))
+ newGroup.addAfterDetaching(old,hwnd,afterAdd=attached))
member this.restartGroup(groupHwnd, enableSuperBar) =
this.groups.tryFind(fun g -> g.hwnd = groupHwnd && not g.isRetiring && g.isSuperBarEnabled <> enableSuperBar)
@@ -241,6 +277,51 @@ type Desktop(notify:IDesktopNotification, settings:ISettings, dispatcher:IDispat
with get() =
let foregroundWindow = os.foreground
this.findGroupContainingHwnd(foregroundWindow.hwnd)
+ member x.adoptIntoPane(groupHwnd,hwnd,path) = this.adoptIntoPane(groupHwnd,hwnd,path)
+ member x.adoptBeside(groupHwnd,hwnd,drop,partner) =
+ this.groups.tryFind(fun g -> g.hwnd=groupHwnd) |> Option.iter(fun group ->
+ this.handToPane(group,hwnd,fun () -> group.group.dropTab(hwnd,drop,partner)))
+
+ /// A window moved and let go over a group's empty pane joins that pane, as a dropped tab would.
+ member private this.dropNativeWindow(hwnd,initial:Rect,maximized) =
+ if WinUserApi.IsWindow hwnd then
+ let actual = os.windowFromHwnd(hwnd).visibleBounds
+ let pt = System.Windows.Forms.Cursor.Position.Pt
+ // A resize or a cancelled move must not become a pane drop.
+ if (maximized || actual.size=initial.size) && actual.location<>initial.location && WinUserApi.GetAsyncKeyState(VirtualKeyCodes.VK_ESCAPE)>=0s then
+ let exposed = os.windowsInZorder.tryFind(fun w ->
+ w.hwnd<>hwnd && w.isVisible && not w.isMinimized && not(WindowCloaking.IsCloaked w.hwnd) && w.visibleBounds.containsPoint(pt))
+ exposed |> Option.iter(fun pane ->
+ this.groups.tryFind(fun g -> not g.isExited && not g.isRetiring && g.group.isEmptyPane pane.hwnd) |> Option.iter(fun group ->
+ let anchor = (group :> IGroup).windows.tryHead
+ let sameDesktop =
+ match anchor |> Option.bind VirtualDesktop.groupingDesktopId,VirtualDesktop.groupingDesktopId hwnd with
+ | Some a,Some b -> a=b
+ | _ -> false
+ if sameDesktop then
+ this.handToPane(group,hwnd,fun () ->
+ match group.group.emptyPaneAt pt with
+ | Some(path,_) -> group.group.execute(FillPane(hwnd,path))
+ | None -> ())))
+
+ /// A window joins the group, leaving the group it was in, and `fill` runs on the group's
+ /// thread once it is a member. A window of the group itself only needs the fill.
+ member private this.handToPane(group:GroupInfo,hwnd,fill:unit -> unit) =
+ if WinUserApi.IsWindow hwnd && not group.isExited && not group.isRetiring then
+ let finish() =
+ group.group.isManual <- true
+ fill()
+ match this.groups.tryFind(fun source -> (source :> IGroup).windows.contains((=) hwnd)) with
+ | Some source when source.hwnd=group.hwnd -> group.invokeGroup finish
+ | Some source when not source.isRetiring -> group.addAfterDetaching(source,hwnd,afterAdd=(fun added -> if added then finish()))
+ | None when Services.filter.isTabbableWindow hwnd ->
+ (group :> IGroup).addWindow(hwnd,false)
+ group.invokeGroup finish
+ | _ -> ()
+
+ member private this.adoptIntoPane(groupHwnd,hwnd,path) =
+ this.groups.tryFind(fun g -> g.hwnd=groupHwnd) |> Option.iter(fun group ->
+ this.handToPane(group,hwnd,fun () -> group.group.execute(FillPane(hwnd,path))))
interface IDragDropParent with
member x.dragBegin() = invoker.asyncInvoke <| fun() ->
@@ -250,22 +331,40 @@ type Desktop(notify:IDesktopNotification, settings:ISettings, dispatcher:IDispat
let dragInfo = unbox(data)
let (Tab(hwnd)) = dragInfo.tab
let window = os.windowFromHwnd(hwnd)
- // Tabs sit on the visible frame, so step back over the invisible resize border too.
- // A maximized or minimized window's frame says nothing about its restored one.
- let frameOffset =
- if window.isMaximized || window.isMinimized then Pt()
- else window.visibleBounds.location.sub(window.bounds.location)
- let windowPt = pt.sub(dragInfo.tabOffset).add(this.windowOffset).sub(frameOffset)
- let monitor = Mon.fromPoint windowPt
+ // Tabs sit on the visible frame; the invisible resize borders go around it. A maximized
+ // or minimized window's frame says nothing about its restored one.
+ let borderLeftTop,borderSize =
+ if window.isMaximized || window.isMinimized then Pt(),Sz()
+ else
+ let bounds,visible = window.bounds,window.visibleBounds
+ visible.location.sub(bounds.location),Sz(bounds.width-visible.width,bounds.height-visible.height)
+ // The monitor under the pointer decides: the size the group had, scaled down as a whole
+ // where it spans most of the screen. A maximized window fills it.
+ let monitor = DragOutPlacement.monitorAt pt
+ let size =
+ let current =
+ if window.isMaximized then monitor |> Option.map(fun mon -> mon.workRect.size) |> Option.defaultValue window.visibleBounds.size
+ else window.visibleBounds.size
+ monitor |> Option.map(fun mon -> DragOutPlacement.size current mon.workRect) |> Option.defaultValue current
+ // The tab stays under the pointer at the width the window lands at: placed with the
+ // shift of the group's width, a window made smaller came out hundreds of pixels to
+ // one side, at times off the screen. Then all of it in the work area.
+ let visiblePt = pt.sub(dragInfo.tabOffset).sub(Pt(dragInfo.shiftFor size.width,0)).add(this.windowOffset)
+ let visible =
+ let frame = Rect(visiblePt,size)
+ monitor |> Option.map(fun mon -> DragOutPlacement.fit mon.workRect frame) |> Option.defaultValue frame
let workspaceOffset = monitor.map(fun mon -> mon.workRect.location.sub(mon.displayRect.location)).def(Pt())
- let windowPt = windowPt.sub(workspaceOffset)
+ let windowPt = visible.location.sub(borderLeftTop).sub(workspaceOffset)
window.setPlacement({
window.placement with
showCmd = ShowWindowCommands.SW_SHOWNORMAL
- rcNormalPosition = Rect(
- windowPt,
- window.placement.rcNormalPosition.size)
- })
+ rcNormalPosition = Rect(windowPt,Sz(visible.width+borderSize.width,visible.height+borderSize.height))
+ })
+ // The window let go is the one in hand: in front and active. Its old group took the
+ // foreground as the tab left it, to show the panes the tab had parked, and the window
+ // landed under them.
+ window.setForeground(true)
+ window.raise()
notify.dragDrop(hwnd)
member x.dragEnd() = invoker.asyncInvoke <| fun() ->
diff --git a/WtProgram/DesktopPlugins/InputManagerPlugin.fs b/WtProgram/DesktopPlugins/InputManagerPlugin.fs
index 1a4cd257..8128f3be 100755
--- a/WtProgram/DesktopPlugins/InputManagerPlugin.fs
+++ b/WtProgram/DesktopPlugins/InputManagerPlugin.fs
@@ -34,6 +34,25 @@ type NumericShortcutCapture() =
else pressed.Contains(key), None
else false, None
+/// Esc beside an empty pane closes it, as its close button does. The pane is a choice still to
+/// make, so the key is taken, and its release with it, as a popup's dismissal would be.
+type EmptyPaneEscape() =
+ let mutable taken = false
+ /// `close` closes the pane beside the active tab, and says whether there was one.
+ member _.handle(msg:int, key:int, modified:bool, close:unit -> bool) =
+ if key<>0x1B then false
+ elif msg=WindowMessages.WM_KEYDOWN || msg=WindowMessages.WM_SYSKEYDOWN then
+ // A held key repeats its press: the first one closed the pane, the rest are taken too.
+ if taken then true
+ else
+ taken <- not modified && close()
+ taken
+ elif msg=WindowMessages.WM_KEYUP || msg=WindowMessages.WM_SYSKEYUP then
+ let wasTaken = taken
+ taken <- false
+ wasTaken
+ else false
+
type InputManagerPlugin(msgSet:Set2) as this =
let hookProcDelegate = HOOKPROC(this.llHook)
let mutable kbHook = null
@@ -42,6 +61,7 @@ type InputManagerPlugin(msgSet:Set2) as this =
let numericCapture = NumericShortcutCapture()
let leader = NumberLeaderState()
let leaderCapture = NumericShortcutCapture()
+ let emptyPaneEscape = EmptyPaneEscape()
let mutable leaderGroup : GroupInfo option = None
let timer = new System.Windows.Forms.Timer(Interval=50)
let owned = new LifetimeScope(ignore)
@@ -102,9 +122,31 @@ type InputManagerPlugin(msgSet:Set2) as this =
member this.registerMouseLLHook() =
mouseHook <- WinUserApi.SetWindowsHookEx(WindowHookTypes.WH_MOUSE_LL, hookProcDelegate, IntPtr.Zero, 0)
+ member private this.modifiersHeld(data:KBDLLHOOKSTRUCT) =
+ (data.flags &&& LlKeyboardHookFlags.LLKHF_ALTDOWN) <> 0 ||
+ [VirtualKeyCodes.VK_CONTROL;VirtualKeyCodes.VK_SHIFT;int System.Windows.Forms.Keys.LWin;int System.Windows.Forms.Keys.RWin]
+ |> List.exists Win32Helper.IsKeyPressed
+
+ /// The group of the active window, if an empty pane is shown beside it, is told to close it.
+ member private this.closeEmptyPane() =
+ match this.foregroundGroup with
+ | Some group ->
+ let info = group.cast()
+ if info.group.emptyPaneHwnds |> List.exists WinUserApi.IsWindowVisible then
+ info.invokeGroup(fun () -> info.group.closeEmptyPane())
+ true
+ else false
+ | None -> false
+
member this.registerKeyboardLLHook() =
kbHook <- OS.registerKeyboardLLHook <| fun(key, data) ->
- if data.dwExtraInfo = AltMenuMask.marker then None else
+ if data.dwExtraInfo = AltMenuMask.marker then None
+ // Escape during a tab drag cancels it and goes no further.
+ elif (int key=WindowMessages.WM_KEYDOWN || int key=WindowMessages.WM_SYSKEYDOWN) && data.vkCode=VirtualKeyCodes.VK_ESCAPE && Services.dragDrop.cancelDrag() then Some 1
+ // Escape beside an empty pane closes it.
+ elif data.vkCode=VirtualKeyCodes.VK_ESCAPE &&
+ emptyPaneEscape.handle(int key,data.vkCode,this.modifiersHeld(data),this.closeEmptyPane) then Some 1
+ else
// The group runs asynchronously; Ctrl may be released before it handles
// this key. Preserve the modifier state belonging to this input event.
let controlPressed = Win32Helper.IsKeyPressed(VirtualKeyCodes.VK_CONTROL)
diff --git a/WtProgram/DragDropController.fs b/WtProgram/DragDropController.fs
index 0fb20df5..fcaeabef 100755
--- a/WtProgram/DragDropController.fs
+++ b/WtProgram/DragDropController.fs
@@ -19,28 +19,94 @@ type DragDetectingState(info:DragDetectingStateInfo) =
info.onBegin()
member this.dispose() = ()
+/// Where the pointer is: a strip joins the tab at once, a group's own windows (and the helper
+/// windows they own) only preview a pane, anything else floats.
+type DragHit = StripHit of IntPtr | LayoutHit of IntPtr | FreeHit
+
+module DragRouting =
+ /// Around a strip's row of tabs, in logical pixels, a dragged tab counts as in the strip:
+ /// joining it there and leaving it only beyond. Just below another group's tabs, over its
+ /// title bar, a tab carried to join them was offered that window's top edge instead.
+ let stripMargin = 24
+
+ let resolve (strips:Map2) (layouts:Map2) hit owner =
+ if strips.contains hit then StripHit hit
+ elif layouts.contains hit then LayoutHit hit
+ elif owner<>IntPtr.Zero && layouts.contains owner then LayoutHit owner
+ else FreeHit
+
+ /// Whether a tab held in one strip moves to the strip under the pointer: strips of groups
+ /// at the top of the screen lie over one another, and the first one the tab crossed kept it
+ /// while the pointer was anywhere in its width, over another group's tabs in sight too.
+ let movesToStrip (strips:Map2) (current:IntPtr) (hit:IntPtr) =
+ hit<>IntPtr.Zero && hit<>current && strips.contains hit
+
+ /// The top-level window under a point, and its owner. The point lands on an app's child
+ /// window, a browser's page say, which no group knows: over such apps a dragged tab never
+ /// offered a pane.
+ let windowsAt (pt:Pt) =
+ let hit = WinUserApi.WindowFromPoint(pt.POINT)
+ let root = if hit=IntPtr.Zero then IntPtr.Zero else WinUserApi.GetAncestor(hit,GetAncestorConstants.GA_ROOT)
+ let owner = if root=IntPtr.Zero then IntPtr.Zero else WinUserApi.GetWindow(root,GetWindowConstants.GW_OWNER)
+ root,owner
+
type DragCapturedStateInfo = {
target : IDragDropTarget
targetHwnd : IntPtr
targetWindow : Window
+ targets : Map2
onDragOut : Pt -> unit
}
type DragCapturedState(info:DragCapturedStateInfo) =
- let dragOutDistance = 20
+ let dragOutDistance = Dpi.scale DragRouting.stripMargin
+ member _.target = info.target
+ member _.targetHwnd = info.targetHwnd
interface IDragState with
member this.mouseMove(ptScreen) =
let dragBounds = info.targetWindow.bounds.inflate(dragOutDistance, dragOutDistance)
- if dragBounds.containsPoint(ptScreen) then
+ let hit,_ = DragRouting.windowsAt ptScreen
+ if dragBounds.containsPoint(ptScreen) && not(DragRouting.movesToStrip info.targets info.targetHwnd hit) then
info.target.dragMove(info.targetWindow.ptToClient(ptScreen))
else
info.target.dragExit()
info.onDragOut(ptScreen)
member this.dispose() = ()
+/// Whether a split may be offered yet: a tab carried over a window on its way to somewhere
+/// else, or let go over one where there was no free desktop left, split it at once. A split
+/// is offered once the pointer has rested in a window's drop zone; from then on the preview
+/// follows it over that window until it leaves the zones. An empty pane takes a drop at once.
+type LayoutDwell = { key: IntPtr; anchor: Pt; since: int64; shown: bool }
+
+module LayoutDwell =
+ let restMs = 100L
+ /// How far the pointer may wander while resting, in logical pixels.
+ let restRadius = 6
+ /// Whether a split over `key` would show now: offered already, or rested long enough.
+ let ready (now:int64) (radius:int) (pt:Pt) (key:IntPtr) (state:LayoutDwell option) =
+ match state with
+ | Some s when s.key=key && s.shown -> true
+ | Some s when s.key=key && abs(pt.x-s.anchor.x)<=radius && abs(pt.y-s.anchor.y)<=radius -> now-s.since>=restMs
+ | _ -> false
+ /// The state after the pointer at `pt` over the window `key`, and whether the preview shows.
+ let step (now:int64) (radius:int) (pt:Pt) (key:IntPtr) (aim:LayoutAim) (state:LayoutDwell option) =
+ match aim with
+ | NoAim -> None,false
+ | FillAim -> None,true
+ | SplitAim ->
+ match state with
+ | Some s when s.key=key && s.shown -> Some s,true
+ | Some s when s.key=key && abs(pt.x-s.anchor.x)<=radius && abs(pt.y-s.anchor.y)<=radius ->
+ let ready = now-s.since>=restMs
+ Some {s with shown=ready},ready
+ | _ -> Some {key=key;anchor=pt;since=now;shown=false},false
+
type DragFloatingStateInfo = {
imageOffset : Pt
targets: Map2
+ layoutTargets: Map2
+ data: obj
animationWindow: AnimationWindow
onDragIn: (IntPtr * Pt) -> unit
}
@@ -48,22 +114,84 @@ type DragFloatingStateInfo = {
type DragFloatingState(info:DragFloatingStateInfo) =
let os = OS()
let animationWindow = info.animationWindow
+ let clock = Diagnostics.Stopwatch.StartNew()
+ let mutable candidate : (IntPtr * ILayoutDropTarget) option = None
+ let mutable dwell : LayoutDwell option = None
+ /// The window and point last aimed at, for the pointer resting with no move to report.
+ let mutable aimed : (IntPtr * ILayoutDropTarget * Pt) option = None
+ let restTimer = new Timer(Interval=25)
+ let clearCandidate() =
+ candidate |> Option.iter(fun (_,target) -> target.clearPreview())
+ candidate <- None
+ let float(ptScreen:Pt) =
+ animationWindow.setLocation(ptScreen.sub(info.imageOffset))
+ animationWindow.setIsVisible(true)
+ /// The preview for the pointer at `pt` over `key`, once it may show: one call to the group
+ /// for what is there. The strip to join instead, when the point lies near its tabs.
+ let previewAt (key:IntPtr) (target:ILayoutDropTarget) (pt:Pt) : IntPtr option =
+ match candidate with
+ | Some(previous,old) when previous<>key -> old.clearPreview()
+ | _ -> ()
+ let now,radius = clock.ElapsedMilliseconds,Dpi.scale LayoutDwell.restRadius
+ match target.probe(info.data,pt,LayoutDwell.ready now radius pt key dwell) with
+ | NearStrip strip -> Some strip
+ | Aimed(aim,shown) ->
+ let state,show = LayoutDwell.step now radius pt key aim dwell
+ dwell <- state
+ // The tab's image stays with the pointer over the highlighted pane.
+ if show && shown then candidate <- Some(key,target)
+ else
+ if candidate.IsSome then target.clearPreview()
+ candidate <- None
+ aimed <- (if aim=SplitAim && not show then Some(key,target,pt) else None)
+ if aimed.IsSome then restTimer.Start() else restTimer.Stop()
+ None
+ do restTimer.Tick.Add(fun _ ->
+ match aimed with
+ | Some(key,target,pt) -> previewAt key target pt |> ignore
+ | None -> restTimer.Stop())
+ /// Drops into the pane under the pointer; false when there is none.
+ member this.commit(pt) =
+ match candidate with
+ | Some(_,target) ->
+ candidate <- None
+ target.commit(info.data,pt)
+ | None -> false
interface IDragState with
member this.mouseMove(ptScreen) =
- let targetHwnd = os.windowAtPt(ptScreen).hwnd
- if info.targets.tryFind(targetHwnd).IsSome then
+ let hit,owner = DragRouting.windowsAt ptScreen
+ let joinStrip strip =
+ clearCandidate()
+ dwell <- None
+ aimed <- None
+ restTimer.Stop()
animationWindow.setIsVisible(false)
- info.onDragIn(targetHwnd, ptScreen)
- else
- animationWindow.setLocation(ptScreen.sub(info.imageOffset))
- animationWindow.setIsVisible(true)
- member this.dispose() = animationWindow.setIsVisible(false)
+ info.onDragIn(strip, ptScreen)
+ match DragRouting.resolve info.targets info.layoutTargets hit owner with
+ | StripHit target -> joinStrip target
+ | LayoutHit key ->
+ let target = info.layoutTargets.find key
+ // Over a group's window near its tabs, the tab goes with them.
+ match previewAt key target ptScreen with
+ | Some strip when info.targets.contains strip -> joinStrip strip
+ | _ -> float ptScreen
+ | FreeHit ->
+ clearCandidate()
+ dwell <- None
+ aimed <- None
+ restTimer.Stop()
+ float ptScreen
+ member this.dispose() =
+ restTimer.Dispose()
+ clearCandidate()
+ animationWindow.setIsVisible(false)
type DragActionInfo = {
targets : Map2
+ layoutTargets : Map2
notifications: Set2
initialHwnd : IntPtr
- image : unit -> Img
+ image : (Img -> unit) -> Img
imageOffset : Pt
initialPt : Pt
data: obj
@@ -75,13 +203,13 @@ type DragActionInfo = {
type DragAction(info:DragActionInfo) =
let os = OS()
- let dragScale = 0.5
let Cell = CellScope(true, false)
let ptScreenCell = Cell.create(info.initialPt)
let dragStateCell = Cell.create(None:Option)
let captureWindowCell = Cell.create(None:Option)
let timer = new Timer()
let animationWindowCell = Cell.create(None:Option)
+ let mutable finished = false
member this.setNextState(newState:obj) =
let newState = unbox(newState)
@@ -90,37 +218,71 @@ type DragAction(info:DragActionInfo) =
member this.captureWindow : Window = os.windowFromHwnd(captureWindowCell.value.Value.hwnd)
- member this.captureEnded(ptScreen) =
+ member private this.release() =
this.captureWindow.releaseCapture()
- (captureWindowCell.value.Value :?>IDisposable).Dispose()
+ (captureWindowCell.value.Value :?> IDisposable).Dispose()
timer.Dispose()
dragStateCell.value.Value.dispose()
animationWindowCell.value.iter <| fun window -> window.Dispose()
- match dragStateCell.value.Value with
- | :? DragDetectingState ->
- info.onCancel()
- | :? DragCapturedState ->
- info.targets.values.iter <| fun target -> target.dragEnd()
- info.notifications.items.iter <| fun n -> n.dragEnd()
- info.onEnd()
- | :? DragFloatingState ->
- info.targets.values.iter <| fun target -> target.dragEnd()
- info.notifications.items.iter <| fun n -> n.dragEnd()
- info.onDrop(ptScreen)
- info.onEnd()
- | _ -> ()
+
+ member private this.notifyEnd() =
+ info.targets.values.iter <| fun target -> target.dragEnd()
+ info.notifications.items.iter <| fun n -> n.dragEnd()
+ info.onEnd()
+
+ /// A cancelled tab goes back to its strip; with that strip gone, it lands where the pointer is.
+ member private this.restoreSource(pt) =
+ match info.targets.tryFind(info.initialHwnd) with
+ | Some source when WinUserApi.IsWindow(info.initialHwnd) -> source.dragCancel(info.data)
+ | _ -> if WinUserApi.IsWindow(this.draggedHwnd) then info.onDrop(pt)
+
+ member private this.draggedHwnd =
+ match info.data with
+ | :? TabDragInfo as drag -> let (Tab hwnd) = drag.tab in hwnd
+ | _ -> IntPtr.Zero
+
+ /// Some pt: the button was released there; None: the drag is cancelled.
+ member private this.finish(drop:Pt option) =
+ if not finished then
+ finished <- true
+ match dragStateCell.value.Value,drop with
+ | :? DragDetectingState,_ ->
+ this.release()
+ info.onCancel()
+ | :? DragCapturedState,Some _ ->
+ this.release()
+ this.notifyEnd()
+ | :? DragCapturedState as captured,None ->
+ // Taken into another strip already: leave it again before going home.
+ if captured.targetHwnd<>info.initialHwnd then captured.target.dragExit()
+ this.release()
+ this.restoreSource(ptScreenCell.value)
+ this.notifyEnd()
+ | :? DragFloatingState as floating,Some pt ->
+ let committed = floating.commit(pt)
+ this.release()
+ if not committed then info.onDrop(pt)
+ this.notifyEnd()
+ | :? DragFloatingState,None ->
+ this.release()
+ this.restoreSource(ptScreenCell.value)
+ this.notifyEnd()
+ | _ -> this.release()
+
+ member this.captureEnded(ptScreen) = this.finish(Some ptScreen)
+
+ member this.cancel() = this.finish(None)
member this.wndProc (msg:Win32Message) =
- let ptScreen() =
+ let ptScreen() =
let pt = msg.lParam.location
let ptScreen = this.captureWindow.ptToScreen(pt)
ptScreenCell.set(ptScreen)
ptScreen
match msg.msg with
- | WindowMessages.WM_MOUSEMOVE ->
- dragStateCell.value.Value.mouseMove(ptScreen())
- | WindowMessages.WM_MOUSELEAVE
- | WindowMessages.WM_LBUTTONUP ->
+ | WindowMessages.WM_MOUSEMOVE ->
+ if not finished then dragStateCell.value.Value.mouseMove(ptScreen())
+ | WindowMessages.WM_LBUTTONUP ->
this.captureEnded(ptScreen())
| _ -> ()
msg.def()
@@ -128,7 +290,9 @@ type DragAction(info:DragActionInfo) =
member this.dragFloat() =
this.setNextState <| DragFloatingState({
targets = info.targets
- imageOffset = info.imageOffset.mulf(dragScale, dragScale)
+ layoutTargets = info.layoutTargets
+ data = info.data
+ imageOffset = info.imageOffset
animationWindow = animationWindowCell.value.Value
onDragIn = fun (targetHwnd, ptScreen) ->
this.dragEnter(targetHwnd, ptScreen, false)
@@ -143,27 +307,35 @@ type DragAction(info:DragActionInfo) =
target = target
targetHwnd = targetHwnd
targetWindow = targetWindow
- onDragOut = fun(ptScreen) ->
- let targetHwnd = os.windowAtPt(ptScreen).hwnd
+ targets = info.targets
+ onDragOut = fun(ptScreen) ->
+ let targetHwnd,_ = DragRouting.windowsAt ptScreen
match info.targets.tryFind(targetHwnd) with
| Some(target) -> this.dragEnter(targetHwnd, ptScreen, false)
| None -> this.dragFloat()
})
- else
+ else
if isInitial then target.dragExit()
this.dragFloat()
member this.dragDetect() =
this.setNextState <| DragDetectingState({
initialPt = info.initialPt
- onBegin = fun() ->
+ onBegin = fun() ->
animationWindowCell.value <-
let animationWindow = AnimationWindow(os)
- animationWindow.setAlpha(byte(0xAA))
- try
- //this may fail if the image coming back is too small
- use full = info.image().bitmap
- animationWindow.setImage(full.img.scale(dragScale))
+ // The image carries its own see-through window; the tab on it stays solid.
+ animationWindow.setAlpha(byte(0xFF))
+ // The image comes drawn at the size it shows: its window small, its tab
+ // readable. The window's picture may follow a moment later, from another
+ // thread: printed before the drag could start, a large window held it up.
+ let invoker = InvokerService.invoker
+ let later (image:Img) =
+ invoker.asyncInvoke(fun () ->
+ match animationWindowCell.value with
+ | Some window when not finished -> window.setImage image
+ | _ -> image.bitmap.Dispose())
+ try animationWindow.setImage(info.image later)
with _ -> ()
Some(animationWindow)
info.targets.values.iter <| fun target -> target.dragBegin()
@@ -177,7 +349,8 @@ type DragAction(info:DragActionInfo) =
captureWindowCell.set(Some(os.createWindow this.wndProc 0 0))
this.captureWindow.setCapture()
timer.Interval <- 500
- timer.Tick.Add <| fun _ -> if this.captureWindow.hasCapture.not then this.captureEnded(ptScreenCell.value)
+ // Capture taken away (another window, a system key) is not a drop.
+ timer.Tick.Add <| fun _ -> if this.captureWindow.hasCapture.not then this.cancel()
timer.Start()
this.dragDetect()
@@ -186,8 +359,14 @@ type DragDropController(parent:IDragDropParent) =
let withLock = lock lockObj
let Cell = CellScope(true, false)
let targetsCell = Cell.create(Map2())
+ let layoutTargetsCell = Cell.create(Map2())
let notificationsCell = Cell.create(Set2())
let dragActionCell = Cell.create(None)
+ /// The thread that began the drag; a cancel from a hook thread goes there.
+ let mutable dragInvoker : Invoker option = None
+
+ /// Whether a drag over this window finds a group's panes.
+ member x.isLayoutTarget hwnd = layoutTargetsCell.value.contains hwnd
interface IDragDrop with
member x.registerNotification(notify) = withLock <| fun() ->
@@ -198,27 +377,44 @@ type DragDropController(parent:IDragDropParent) =
targetsCell.map(fun targets -> targets.add hwnd target)
member x.unregisterTarget(hwnd) = withLock <| fun() ->
targetsCell.map(fun targets -> targets.remove hwnd)
+ member x.registerLayoutTarget((hwnd, target)) = withLock <| fun() ->
+ layoutTargetsCell.map(fun targets -> targets.add hwnd target)
+ member x.unregisterLayoutTarget((hwnd, target)) = withLock <| fun() ->
+ layoutTargetsCell.map(fun targets ->
+ match targets.tryFind hwnd with
+ | Some registered when obj.ReferenceEquals(registered,target) -> targets.remove hwnd
+ | _ -> targets)
member x.beginDrag((initialHwnd, image, imageOffset, initialPt, data)) = withLock <| fun() ->
- if dragActionCell.value.IsNone then
+ if dragActionCell.value.IsNone then
let dragAction = DragAction({
targets = targetsCell.value
+ layoutTargets = layoutTargetsCell.value
notifications = notificationsCell.value
initialHwnd = initialHwnd
image = image
imageOffset = imageOffset
initialPt = initialPt
data = data
- onCancel = fun() ->
- dragActionCell.set(None)
- onBegin = fun() ->
+ onCancel = fun() ->
+ withLock(fun () ->
+ dragActionCell.set(None)
+ dragInvoker <- None)
+ onBegin = fun() ->
parent.dragBegin()
onDrop = fun pt ->
parent.dragDrop(pt, data)
- onEnd = fun() ->
+ onEnd = fun() ->
parent.dragEnd()
- dragActionCell.set(None)
+ withLock(fun () ->
+ dragActionCell.set(None)
+ dragInvoker <- None)
})
dragActionCell.set(Some(dragAction))
+ dragInvoker <- Some InvokerService.invoker
dragAction.start()
- ()
-
+ member x.cancelDrag() = lock lockObj <| fun() ->
+ match dragActionCell.value,dragInvoker with
+ | Some action,Some invoker ->
+ invoker.asyncInvoke(fun () -> action.cancel())
+ true
+ | _ -> false
diff --git a/WtProgram/GroupPlugins/SuperBarPlugin.fs b/WtProgram/GroupPlugins/SuperBarPlugin.fs
index 7fd7d146..23254ec2 100755
--- a/WtProgram/GroupPlugins/SuperBarPlugin.fs
+++ b/WtProgram/GroupPlugins/SuperBarPlugin.fs
@@ -78,54 +78,93 @@ module TaskbarProxies =
/// A group with combined icons owns its windows, so they follow it between desktops.
let ownsWindow (hwnd:IntPtr) = contains (WinUserApi.GetWindowLong(hwnd, WindowLongFieldOffset.GWL_HWNDPARENT))
-/// A group's taskbar icon: the app's icon with the WindowTabs badge at the bottom right, as in
-/// the window switcher. Windows 11 draws an overlay icon at the top right instead. In a group
-/// of several apps the badge is the next app's icon instead, so the front app keeps its full size.
+/// A group's icon as its taskbar button shows it: the app's icon with the WindowTabs badge at the
+/// bottom right. In a group of several apps the other apps line up small along the bottom right
+/// instead, the main app keeping its full size; one in the corner showed only the second. The
+/// window switcher draws a group the same way.
+module GroupIconImage =
+ /// The most apps one icon shows.
+ let maxApps = 4
+ let compose (size:int) (app:Bitmap) (others:Bitmap list) =
+ let canvas = new Bitmap(size,size,PixelFormat.Format32bppArgb)
+ use g = Graphics.FromImage(canvas)
+ g.InterpolationMode <- Drawing2D.InterpolationMode.HighQualityBicubic
+ match List.truncate (maxApps-1) others with
+ | [] ->
+ g.DrawImage(app,Rectangle(0,0,size,size))
+ use badgeIcon = Services.openIcon("Bemo.ico")
+ use badge = badgeIcon.ToBitmap()
+ // Leave more of the application visible, with the badge tucked into the right corner.
+ let side = size*7/12
+ // The badge's transparent margin otherwise keeps its visible edge inset.
+ let rightOffset = size/12
+ g.DrawImage(badge,Rectangle(size-side+rightOffset,size-side,side,side))
+ | rest ->
+ g.DrawImage(app,Rectangle(0,0,size,size))
+ // The other apps sit small along the bottom, the last at the right edge: the first of
+ // them whole, each after it behind the one before with about a third showing, so
+ // every app in the group can be told while the main one keeps its full size.
+ let side = size*7/16
+ let step = (side+2)/3
+ let top = size-side
+ let left = size-side-(rest.Length-1)*step
+ // One clear ring round the whole row keeps it apart from the main app's icon; a ring
+ // round each one cut dark seams between them. One pixel at taskbar size: a wider
+ // one read as a dark border on the taskbar.
+ let gap = max 1 (size/32)
+ use clear = new SolidBrush(Color.Transparent)
+ use path = new Drawing2D.GraphicsPath()
+ // Half a pixel further out, so the ring's first column and row are cleared whole.
+ let x,y = float32(left-gap)-0.5f,float32(top-gap)-0.5f
+ let width,height = float32(size-left+2*gap)+0.5f,float32(side+2*gap)+0.5f
+ let d = height*0.4f
+ path.AddArc(x,y,d,d,180.0f,90.0f)
+ path.AddArc(x+width-d,y,d,d,270.0f,90.0f)
+ path.AddArc(x+width-d,y+height-d,d,d,0.0f,90.0f)
+ path.AddArc(x,y+height-d,d,d,90.0f,90.0f)
+ path.CloseFigure()
+ g.CompositingMode <- Drawing2D.CompositingMode.SourceCopy
+ g.FillPath(clear,path)
+ g.CompositingMode <- Drawing2D.CompositingMode.SourceOver
+ // From the back: each one draws itself over the ones after it, on a plate of its
+ // own, so an icon drawn on nothing, as some apps' are, neither shows the one behind
+ // through it nor fades into the taskbar.
+ // The taskbar's own shade, which follows the system's theme, not the tabs' setting.
+ let plate = if ThemeService.systemIsDark() then Color.FromArgb(56,56,56) else Color.FromArgb(232,232,232)
+ use plateBrush = new SolidBrush(plate)
+ rest |> List.indexed |> List.rev |> List.iter(fun (index,icon) ->
+ let box = Rectangle(left+index*step,top,side,side)
+ let radius = max 2 (side/6)
+ use shape = new Drawing2D.GraphicsPath()
+ let d = float32(radius*2)
+ let x,y,w,h = float32 box.X,float32 box.Y,float32 box.Width,float32 box.Height
+ shape.AddArc(x,y,d,d,180.0f,90.0f)
+ shape.AddArc(x+w-d,y,d,d,270.0f,90.0f)
+ shape.AddArc(x+w-d,y+h-d,d,d,0.0f,90.0f)
+ shape.AddArc(x,y+h-d,d,d,90.0f,90.0f)
+ shape.CloseFigure()
+ g.SmoothingMode <- Drawing2D.SmoothingMode.AntiAlias
+ g.FillPath(plateBrush,shape)
+ g.SmoothingMode <- Drawing2D.SmoothingMode.None
+ g.DrawImage(icon,box))
+ canvas
+
+/// A group's taskbar icon, drawn by GroupIconImage. Windows 11 draws an overlay icon at the top
+/// right instead.
type TaskbarBadgedIcon(icon:Icon, ?stacked:Icon list) =
let others = defaultArg stacked [] |> List.truncate TaskbarBadgedIcon.maxStacked
// Some apps give a 256 pixel icon, which the Windows Alt+Tab drew across a group's whole tile.
let size = min 64 (max 32 icon.Width)
let handle =
- use canvas = new Bitmap(size,size,PixelFormat.Format32bppArgb)
- do
- use g = Graphics.FromImage(canvas)
- g.InterpolationMode <- Drawing2D.InterpolationMode.HighQualityBicubic
- use app = icon.ToBitmap()
- g.DrawImage(app,Rectangle(0,0,size,size))
- match others with
- | other :: _ ->
- // A clear ring round the corner icon keeps it apart from the front app's. One
- // pixel at taskbar size: a wider one read as a dark border on the taskbar.
- let side = size*7/16
- let gap = max 1 (size/32)
- let corner = size-side
- use ring = new Drawing2D.GraphicsPath()
- // Half a pixel further out, so the ring's first column is cleared whole.
- let x,span = float32(corner-gap)-0.5f,float32(side+2*gap)+0.5f
- let d = span*0.4f
- ring.AddArc(x,x,d,d,180.0f,90.0f)
- ring.AddArc(x+span-d,x,d,d,270.0f,90.0f)
- ring.AddArc(x+span-d,x+span-d,d,d,0.0f,90.0f)
- ring.AddArc(x,x+span-d,d,d,90.0f,90.0f)
- ring.CloseFigure()
- use clear = new SolidBrush(Color.Transparent)
- g.CompositingMode <- Drawing2D.CompositingMode.SourceCopy
- g.FillPath(clear,ring)
- g.CompositingMode <- Drawing2D.CompositingMode.SourceOver
- use image = other.ToBitmap()
- g.DrawImage(image,Rectangle(corner,corner,side,side))
- | [] ->
- use badgeIcon = Services.openIcon("Bemo.ico")
- use badge = badgeIcon.ToBitmap()
- // Leave more of the application visible, with the badge tucked into the right corner.
- let side = size*7/12
- // The badge's transparent margin otherwise keeps its visible edge inset.
- let rightOffset = size/12
- g.DrawImage(badge,Rectangle(size-side+rightOffset,size-side,side,side))
- canvas.GetHicon()
+ use app = icon.ToBitmap()
+ let images = others |> List.map(fun other -> other.ToBitmap())
+ try
+ use canvas = GroupIconImage.compose size app images
+ canvas.GetHicon()
+ finally images |> List.iter(fun image -> image.Dispose())
let badged = Icon.FromHandle(handle)
- /// The other apps' icons shown: one, in the corner, which is all a taskbar icon has room for.
- static member maxStacked = 1
+ /// The other apps' icons shown along the bottom right.
+ static member maxStacked = GroupIconImage.maxApps-1
member _.source = icon
member _.stacked = others
member _.icon = badged
@@ -513,9 +552,9 @@ type TaskBarButton(info) as this =
member _.ownsApplication(hwnd:IntPtr) = windows.ContainsKey(WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_OWNER))
/// Peek must own only the application represented by that preview, rather than every tab.
- member this.adoptWindow(hwnd:IntPtr) =
+ member this.adoptWindow(hwnd:IntPtr, follow:bool) =
match tabWindowsCell.value.tryFind(TaskBarButton.key hwnd) with
- | Some tab -> tab.adoptWindow hwnd
+ | Some tab -> tab.adoptWindow(hwnd,follow)
| None ->
// Discovery can announce a member before its preview joins the strip.
if WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_OWNER)<>this.window.hwnd then
@@ -620,7 +659,8 @@ and TaskbarTab(parent:TaskBarButton, config,size,key) =
// Owned by the group's taskbar window, except while the group's thumbnails are up: see
// TaskBarButton.releasePreviews.
- member this.adoptWindow hwnd =
+ /// `follow`: the preview goes back just below its window if it is not there.
+ member this.adoptWindow(hwnd, follow:bool) =
if WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_OWNER)<>_window.hwnd then
StartupTrace.measure "taskbar.owner" (fun () ->
WinUserApi.SetWindowLong(hwnd,WindowLongFieldOffset.GWL_HWNDPARENT,_window.hwnd) |> ignore
@@ -630,6 +670,15 @@ and TaskbarTab(parent:TaskBarButton, config,size,key) =
// goes just below the window, as an owner would be.
WinUserApi.SetWindowPos(_window.hwnd,hwnd,0,0,0,0,
SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE ||| SetWindowPosFlags.SWP_NOACTIVATE) |> ignore)
+ elif follow && WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_HWNDNEXT)<>_window.hwnd then
+ // Activating a window raises every window of the group's taskbar window with it, each
+ // just above its preview, in the previews' order. The group stacks its windows and
+ // leaves the previews behind, so the preview follows: else the next activation brought
+ // an old order back, a tab behind a split over a pane, and the first window of an app
+ // was not the one last used.
+ WinUserApi.SetWindowPos(_window.hwnd,hwnd,0,0,0,0,
+ SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE |||
+ SetWindowPosFlags.SWP_NOACTIVATE ||| SetWindowPosFlags.SWP_NOOWNERZORDER) |> ignore
ownedWindow <- hwnd
/// Destroying an owner also destroys its owned windows; a preview never owns their lifetime.
@@ -816,7 +865,10 @@ type SuperBarPlugin(canShareInput:IntPtr -> bool, ?desktopOf:IntPtr -> Guid opti
let owner = WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_OWNER)
let movedAway = adopted.Contains hwnd && owner<>IntPtr.Zero && TaskbarProxies.contains owner && not(taskbarButton.ownsApplication hwnd)
if not movedAway then
- taskbarButton.adoptWindow hwnd
+ // Not while the group minimizes or restores: Windows restores the windows
+ // one by one, by their previews' order, and previews moved to an order
+ // passing by in the meantime swapped tabs behind as the group came back.
+ taskbarButton.adoptWindow(hwnd,not this.wtGroup.isChangingMinimizeState && not(WinUserApi.IsIconic hwnd))
if adopted.Add hwnd then
this.os.windowFromHwnd(hwnd).parkIfMinimized()
this.wtGroup.prepareMinimizeAnchor hwnd
diff --git a/WtProgram/ManagerViewService/SettingsTreeList.fs b/WtProgram/ManagerViewService/SettingsTreeList.fs
index 403bd3e4..0714509d 100644
--- a/WtProgram/ManagerViewService/SettingsTreeList.fs
+++ b/WtProgram/ManagerViewService/SettingsTreeList.fs
@@ -51,7 +51,8 @@ type TreeListItem(text:string) =
member val Glyph = NoGlyph with get,set
/// Draws a divider above the row, to set it apart from the rows before.
member val SeparatorAbove = false with get,set
- /// Said on hover over the row's icon or glyph, for a row whose icon stands in for a name.
+ /// Said on hover over the row's icon or glyph, for a row whose icon stands in for a name. The
+ /// icon only explains; it does not light up as a button would.
member val IconTip = "" with get,set
/// Per text column, (start,length) runs of its text to mark, such as search matches.
member val Highlights : (int * int) list[] = [||] with get,set
@@ -72,6 +73,8 @@ type TreeListItem(text:string) =
member val ChipAdd = false with get,set
/// Chips drawn muted, with grey icons, for a row whose items are turned off.
member val ChipsDimmed = false with get,set
+ /// Chips laid out this many to a line, all one width, filling it; 0 sizes each to its text.
+ member val ChipColumns = 0 with get,set
member val AlwaysShowActions = false with get,set
member _.Children = children :> IReadOnlyList
member this.Add(child:TreeListItem) = child.Parent <- this; children.Add(child); child
@@ -105,7 +108,6 @@ type SettingsTreeList(columns:TreeListColumn list) as this =
let mutable hoveredChip : (TreeListItem * int) option = None
let mutable hoveredChipAdd : TreeListItem = null
/// The row whose icon, which says something on hover, is under the pointer.
- let mutable hoveredIcon : TreeListItem = null
/// Where each shown row starts, below the header and before scrolling, and where the last
/// ends; rows with chips grow a line for each line of chips. Kept for one set of rows at
/// one width.
@@ -345,6 +347,7 @@ type SettingsTreeList(columns:TreeListColumn list) as this =
let left = if item.Text="" then bounds.X else bounds.X+nameWidth+Dpi.scale 12
let right = max (left+height) bounds.Right
let widthOf (chip:TreeListChip) =
+ if item.ChipColumns>0 then max height ((right-left-(item.ChipColumns-1)*gap)/item.ChipColumns) else
let iconWidth = if isNull chip.Icon then 0 else icon+Dpi.scale 5
let closeWidth = if chip.Removable then Dpi.scale 4+close+Dpi.scale 2 else pad
min (right-left) (pad+iconWidth+min (Dpi.scale 160) (measure chip.Text+Dpi.scale 4)+closeWidth)
@@ -573,14 +576,6 @@ type SettingsTreeList(columns:TreeListColumn list) as this =
if not same then
hoveredChip <- chip
this.Invalidate()
- let icon =
- match this.rowAt e.Y with
- | Some(index,(item,level)) when item.IconTip<>"" &&
- (let box,_ = this.nameLayout(item,level,this.rowTop index) in Rectangle.Inflate(box,Dpi.scale 4,Dpi.scale 4).Contains(e.Location)) -> item
- | _ -> null
- if not (Object.ReferenceEquals(icon,hoveredIcon)) then
- hoveredIcon <- icon
- this.Invalidate()
let add = this.chipAddAt e.Location |> Option.toObj
if not (Object.ReferenceEquals(add,hoveredChipAdd)) then
hoveredChipAdd <- add
@@ -630,7 +625,6 @@ type SettingsTreeList(columns:TreeListColumn list) as this =
hoveredAction <- -1
hoveredChip <- None
hoveredChipAdd <- null
- hoveredIcon <- null
tooltipText <- ""
tooltip.Hide()
this.Invalidate()
@@ -718,15 +712,7 @@ type SettingsTreeList(columns:TreeListColumn list) as this =
g.InterpolationMode <- InterpolationMode.HighQualityBicubic
g.DrawImage(item.Icon,iconBox)
elif not hidesIcon && item.Glyph<>NoGlyph then
- // An icon that says something on hover lights up as the row buttons do.
- let pointed = Object.ReferenceEquals(item,hoveredIcon)
- if pointed then
- let button = Rectangle.Inflate(iconBox,(Dpi.scale 24-iconBox.Width)/2,(Dpi.scale 24-iconBox.Height)/2)
- use shape = SettingsShapes.rounded (RectangleF(float32 button.X,float32 button.Y,float32 button.Width,float32 button.Height)) (float32(Dpi.scale 4))
- use fill = new SolidBrush(if SystemInformation.HighContrast then SystemColors.Highlight else Color.FromArgb(36,p.text))
- g.FillPath(fill,shape)
- let color = if pointed && SystemInformation.HighContrast then SystemColors.HighlightText elif pointed then text else p.muted
- SettingsTreeList.drawGlyph(g,item.Glyph,iconBox,color)
+ SettingsTreeList.drawGlyph(g,item.Glyph,iconBox,p.muted)
if not editing then
let nameBounds,laid,add,_ = if item.Chips.IsEmpty && not item.ChipAdd then bounds,[],None,1 else this.chipLayout(item,level,top)
this.drawHighlights(g,item.Text,item.highlights 0,nameBounds,flags,p)
diff --git a/WtProgram/ManagerViewService/Views/AppGroupingRulesView.fs b/WtProgram/ManagerViewService/Views/AppGroupingRulesView.fs
index 1cbbb083..4f40862c 100644
--- a/WtProgram/ManagerViewService/Views/AppGroupingRulesView.fs
+++ b/WtProgram/ManagerViewService/Views/AppGroupingRulesView.fs
@@ -238,7 +238,7 @@ type AppGroupingRulesView() as this =
// be renamed) would leave less room for; its icon says on hover what it is.
Services.program.handMadeGroups() |> List.iteri(fun index (id,members) ->
let row = TreeListItem("",Tag=HandMadeNode id,Glyph=TabsGlyph,SeparatorAbove=(index=0),IconTip=tr Strings.AppRules.handMadeGroups,
- Checks=[|None;None|],Actions=Some [NoGlyph;UngroupGlyph],AlwaysShowActions=true)
+ Checks=[|None;None|],Actions=Some [NoGlyph;UngroupGlyph],AlwaysShowActions=true,ChipColumns=3)
row.Chips <- members |> List.map(fun (app,title,hwnd) ->
// An open window's own icon; a closed one's app icon in grey, as another of its
// windows shows it, else from where the app last ran or the settings know it to
diff --git a/WtProgram/ManagerViewService/Views/AppearanceView.fs b/WtProgram/ManagerViewService/Views/AppearanceView.fs
index dd98d87c..0a84c27f 100755
--- a/WtProgram/ManagerViewService/Views/AppearanceView.fs
+++ b/WtProgram/ManagerViewService/Views/AppearanceView.fs
@@ -286,7 +286,7 @@ type AppearanceView(?settings:ISettings) =
use font = TabMetrics.font appearance.tabHeight FontStyle.Regular
let info index (caption:string) : TabDisplayInfo = {
tint=(if settings.getValue("tabColorMode") :?> string = "Off" then None else Some((Theme.tabPalette (Theme.darkBar appearance.tabNormalBgColor)).[index])); colorStyle=settings.getValue("tabColorStyle") :?> string; numberBadge=None; bgColor=None; text=caption; icon=SystemIcons.Application
- textFont=font; textBrush=SystemBrushes.MenuText }
+ textFont=font; textBrush=SystemBrushes.MenuText; splitTrail=None }
let ts : TabStripSprite = {
tabs=Map2(List2([1,info 1 (tr Strings.Settings.tabActiveBgColor.caption);2,info 2 (tr Strings.Settings.tabHighlightBgColor.caption);3,info 4 (tr Strings.Settings.tabNormalBgColor.caption)]))
lorder=List2([1;2;3]);zorder=List2([1;2;3]);size=Sz(tabs.Width,tabs.Height)
diff --git a/WtProgram/ManagerViewService/Views/GeneralView.fs b/WtProgram/ManagerViewService/Views/GeneralView.fs
index a69cff9b..82ed3dfe 100644
--- a/WtProgram/ManagerViewService/Views/GeneralView.fs
+++ b/WtProgram/ManagerViewService/Views/GeneralView.fs
@@ -7,6 +7,8 @@ type GeneralView() =
do
let startup = SettingsUi.sectionCard table (tr Strings.General.startup)
SettingsBindings.toggleRow startup "launch-at-sign-in"
+ SettingsBindings.choiceRow startup "restore-session"
+ [|tr Strings.General.sessionOff;tr Strings.General.sessionWindows;tr Strings.General.sessionApps|] |> ignore
let behaviour = SettingsUi.sectionCard table (tr Strings.General.tabBehavior)
SettingsBindings.toggleRow behaviour "dim-inactive-groups"
let position = SettingsBindings.choiceRow behaviour "tab-position"
diff --git a/WtProgram/ManagerViewService/Views/HotKeyView.fs b/WtProgram/ManagerViewService/Views/HotKeyView.fs
index e78bd1bf..e76e04dc 100755
--- a/WtProgram/ManagerViewService/Views/HotKeyView.fs
+++ b/WtProgram/ManagerViewService/Views/HotKeyView.fs
@@ -4,7 +4,10 @@ open System.Windows.Forms
type HotKeyView() =
let panel,table = SettingsUi.page()
// Setting id for each program hotkey, so a conflict can name the other action.
- let actions = ["nextTab","next-tab";"prevTab","previous-tab";"searchTabs","search-tabs";"newTab","new-tab";"closeTab","close-tab";"numberLeader","number-leader"]
+ let actions = ["nextTab","next-tab";"prevTab","previous-tab";"searchTabs","search-tabs";"newTab","new-tab";"closeTab","close-tab";"numberLeader","number-leader"
+ "splitPickRight","split-pick-right";"splitPickBelow","split-pick-below"
+ "splitFocusLeft","split-focus-left";"splitFocusRight","split-focus-right";"splitFocusUp","split-focus-up";"splitFocusDown","split-focus-down"]
+ let isSplit (key:string) = key.StartsWith "split"
let hotKey key =
let editor = new SettingsShortcutInput(Font=SettingsUi.bodyFont(),Shortcut=Services.program.getHotKey key)
editor.Changed.Add(fun _ ->
@@ -35,7 +38,7 @@ type HotKeyView() =
SettingsUi.add table keyboard
SettingsUi.note keyboard (tr Strings.Shortcuts.keyboardNote)
for (key,editor),(_,id) in List.zip editors actions do
- if key<>"numberLeader" then SettingsUi.settingRow keyboard id editor
+ if key<>"numberLeader" && not(isSplit key) then SettingsUi.settingRow keyboard id editor
// Rows inset under a toggle and collapsed while it is off.
let dependOn (toggle:SettingsToggle) (rows:SettingsRow list) =
for row in rows do SettingsUi.indentDependentRow row
@@ -142,6 +145,10 @@ type HotKeyView() =
for _,editor in editors do editor.Changed.Add(fun _ -> updateRestore())
restore.Click.Add(fun _ -> restoreDefaults(); updateRestore())
updateRestore()
+ // The split view's keys in a card of their own: among the tabs' they were hard to tell apart.
+ let split = SettingsUi.sectionCard table (tr Strings.Shortcuts.splitView)
+ for (key,editor),(_,id) in List.zip editors actions do
+ if isSplit key then SettingsUi.settingRow split id editor
let pointer = SettingsUi.sectionCard table (tr Strings.Shortcuts.mouse)
SettingsBindings.toggleRow pointer "activate-on-hover"
SettingsBindings.toggleRow pointer "shift-scroll"
diff --git a/WtProgram/Notice.fs b/WtProgram/Notice.fs
new file mode 100644
index 00000000..3342d114
--- /dev/null
+++ b/WtProgram/Notice.fs
@@ -0,0 +1,95 @@
+namespace Bemo
+open System
+open System.Drawing
+open System.Windows.Forms
+
+/// A line of text at the top of the main monitor, in the theme's colours, over everything and
+/// taking no focus: what WindowTabs is doing to the windows just now, so a user does not pull
+/// at them meanwhile. One at a time; it goes on its own after a while.
+type NoticeWindow() =
+ inherit Form(FormBorderStyle=FormBorderStyle.None,ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,TopMost=true)
+ let mutable text = ""
+ let mutable font : Font option = None
+ let hide = new Timer(Interval=4000)
+ let mutable wired = false
+ override _.ShowWithoutActivation = true
+ override _.CreateParams =
+ let cp = base.CreateParams
+ cp.ExStyle <- cp.ExStyle ||| WindowsExtendedStyles.WS_EX_NOACTIVATE ||| WindowsExtendedStyles.WS_EX_TOOLWINDOW
+ cp
+ override this.OnHandleCreated(e) =
+ this.SetStyle(ControlStyles.OptimizedDoubleBuffer ||| ControlStyles.AllPaintingInWmPaint ||| ControlStyles.UserPaint,true)
+ // Wired here rather than in the constructor: a self reference there put an initialization
+ // check on every member, which the finalizer's Dispose failed and took the process with it.
+ if not wired then
+ wired <- true
+ hide.Tick.Add(fun _ -> hide.Stop(); this.Hide())
+ base.OnHandleCreated(e)
+ member private this.textFont =
+ match font with
+ | Some value -> value
+ | None ->
+ let scale = float32(Dpi.value())/float32(Dpi.system())
+ let value = new Font("Segoe UI",10.5f*scale)
+ font <- Some value
+ value
+ member private this.reshape() =
+ if this.Width>0 && this.Height>0 then
+ use outline = MenuShape.outline this.Width this.Height
+ let previous = this.Region
+ this.Region <- new Region(outline)
+ if not(isNull previous) then previous.Dispose()
+ /// Shows the text at the top of the main monitor's work area; a later call replaces it.
+ /// `stay` keeps it until the next call, else it goes after a few seconds.
+ member this.show(message:string, stay:bool) =
+ text <- message
+ let palette = SettingsColors.current()
+ this.BackColor <- palette.surface
+ let size = TextRenderer.MeasureText(text,this.textFont,Size(Int32.MaxValue,Int32.MaxValue),TextFormatFlags.NoPrefix)
+ let padding = Dpi.scale 18
+ let bounds = Size(size.Width+2*padding,size.Height+Dpi.scale 16)
+ let area = Screen.PrimaryScreen.WorkingArea
+ this.Bounds <- Rectangle(area.Left+(area.Width-bounds.Width)/2,area.Top+Dpi.scale 12,bounds.Width,bounds.Height)
+ this.reshape()
+ if not this.Visible then this.Show()
+ this.Invalidate()
+ this.Update()
+ hide.Stop()
+ if not stay then hide.Start()
+ override this.OnPaint(e) =
+ base.OnPaint(e)
+ let palette = SettingsColors.current()
+ let g = e.Graphics
+ g.SmoothingMode <- Drawing2D.SmoothingMode.AntiAlias
+ use outline = MenuShape.outline (this.Width-1) (this.Height-1)
+ let state = g.Save()
+ g.TranslateTransform(0.5f,0.5f)
+ use pen = new Pen(palette.border)
+ g.DrawPath(pen,outline)
+ g.Restore(state)
+ TextRenderer.DrawText(g,text,this.textFont,this.ClientRectangle,palette.text,
+ TextFormatFlags.HorizontalCenter ||| TextFormatFlags.VerticalCenter ||| TextFormatFlags.NoPrefix)
+ override this.Dispose(disposing) =
+ if disposing then
+ hide.Dispose()
+ font |> Option.iter(fun value -> value.Dispose())
+ font <- None
+ this.Region |> Option.ofObj |> Option.iter(fun region -> region.Dispose())
+ base.Dispose(disposing)
+
+/// The one notice of the program, made on first use on the thread that uses it.
+module Notice =
+ let mutable private window : NoticeWindow option = None
+ let private current() =
+ match window with
+ | Some value when not value.IsDisposed -> value
+ | _ ->
+ let value = new NoticeWindow()
+ window <- Some value
+ value
+ /// A notice that cannot be shown is no reason to stop what it was about.
+ let private attempt action = try action() with error -> Diagnostics.Trace.TraceWarning("Notice failed: {0}",error.Message)
+ let show (message:string) = attempt (fun () -> (current()).show(message,false))
+ /// Stays until the next notice.
+ let hold (message:string) = attempt (fun () -> (current()).show(message,true))
+ let hideNow() = attempt (fun () -> window |> Option.iter(fun value -> if not value.IsDisposed then value.Hide()))
diff --git a/WtProgram/Program.fs b/WtProgram/Program.fs
index 7ad82a27..8f9c451e 100755
--- a/WtProgram/Program.fs
+++ b/WtProgram/Program.fs
@@ -95,6 +95,13 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
("closeTab", fun () ->
let hwnd = WinUserApi.GetForegroundWindow()
if this.isInGroup hwnd then os.windowFromHwnd(hwnd).close())
+ // A window chosen from a list goes beside the tab in front, as from the tab menu.
+ ("splitPickRight", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.pickPane(SideBySide,Second)))
+ ("splitPickBelow", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.pickPane(Stacked,Second)))
+ ("splitFocusLeft", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.executeSplit(FocusToward PaneLeft)))
+ ("splitFocusRight", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.executeSplit(FocusToward PaneRight)))
+ ("splitFocusUp", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.executeSplit(FocusToward PaneUp)))
+ ("splitFocusDown", fun () -> Services.desktop.foregroundGroup.iter(fun g -> g.executeSplit(FocusToward PaneDown)))
]))
let hotKeyManager = lifetime.Own(new HotKeyManager())
@@ -120,6 +127,21 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
let settleTimer = lifetime.Own(new System.Windows.Forms.Timer(Interval=1000))
/// Groups are recorded a moment after they change, once for a burst of changes.
let rememberSoon = lifetime.Own(new CoalescedAction(500, fun () -> this.rememberGroups()))
+ /// The session, written as the groups change and every so often as windows move, so a
+ /// sign-in finds the last state. A window carrying a group token at start means WindowTabs
+ /// alone restarted: the tokens put the groups back and the session is left alone.
+ let sessions = WorkspaceModel()
+ let sessionSoon = lifetime.Own(new CoalescedAction(3000, fun () -> this.saveSession()))
+ let sessionTimer = lifetime.Own(new System.Windows.Forms.Timer(Interval=120000))
+ let mutable tokensSeen = false
+ /// Each group's members as last seen, so a title change alone writes no session.
+ let sessionMembers = Dictionary()
+ /// Nothing is written until the start has decided about the last session: the groups the
+ /// first scan forms on its own came to be saved over it before it was restored.
+ let mutable sessionReady = false
+ /// Windows is signing out: the session is written now, while the apps are still open, and not
+ /// again at exit, when some have closed already and would be missing from it.
+ let mutable sessionEnding = false
/// Automatic groups of one app that have come to share a desktop are looked for at most once a second.
let mergeSoon = lifetime.Own(new CoalescedAction(1000, fun () -> this.mergeAutoGroups()))
let desktopRetry = lifetime.Own(new CoalescedAction(100, fun () ->
@@ -211,7 +233,55 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
/// A window that was in a group before WindowTabs restarted goes back to it, ahead of rules
/// and auto grouping, so groups made by hand are kept; the first of its group starts it again.
member this.restoredToken(hwnd:IntPtr) =
- if groupedThisRun.Contains hwnd then None else WindowGroupToken.read hwnd
+ if groupedThisRun.Contains hwnd then None
+ else
+ let token = WindowGroupToken.read hwnd
+ if token.IsSome then tokensSeen <- true
+ token
+
+ member private this.sessionMode = string(Services.settings.getValue("sessionRestore"))
+
+ /// Not once Windows is signing out: the session was written then, with every app still
+ /// open, and a save after it, as the apps close one by one, would leave their windows out.
+ member private this.saveSession() =
+ if this.sessionMode<>"Off" && sessionReady && not sessionEnding && not inShutdown.value && not this.desktop.isDragging then
+ try sessions.saveSession() with error -> Diagnostics.Trace.TraceWarning("Session save failed: {0}",error.Message)
+
+ /// After a sign-in, once the first scan is done: no window has a group token, so the
+ /// session is what puts the groups, positions and splits back. A moment later, as apps
+ /// started with Windows still open their windows. Saving waits for it.
+ member private this.restoreSessionAtStart() =
+ let mode = this.sessionMode
+ if mode="Off" || tokensSeen then sessionReady <- true
+ else
+ let timer = new System.Windows.Forms.Timer(Interval=4000)
+ timer.Tick.Add(fun _ ->
+ timer.Stop()
+ timer.Dispose()
+ if not inShutdown.value then
+ match sessions.loadSession() with
+ | None -> sessionReady <- true
+ | Some _ ->
+ // Said on screen first, so a user leaves the windows alone while they move.
+ Notice.hold (tr Strings.Session.restoring)
+ let go = new System.Windows.Forms.Timer(Interval=50)
+ go.Tick.Add(fun _ ->
+ go.Stop()
+ go.Dispose()
+ try
+ sessions.restoreSession((mode="Apps"),
+ (fun apps -> Notice.hold (tr (Strings.Session.launching apps))),
+ fun result ->
+ sessionReady <- true
+ sessionSoon.Request()
+ Notice.show (tr (Strings.Session.restored result.restored result.missing.Length))
+ Diagnostics.Trace.TraceInformation("Session restored: {0} windows, {1} not found, {2} failed",result.restored,result.missing.Length,result.failed.Length))
+ with error ->
+ sessionReady <- true
+ Notice.hideNow()
+ Diagnostics.Trace.TraceWarning("Session restore failed: {0}",error.Message))
+ go.Start())
+ timer.Start()
member private this.appKey(hwnd:IntPtr) =
match appKeys.TryGetValue hwnd with
@@ -347,6 +417,14 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
/// Only groups made by hand, or restored from memory, are recorded; others change all the
/// time (browser titles) and need no record.
member private this.onGroupChanged(group:IGroup) =
+ // Only membership: a group changes at every title too, and the session was written to
+ // disk every few seconds while a browser's title ran. The timer picks up the rest.
+ let members = group.windows.list
+ match sessionMembers.TryGetValue group.hwnd with
+ | true,known when known=members -> ()
+ | _ ->
+ sessionMembers.[group.hwnd] <- members
+ sessionSoon.Request()
match group with
| :? GroupInfo as info when info.group.isManual || remembered |> List.exists(fun saved -> saved.id=info.group.groupToken) ->
rememberSoon.Request()
@@ -648,6 +726,11 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
this.refresh()
member x.shutdown() =
+ sessionTimer.Stop()
+ sessionSoon.Cancel()
+ // From the layouts last read: the groups are about to go and cannot be asked.
+ if this.sessionMode<>"Off" && sessionReady && not sessionEnding then
+ try sessions.saveSessionNow() with error -> Diagnostics.Trace.TraceWarning("Session save failed: {0}",error.Message)
settingsManager.Flush() |> ignore
settleTimer.Stop()
rememberSoon.Cancel()
@@ -746,6 +829,13 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
member x.llMouse = llMouseEvent.Publish
+ member x.paneCandidates() =
+ let nameOverride hwnd = windowNameOverride.tryFind(hwnd).bind(id)
+ let groups = this.desktop.groups.list |> List.map(fun group -> group.windows.list)
+ TabSearch.tabs nameOverride (WinUserApi.GetForegroundWindow()) groups
+ |> List.filter(fun entry -> entry.desktop="")
+ |> List.map(fun entry -> entry.hwnd,entry.title,entry.program)
+
interface IDesktopNotification with
member x.dragDrop(hwnd) =
isDroppedAndAwaitingGrouping.map <| fun s -> s.add hwnd
@@ -759,6 +849,8 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
Services.register(DispatchedProgram(this, dispatcher) :> IProgram)
Services.register(DispatchedFilterService(FilterService(), dispatcher) :> IFilterService)
Services.register(DispatchedManagerView(ManagerViewService(), dispatcher) :> IManagerView)
+ // Not dispatched: it builds its drop-down on the group thread that opens it.
+ Services.register(SplitPanePicker() :> ISplitPanePicker)
SettingsAlert.install()
plugins.iter(fun plugin ->
match plugin with
@@ -770,7 +862,21 @@ type Program(lifetime:LifetimeScope, ?settings:Settings) as this =
settleTimer.Tick.Add(fun _ -> this.settleTick())
if settling.Count>0 then settleTimer.Start()
Services.desktop.groupChanged.Add this.onGroupChanged
- this.updateTaskSwitcher(Services.settings.getValue("replaceAltTab")))
+ Services.desktop.groupExited.Add(fun group -> if sessionMembers.Remove group.hwnd then sessionSoon.Request())
+ this.updateTaskSwitcher(Services.settings.getValue("replaceAltTab"))
+ this.restoreSessionAtStart()
+ sessionTimer.Tick.Add(fun _ -> this.saveSession())
+ sessionTimer.Start()
+ Microsoft.Win32.SystemEvents.SessionEnding.Add(fun _ ->
+ if not sessionEnding then
+ sessionEnding <- true
+ sessionTimer.Stop()
+ sessionSoon.Cancel()
+ if this.sessionMode<>"Off" && sessionReady then
+ try
+ sessions.saveSessionNow()
+ settingsManager.Flush() |> ignore
+ with error -> Diagnostics.Trace.TraceWarning("Session save failed: {0}",error.Message)))
member this.run(plugins:List2) =
this.initializePlugins plugins
@@ -798,6 +904,9 @@ module Bootstrap =
0
else
Application.EnableVisualStyles()
+ // As under a debugger: WinForms then refuses a control touched from a thread not its
+ // own, so a run outside the debugger can find what the debugger would stop at.
+ if Environment.GetEnvironmentVariable("WINDOWTABS_CHECK_THREADS")="1" then Control.CheckForIllegalCrossThreadCalls <- true
use lifetime = new LifetimeScope(fun error -> logger.log "Shutdown" error)
let program = StartupTrace.measure "program.initialize" (fun () -> Program(lifetime))
program.claimRunAtStartup()
diff --git a/WtProgram/Settings.fs b/WtProgram/Settings.fs
index 93b3a810..673d6390 100755
--- a/WtProgram/Settings.fs
+++ b/WtProgram/Settings.fs
@@ -158,6 +158,7 @@ type Settings(isStandAlone, ?saveDelay:int) as this =
enabledNumberShortcutPaths = Set2(settingsJson.getStringArray("enabledNumberShortcutPaths").def(List2()))
numberLeaderKeys = settingsJson.getString("numberLeaderKeys").def(SettingsCatalog.textDefault "numberLeaderKeys") |> NumberLeaderKeys.normalize
numberHotKeyModifier = settingsJson.getString("numberHotKeyModifier").def(SettingsCatalog.choiceDefault "numberHotKeyModifier") |> SettingsCatalog.normalizeChoice "numberHotKeyModifier"
+ sessionRestore = settingsJson.getString("sessionRestore").def(SettingsCatalog.choiceDefault "sessionRestore") |> SettingsCatalog.normalizeChoice "sessionRestore"
enableHoverActivate = settingsJson.getBool("enableHoverActivate").def(SettingsCatalog.toggleDefault "enableHoverActivate" hasExistingSettings)
// Older versions stored two toggles: minimalMode (every window) and autoHide (maximized only).
autoHideMode =
@@ -250,6 +251,7 @@ type Settings(isStandAlone, ?saveDelay:int) as this =
settingsJson.setStringArray("enabledNumberShortcutPaths", settings.enabledNumberShortcutPaths.items)
settingsJson.setString("numberLeaderKeys",settings.numberLeaderKeys)
settingsJson.setString("numberHotKeyModifier", settings.numberHotKeyModifier)
+ settingsJson.setString("sessionRestore", settings.sessionRestore)
settingsJson.setBool("enableHoverActivate", settings.enableHoverActivate)
settingsJson.setString("autoHideMode", settings.autoHideMode)
settingsJson.setBool("showTabsOnSwitch", settings.showTabsOnSwitch)
@@ -308,7 +310,7 @@ type Settings(isStandAlone, ?saveDelay:int) as this =
let api = x :> ISettings
let value = if key="tabSearchScope" then box(SettingsCatalog.normalizeTabSearchScope (unbox value)) else value
let value = if key="numberLeaderKeys" then box(NumberLeaderKeys.normalize (unbox value)) else value
- let value = if key="alignment" || key="language" || key="autoHideMode" || key="switcherStyle" || key="numberHotKeyModifier" || key="tabColorStyle" || key="tabColorMode" || key="tabPosition" then box(SettingsCatalog.normalizeChoice key (unbox value)) else value
+ let value = if key="alignment" || key="language" || key="autoHideMode" || key="switcherStyle" || key="numberHotKeyModifier" || key="tabColorStyle" || key="tabColorMode" || key="tabPosition" || key="sessionRestore" then box(SettingsCatalog.normalizeChoice key (unbox value)) else value
let value = if key="tabColumnWidth" then box(between SettingsCatalog.columnWidthRange (unbox value)) else value
match key with
| "tabAppearance" ->
diff --git a/WtProgram/Shared/DragDrop.fs b/WtProgram/Shared/DragDrop.fs
index d95f22c5..5f272935 100755
--- a/WtProgram/Shared/DragDrop.fs
+++ b/WtProgram/Shared/DragDrop.fs
@@ -10,15 +10,46 @@ type IDragDropNotification =
abstract member dragBegin : unit -> unit
abstract member dragEnd : unit -> unit
+/// A tab strip: a tab dragged over it joins at once and leaves again when dragged away.
type IDragDropTarget =
inherit IDragDropNotification
abstract member dragEnter : obj -> Pt -> bool
abstract member dragMove : Pt -> unit
abstract member dragExit : unit -> unit
+ /// The source takes a cancelled drag's tab back where it started.
+ abstract member dragCancel : obj -> unit
+
+/// What a drop at a point would do to a group's windows: nothing, split a window or pane, or
+/// fill an empty pane.
+type LayoutAim = NoAim | SplitAim | FillAim
+
+/// What a point over a group's window meets: the margin around its strip's tabs in sight, where
+/// a carried tab is meant to go with those tabs, or a drop surface, with what a drop there would
+/// do and whether the place is shown.
+type LayoutProbe = NearStrip of IntPtr | Aimed of LayoutAim * shown:bool
+
+/// A group's windows as a drop surface: the preview changes nothing, only the drop commits.
+type ILayoutDropTarget =
+ /// One call per pointer move: the strip when the point lies near its tabs; else what a drop
+ /// here would do, shown when `show` says so, or at once for an empty pane. Asked the strip,
+ /// the aim and the preview in three calls, the drag waited on the group three times a move.
+ abstract member probe : obj * Pt * show:bool -> LayoutProbe
+ abstract member clearPreview : unit -> unit
+ /// False when nothing was dropped: the drag then ends as one let go anywhere else.
+ abstract member commit : obj * Pt -> bool
type IDragDrop =
abstract member registerNotification: IDragDropNotification -> unit
abstract member unregisterNotification: IDragDropNotification -> unit
abstract member registerTarget : (IntPtr * IDragDropTarget) -> unit
abstract member unregisterTarget : IntPtr -> unit
- abstract member beginDrag : (IntPtr * (unit -> Img) * Pt * Pt * obj) -> unit
\ No newline at end of file
+ /// The windows (and helper windows' owner) a group answers for as a drop surface.
+ abstract member registerLayoutTarget : (IntPtr * ILayoutDropTarget) -> unit
+ /// Only this target's registration goes: a window that moved to another group is that
+ /// group's now, and the old group's late removal must not take it from the new one.
+ abstract member unregisterLayoutTarget : (IntPtr * ILayoutDropTarget) -> unit
+ /// The image function gives the image to show now and may hand a finished one, the same
+ /// size, to the function it is given, from any thread, a moment later.
+ abstract member beginDrag : (IntPtr * ((Img -> unit) -> Img) * Pt * Pt * obj) -> unit
+ /// Ends the drag in progress without dropping; true if there was one.
+ abstract member cancelDrag : unit -> bool
diff --git a/WtProgram/Shared/ProgramTypes.fs b/WtProgram/Shared/ProgramTypes.fs
index 06e85df2..fced9375 100755
--- a/WtProgram/Shared/ProgramTypes.fs
+++ b/WtProgram/Shared/ProgramTypes.fs
@@ -47,6 +47,8 @@ type SettingsRec = {
enableHoverActivate: bool
/// "Never", "Maximized" or "Always".
autoHideMode: string
+ /// Off, Windows (groups, positions and splits among the windows open) or Apps (their apps started too).
+ sessionRestore: string
/// Expand auto-hidden tabs for a moment after switching tabs.
showTabsOnSwitch: bool
enableShiftScroll: bool
@@ -144,12 +146,18 @@ type IProgram =
abstract member suspendTabMonitoring : unit -> unit
abstract member resumeTabMonitoring : unit -> unit
abstract member llMouse : IEvent
+ /// Windows an empty pane can take, on this desktop: handle, tab name and program.
+ abstract member paneCandidates : unit -> (IntPtr * string * string) list
type IGroup =
abstract member hwnd : IntPtr
abstract member addWindow: IntPtr * bool -> unit
abstract member removeWindow: IntPtr -> unit
abstract member switchWindow: bool * bool -> unit
+ /// Split-view commands from outside the group, such as program hotkeys.
+ abstract member executeSplit: SplitCommand -> unit
+ /// Lists the windows to put on that side of the tab in front, as the tab menu does.
+ abstract member pickPane: SplitAxis * Side -> unit
abstract member windows: List2
abstract member destroy: unit -> unit
@@ -164,6 +172,12 @@ type IDesktop =
/// A group's windows, their titles, or whether it was made by hand changed. Main thread.
abstract member groupChanged: IEvent
abstract member foregroundGroup: IGroup option
+ /// Puts a window, grouped elsewhere or not at all, into the empty pane at the path of the
+ /// group whose strip is given.
+ abstract member adoptIntoPane: IntPtr * IntPtr * PanePath -> unit
+ /// Puts a window, grouped elsewhere or not at all, beside the partner tab of the group whose
+ /// strip is given, as the drop says.
+ abstract member adoptBeside: IntPtr * IntPtr * LayoutDrop * IntPtr -> unit
type IPlugin =
abstract member init: unit -> unit
diff --git a/WtProgram/Shared/Services.fs b/WtProgram/Shared/Services.fs
index b82cb045..a4ae77be 100755
--- a/WtProgram/Shared/Services.fs
+++ b/WtProgram/Shared/Services.fs
@@ -24,6 +24,16 @@ type ServiceProvider() =
member this.registerLocal(service:'a) =
ServiceProvider.localServices.Add(typeof<'a>, service)
+ /// None for a service nobody registered, such as an optional one in a test host.
+ member this.tryGet<'a>() : 'a option =
+ let t = typeof<'a>
+ match ServiceProvider.localServices.TryGetValue(t) with
+ | true,service -> Some(unbox<'a> service)
+ | _ ->
+ match services.TryGetValue(t) with
+ | true,service -> Some(unbox<'a> service)
+ | _ -> None
+
member this.get<'a>() =
let t = typeof<'a>
let service =
@@ -72,6 +82,8 @@ type DispatchedDesktop(inner:IDesktop, dispatcher:IDispatcher) =
member _.groupRemoved = dispatcher.Send(fun () -> inner.groupRemoved)
member _.groupChanged = dispatcher.Send(fun () -> inner.groupChanged)
member _.foregroundGroup = dispatcher.Send(fun () -> inner.foregroundGroup)
+ member _.adoptIntoPane(group,hwnd,path) = dispatcher.Post(fun () -> inner.adoptIntoPane(group,hwnd,path))
+ member _.adoptBeside(group,hwnd,drop,partner) = dispatcher.Post(fun () -> inner.adoptBeside(group,hwnd,drop,partner))
type DispatchedProgram(inner:IProgram, dispatcher:IDispatcher) =
interface IProgram with
@@ -103,6 +115,7 @@ type DispatchedProgram(inner:IProgram, dispatcher:IDispatcher) =
member _.suspendTabMonitoring() = dispatcher.Send(fun () -> inner.suspendTabMonitoring())
member _.resumeTabMonitoring() = dispatcher.Send(fun () -> inner.resumeTabMonitoring())
member _.llMouse = dispatcher.Send(fun () -> inner.llMouse)
+ member _.paneCandidates() = dispatcher.Send(fun () -> inner.paneCandidates())
type DispatchedFilterService(inner:IFilterService, dispatcher:IDispatcher) =
interface IFilterService with
diff --git a/WtProgram/Shared/SettingsCatalog.fs b/WtProgram/Shared/SettingsCatalog.fs
index 2d089ae4..85e9d61f 100644
--- a/WtProgram/Shared/SettingsCatalog.fs
+++ b/WtProgram/Shared/SettingsCatalog.fs
@@ -31,6 +31,7 @@ module SettingsCatalog =
{ id="theme"; page=AppearanceSettings; text=Strings.Settings.theme; binding=Choice("tabThemeMode",["system";"light";"dark"],"system") }
{ id="language"; page=GeneralSettings; text=Strings.Settings.language; binding=Choice("language",Localization.preferences,"system") }
{ id="launch-at-sign-in"; page=GeneralSettings; text=Strings.Settings.launchAtSignIn; binding=Toggle("runAtStartup",true,false) }
+ { id="restore-session"; page=GeneralSettings; text=Strings.Settings.restoreSession; binding=Choice("sessionRestore",["Off";"Windows";"Apps"],"Off") }
{ id="enable-tabs-for-new-apps"; page=ProgramSettings; text=Strings.Settings.enableTabsByDefault; binding=Toggle("enableTabbingByDefault",true,false) }
{ id="dim-inactive-groups"; page=GeneralSettings; text=Strings.Settings.dimInactiveGroups; binding=Toggle("hideInactiveTabs",true,false) }
{ id="tab-alignment"; page=GeneralSettings; text=Strings.Settings.tabAlignment; binding=Choice("alignment",["Left";"Center";"Right"],"Center") }
@@ -49,6 +50,13 @@ module SettingsCatalog =
{ id="new-tab"; page=HotKeySettings; text=Strings.Settings.newTab; binding=Shortcut("newTab",1614) }
// Ctrl+Alt+W beside New tab's Ctrl+Alt+N; Ctrl+W alone belongs to the apps.
{ id="close-tab"; page=HotKeySettings; text=Strings.Settings.closeTab; binding=Shortcut("closeTab",1623) }
+ // Split view keys ship unbound: nothing global is taken until the user picks a key.
+ { id="split-pick-right"; page=HotKeySettings; text=Strings.Settings.splitPickRight; binding=Shortcut("splitPickRight",0) }
+ { id="split-pick-below"; page=HotKeySettings; text=Strings.Settings.splitPickBelow; binding=Shortcut("splitPickBelow",0) }
+ { id="split-focus-left"; page=HotKeySettings; text=Strings.Settings.splitFocusLeft; binding=Shortcut("splitFocusLeft",0) }
+ { id="split-focus-right"; page=HotKeySettings; text=Strings.Settings.splitFocusRight; binding=Shortcut("splitFocusRight",0) }
+ { id="split-focus-up"; page=HotKeySettings; text=Strings.Settings.splitFocusUp; binding=Shortcut("splitFocusUp",0) }
+ { id="split-focus-down"; page=HotKeySettings; text=Strings.Settings.splitFocusDown; binding=Shortcut("splitFocusDown",0) }
{ 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) }
@@ -103,7 +111,7 @@ module SettingsCatalog =
let appGroupingMatchTypes = [-1]
let appGroupingMatchDefault = -1
let appRuleKeys = appRulePathKeys @ ["disabledNumberShortcutPaths";"enabledNumberShortcutPaths";"appTabColors";"appGroupingRules";"appGroupingTargets"]
- let workspaceKeys = ["workspaces";"workspaceSchemaVersion";"workspaceRecovery"]
+ let workspaceKeys = ["workspaces";"workspaceSchemaVersion";"workspaceRecovery";"session"]
/// The settings a reset leaves: fresh-install toggles, the version (so the next start does
/// not take the reset for an upgrade) and, unless cleared, app rules and saved workspaces.
let resetRoot (current:JObject) clearAppRules clearWorkspaces =
diff --git a/WtProgram/Shared/SplitView.fs b/WtProgram/Shared/SplitView.fs
new file mode 100644
index 00000000..1d319bf3
--- /dev/null
+++ b/WtProgram/Shared/SplitView.fs
@@ -0,0 +1,733 @@
+namespace Bemo
+open System
+
+type SplitAxis = SideBySide | Stacked
+type Side = First | Second
+/// An empty pane waits for a drop; Occupied never carries IntPtr.Zero.
+type Pane = Empty | Occupied of IntPtr
+/// A node of the layout named from the root: the side taken at each split on the way down.
+/// The root itself is [].
+type PanePath = Side list
+
+/// A split divides its node in two; either half is a pane or a split of its own.
+type SplitNode =
+ | Leaf of Pane
+ | Branch of SplitTree
+and SplitTree = {
+ axis: SplitAxis
+ ratio: float
+ first: SplitNode
+ second: SplitNode
+}
+
+/// The whole tree and the pane in focus, the path to a leaf.
+type SplitLayout = {
+ tree: SplitTree
+ focused: PanePath
+}
+
+/// Parked: another tab fills the group while the panes wait to be shown again.
+type GroupLayout =
+ | Single
+ | Split of SplitLayout
+ | Parked of SplitLayout
+
+type PaneDirection = PaneLeft | PaneRight | PaneUp | PaneDown
+
+/// Every entry point (menu, divider, drag, hotkey) produces one of these.
+type SplitCommand =
+ /// The current pane splits again to make room for the partner, which comes from wherever
+ /// it was. With the partner already in that pane, the split turns to the axis.
+ | SplitWith of partner:IntPtr * SplitAxis
+ /// The current pane splits again, the new half empty.
+ | NewEmptyPane of SplitAxis
+ /// The node at `target`, a pane or a whole split, makes room on `side` for the window; the
+ /// root is [] and a single window is split in two.
+ | DropInto of hwnd:IntPtr * target:PanePath * SplitAxis * Side
+ /// The empty pane at the path takes the window.
+ | FillPane of hwnd:IntPtr * PanePath
+ | FocusPane of PanePath
+ | FocusToward of PaneDirection
+ /// The next pane holding a window, around and around.
+ | FocusOther
+ /// The two halves of a split change places: the one named, or the focused pane's.
+ | Swap of PanePath option
+ | SetRatio of PanePath * float
+ | Equalize of PanePath option
+ | ToggleAxis of PanePath option
+ /// The pane, or the focused one, goes and its neighbour takes its room; the window stays a tab.
+ | ClosePane of PanePath option
+ | EndSplit of keep:IntPtr option
+ /// Group-level fill/restore; the layout itself is unchanged.
+ | ToggleFill
+
+/// What a drop at a point does: fills an empty pane, or makes room beside a node (the whole
+/// group at []).
+type LayoutDrop =
+ | FillEmpty of PanePath
+ | SplitAt of PanePath * SplitAxis * Side
+
+type Placement = { hwnd: IntPtr; rect: Rect; below: IntPtr option }
+
+/// Logical pixels; callers scale with Dpi.scale at the point of use.
+module SplitMetrics =
+ /// Panes touch: nothing behind the group shows between them.
+ let gap = 0
+ /// The divider's bar, drawn at the seam.
+ let divider = 4
+ /// The band that takes the pointer, centred on the seam: just wide enough to cover both
+ /// panes' invisible resize borders (7px each at 100%), so a press near the seam always drags
+ /// the divider and never starts a pane's own resize, which went on in that app's loop with
+ /// the other pane following and could not be told apart from the divider by eye. No wider:
+ /// what it covers of a pane, a scroll bar at the seam say, cannot be clicked.
+ let dividerGrab = 14
+ let minPane = 120
+ let minRatio = 0.15
+ let maxRatio = 0.85
+ let tolerance = 3
+ /// How far an app's own size may stay off its pane, as apps on a character grid round it.
+ let snap = 40
+ let settleMs = 2000
+ /// An edge's drop zone: this deep at its ends, and `edgeShare` of the frame at its middle.
+ let edgeZone = 36
+ let edgeShare = 0.2
+ /// Within this of the group's own edge a drop splits the whole group; further in, the pane
+ /// there. Like a pane's zone it deepens at the edge's middle, to `outerShare` of the frame
+ /// and at most twice this.
+ let outerZone = 36
+ let outerShare = 0.08
+ let clampRatio ratio = max minRatio (min maxRatio ratio)
+
+module Side =
+ let other = function First -> Second | Second -> First
+
+/// The tree alone: nodes by path, leaves in order, and the two edits every command is made of.
+module SplitTree =
+ let child side (branch:SplitTree) = if side=First then branch.first else branch.second
+ let withChild side node (branch:SplitTree) = if side=First then {branch with first=node} else {branch with second=node}
+
+ let rec node (path:PanePath) (current:SplitNode) =
+ match path,current with
+ | [],_ -> Some current
+ | side::rest,Branch branch -> node rest (child side branch)
+ | _,Leaf _ -> None
+
+ let rec update (path:PanePath) (f:SplitNode -> SplitNode) (current:SplitNode) =
+ match path,current with
+ | [],_ -> f current
+ | side::rest,Branch branch -> Branch(withChild side (update rest f (child side branch)) branch)
+ | _,Leaf _ -> current
+
+ /// Every pane with its path, first to last.
+ let rec leaves (path:PanePath) (current:SplitNode) =
+ match current with
+ | Leaf pane -> [path,pane]
+ | Branch branch -> leaves (path@[First]) branch.first @ leaves (path@[Second]) branch.second
+
+ /// Every split with its path, parents before children.
+ let rec branches (path:PanePath) (current:SplitNode) =
+ match current with
+ | Leaf _ -> []
+ | Branch branch -> (path,branch) :: branches (path@[First]) branch.first @ branches (path@[Second]) branch.second
+
+ let parent (path:PanePath) = match List.rev path with [] -> [] | _::rest -> List.rev rest
+ let last (path:PanePath) = List.tryLast path
+
+ let pathOf hwnd (current:SplitNode) =
+ if hwnd=IntPtr.Zero then None
+ else leaves [] current |> List.tryPick(fun (path,pane) -> if pane=Occupied hwnd then Some path else None)
+
+ /// The node at the path makes room on `side` for a pane.
+ let insert (path:PanePath) axis side pane current =
+ update path (fun old ->
+ Branch {axis=axis;ratio=0.5;first=(if side=First then Leaf pane else old);second=(if side=First then old else Leaf pane)}) current
+
+ /// The leaf goes and its neighbour takes their parent's place.
+ let remove (path:PanePath) current =
+ match last path with
+ | None -> current
+ | Some side -> update (parent path) (function Branch branch -> child (Side.other side) branch | other -> other) current
+
+ let removeWindow hwnd current =
+ match pathOf hwnd current with
+ | Some path -> remove path current
+ | None -> current
+
+ let mapBranch (path:PanePath) (f:SplitTree -> SplitTree) current =
+ update path (function Branch branch -> Branch(f branch) | other -> other) current
+
+ /// The same panes in the same splits, whatever the ratios.
+ let rec sameShape (a:SplitNode) (b:SplitNode) =
+ match a,b with
+ | Leaf x,Leaf y -> x=y
+ | Branch x,Branch y -> x.axis=y.axis && sameShape x.first y.first && sameShape x.second y.second
+ | _ -> false
+
+module SplitGeometry =
+ /// First half, seam and second half of a split; the remainder goes to the second half so the
+ /// three exactly cover the frame.
+ let rectangles gap (frame:Rect) (branch:SplitTree) =
+ let length = (if branch.axis=SideBySide then frame.width else frame.height)-gap
+ let first = max 1 (min (length-1) (int (float length * branch.ratio)))
+ if branch.axis=SideBySide then
+ Rect(frame.location,Sz(first,frame.height)),
+ Rect(Pt(frame.x+first,frame.y),Sz(gap,frame.height)),
+ Rect(Pt(frame.x+first+gap,frame.y),Sz(length-first,frame.height))
+ else
+ Rect(frame.location,Sz(frame.width,first)),
+ Rect(Pt(frame.x,frame.y+first),Sz(frame.width,gap)),
+ Rect(Pt(frame.x,frame.y+first+gap),Sz(frame.width,length-first))
+
+ /// The rectangle of the node at the path, inside the frame.
+ let rec nodeRect gap (frame:Rect) (current:SplitNode) (path:PanePath) =
+ match path,current with
+ | [],_ -> Some frame
+ | side::rest,Branch branch ->
+ let a,_,b = rectangles gap frame branch
+ nodeRect gap (if side=First then a else b) (SplitTree.child side branch) rest
+ | _,Leaf _ -> None
+
+ /// Every pane with its path and rectangle, first to last.
+ let rec leafRects gap (frame:Rect) (current:SplitNode) (path:PanePath) =
+ match current with
+ | Leaf pane -> [path,pane,frame]
+ | Branch branch ->
+ let a,_,b = rectangles gap frame branch
+ leafRects gap a branch.first (path@[First]) @ leafRects gap b branch.second (path@[Second])
+
+ /// Every split with its path, its own frame and its seam, parents before children.
+ let rec seams gap (frame:Rect) (current:SplitNode) (path:PanePath) =
+ match current with
+ | Leaf _ -> []
+ | Branch branch ->
+ let a,seam,b = rectangles gap frame branch
+ (path,branch,frame,seam) :: seams gap a branch.first (path@[First]) @ seams gap b branch.second (path@[Second])
+
+ let paneRect gap frame (layout:SplitLayout) path = nodeRect gap frame (Branch layout.tree) path
+
+ /// The ratio a point in a split's own frame asks for.
+ let ratioAt (pt:Pt) gap (frame:Rect) (branch:SplitTree) =
+ let distance,length = if branch.axis=SideBySide then pt.x-frame.x,frame.width-gap else pt.y-frame.y,frame.height-gap
+ SplitMetrics.clampRatio (float distance / float (max 1 length))
+
+ /// Every pane at least `minimum` on a side.
+ let fits gap minimum (frame:Rect) (tree:SplitTree) =
+ leafRects gap frame (Branch tree) [] |> List.forall(fun (_,_,rect) -> rect.width>=minimum && rect.height>=minimum)
+
+ /// Every pane at least the size its window lets itself be sized to.
+ let fitsPanes gap (least:Pane -> Sz) (frame:Rect) (tree:SplitTree) =
+ leafRects gap frame (Branch tree) [] |> List.forall(fun (_,pane,rect) ->
+ let size = least pane
+ rect.width>=size.width && rect.height>=size.height)
+
+ /// The least a node can be: a pane's own; a split's halves added along its axis with the
+ /// seam between them, and the larger across it.
+ let rec leastSize gap (least:Pane -> Sz) (node:SplitNode) =
+ match node with
+ | Leaf pane -> least pane
+ | Branch branch ->
+ let a,b = leastSize gap least branch.first,leastSize gap least branch.second
+ if branch.axis=SideBySide then Sz(a.width+gap+b.width,max a.height b.height)
+ else Sz(max a.width b.width,a.height+gap+b.height)
+
+ /// Each split's ratio moved as little as it takes for both halves to keep their least size,
+ /// where the split has room for both; where it has not, the ratio stays. An app with a
+ /// least size of its own, a terminal's 600px say, kept it in a narrower pane and lay over
+ /// the pane beside it.
+ let rec fitToPanes gap (least:Pane -> Sz) (frame:Rect) (tree:SplitTree) : SplitTree =
+ let along (size:Sz) = if tree.axis=SideBySide then size.width else size.height
+ let length = along frame.size-gap
+ let a,b = along(leastSize gap least tree.first),along(leastSize gap least tree.second)
+ let ratio =
+ if length<=1 || a+b>length then tree.ratio
+ else
+ // The first half, as `rectangles` takes it from the ratio, kept from a to length-b;
+ // the ratio for that many pixels lands mid-pixel, clear of rounding.
+ let current = max 1 (min (length-1) (int(float length*tree.ratio)))
+ let wanted = max 1 (min (length-1) (max a (min (length-b) current)))
+ if wanted=current then tree.ratio else (float wanted+0.5)/float length
+ let fitted = {tree with ratio=ratio}
+ let first,_,second = rectangles gap frame fitted
+ let inside (rect:Rect) node = match node with Branch branch -> Branch(fitToPanes gap least rect branch) | leaf -> leaf
+ {fitted with first=inside first fitted.first; second=inside second fitted.second}
+
+ /// The frame and tree after a pane was moved or sized natively from `expected`, its rectangle
+ /// when that began. Moved, it carries the whole frame. Sized, each edge that moved is either
+ /// the group's own, which moves with it, or the seam of the nearest split it borders, whose
+ /// ratio follows.
+ let resizePane (path:PanePath) (expected:Rect) (actual:Rect) gap (frame:Rect) (tree:SplitTree) =
+ if actual.size=expected.size then frame.move(actual.x-expected.x,actual.y-expected.y),tree
+ // Both of a pair of opposite edges moved at once, as a snap (Win+Left, Win+Right) does
+ // and no drag at an edge or corner can: the whole group takes the pane's new rectangle,
+ // the panes keeping their shares. Read as one edge moving the frame and the other the
+ // seam, a snap left the other pane its old size, off the screen.
+ elif (actual.left<>expected.left && actual.right<>expected.right) || (actual.top<>expected.top && actual.bottom<>expected.bottom) then actual,tree
+ else
+ // The nearest split above the pane whose seam lies on this edge: the pane is on the
+ // far side of a split along the edge's axis.
+ let seamAbove axis seamSide =
+ let rec walk (prefix:PanePath) remaining =
+ match remaining with
+ | [] -> None
+ | side::rest ->
+ let here =
+ match SplitTree.node prefix (Branch tree) with
+ | Some(Branch branch) when branch.axis=axis && side=seamSide -> Some prefix
+ | _ -> None
+ match walk (prefix@[side]) rest with
+ | Some deeper -> Some deeper
+ | None -> here
+ walk [] path
+ let mutable frame = frame
+ let mutable tree = tree
+ let edge axis seamSide (moved:bool) (position:int) =
+ if moved then
+ match seamAbove axis seamSide with
+ | Some seam ->
+ let rect = (nodeRect gap frame (Branch tree) seam).Value
+ let length = max 1 ((if axis=SideBySide then rect.width else rect.height)-gap)
+ let first =
+ match axis,seamSide with
+ | SideBySide,Second -> position-gap-rect.x
+ | SideBySide,First -> position-rect.x
+ | Stacked,Second -> position-gap-rect.y
+ | Stacked,First -> position-rect.y
+ tree <-
+ match SplitTree.mapBranch seam (fun branch -> {branch with ratio=SplitMetrics.clampRatio(float first/float length)}) (Branch tree) with
+ | Branch updated -> updated
+ | Leaf _ -> tree
+ | None ->
+ // The group's own edge: the frame moves with it, and every split along the
+ // way gives the room to the pane's side, so the other side keeps its size.
+ let grown =
+ match axis,seamSide with
+ | SideBySide,Second -> frame.left-position
+ | SideBySide,First -> position-frame.right
+ | Stacked,Second -> frame.top-position
+ | Stacked,First -> position-frame.bottom
+ let rec prefixes (prefix:PanePath) remaining =
+ match remaining with
+ | [] -> []
+ | side::rest -> prefix :: prefixes (prefix@[side]) rest
+ let shares =
+ prefixes [] path |> List.choose(fun prefix ->
+ match SplitTree.node prefix (Branch tree),nodeRect gap frame (Branch tree) prefix with
+ | Some(Branch branch),Some rect when branch.axis=axis ->
+ let length = float(max 1 ((if axis=SideBySide then rect.width else rect.height)-gap))
+ let first = length*branch.ratio
+ let ratio = if seamSide=Second then (first+float grown)/(length+float grown) else first/(length+float grown)
+ Some(prefix,SplitMetrics.clampRatio ratio)
+ | _ -> None)
+ frame <-
+ match axis,seamSide with
+ | SideBySide,Second -> Rect(Pt(position,frame.y),Sz(frame.right-position,frame.height))
+ | SideBySide,First -> Rect(frame.location,Sz(position-frame.x,frame.height))
+ | Stacked,Second -> Rect(Pt(frame.x,position),Sz(frame.width,frame.bottom-position))
+ | Stacked,First -> Rect(frame.location,Sz(frame.width,position-frame.y))
+ for prefix,ratio in shares do
+ tree <-
+ match SplitTree.mapBranch prefix (fun branch -> {branch with ratio=ratio}) (Branch tree) with
+ | Branch updated -> updated
+ | Leaf _ -> tree
+ edge SideBySide Second (actual.left<>expected.left) actual.left
+ edge SideBySide First (actual.right<>expected.right) actual.right
+ edge Stacked Second (actual.top<>expected.top) actual.top
+ edge Stacked First (actual.bottom<>expected.bottom) actual.bottom
+ frame,tree
+
+ /// Which side a drop near the frame's edge would take. An edge's zone reaches `edgeShare` of
+ /// the frame in at the edge's middle, where a drop aims, and narrows to `edge` pixels at its
+ /// ends, so the zones meet without a corner going to the wrong side. Where two zones overlap
+ /// the one the point is deeper in wins.
+ let edgeDrop (pt:Pt) edge (frame:Rect) =
+ if not(frame.containsPoint pt) then None
+ else
+ let reach across along =
+ let deepest = max edge (int(float across*SplitMetrics.edgeShare))
+ float edge+float(deepest-edge)*(1.0-abs(2.0*along-1.0))
+ let u = float(pt.x-frame.left)/float(max 1 frame.width)
+ let v = float(pt.y-frame.top)/float(max 1 frame.height)
+ let depth side =
+ let distance,limit =
+ match side with
+ | SideBySide,First -> pt.x-frame.left,reach frame.width v
+ | SideBySide,Second -> frame.right-pt.x,reach frame.width v
+ | Stacked,First -> pt.y-frame.top,reach frame.height u
+ | Stacked,Second -> frame.bottom-pt.y,reach frame.height u
+ if float distance List.choose(fun side -> depth side |> Option.map(fun d -> d,side))
+ |> List.sortBy fst |> List.tryHead |> Option.map snd
+
+ /// Where a drop at the point goes and the rectangle it would take: within `outer` of the
+ /// group's own edge the whole group splits (the root, []); further in, the pane under the
+ /// point splits at its edge. A single window is the root too.
+ let dropAt (pt:Pt) edge outer gap (frame:Rect) (layout:SplitLayout option) =
+ let half (rect:Rect) axis side =
+ let shape = {axis=axis;ratio=0.5;first=Leaf Empty;second=Leaf Empty}
+ let a,_,b = rectangles gap rect shape
+ if side=First then a else b
+ if not(frame.containsPoint pt) then None
+ else
+ match layout with
+ | None -> edgeDrop pt edge frame |> Option.map(fun (axis,side) -> ([],axis,side),half frame axis side)
+ | Some layout ->
+ // The group's own zone is `outer` deep at an edge's ends and deeper at its middle,
+ // where a drop aims; the corners stay with the panes.
+ let reach across along =
+ let deepest = min (2*outer) (max outer (int(float across*SplitMetrics.outerShare)))
+ float outer+float(deepest-outer)*(1.0-abs(2.0*along-1.0))
+ let u = float(pt.x-frame.left)/float(max 1 frame.width)
+ let v = float(pt.y-frame.top)/float(max 1 frame.height)
+ let depths =
+ [float(pt.x-frame.left)/reach frame.width v,(SideBySide,First)
+ float(frame.right-pt.x)/reach frame.width v,(SideBySide,Second)
+ float(pt.y-frame.top)/reach frame.height u,(Stacked,First)
+ float(frame.bottom-pt.y)/reach frame.height u,(Stacked,Second)]
+ let nearest = depths |> List.minBy fst
+ if fst nearest<1.0 then
+ let axis,side = snd nearest
+ Some(([],axis,side),half frame axis side)
+ else
+ leafRects gap frame (Branch layout.tree) []
+ |> List.tryFind(fun (_,_,rect) -> rect.containsPoint pt)
+ |> Option.bind(fun (path,_,rect) ->
+ edgeDrop pt edge rect |> Option.map(fun (axis,side) -> (path,axis,side),half rect axis side))
+
+module SplitView =
+ let root (layout:SplitLayout) = Branch layout.tree
+ let leaves (layout:SplitLayout) = SplitTree.leaves [] (root layout)
+ let pane (path:PanePath) (layout:SplitLayout) =
+ match SplitTree.node path (root layout) with
+ | Some(Leaf pane) -> Some pane
+ | _ -> None
+ let window path layout = match pane path layout with Some(Occupied hwnd) -> Some hwnd | _ -> None
+ let pathOf hwnd (layout:SplitLayout) = SplitTree.pathOf hwnd (root layout)
+ let contains hwnd layout = (pathOf hwnd layout).IsSome
+ /// The pane windows, first to last.
+ let windows layout = leaves layout |> List.choose(fun (_,pane) -> match pane with Occupied hwnd -> Some hwnd | Empty -> None)
+ let emptyPanes layout = leaves layout |> List.choose(fun (path,pane) -> if pane=Empty then Some path else None)
+ let hasEmpty layout = not(List.isEmpty(emptyPanes layout))
+ let focusedWindow layout = window layout.focused layout
+ let layoutOf = function Single -> None | Split s | Parked s -> Some s
+ /// The split the pane is in and the side it is on.
+ let position (path:PanePath) (layout:SplitLayout) =
+ match SplitTree.last path,SplitTree.node (SplitTree.parent path) (root layout) with
+ | Some side,Some(Branch branch) -> Some(branch.axis,side)
+ | _ -> None
+
+ /// The pane label a tab shows, in a split or while it is parked: its side of its own split.
+ let badge hwnd groupLayout =
+ layoutOf groupLayout |> Option.bind(fun s -> pathOf hwnd s |> Option.bind(fun path -> position path s))
+
+ /// The pane windows in layout order, for keeping their tabs together.
+ let paneOrder groupLayout = layoutOf groupLayout |> Option.map windows |> Option.defaultValue []
+
+ /// The splits from the root down to the pane: each one's axis and the side taken.
+ let trail hwnd groupLayout =
+ layoutOf groupLayout |> Option.bind(fun s ->
+ pathOf hwnd s |> Option.map(fun path ->
+ path |> List.mapi(fun depth side ->
+ match SplitTree.node (List.truncate depth path) (root s) with
+ | Some(Branch branch) -> branch.axis,side
+ | _ -> s.tree.axis,side)))
+
+ /// The split that parts two panes: the deepest one holding both, with its axis.
+ let commonSplit a b (layout:SplitLayout) =
+ match pathOf a layout,pathOf b layout with
+ | Some x,Some y ->
+ let shared = Seq.zip x y |> Seq.takeWhile(fun (p,q) -> p=q) |> Seq.length
+ let path = List.truncate shared x
+ match SplitTree.node path (root layout) with
+ | Some(Branch branch) -> Some(path,branch.axis)
+ | _ -> None
+ | _ -> None
+
+ let dropCommand hwnd = function
+ | FillEmpty path -> FillPane(hwnd,path)
+ | SplitAt(path,axis,side) -> DropInto(hwnd,path,axis,side)
+
+ /// The empty pane Esc closes: the focused pane's neighbour when it is empty, else the first.
+ let emptyToClose (layout:SplitLayout) =
+ let beside = SplitTree.parent layout.focused@[Side.other (defaultArg (SplitTree.last layout.focused) First)]
+ if pane beside layout=Some Empty then Some beside else emptyPanes layout |> List.tryHead
+
+ /// The focus goes to the pane again, or to the first pane with a window when it is gone.
+ let refocus (tree:SplitTree) (focused:PanePath) =
+ let layout = {tree=tree;focused=focused}
+ if (window focused layout).IsSome then layout
+ else
+ let fallback =
+ leaves layout |> List.tryPick(fun (path,pane) -> match pane with Occupied _ -> Some path | Empty -> None)
+ |> Option.orElse(if (pane focused layout).IsSome then Some focused else None)
+ |> Option.orElse(leaves layout |> List.tryHead |> Option.map fst)
+ {layout with focused=defaultArg fallback []}
+
+ /// The pane at the path goes; a tree down to one pane is no split any more. The focus stays
+ /// with its window, or, with that pane gone, goes to what took its room.
+ let private closeLeaf (path:PanePath) (layout:SplitLayout) =
+ let focusedWindow = window layout.focused layout
+ match SplitTree.remove path (root layout) with
+ | Branch tree ->
+ let remaining = {tree=tree;focused=[]}
+ let focused =
+ match focusedWindow |> Option.bind(fun hwnd -> pathOf hwnd remaining) with
+ | Some at -> at
+ | None ->
+ let taken = SplitTree.parent path
+ match SplitTree.node taken (Branch tree) with
+ | Some node ->
+ SplitTree.leaves taken node |> List.tryPick(fun (at,pane) -> match pane with Occupied _ -> Some at | Empty -> None)
+ |> Option.defaultValue taken
+ | None -> []
+ Some(refocus tree focused)
+ | Leaf _ -> None
+
+ let private fresh axis current partner focused =
+ {tree={axis=axis;ratio=0.5;first=Leaf(Occupied current);second=Leaf partner};focused=[focused]}
+
+ /// The split at the path turns about; a focused pane under it keeps its pane.
+ let private swapAt (path:PanePath) (layout:SplitLayout) =
+ match SplitTree.mapBranch path (fun branch -> {branch with first=branch.second;second=branch.first}) (root layout) with
+ | Branch tree ->
+ let depth = List.length path
+ let focused =
+ if List.length layout.focused>depth && List.truncate depth layout.focused=path then
+ path@[Side.other layout.focused.[depth]]@List.skip (depth+1) layout.focused
+ else layout.focused
+ {tree=tree;focused=focused}
+ | Leaf _ -> layout
+
+ /// The split a command without a path means: the one the focused pane is in.
+ let private branchOf (path:PanePath option) (layout:SplitLayout) = defaultArg path (SplitTree.parent layout.focused)
+
+ let private mapTree f = function
+ | Single -> Single
+ | Split s -> Split(f s)
+ | Parked s -> Parked(f s)
+
+ let private mapBranch path f (layout:SplitLayout) =
+ match SplitTree.mapBranch path f (root layout) with
+ | Branch tree -> {layout with tree=tree}
+ | Leaf _ -> layout
+
+ /// The pane the current window is in, or else the one in focus.
+ let private currentPath current (layout:SplitLayout) = pathOf current layout |> Option.defaultValue layout.focused
+
+ /// The rectangles of the panes in a nominal frame, for finding neighbours by direction.
+ let private shape (layout:SplitLayout) = SplitGeometry.leafRects 0 (Rect(Pt(),Sz(10000,10000))) (root layout) []
+
+ /// The pane window beside the focused pane in the direction: the nearest, and of those the
+ /// one sharing the most of the focused pane's edge.
+ let toward direction (layout:SplitLayout) =
+ let rects = shape layout
+ rects |> List.tryFind(fun (path,_,_) -> path=layout.focused) |> Option.bind(fun (_,_,from) ->
+ let overlap (a1,a2) (b1,b2) = min a2 b2-max a1 b1
+ rects |> List.choose(fun (path,pane,rect) ->
+ match pane with
+ | Empty -> None
+ | Occupied _ when path=layout.focused -> None
+ | Occupied _ ->
+ let distance,shared =
+ match direction with
+ | PaneRight -> rect.left-from.right,overlap (from.top,from.bottom) (rect.top,rect.bottom)
+ | PaneLeft -> from.left-rect.right,overlap (from.top,from.bottom) (rect.top,rect.bottom)
+ | PaneDown -> rect.top-from.bottom,overlap (from.left,from.right) (rect.left,rect.right)
+ | PaneUp -> from.top-rect.bottom,overlap (from.left,from.right) (rect.left,rect.right)
+ if distance>=0 && shared>0 then Some((distance,-shared),path) else None)
+ |> List.sortBy fst |> List.tryHead |> Option.map snd)
+
+ /// `current` is the window shown on top when the command arrives.
+ let rec apply current command layout =
+ match command,layout with
+ | SplitWith(partner,axis),(Single | Parked _) ->
+ if partner=current || partner=IntPtr.Zero then layout else Split(fresh axis current (Occupied partner) Second)
+ | SplitWith(partner,axis),Split s ->
+ if partner=IntPtr.Zero then layout
+ elif partner=current then
+ // The pane's own split turns to the axis asked for.
+ match pathOf current s with
+ | Some path -> Split(mapBranch (SplitTree.parent path) (fun branch -> {branch with axis=axis}) {s with focused=path})
+ | None -> layout
+ else
+ let path = currentPath current s
+ let here = window path s
+ // The partner leaves the pane it was in; what remains splits again beside the current pane.
+ match SplitTree.removeWindow partner (root s) with
+ | Branch tree ->
+ let remaining = refocus tree s.focused
+ let path = here |> Option.bind(fun hwnd -> pathOf hwnd remaining) |> Option.defaultValue remaining.focused
+ match SplitTree.insert path axis Second (Occupied partner) (root remaining) with
+ | Branch tree -> Split {tree=tree;focused=path@[Second]}
+ | Leaf _ -> Split remaining
+ | Leaf _ -> Split(fresh axis current (Occupied partner) Second)
+ | NewEmptyPane axis,(Single | Parked _) -> Split(fresh axis current Empty First)
+ | NewEmptyPane axis,Split s ->
+ let path = currentPath current s
+ match SplitTree.insert path axis Second Empty (root s) with
+ | Branch tree -> Split {tree=tree;focused=path@[First]}
+ | Leaf _ -> layout
+ | DropInto(hwnd,_,axis,side),(Single | Parked _) ->
+ // Beside the window shown; panes parked behind it are let go, as by any new split.
+ if hwnd=current || hwnd=IntPtr.Zero then layout
+ else
+ let s = {axis=axis;ratio=0.5;first=Leaf Empty;second=Leaf Empty}
+ let tree = s |> SplitTree.withChild side (Leaf(Occupied hwnd)) |> SplitTree.withChild (Side.other side) (Leaf(Occupied current))
+ Split {tree=tree;focused=[side]}
+ | DropInto(hwnd,target,axis,side),Split s ->
+ if hwnd=IntPtr.Zero then layout
+ else
+ match SplitTree.node target (root s) with
+ | None -> layout
+ | Some(Leaf(Occupied existing)) when existing=hwnd -> Split {s with focused=target}
+ | Some(Leaf Empty) ->
+ // An empty pane takes the window rather than splitting again.
+ let placed = SplitTree.update target (fun _ -> Leaf(Occupied hwnd)) (root s)
+ let old = pathOf hwnd s
+ let node = match old with Some path -> SplitTree.remove path placed | None -> placed
+ match node with
+ | Branch tree -> Split(refocus tree (defaultArg (SplitTree.pathOf hwnd node) []))
+ | Leaf _ -> Single
+ | Some _ ->
+ let inserted = SplitTree.insert target axis side (Occupied hwnd) (root s)
+ // The window's old pane, moved down a level if it lay under the target, goes.
+ let old =
+ pathOf hwnd s |> Option.map(fun path ->
+ if List.length path>=List.length target && List.truncate (List.length target) path=target then
+ target@[Side.other side]@List.skip (List.length target) path
+ else path)
+ let node = match old with Some path -> SplitTree.remove path inserted | None -> inserted
+ match node with
+ | Branch tree -> Split(refocus tree (defaultArg (SplitTree.pathOf hwnd node) []))
+ | Leaf _ -> layout
+ | FillPane(hwnd,target),(Split s | Parked s) ->
+ match pane target s with
+ | Some Empty -> apply current (DropInto(hwnd,target,s.tree.axis,First)) (Split s)
+ | _ -> layout
+ | FocusPane path,(Split s | Parked s) -> if (window path s).IsSome then Split {s with focused=path} else layout
+ | FocusToward direction,Split s -> (match toward direction s with Some path -> Split {s with focused=path} | None -> layout)
+ | FocusToward _,Parked s -> Split s
+ | FocusOther,Split s ->
+ let order = leaves s |> List.choose(fun (path,pane) -> match pane with Occupied _ -> Some path | Empty -> None)
+ match List.tryFindIndex ((=) s.focused) order with
+ | Some index when order.Length>1 -> Split {s with focused=order.[(index+1) % order.Length]}
+ | None when not order.IsEmpty -> Split {s with focused=order.Head}
+ | _ -> layout
+ | FocusOther,Parked s -> Split s
+ | Swap path,_ -> mapTree (fun s -> swapAt (branchOf path s) s) layout
+ | SetRatio(path,ratio),_ -> mapTree (mapBranch path (fun branch -> {branch with ratio=SplitMetrics.clampRatio ratio})) layout
+ | Equalize path,_ -> mapTree (fun s -> mapBranch (branchOf path s) (fun branch -> {branch with ratio=0.5}) s) layout
+ | ToggleAxis path,_ -> mapTree (fun s -> mapBranch (branchOf path s) (fun branch -> {branch with axis=(if branch.axis=SideBySide then Stacked else SideBySide)}) s) layout
+ | ClosePane path,(Split s | Parked s) ->
+ let path = defaultArg path s.focused
+ if (pane path s).IsNone then layout
+ else
+ match closeLeaf path s,layout with
+ | Some next,Split _ -> Split next
+ | Some next,_ -> Parked next
+ | None,_ -> Single
+ | EndSplit _,_ -> Single
+ | ToggleFill,_ -> layout
+ | _,Single -> Single
+
+ /// A pane window coming to the front focuses its pane; any other tab parks the panes.
+ let onActivated hwnd layout =
+ match layout with
+ | Split s -> (match pathOf hwnd s with Some path -> Split {s with focused=path} | None -> Parked s)
+ | Parked s -> (match pathOf hwnd s with Some path -> Split {s with focused=path} | None -> layout)
+ | Single -> Single
+
+ /// Losing a pane window: its neighbour takes its room; the last pane ends the split.
+ let onRemoved hwnd layout =
+ match layout with
+ | Split s when contains hwnd s -> (match closeLeaf (pathOf hwnd s).Value s with Some s -> Split s | None -> Single)
+ | Parked s when contains hwnd s -> (match closeLeaf (pathOf hwnd s).Value s with Some s -> Parked s | None -> Single)
+ | _ -> layout
+
+ let prune isMember layout =
+ match layoutOf layout with
+ | Some s -> windows s |> List.filter(isMember >> not) |> List.fold(fun layout hwnd -> onRemoved hwnd layout) layout
+ | None -> layout
+
+ /// The pane the other tabs wait under: the first one holding a window. It does not follow
+ /// the focus, so moving between the panes moves none of them; carried across with the
+ /// focus, they showed over the other pane for a moment before they were restacked.
+ let host (layout:SplitLayout) =
+ leaves layout |> List.tryPick(fun (path,pane) -> match pane with Occupied _ -> Some path | Empty -> None)
+ |> Option.defaultValue (leaves layout |> List.head |> fst)
+
+ /// Where every member goes. Single and Parked keep the current behaviour: followers
+ /// sit under the top window at the frame. In a split each pane window has its own
+ /// rectangle and the rest wait under the host pane.
+ let plan layout (frame:Rect) gap (members:IntPtr list) (top:IntPtr) =
+ match layout with
+ | Split s ->
+ let rects = SplitGeometry.leafRects gap frame (root s) []
+ let hostPath = host s
+ let hostHwnd = window hostPath s
+ let hostRect = rects |> List.find(fun (path,_,_) -> path=hostPath) |> fun (_,_,rect) -> rect
+ members |> List.map(fun hwnd ->
+ match rects |> List.tryFind(fun (_,pane,_) -> pane=Occupied hwnd) with
+ | Some(_,_,rect) -> {hwnd=hwnd;rect=rect;below=None}
+ | None -> {hwnd=hwnd;rect=hostRect;below=hostHwnd})
+ | Single | Parked _ ->
+ members |> List.filter((<>) top) |> List.map(fun hwnd -> {hwnd=hwnd;rect=frame;below=Some top})
+
+/// What a pane window remembers of its split, kept on the window itself across restarts: the
+/// splits above it with the side taken at each and their ratios, and whether it was in focus.
+type SavedPane = {
+ levels: (SplitAxis * Side) list
+ ratios: float list
+ focused: bool
+ parked: bool
+}
+
+module SplitPersistence =
+ /// Each pane window's place in the layout.
+ let entries (layout:GroupLayout) =
+ match layout with
+ | Single -> []
+ | Split s | Parked s ->
+ let parked = match layout with Parked _ -> true | _ -> false
+ let branchAt depth (path:PanePath) =
+ match SplitTree.node (List.truncate depth path) (SplitView.root s) with
+ | Some(Branch branch) -> branch
+ | _ -> s.tree
+ SplitView.leaves s |> List.choose(fun (path,pane) ->
+ match pane with
+ | Occupied hwnd ->
+ Some(hwnd,{ levels = path |> List.mapi(fun depth side -> (branchAt depth path).axis,side)
+ ratios = path |> List.mapi(fun depth _ -> (branchAt depth path).ratio)
+ focused = (path=s.focused)
+ parked = parked })
+ | Empty -> None)
+
+ /// The layout the windows present remember together. Panes gone, the empty ones and the
+ /// windows closed since, leave their room to their neighbours; one pane is no split.
+ let rebuild (saved:(IntPtr * SavedPane) list) =
+ let rec build (entries:(IntPtr * (SplitAxis * Side) list * float list) list) =
+ match entries |> List.tryFind(fun (_,levels,_) -> levels.IsEmpty) with
+ | Some(hwnd,_,_) -> Some(Leaf(Occupied hwnd))
+ | None ->
+ match entries with
+ | [] -> None
+ | (_,(axis,_)::_,ratios)::_ ->
+ let on side =
+ entries |> List.choose(fun (hwnd,levels,ratios) ->
+ match levels,ratios with
+ | (_,taken)::rest,_::ratiosRest when taken=side -> Some(hwnd,rest,ratiosRest)
+ | (_,taken)::rest,[] when taken=side -> Some(hwnd,rest,[])
+ | _ -> None)
+ let ratio = ratios |> List.tryHead |> Option.defaultValue 0.5
+ match build (on First),build (on Second) with
+ | Some first,Some second -> Some(Branch {axis=axis;ratio=SplitMetrics.clampRatio ratio;first=first;second=second})
+ | Some only,None | None,Some only -> Some only
+ | None,None -> None
+ | _ -> None
+ match build (saved |> List.map(fun (hwnd,pane) -> hwnd,pane.levels,pane.ratios)) with
+ | Some(Branch tree) ->
+ let layout = {tree=tree;focused=[]}
+ let focused = saved |> List.tryPick(fun (hwnd,pane) -> if pane.focused then SplitView.pathOf hwnd layout else None)
+ let layout = SplitView.refocus tree (defaultArg focused [])
+ if saved |> List.exists(fun (_,pane) -> pane.parked) then Parked layout else Split layout
+ | _ -> Single
diff --git a/WtProgram/Shared/Strings.fs b/WtProgram/Shared/Strings.fs
index b5d5a7e7..50570ca0 100644
--- a/WtProgram/Shared/Strings.fs
+++ b/WtProgram/Shared/Strings.fs
@@ -22,7 +22,7 @@ module Strings =
let center = { en="Center"; zh="居中"; ja="中央"; ar="الوسط" }
let right = { en="Right"; zh="右侧"; ja="右"; ar="يمين" }
let never = { en="Never"; zh="从不"; ja="しない"; ar="أبدًا" }
- let whenMaximized = { en="When maximized"; zh="最大化时"; ja="最大化時"; ar="عند التكبير" }
+ let whenMaximized = { en="Maximized"; zh="最大化时"; ja="最大化時"; ar="عند التكبير" }
let always = { en="Always"; zh="始终"; ja="常に"; ar="دائمًا" }
let selectedChoice (name:LocalizedText) = { en=name.en+" ✓"; zh=name.zh+" ✓"; ja=name.ja+" ✓"; ar=name.ar+" ✓" }
let operationFailed = { en="Operation failed"; zh="操作失败"; ja="操作に失敗しました"; ar="فشلت العملية" }
@@ -54,6 +54,25 @@ module Strings =
/// Tab context menu.
module TabMenu =
+ let split = { en="Split view"; zh="组内分屏"; ja="分割表示"; ar="العرض المقسّم" }
+ /// A window chosen from a list goes on that side of the tab.
+ let splitPickRight = { en="Window on the right…"; zh="在右侧放入窗口…"; ja="右側にウィンドウを配置…"; ar="نافذة على اليمين…" }
+ let splitPickBelow = { en="Window below…"; zh="在下方放入窗口…"; ja="下側にウィンドウを配置…"; ar="نافذة في الأسفل…" }
+ let splitPickLeft = { en="Window on the left…"; zh="在左侧放入窗口…"; ja="左側にウィンドウを配置…"; ar="نافذة على اليسار…" }
+ let splitPickAbove = { en="Window above…"; zh="在上方放入窗口…"; ja="上側にウィンドウを配置…"; ar="نافذة في الأعلى…" }
+ let splitEmpty = { en="Drop a tab or window here"; zh="将标签或窗口拖到这里"; ja="ここにタブまたはウィンドウをドロップ"; ar="أفلت علامة تبويب أو نافذة هنا" }
+ let splitChoose = { en="Choose a window…"; zh="选择窗口…"; ja="ウィンドウを選択…"; ar="اختر نافذة…" }
+ let splitOr = { en="or"; zh="或"; ja="または"; ar="أو" }
+ let splitSearch = { en="Type a title or app name to fill the pane"; zh="输入标题或应用名，放入这一侧"; ja="タイトルやアプリ名を入力してペインに配置"; ar="اكتب عنوانًا أو اسم تطبيق لملء الجزء" }
+ let splitShow = { en="Show split view"; zh="显示分屏"; ja="分割表示に戻す"; ar="إظهار العرض المقسّم" }
+ let splitNoWindows = { en="No other windows"; zh="没有其他窗口"; ja="他のウィンドウはありません"; ar="لا توجد نوافذ أخرى" }
+ let splitMerge = { en="End split view"; zh="结束分屏"; ja="分割表示を終了"; ar="إنهاء العرض المقسّم" }
+ let splitMakeStacked = { en="Switch to top and bottom"; zh="切换为上下"; ja="上下に切り替え"; ar="التبديل إلى أعلى وأسفل" }
+ let splitMakeSideBySide = { en="Switch to side by side"; zh="切换为左右"; ja="左右に切り替え"; ar="التبديل إلى جنبًا إلى جنب" }
+ let splitSwap = { en="Swap panes"; zh="交换两侧"; ja="ペインを入れ替え"; ar="تبديل الأجزاء" }
+ let splitEqual = { en="Equal panes"; zh="恢复均分"; ja="均等に分割"; ar="أجزاء متساوية" }
+ let splitRatio = { en="Split divider"; zh="分屏分隔条"; ja="分割境界"; ar="فاصل التقسيم" }
+ let splitFailed = { en="These windows could not fit the split layout. Split view has ended."; zh="窗口无法适应分屏尺寸，已退出分屏。"; ja="ウィンドウを分割領域に配置できないため、分割を終了しました。"; ar="تعذّر احتواء هذه النوافذ في تخطيط التقسيم. انتهى العرض المقسّم." }
let position = { en="Tab position"; zh="标签位置"; ja="タブの位置"; ar="موضع علامات التبويب" }
let top = { en="Top"; zh="顶部"; ja="上部"; ar="أعلى" }
let showTabTitles = { en="Show tab titles"; zh="显示标签标题"; ja="タブのタイトルを表示"; ar="إظهار عناوين علامات التبويب" }
@@ -132,6 +151,12 @@ module Strings =
let launchAtSignIn = { caption={ en="Start with Windows"; zh="随 Windows 启动"; ja="Windows と同時に起動"; ar="التشغيل مع Windows" }
description={ en="Runs in the system tray after you sign in."; zh="登录后在系统托盘中运行。"; ja="サインイン後にシステムトレイで実行します。"; ar="يعمل في منطقة الإعلام بعد تسجيل الدخول." }
keywords={ en="startup autostart"; zh="开机启动 自启动"; ja="スタートアップ 自動起動"; ar="بدء التشغيل التشغيل التلقائي" } }
+ let restoreSession = { caption={ en="Restore the last session after sign-in"; zh="登录后恢复上次会话"; ja="サインイン後に前回のセッションを復元"; ar="استعادة الجلسة الأخيرة بعد تسجيل الدخول" }
+ description={ en="Puts open windows back into the groups, positions and split views they had, optionally launching missing apps first."
+ zh="把已打开的窗口放回原来的分组、位置和分屏，可选先启动缺少的应用。"
+ ja="開いているウィンドウを元のグループ、位置、分割表示に戻します。足りないアプリを先に起動することもできます。"
+ ar="يعيد النوافذ المفتوحة إلى مجموعاتها ومواضعها وعروضها المقسّمة السابقة، مع تشغيل التطبيقات الناقصة أولًا اختياريًا." }
+ keywords={ en="session reboot"; zh="会话 重启"; ja="セッション 再起動"; ar="جلسة إعادة التشغيل" } }
let enableTabsByDefault = { caption={ en="Use tabs for new apps"; zh="新应用自动启用标签"; ja="新しいアプリでタブを使う"; ar="استخدام علامات التبويب للتطبيقات الجديدة" }
description={ en="Only apps first discovered after this change. Existing apps keep their tab setting."; zh="只影响此后首次出现的应用。已有应用保留原来的标签设置。"; ja="変更後に初めて検出するアプリに適用します。既存のアプリのタブ設定は維持します。"; ar="ينطبق ذلك على التطبيقات التي يكتشفها البرنامج لأول مرة بعد هذا التغيير فقط. وتحتفظ التطبيقات الموجودة بإعداد علامات التبويب الحالي." }
keywords={ en=""; zh=""; ja=""; ar="" } }
@@ -164,7 +189,7 @@ module Strings =
description={ en="Large icons in a row, or a list with full window titles."; zh="一排大图标，或显示完整窗口标题的列表。"; ja="大きなアイコンを横に並べるか、ウィンドウ タイトルを一覧で表示します。"; ar="أيقونات كبيرة في صف، أو قائمة تعرض عناوين النوافذ كاملة." }
keywords={ en="layout"; zh="布局"; ja="レイアウト"; ar="التخطيط" } }
let groupWindowsInSwitcher = { caption={ en="Group windows in Alt+Tab"; zh="在 Alt+Tab 中按分组显示"; ja="Alt+Tab でグループをまとめる"; ar="تجميع النوافذ في Alt+Tab" }
- description={ en="Each group appears as one item."; zh="每个分组只显示一项。"; ja="各グループを 1 項目として表示します。"; ar="تظهر كل مجموعة كعنصر واحد." }
+ description={ en="Each group appears as one item, with the icon its taskbar button has."; zh="每个分组只显示一项，图标与任务栏按钮相同。"; ja="各グループを、タスク バーのボタンと同じアイコンの 1 項目として表示します。"; ar="تظهر كل مجموعة كعنصر واحد بالأيقونة نفسها التي يحملها زر شريط المهام." }
keywords={ en="switcher"; zh="切换器"; ja="切り替え"; ar="المبدّل" } }
let nextTab = { caption={ en="Switch to next tab"; zh="切换到下一个标签"; ja="次のタブに切り替え"; ar="الانتقال إلى علامة التبويب التالية" }
description=none
@@ -187,6 +212,25 @@ module Strings =
ja="前面のタブのウィンドウを閉じます。"
ar="يغلق نافذة علامة التبويب الأمامية." }
keywords={ en="close window"; zh="关闭窗口"; ja="ウィンドウを閉じる"; ar="إغلاق النافذة" } }
+ let private splitWords = { en="split view pane"; zh="分屏 窗格"; ja="分割 ペイン"; ar="عرض مقسّم جزء" }
+ let splitPickRight = { caption={ en="Window on the right…"; zh="在右侧放入窗口…"; ja="右側にウィンドウを配置…"; ar="نافذة على اليمين…" }
+ description={ en="Lists the windows to put beside the tab in front."; zh="列出可放到当前标签旁边的窗口。"; ja="前面のタブの隣に置くウィンドウを一覧表示します。"; ar="يعرض النوافذ التي يمكن وضعها بجانب علامة التبويب الأمامية." }
+ keywords=splitWords }
+ let splitPickBelow = { caption={ en="Window below…"; zh="在下方放入窗口…"; ja="下側にウィンドウを配置…"; ar="نافذة في الأسفل…" }
+ description=none
+ keywords=splitWords }
+ let splitFocusLeft = { caption={ en="Focus the pane to the left"; zh="焦点切到左边的格"; ja="左のペインにフォーカス"; ar="التركيز على الجزء الأيسر" }
+ description=none
+ keywords=splitWords }
+ let splitFocusRight = { caption={ en="Focus the pane to the right"; zh="焦点切到右边的格"; ja="右のペインにフォーカス"; ar="التركيز على الجزء الأيمن" }
+ description=none
+ keywords=splitWords }
+ let splitFocusUp = { caption={ en="Focus the pane above"; zh="焦点切到上边的格"; ja="上のペインにフォーカス"; ar="التركيز على الجزء الأعلى" }
+ description=none
+ keywords=splitWords }
+ let splitFocusDown = { caption={ en="Focus the pane below"; zh="焦点切到下边的格"; ja="下のペインにフォーカス"; ar="التركيز على الجزء الأسفل" }
+ description=none
+ keywords=splitWords }
let switchTabsByNumber = { caption={ en="Switch tabs by number"; zh="按数字切换标签"; ja="番号でタブを切り替え"; ar="التبديل بين علامات التبويب باستخدام الأرقام" }
description={ en="Hold a modifier key and press 1–9."; zh="按住修饰键再按 1–9。"; ja="修飾キーを押しながら 1～9 を押します。"; ar="اضغط باستمرار على مفتاح تعديل ثم اضغط على رقم من 1 إلى 9." }
keywords={ en="digit"; zh="数字"; ja="数字"; ar="رقم" } }
@@ -295,7 +339,25 @@ module Strings =
description={ en="Then restarts. App rules and workspaces can be kept."; zh="完成后重新启动，可保留应用规则和工作区。"; ja="その後再起動します。アプリのルールとワークスペースは残せます。"; ar="ثم يُعاد تشغيل البرنامج. يمكن الاحتفاظ بقواعد التطبيقات ومساحات العمل." }
keywords={ en="factory"; zh="恢复默认 出厂"; ja="初期化"; ar="إعدادات المصنع" } }
+ /// What letting go of a dragged tab here would do, on the preview.
+ module Session =
+ let restoring = { en="Restoring the last session…"; zh="正在恢复上次会话…"; ja="前回のセッションを復元しています…"; ar="جارٍ استعادة الجلسة الأخيرة…" }
+ let launching count =
+ { en=(if count=1 then "Starting an app for the last session…" else sprintf "Starting %d apps for the last session…" count)
+ zh=sprintf "正在为上次会话启动 %d 个应用…" count
+ ja=sprintf "前回のセッションのためにアプリを %d 個起動しています…" count
+ ar=sprintf "جارٍ تشغيل %d من التطبيقات للجلسة الأخيرة…" count }
+ let restored restored missing =
+ { en=(sprintf "Session restored: %d windows" restored)+(if missing=0 then "" else sprintf ", %d not found" missing)
+ zh=(sprintf "已恢复上次会话：%d 个窗口" restored)+(if missing=0 then "" else sprintf "，%d 个未找到" missing)
+ ja=(sprintf "前回のセッションを復元しました: %d 個のウィンドウ" restored)+(if missing=0 then "" else sprintf "、%d 個が見つかりません" missing)
+ ar=(sprintf "تمت استعادة الجلسة: %d نافذة" restored)+(if missing=0 then "" else sprintf "، %d غير موجودة" missing) }
+
module General =
+ /// The choices of Restore the last session at start.
+ let sessionOff = { en="Off"; zh="关闭"; ja="オフ"; ar="إيقاف" }
+ let sessionWindows = { en="Open windows only"; zh="仅已打开的窗口"; ja="開いているウィンドウのみ"; ar="النوافذ المفتوحة فقط" }
+ let sessionApps = { en="Open windows, and start their apps"; zh="已打开的窗口，并启动缺少的应用"; ja="開いているウィンドウと、アプリの起動"; ar="النوافذ المفتوحة، مع تشغيل تطبيقاتها" }
let settingsFile = { en="Settings file"; zh="设置文件"; ja="設定ファイル"; ar="ملف الإعدادات" }
let openFolder = { en="Open folder"; zh="打开文件夹"; ja="フォルダーを開く"; ar="فتح المجلد" }
let export = { en="Export…"; zh="导出…"; ja="エクスポート…"; ar="تصدير…" }
@@ -392,6 +454,7 @@ module Strings =
module Shortcuts =
let keyboard = { en="Keyboard"; zh="键盘"; ja="キーボード"; ar="لوحة المفاتيح" }
let mouse = { en="Mouse"; zh="鼠标"; ja="マウス"; ar="الفأرة" }
+ let splitView = { en="Split view"; zh="分屏"; ja="分割表示"; ar="العرض المقسّم" }
let keyboardNote = { en="Click a shortcut, then press the new combination. Esc cancels."
zh="点击快捷键后按下新的组合键。按 Esc 取消。"
ja="ショートカットをクリックして、新しいキーの組み合わせを押します。Esc でキャンセルします。"
@@ -509,6 +572,7 @@ module Strings =
let expectedList = { en=": expected a list."; zh="：应为列表。"; ja="：リストが必要です。"; ar=": كان متوقعًا وجود قائمة." }
let missingPlacement = { en="Missing placement."; zh="缺少窗口位置。"; ja="ウィンドウの配置がありません。"; ar="موضع النافذة مفقود." }
let invalidTabLayout = { en="Invalid saved tab layout; the group will use current defaults."; zh="保存的标签布局无效；该分组将使用当前默认设置。"; ja="保存されたタブ配置が無効です。グループには現在の既定値を使用します。"; ar="تخطيط علامات التبويب المحفوظ غير صالح؛ ستستخدم المجموعة الإعدادات الافتراضية الحالية." }
+ let invalidSplit = { en="Invalid saved split view; the group will restore without it."; zh="保存的分屏无效；该分组恢复时不带分屏。"; ja="保存された分割表示が無効です。グループは分割なしで復元されます。"; ar="العرض المقسّم المحفوظ غير صالح؛ ستتم استعادة المجموعة بدونه." }
let noValidWindows = { en="No valid windows in this group."; zh="此分组中没有有效窗口。"; ja="このグループに有効なウィンドウがありません。"; ar="لا توجد نوافذ صالحة في هذه المجموعة." }
let unsupportedVersion = { en="Unsupported workspace version; saved workspaces will not be modified."
zh="不支持此工作区版本；已保存的工作区不会被修改。"
diff --git a/WtProgram/Shared/TabStripTypes.fs b/WtProgram/Shared/TabStripTypes.fs
index 1835f977..a1a0f306 100755
--- a/WtProgram/Shared/TabStripTypes.fs
+++ b/WtProgram/Shared/TabStripTypes.fs
@@ -10,6 +10,9 @@ and TabInfo = {
iconBig: Icon
preview: unit -> Img
isRenamed: bool
+ /// The splits above this tab's pane, root first, with the side taken at each: the button on
+ /// the seam between two pane tabs shows the split that parts them; the text itself stays clean.
+ splitTrail: (SplitAxis * Side) list option
}
and TabDragInfo = {
@@ -17,13 +20,31 @@ and TabDragInfo = {
tabOffset: Pt
tabSize: Sz
tabInfo: TabInfo
+ /// Where the tab sits over the window in the drag image, as the strip's alignment would
+ /// put a lone tab; the dropped window lands so that the tab stays under the pointer.
+ tabShift: int
+ /// The strip's alignment, which places a lone tab again over whatever width the window lands at.
+ tabAlignment: TabAlignment
} with
+ /// Where a lone tab sits over a window of this width.
+ member this.shiftFor(windowWidth:int) =
+ match this.tabAlignment with
+ | TabCenter -> max 0 ((windowWidth-this.tabSize.width)/2)
+ | TabRight -> max 0 (windowWidth-this.tabSize.width-60)
+ | TabLeft -> 0
/// Keep the grabbed point proportional when entering a differently sized tab or DPI.
member this.offsetIn(size:Sz) =
let fit offset source target =
int(Math.Round(float(between (0,max 1 source) offset)*float target/float(max 1 source)))
Pt(fit this.tabOffset.x this.tabSize.width size.width,fit this.tabOffset.y this.tabSize.height size.height)
+/// The image a dragged tab carries: its window at this scale, the tab itself at full size, so
+/// the tab stays readable over a window shown small.
+and DragImage =
+ static member windowScale = 0.5
+ /// The window shows a little of what lies under it; the tab is solid, to stay readable.
+ static member windowOpacity = 0.85f
+
and TabStripPlacment = {
showInside: bool
bounds: Rect
@@ -33,6 +54,8 @@ and TabPart =
| TabBackground
| TabIcon
| TabClose
+ /// The button where the two tabs of a split view meet.
+ | TabSplit
and TabDirection =
| TabUp
diff --git a/WtProgram/Shared/WindowPlacementQueue.fs b/WtProgram/Shared/WindowPlacementQueue.fs
index 9950f196..78700bc1 100644
--- a/WtProgram/Shared/WindowPlacementQueue.fs
+++ b/WtProgram/Shared/WindowPlacementQueue.fs
@@ -137,6 +137,8 @@ type FollowerPlacementRequest =
| SetMinimized of bool * IntPtr option
| HideForMove
| PrepareMinimizeAnchor
+ /// Only the stacking: directly below the given window, as a split's other pane goes below the tabs.
+ | StackBelow of IntPtr
module FollowerPlacement =
let private identity hwnd =
@@ -151,6 +153,9 @@ module FollowerPlacement =
match request with
| PrepareMinimizeAnchor -> window.prepareMinimizeAnchor(valid)
| HideForMove -> if valid() && not window.isMinimized then window.hideOffScreen(None)
+ | StackBelow top ->
+ if valid() && not window.isMinimized && WinUserApi.IsWindow(top) && window.prevZorder.hwnd<>top then
+ window.insertAfter(top)
| SetMinimized(minimized,below) ->
if window.isMinimized<>minimized && valid() then
if minimized then window.prepareMinimizeAnchor(valid)
@@ -198,8 +203,11 @@ module FollowerPlacement =
if valid() && window.needsMinimizeAnchor then positioned <- true
window.prepareMinimizeAnchor(valid)
// Restoring can move again after SetWindowPlacement. Correct stacking
- // after every native phase, using the source captured by the request.
- if positioned && valid() && not window.isMinimized && previous<>IntPtr.Zero && WinUserApi.IsWindow(previous) then
+ // after every native phase, using the source captured by the request. A window
+ // already there is left alone: during a split's divider drag every step would
+ // otherwise wait on the app twice, once for the size and once for the stacking.
+ if positioned && valid() && not window.isMinimized && previous<>IntPtr.Zero && WinUserApi.IsWindow(previous) &&
+ window.prevZorder.hwnd<>previous then
window.insertAfter(previous)
/// A group's windows usually each have a thread of their own and change state together, so a
@@ -213,6 +221,7 @@ module FollowerPlacement =
let minimizeRequest hwnd minimized = identity hwnd,SetMinimized(minimized,None)
let restoreBelowRequest hwnd top = identity hwnd,SetMinimized(false,Some top)
let hideRequest hwnd = identity hwnd,HideForMove
+ let stackBelowRequest hwnd top = identity hwnd,StackBelow top
let prepareMinimizeRequest hwnd = identity hwnd,PrepareMinimizeAnchor
let isChangingMinimizeState owner hwnd =
queue.isWindowBusyWith(owner,hwnd,fun (_,request) -> match request with SetMinimized _ -> true | _ -> false)
diff --git a/WtProgram/SplitPanePicker.fs b/WtProgram/SplitPanePicker.fs
new file mode 100644
index 00000000..4cfc3fa2
--- /dev/null
+++ b/WtProgram/SplitPanePicker.fs
@@ -0,0 +1,31 @@
+namespace Bemo
+open System
+open System.Drawing
+open System.Windows.Forms
+
+/// The window list for a pane: the tab search's box, over the pane or the group about to split,
+/// sorted by app and then title with a divider between apps; type to filter, and Enter or a
+/// click puts the window there.
+type SplitPanePicker() =
+ let open' (within:Rectangle) windows choose =
+ let key (text:string) = text.ToLowerInvariant()
+ let sorted =
+ windows
+ |> List.map(fun (hwnd,title,program) -> TabSearch.create hwnd title title program)
+ // Windows whose program cannot be read, elevated system tools such as Task Manager
+ // or hosts of Store apps, go last: they are seldom the ones to put beside another.
+ |> List.sortBy(fun entry -> entry.program="",key entry.program,key entry.title)
+ let apps = sorted |> List.map(fun entry -> key entry.program) |> List.distinct
+ let entries = sorted |> List.mapi(fun index entry ->
+ { entry with group=List.findIndex ((=) (key entry.program)) apps; recency=index })
+ // Half the screen wide and most of its height, so most windows can be picked without
+ // scrolling; the box and scope line above the rows take about two rows.
+ let area = Screen.FromRectangle(within).WorkingArea
+ let rows = max 9 (area.Height*7/10/Dpi.scale 44-2)
+ let width = max 640 (int(float area.Width/2.0/Dpi.currentFactor()))
+ let search = TabSearchForm(entries,[],pick=choose,within=within,prompt=tr Strings.TabMenu.splitSearch,
+ rows=rows,width=width)
+ search.Show()
+ interface ISplitPanePicker with
+ member _.show(owner,_,windows,choose) = open' (owner.RectangleToScreen(owner.ClientRectangle)) windows choose
+ member _.showWithin(within,windows,choose) = open' within windows choose
diff --git a/WtProgram/SplitViewChrome.fs b/WtProgram/SplitViewChrome.fs
new file mode 100644
index 00000000..9aece6eb
--- /dev/null
+++ b/WtProgram/SplitViewChrome.fs
@@ -0,0 +1,676 @@
+namespace Bemo
+open System
+open System.Drawing
+open System.Windows.Forms
+
+/// A helper window of a split view: owned by the strip, never an application tab, not in the
+/// taskbar or Alt+Tab, and it never takes the keyboard focus.
+type SplitChromeForm() =
+ inherit Form(FormBorderStyle=FormBorderStyle.None,ShowInTaskbar=false,StartPosition=FormStartPosition.Manual)
+ /// Painted off screen in one go: erasing first flickered on every hover, click and resize.
+ /// Set once the handle exists: Form's constructor reads CreateParams before an F#
+ /// constructor body could run, so a self reference there fails.
+ override this.OnHandleCreated(e) =
+ this.SetStyle(ControlStyles.OptimizedDoubleBuffer ||| ControlStyles.AllPaintingInWmPaint |||
+ ControlStyles.UserPaint ||| ControlStyles.ResizeRedraw,true)
+ base.OnHandleCreated(e)
+ override _.ShowWithoutActivation = true
+ override _.CreateParams =
+ let cp = base.CreateParams
+ cp.ExStyle <- cp.ExStyle ||| WindowsExtendedStyles.WS_EX_NOACTIVATE ||| WindowsExtendedStyles.WS_EX_TOOLWINDOW
+ cp
+
+/// The split's own commands, shared by the button between the pair's tabs and the divider.
+module SplitMenu =
+ /// The commands for one split: the one at `at`, or the focused pane's own.
+ let ofSplit (axis:SplitAxis) (parked:bool) (at:PanePath option) (execute:SplitCommand -> unit) =
+ let item text command = CmiRegular({text=tr text;image=None;flags=List2();click=fun () -> execute command})
+ let turn = if axis=SideBySide then Strings.TabMenu.splitMakeStacked else Strings.TabMenu.splitMakeSideBySide
+ List2([
+ // Parked panes come back first, as clicking any of their tabs would.
+ if parked then
+ yield item Strings.TabMenu.splitShow FocusOther
+ yield CmiSeparator
+ yield item Strings.TabMenu.splitSwap (Swap at)
+ yield item Strings.TabMenu.splitEqual (Equalize at)
+ yield item turn (ToggleAxis at)
+ yield CmiSeparator
+ yield item Strings.TabMenu.splitMerge (EndSplit None)])
+ let items (layout:GroupLayout) (execute:SplitCommand -> unit) =
+ match layout with
+ | Split s | Parked s ->
+ let axis =
+ match SplitTree.node (SplitTree.parent s.focused) (SplitView.root s) with
+ | Some(Branch branch) -> branch.axis
+ | _ -> s.tree.axis
+ ofSplit axis (match layout with Parked _ -> true | _ -> false) None execute
+ | Single -> List2()
+
+/// Lists windows for a pane to take. Registered by the program with the settings window's
+/// drop-down; the picker builds its controls on the calling thread.
+type ISplitPanePicker =
+ /// Opens below `anchor`, on screen; `choose` receives the window picked.
+ abstract member show : owner:Control * anchor:Rectangle * windows:(IntPtr * string * string) list * choose:(IntPtr -> unit) -> unit
+ /// Opens over `within`, on screen, as for a group about to split.
+ abstract member showWithin : within:Rectangle * windows:(IntPtr * string * string) list * choose:(IntPtr -> unit) -> unit
+
+/// The bar between the panes: dragged for the ratio, double-clicked to equalize, right-clicked
+/// for the split's menu. It only produces commands.
+/// `live` says when a drag starts and ends, so the group can keep the other tabs out of the way.
+/// Like the empty pane it lives on a thread of its own, owned by nothing: its drag never waits
+/// on the apps in the panes, whose input the strip's thread shares by owning the strip to them.
+type SplitDivider(execute:SplitCommand -> unit, live:bool -> unit) =
+ inherit SplitChromeForm()
+ /// The split this divider belongs to, where it is in the layout, and its own frame.
+ let mutable layout : SplitTree option = None
+ let mutable path : PanePath = []
+ let mutable frame = Rect()
+ let mutable gap = SplitMetrics.divider
+ let mutable dragging = false
+ let mutable hovering = false
+ let mutable menu : ThemedContextMenu option = None
+ /// While dragged, one ratio at a time goes to the group and only the latest waits: sent at
+ /// every pointer move, they piled up faster than the group placed them, and the divider
+ /// trailed the pointer by seconds.
+ let mutable inFlight = false
+ let mutable pending : float option = None
+ /// The ratio last sent. Sent again, it changed nothing, so no word came back and the next
+ /// ratio waited; a move the window's own repositioning causes repeats it.
+ let mutable lastSent = nan
+ /// Places the panes for a ratio from this thread, as the group would.
+ let mutable place : float -> unit = ignore
+ let sent = Diagnostics.Stopwatch()
+ /// Bounds and state last drawn, so frequent updates leave an unchanged bar alone.
+ let mutable drawn : (Rectangle * bool * bool * SplitAxis) option = None
+ /// Drawn with per-pixel alpha: the whole gap takes the pointer, nearly clear, and only a
+ /// thin bar with round ends shows, and only while pointed at or dragged, as an editor's sash.
+ override _.CreateParams =
+ let cp = base.CreateParams
+ cp.ExStyle <- cp.ExStyle ||| WindowsExtendedStyles.WS_EX_LAYERED
+ cp
+ member private this.render() =
+ let axis = layout |> Option.map(fun value -> value.axis) |> Option.defaultValue SideBySide
+ let state = Some(this.Bounds,hovering,dragging,axis)
+ if this.IsHandleCreated && this.Width>0 && this.Height>0 && state<>drawn then
+ drawn <- state
+ let width,height = this.Width,this.Height
+ use bitmap = new Bitmap(width,height,Imaging.PixelFormat.Format32bppArgb)
+ use g = Graphics.FromImage(bitmap)
+ // Alpha 1, not 0: a clear pixel would let the pointer through to the window behind.
+ g.Clear(Color.FromArgb(1,0,0,0))
+ if hovering || dragging then
+ let palette = SettingsColors.current()
+ g.SmoothingMode <- Drawing2D.SmoothingMode.AntiAlias
+ // A thin bar with round ends in the middle of the wider band that takes the pointer.
+ let thickness = float32(min (Dpi.scale SplitMetrics.divider) (if axis=SideBySide then width else height))
+ let inset = 0.0f
+ let bar =
+ if axis=SideBySide then RectangleF((float32 width-thickness)/2.0f,inset,thickness,max thickness (float32 height-2.0f*inset))
+ else RectangleF(inset,(float32 height-thickness)/2.0f,max thickness (float32 width-2.0f*inset),thickness)
+ use path = new Drawing2D.GraphicsPath()
+ let d = thickness
+ if axis=SideBySide then
+ path.AddArc(bar.X,bar.Y,d,d,180.0f,180.0f)
+ path.AddArc(bar.X,bar.Bottom-d,d,d,0.0f,180.0f)
+ else
+ path.AddArc(bar.X,bar.Y,d,d,90.0f,180.0f)
+ path.AddArc(bar.Right-d,bar.Y,d,d,270.0f,180.0f)
+ path.CloseFigure()
+ use brush = new SolidBrush(if dragging then palette.accent else palette.muted)
+ g.FillPath(brush,path)
+ Win32Helper.UpdateLayeredWindow(this.Handle,this.Location,bitmap,255uy)
+ member this.initialize() =
+ this.AccessibleName <- tr Strings.TabMenu.splitRatio
+ this.MouseEnter.Add(fun _ -> hovering <- true; this.render())
+ this.MouseLeave.Add(fun _ -> hovering <- false; this.render())
+ this.MouseDown.Add(fun e ->
+ if e.Button=MouseButtons.Left then
+ // First: the group parts this thread's input from the app's, which drops capture.
+ live true
+ dragging <- true
+ this.Capture <- true
+ this.render())
+ this.MouseMove.Add(fun _ ->
+ if dragging then
+ layout |> Option.iter(fun value ->
+ let ratio = SplitGeometry.ratioAt Cursor.Position.Pt gap frame value
+ // The bar follows the pointer itself; the panes follow as the group places them.
+ let bounds = this.band {value with ratio=ratio}
+ if this.Bounds<>bounds then
+ this.Bounds <- bounds
+ this.render()
+ // The panes go straight to the placement queue, which keeps only the newest
+ // request for a window; the group's own layout follows, one ratio at a time.
+ place ratio
+ pending <- Some ratio
+ this.sendRatio()))
+ this.MouseUp.Add(fun e ->
+ let wasDragging = dragging
+ dragging <- false
+ this.Capture <- false
+ if wasDragging then
+ // The last ratio goes at once, whatever is still on its way.
+ pending |> Option.filter((<>) lastSent) |> Option.iter(fun ratio -> execute(SetRatio(path,ratio)))
+ pending <- None
+ inFlight <- false
+ lastSent <- nan
+ live false
+ hovering <- this.ClientRectangle.Contains(this.PointToClient(Cursor.Position))
+ this.render()
+ if e.Button=MouseButtons.Right then this.showMenu())
+ this.DoubleClick.Add(fun _ -> execute(Equalize(Some path)))
+ /// The menu runs the chosen item from a timer after closing and disposes itself then.
+ member private this.showMenu() =
+ menu |> Option.iter(fun previous -> previous.Dispose())
+ let items = SplitMenu.ofSplit (layout |> Option.map(fun value -> value.axis) |> Option.defaultValue SideBySide) false (Some path) execute
+ if items.count>0 then
+ let created = new ThemedContextMenu(items,ignore)
+ menu <- Some created
+ let at = Cursor.Position
+ created.Show(this.Handle,at.X,at.Y)
+ override this.Dispose(disposing) =
+ if disposing then
+ menu |> Option.iter(fun current -> current.Dispose())
+ menu <- None
+ base.Dispose(disposing)
+ /// A band straddling the seam: the panes touch, so it lies over both of their edges.
+ member private this.band(value:SplitTree) =
+ let _,seam,_ = SplitGeometry.rectangles gap frame value
+ let band = Dpi.scale SplitMetrics.dividerGrab
+ if value.axis=SideBySide then Rectangle(seam.x+seam.width/2-band/2,seam.y,band,seam.height)
+ else Rectangle(seam.x,seam.y+seam.height/2-band/2,seam.width,band)
+
+ /// Sends the latest ratio once the one before has been placed, or after a while without word.
+ member private this.sendRatio() =
+ match pending with
+ | Some ratio when ratio=lastSent -> pending <- None
+ | Some ratio when not inFlight || sent.ElapsedMilliseconds>100L ->
+ pending <- None
+ lastSent <- ratio
+ inFlight <- true
+ sent.Restart()
+ execute(SetRatio(path,ratio))
+ | _ -> ()
+
+ /// Kept just below `below`, the strip: over both halves' edges, under the tabs. `splitFrame`
+ /// is the frame of this divider's own split, not the whole group's.
+ member this.update(at:PanePath, value:SplitTree, dividerGap:int, splitFrame:Rect, below:IntPtr, visible:bool, placePanes:float -> unit) =
+ layout <- Some value
+ path <- at
+ gap <- dividerGap
+ frame <- splitFrame
+ place <- placePanes
+ this.Cursor <- if value.axis=SideBySide then Cursors.VSplit else Cursors.HSplit
+ // While dragged the bar stays with the pointer, and the next ratio goes only once the
+ // group reports the one sent: it reports every placement, and taken as the word for any
+ // ratio, ratios went out at every pointer move, faster than the group took them, and
+ // queued up on its thread for hundreds of milliseconds.
+ let bounds = this.band value
+ if not dragging && this.Bounds<>bounds then this.Bounds <- bounds
+ if not dragging || value.ratio=lastSent then inFlight <- false
+ this.sendRatio()
+ if visible then
+ if not this.Visible then this.Show()
+ this.render()
+ let window = OS().windowFromHwnd(this.Handle)
+ if not dragging && below<>IntPtr.Zero && window.prevZorder.hwnd<>below then
+ window.insertAfter(below)
+ else
+ this.Hide()
+ drawn <- None
+
+type private PanePart = PaneClose | PanePick
+
+/// What an empty pane asks of its group.
+type EmptyPaneActions = {
+ /// Windows the drop-down offers: handle, tab name and program. Called on the pane's thread,
+ /// so it must not read the group's state; the pane leaves out the panes' own windows itself.
+ candidates: unit -> (IntPtr * string * string) list
+ choose: IntPtr -> unit
+ close: unit -> unit
+ /// Its edges dragged as a window's are: started, the pane's bounds as they go, ended.
+ resizeStarted: unit -> unit
+ resized: Rect -> unit
+ resizeEnded: unit -> unit
+}
+
+/// The pane that waits for a window: dropped on it, or chosen from the drop-down in its middle.
+/// Drops reach the group through drag targets; the rest through `actions`. Its edges size the
+/// split as a pane window's would.
+type EmptySplitPane(actions:EmptyPaneActions) =
+ inherit SplitChromeForm()
+ let candidates,choose,close = actions.candidates,actions.choose,actions.close
+ /// The panes' own windows, told with each update: the group's layout stays on its thread.
+ let mutable occupied : IntPtr list = []
+ let mutable menu : ThemedContextMenu option = None
+ let mutable hintFont : Font option = None
+ let mutable bodyFont : Font option = None
+ let mutable hovered : PanePart option = None
+ let mutable pressed : PanePart option = None
+ /// Inside Windows' sizing loop: the group must not move the pane under the pointer.
+ let mutable resizing = false
+ /// Shown once, opened out from the group's edge rather than appearing at once; later shows,
+ /// after a drag or a restore, come back as they are.
+ let mutable shownBefore = false
+ let mutable fade : Timer option = None
+ let fadeClock = Diagnostics.Stopwatch()
+ let revealMs = 220.0
+ /// Where the pane is going while it opens out; updates move the goal, not the pane.
+ let mutable goal = Rectangle()
+ member private this.reshape() =
+ if this.Width>0 && this.Height>0 then
+ use outline = MenuShape.outline this.Width this.Height
+ let previous = this.Region
+ this.Region <- new Region(outline)
+ if not(isNull previous) then previous.Dispose()
+ this.Invalidate()
+ /// Edges answer as a sizable window's do, so Windows runs the resize.
+ override this.WndProc(message:byref) =
+ base.WndProc(&message)
+ if message.Msg=0x84 && message.Result=IntPtr(1) then // WM_NCHITTEST over the client area
+ let value = message.LParam.ToInt64()
+ let pt = this.PointToClient(Point(int(int16(value &&& 0xFFFFL)),int(int16((value >>> 16) &&& 0xFFFFL))))
+ let edge = Dpi.scale 6
+ let left = pt.X < edge
+ let right = pt.X >= this.ClientSize.Width-edge
+ let top = pt.Y < edge
+ let bottom = pt.Y >= this.ClientSize.Height-edge
+ let code =
+ if top && left then 13 elif top && right then 14
+ elif bottom && left then 16 elif bottom && right then 17
+ elif left then 10 elif right then 11 elif top then 12 elif bottom then 15
+ else 1
+ message.Result <- IntPtr(code)
+ override this.OnResizeBegin(e) =
+ base.OnResizeBegin(e)
+ resizing <- true
+ actions.resizeStarted()
+ override this.OnResize(e) =
+ base.OnResize(e)
+ // The rounded outline is set once the drag ends: a new region at every step slowed it.
+ if resizing then actions.resized(Rect.fromRectangle this.Bounds)
+ else this.reshape()
+ override this.OnResizeEnd(e) =
+ base.OnResizeEnd(e)
+ resizing <- false
+ actions.resizeEnded()
+ this.reshape()
+ /// Windows 11's window border: measured beside Explorer in the dark theme, its light
+ /// counterpart, and the system's text colour in high contrast.
+ static member frameColor() =
+ if SystemInformation.HighContrast then SystemColors.WindowText
+ elif ThemeService.currentIsDark() then Color.FromArgb(60,62,65)
+ else Color.FromArgb(201,201,201)
+ member private this.closeBox =
+ let side = Dpi.scale 28
+ let inset = Dpi.scale 8
+ Rectangle(this.ClientSize.Width-inset-side,inset,side,side)
+ /// Two ways to fill the pane, one above the other: a dashed area to drop on, "or", and the
+ /// drop-down, as wide as the area and centred together.
+ member private this.choiceWidth = max (Dpi.scale 140) (min (Dpi.scale 320) (this.ClientSize.Width-2*Dpi.scale 24))
+ member private this.choiceTop =
+ let total = Dpi.scale 96+Dpi.scale 40+Dpi.scale 38
+ max (Dpi.scale 44) ((this.ClientSize.Height-total)/2)
+ member private this.dropBox =
+ Rectangle((this.ClientSize.Width-this.choiceWidth)/2,this.choiceTop,this.choiceWidth,Dpi.scale 96)
+ member private this.orBox =
+ let drop = this.dropBox
+ Rectangle(drop.X,drop.Bottom,drop.Width,Dpi.scale 40)
+ member private this.pickBox =
+ let rule = this.orBox
+ Rectangle(rule.X,rule.Bottom,rule.Width,Dpi.scale 38)
+ member private this.partAt(pt:Point) =
+ if this.closeBox.Contains(pt) then Some PaneClose
+ elif this.pickBox.Contains(pt) then Some PanePick
+ else None
+ member this.initialize() =
+ this.Text <- tr Strings.TabMenu.splitEmpty
+ this.AccessibleName <- this.Text
+ // The settings window's body size, scaled to the monitor as its fonts are.
+ let scale = float32(Dpi.value())/float32(Dpi.system())
+ let body = new Font("Segoe UI",10.5f*scale)
+ bodyFont <- Some body
+ this.Font <- body
+ hintFont <- Some(new Font("Segoe UI",13.0f*scale))
+ // Only the button whose state changed is drawn again.
+ let redraw part =
+ part |> Option.iter(fun part ->
+ let box = match part with PaneClose -> this.closeBox | PanePick -> this.pickBox
+ this.Invalidate(Rectangle.Inflate(box,2,2)))
+ this.MouseMove.Add(fun e ->
+ let part = this.partAt(e.Location)
+ if part<>hovered then
+ redraw hovered
+ redraw part
+ hovered <- part
+ this.Cursor <- if part.IsSome then Cursors.Hand else Cursors.Default)
+ this.MouseLeave.Add(fun _ ->
+ if hovered.IsSome then
+ redraw hovered
+ hovered <- None)
+ this.MouseDown.Add(fun e ->
+ if e.Button=MouseButtons.Left then
+ pressed <- this.partAt(e.Location)
+ redraw pressed)
+ this.MouseUp.Add(fun e ->
+ let part = pressed
+ pressed <- None
+ redraw part
+ if e.Button=MouseButtons.Left && part.IsSome && part=this.partAt(e.Location) then
+ match part with
+ | Some PaneClose -> close()
+ | Some PanePick -> this.showPicker()
+ | None -> ())
+ /// The settings window's drop-down with each window's icon; without it, or with nothing to
+ /// offer, a plain menu says so.
+ member private this.showPicker() =
+ let entries = candidates() |> List.filter(fun (hwnd,_,_) -> not(List.contains hwnd occupied))
+ let anchor = this.RectangleToScreen(this.pickBox)
+ match Services.tryGet() with
+ | Some picker when not entries.IsEmpty -> picker.show(this,anchor,entries,choose)
+ | _ ->
+ menu |> Option.iter(fun previous -> previous.Dispose())
+ let items =
+ if entries.IsEmpty then [CmiRegular({text=tr Strings.TabMenu.splitNoWindows;image=None;flags=List2([MenuFlags.MF_GRAYED]);click=ignore})]
+ else entries |> List.map(fun (hwnd,title,_) -> CmiRegular({text=title;image=None;flags=List2();click=fun () -> choose hwnd}))
+ let created = new ThemedContextMenu(List2(items),ignore)
+ menu <- Some created
+ created.Show(this.Handle,anchor.X,anchor.Bottom+Dpi.scale 4)
+ override this.OnPaint(e) =
+ base.OnPaint(e)
+ let palette = SettingsColors.current()
+ let g = e.Graphics
+ g.SmoothingMode <- Drawing2D.SmoothingMode.AntiAlias
+ // The one-pixel frame Windows draws round an app window, as next to Explorer.
+ use outline = MenuShape.outline (this.Width-1) (this.Height-1)
+ let state = g.Save()
+ g.TranslateTransform(0.5f,0.5f)
+ use pen = new Pen(EmptySplitPane.frameColor())
+ g.DrawPath(pen,outline)
+ g.Restore(state)
+ // The place to drop, dashed as a drop target is.
+ let drop = this.dropBox
+ use dropShape = MenuShape.outline drop.Width drop.Height
+ let state = g.Save()
+ g.TranslateTransform(float32 drop.X,float32 drop.Y)
+ use dashes = new Pen(palette.muted,float32(max 1 (Dpi.scale 1))*1.2f,DashPattern=[|4.0f;3.0f|])
+ g.DrawPath(dashes,dropShape)
+ g.Restore(state)
+ let font = hintFont |> Option.defaultValue this.Font
+ let gap = Dpi.scale 8
+ TextRenderer.DrawText(g,this.Text,font,Rectangle(drop.X+gap,drop.Y,drop.Width-2*gap,drop.Height),palette.text,
+ TextFormatFlags.HorizontalCenter ||| TextFormatFlags.VerticalCenter ||| TextFormatFlags.WordBreak ||| TextFormatFlags.NoPrefix)
+ // "or" between two short rules: either way fills the pane.
+ let rule = this.orBox
+ let word = tr Strings.TabMenu.splitOr
+ let wordWidth = TextRenderer.MeasureText(word,this.Font).Width
+ let middle = rule.Y+rule.Height/2
+ let length = max 0 ((rule.Width-wordWidth)/2-Dpi.scale 12)
+ use line = new Pen(palette.border)
+ g.DrawLine(line,rule.X,middle,rule.X+length,middle)
+ g.DrawLine(line,rule.Right-length,middle,rule.Right,middle)
+ TextRenderer.DrawText(g,word,this.Font,rule,palette.muted,
+ TextFormatFlags.HorizontalCenter ||| TextFormatFlags.VerticalCenter ||| TextFormatFlags.NoPrefix)
+ let pick = this.pickBox
+ let active = hovered=Some PanePick || pressed=Some PanePick
+ use box = MenuShape.outline pick.Width pick.Height
+ let state = g.Save()
+ g.TranslateTransform(float32 pick.X,float32 pick.Y)
+ use fill = new SolidBrush(if active then palette.hover else palette.background)
+ g.FillPath(fill,box)
+ use border = new Pen(if active then palette.muted else palette.border)
+ g.DrawPath(border,box)
+ g.Restore(state)
+ // A button: the title centred in the body font.
+ TextRenderer.DrawText(g,tr Strings.TabMenu.splitChoose,this.Font,pick,palette.text,
+ TextFormatFlags.HorizontalCenter ||| TextFormatFlags.VerticalCenter ||| TextFormatFlags.EndEllipsis ||| TextFormatFlags.NoPrefix)
+ // The close button, filled only under the pointer as a tab's is.
+ let closing = this.closeBox
+ if hovered=Some PaneClose || pressed=Some PaneClose then
+ use hover = new SolidBrush(palette.hover)
+ use shape = MenuShape.outline closing.Width closing.Height
+ let state = g.Save()
+ g.TranslateTransform(float32 closing.X,float32 closing.Y)
+ g.FillPath(hover,shape)
+ g.Restore(state)
+ let inset = float32 closing.Width*0.32f
+ use cross = new Pen(palette.text,float32(max 1 (Dpi.scale 1))*1.2f)
+ g.DrawLine(cross,float32 closing.X+inset,float32 closing.Y+inset,float32 closing.Right-inset,float32 closing.Bottom-inset)
+ g.DrawLine(cross,float32 closing.X+inset,float32 closing.Bottom-inset,float32 closing.Right-inset,float32 closing.Y+inset)
+ override this.Dispose(disposing) =
+ if disposing then
+ menu |> Option.iter(fun current -> current.Dispose())
+ menu <- None
+ fade |> Option.iter(fun timer -> timer.Dispose())
+ fade <- None
+ hintFont |> Option.iter(fun font -> font.Dispose())
+ hintFont <- None
+ bodyFont |> Option.iter(fun font -> font.Dispose())
+ bodyFont <- None
+ this.Region |> Option.ofObj |> Option.iter(fun region -> region.Dispose())
+ base.Dispose(disposing)
+ /// Kept just below `below`, the strip or the divider under it, so tabs shown inside the
+ /// title bars cover its top as they cover a window's.
+ /// Clear to solid with an ease-out, as Windows' own windows appear. Opaque again at the end,
+ /// so the pane is an ordinary window afterwards.
+ /// Opens out from `start`, a sliver at the group's edge, to the pane's place while it fades in,
+ /// with an ease-out. Opaque at the end, so the pane is an ordinary window afterwards.
+ member private this.reveal(start:Rectangle) =
+ this.Opacity <- 0.0
+ this.Bounds <- start
+ this.Show()
+ fadeClock.Restart()
+ let timer = new Timer(Interval=15)
+ let between (a:int) (b:int) (t:float) = a+int(Math.Round(float(b-a)*t))
+ timer.Tick.Add(fun _ ->
+ let t = min 1.0 (fadeClock.Elapsed.TotalMilliseconds/revealMs)
+ if t>=1.0 || this.IsDisposed then
+ timer.Stop()
+ timer.Dispose()
+ fade <- None
+ if not this.IsDisposed then
+ this.Bounds <- goal
+ this.Opacity <- 1.0
+ else
+ let eased = 1.0-(1.0-t)*(1.0-t)*(1.0-t)
+ let left,top = between start.Left goal.Left eased,between start.Top goal.Top eased
+ let right,bottom = between start.Right goal.Right eased,between start.Bottom goal.Bottom eased
+ this.Bounds <- Rectangle.FromLTRB(left,top,max (left+1) right,max (top+1) bottom)
+ this.Opacity <- eased)
+ fade <- Some timer
+ timer.Start()
+ /// `from`: where it opens out from the first time it shows, a sliver at the group's edge;
+ /// `panes`: the windows in the split, which its list leaves out.
+ member this.update(bounds:Rect, below:IntPtr, visible:bool, from:Rect option, panes:IntPtr list) =
+ occupied <- panes
+ let surface = (SettingsColors.current()).surface
+ if this.BackColor.ToArgb()<>surface.ToArgb() then this.BackColor <- surface
+ goal <- bounds.Rectangle
+ if not resizing && fade.IsNone && this.Bounds<>bounds.Rectangle then this.Bounds <- bounds.Rectangle
+ if visible then
+ if not this.Visible then
+ match from with
+ | Some start when not shownBefore && SystemInformation.UIEffectsEnabled -> this.reveal(start.Rectangle)
+ | _ -> this.Show()
+ shownBefore <- true
+ // Not while its own edges are dragged, nor under a strip put away for the drag:
+ // restacking the window being sized at every step stalled the drag.
+ let window = OS().windowFromHwnd(this.Handle)
+ if not resizing && below<>IntPtr.Zero && window.prevZorder.hwnd<>below then
+ window.insertAfter(below)
+ else this.Hide()
+
+/// Whether a window comes into the split, leaves it, or stays.
+type SplitFade = FadeIn | FadeOut | NoFade
+
+/// One window's way while a split changes, on screen: from where it is seen to its place, its
+/// visible frame `border` in from its outer one, fading in when it comes from outside the split
+/// and out when it leaves.
+type SplitMove = { hwnd:IntPtr; from:Rect; target:Rect; fade:SplitFade; border:Pt; borderSize:Sz }
+
+/// A split changing moves its windows smoothly rather than at once: over the group, live images
+/// of them (DWM thumbnails) go from where they were to their places with an ease-out, while the
+/// windows themselves are placed underneath. Moved step by step instead, apps laid themselves
+/// out again at every step, and slow ones jerked. Each image shows its window 1:1 from the top
+/// left, cut to its rectangle, so nothing is stretched; where a window is smaller than its
+/// rectangle for a moment, the theme's surface shows, as behind the panes. It closes once the
+/// group says the windows are in place, or after a while.
+/// `durationMs`: how long the images take, `DurationMs` unless given; a tab clicked over the
+/// panes switches in a fraction of that (`ClickMs`), as it felt slow at the full length. With
+/// no time at all the images stand at their places from the first frame, the ones leaving kept
+/// under the rest, so the cover only hides the windows being placed.
+/// `crossFade`: the whole cover, images and all, fades out over the windows underneath and
+/// goes on its own: for a plain switch between tabs, the window shown fades into the one
+/// coming up, so an app that paints its background first when uncovered shows no blank.
+type SplitTransition(frame:Rect, moves:SplitMove list, ?durationMs:int, ?crossFade:bool, ?strip:IntPtr) =
+ inherit SplitChromeForm()
+ let durationMs = float(defaultArg durationMs SplitTransition.DurationMs)
+ let crossFade = defaultArg crossFade false
+ let instant = durationMs<=0.0
+ /// How long the last step waits for the windows to be in place.
+ let holdMs = 600.0
+ let clock = Diagnostics.Stopwatch()
+ let mutable thumbs : (SplitMove * IntPtr) list = []
+ let mutable timer : Timer option = None
+ let mutable settled = false
+ let mutable closing = false
+ let mutable closed = false
+ let mutable viewport = frame.Rectangle
+ override _.CreateParams =
+ let cp = base.CreateParams
+ // Over the apps for its moment; the pointer goes through to them.
+ cp.ExStyle <- cp.ExStyle ||| WindowsExtendedStyles.WS_EX_TOPMOST ||| WindowsExtendedStyles.WS_EX_TRANSPARENT
+ cp
+ member private this.place(t:float) =
+ // Keep both the cover HWND and its DWM destinations outside the live tabs.
+ strip |> Option.iter(fun hwnd ->
+ let bounds =
+ if WinUserApi.IsWindow hwnd && WinUserApi.IsWindowVisible hwnd then
+ let bounds = OS().windowFromHwnd(hwnd).bounds.Rectangle
+ Rectangle.Intersect(frame.Rectangle,bounds)
+ else Rectangle.Empty
+ let next = SplitTransition.contentBounds(frame.Rectangle,bounds)
+ if viewport<>next then
+ viewport <- next
+ this.Bounds <- viewport)
+ let eased = 1.0-(1.0-t)*(1.0-t)*(1.0-t)
+ // Layered still at the end, so a click goes through to the last.
+ if crossFade then this.Opacity <- max 0.01 (0.999*(1.0-eased))
+ let between (a:int) (b:int) = a+int(Math.Round(float(b-a)*eased))
+ for move,thumb in thumbs do
+ let left,top = between move.from.left move.target.left,between move.from.top move.target.top
+ let right,bottom = between move.from.right move.target.right,between move.from.bottom move.target.bottom
+ // Never more of the window than it has: its visible size now.
+ let source = OS().windowFromHwnd(move.hwnd).bounds
+ let width = max 0 (min (right-left) (source.width-move.borderSize.width))
+ let height = max 0 (min (bottom-top) (source.height-move.borderSize.height))
+ let shown = Rectangle.Intersect(viewport,Rectangle(left,top,width,height))
+ let mutable props = DWM_THUMBNAIL_PROPERTIES()
+ props.dwFlags <- DWM_THUMBNAIL_PROPERTY_FLAGS.DWM_TNP_RECTDESTINATION ||| DWM_THUMBNAIL_PROPERTY_FLAGS.DWM_TNP_RECTSOURCE |||
+ DWM_THUMBNAIL_PROPERTY_FLAGS.DWM_TNP_OPACITY ||| DWM_THUMBNAIL_PROPERTY_FLAGS.DWM_TNP_VISIBLE
+ props.rcDestination <- RECT.FromRectangle(Rectangle(shown.X-viewport.X,shown.Y-viewport.Y,shown.Width,shown.Height))
+ props.rcSource <- RECT.FromRectangle(Rectangle(move.border.x+shown.X-left,move.border.y+shown.Y-top,shown.Width,shown.Height))
+ props.opacity <-
+ match move.fade with
+ | _ when instant -> 255uy
+ | FadeIn -> byte(Math.Round(255.0*eased))
+ | FadeOut -> byte(Math.Round(255.0*(1.0-eased)))
+ | NoFade -> 255uy
+ props.fVisible <- if shown.Width>0 && shown.Height>0 then 1 else 0
+ DwmApi.DwmUpdateThumbnailProperties(thumb,&props) |> ignore
+ /// A rectangular content viewport keeps DWM thumbnails out of the strip's whole edge.
+ static member contentBounds(frame:Rectangle, strip:Rectangle) =
+ let overlap = Rectangle.Intersect(frame,strip)
+ if overlap.Width<=0 || overlap.Height<=0 then frame
+ else
+ [ Rectangle.FromLTRB(frame.Left,overlap.Bottom,frame.Right,frame.Bottom)
+ Rectangle.FromLTRB(overlap.Right,frame.Top,frame.Right,frame.Bottom)
+ Rectangle.FromLTRB(frame.Left,frame.Top,overlap.Left,frame.Bottom)
+ Rectangle.FromLTRB(frame.Left,frame.Top,frame.Right,overlap.Top) ]
+ |> List.maxBy(fun bounds -> int64 bounds.Width*int64 bounds.Height)
+ /// How long the images take to move, in milliseconds.
+ static member DurationMs = 220
+ /// For a tab clicked over the panes, or a pane's tab clicked to bring them back: no steps.
+ static member ClickMs = 0
+ /// For a plain switch between tabs: how long the window shown takes to fade into the next.
+ static member CrossFadeMs = 120
+ /// How long the images stay once the windows are placed: an app paints its new size a
+ /// moment after it is given, and the cover gone before that showed the window half painted.
+ static member HoldAfterMs = 80
+ /// Shown with every image at its start, so the first frame looks as the windows did. False
+ /// when there was nothing to show.
+ member this.start() : bool =
+ this.BackColor <- (SettingsColors.current()).surface
+ // Layered, as a click goes through only a layered window: all but opaque.
+ this.Opacity <- 0.999
+ this.Bounds <- frame.Rectangle
+ // Registered later, an image draws over those before: the ones leaving go under, the
+ // ones coming in over the rest.
+ let order move = match move.fade with FadeOut -> 0 | NoFade -> 1 | FadeIn -> 2
+ thumbs <- moves |> List.sortBy order |> List.choose(fun move ->
+ let mutable thumb = IntPtr.Zero
+ if DwmApi.DwmRegisterThumbnail(this.Handle,move.hwnd,&thumb)=0 then Some(move,thumb) else None)
+ // Without an image of every window that stays, as with no desktop composition, there is
+ // nothing to move: the windows are placed as they always were, with no blank cover over
+ // them. One leaving can go without its fade.
+ let shown move = thumbs |> List.exists(fun (each,_) -> each.hwnd=move.hwnd)
+ if moves |> List.exists(fun move -> move.fade<>FadeOut && not(shown move)) then
+ this.close()
+ false
+ else
+ this.place 0.0
+ this.Show()
+ clock.Restart()
+ let tick = new Timer(Interval=15)
+ tick.Tick.Add(fun _ ->
+ let elapsed = clock.Elapsed.TotalMilliseconds
+ if elapsed=durationMs+holdMs then this.close())
+ timer <- Some tick
+ tick.Start()
+ true
+ /// The windows are in place: it closes once its own steps are done, and a moment more.
+ member this.settle() =
+ settled <- true
+ if not closed && clock.Elapsed.TotalMilliseconds>=durationMs then this.closeSoon()
+ /// The images are live, so staying a moment over windows already placed shows nothing;
+ /// going at once showed a window not yet painted at its new size.
+ member private this.closeSoon() =
+ if not closed && not closing then
+ closing <- true
+ let wait = new Timer(Interval=SplitTransition.HoldAfterMs)
+ wait.Tick.Add(fun _ ->
+ wait.Stop()
+ wait.Dispose()
+ this.close())
+ wait.Start()
+ member this.close() =
+ if not closed then
+ closed <- true
+ timer |> Option.iter(fun tick -> tick.Stop(); tick.Dispose())
+ timer <- None
+ for _,thumb in thumbs do DwmApi.DwmUnregisterThumbnail(thumb) |> ignore
+ thumbs <- []
+ this.Hide()
+ // Not inside its own timer's tick.
+ this.BeginInvoke(Action(fun () -> this.Dispose())) |> ignore
+
+/// A plain window the colour of the theme's surface, behind every pane and over the tabs behind
+/// them. An app that paints less than its frame, with a clear resize margin inside it as
+/// frameless Electron windows have, or one still catching up with a new size, shows this at
+/// the seam rather than whatever waits behind the panes.
+type SplitBackdrop() =
+ inherit SplitChromeForm()
+ member this.update(bounds:Rect, below:IntPtr, visible:bool) =
+ let surface = (SettingsColors.current()).surface
+ if this.BackColor.ToArgb()<>surface.ToArgb() then this.BackColor <- surface
+ if this.Bounds<>bounds.Rectangle then this.Bounds <- bounds.Rectangle
+ if visible then
+ if not this.Visible then this.Show()
+ let window = OS().windowFromHwnd(this.Handle)
+ if below<>IntPtr.Zero && window.prevZorder.hwnd<>below then window.insertAfter(below)
+ else this.Hide()
diff --git a/WtProgram/TabSearch.fs b/WtProgram/TabSearch.fs
index e097ce03..b0991aff 100644
--- a/WtProgram/TabSearch.fs
+++ b/WtProgram/TabSearch.fs
@@ -162,11 +162,20 @@ module private TabSearchNative =
/// switches. It remembers the chosen scope; Tab, or clicking the line under the box,
/// switches between the group and all windows. Esc or clicking
/// elsewhere closes it. Used once, then disposed.
-type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISettings) =
+/// pick: what a chosen window is for, switching to it unless given; within: an area on screen to
+/// open over instead of high on the active screen; prompt: the hint in the empty box; rows and
+/// width: how many rows show and how wide it is, in logical pixels.
+type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISettings,
+ ?pick:IntPtr -> unit, ?within:Rectangle, ?prompt:string, ?rows:int, ?width:int) =
let rowHeight = 44
- let visibleRows = 9
+ let visibleRows = defaultArg rows 9
let palette = SettingsColors.current()
- let area = Screen.FromHandle(WinUserApi.GetForegroundWindow()).WorkingArea
+ let prompt = defaultArg prompt (tr Strings.TabSearch.prompt)
+ let pick = defaultArg pick (fun hwnd -> OS().windowFromHwnd(hwnd).setForegroundOrRestore(false))
+ let area =
+ match within with
+ | Some box -> Screen.FromRectangle(box).WorkingArea
+ | None -> Screen.FromHandle(WinUserApi.GetForegroundWindow()).WorkingArea
let padding = Dpi.scale 12
let radius = Dpi.scale 12
let boxHeight = Dpi.scale 40
@@ -192,7 +201,7 @@ type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISetti
let scoped() = match scope with GroupTabs -> groupItems | AllTabs -> items
let input = new TextBox(Font=SettingsUi.bodyFont(),BorderStyle=BorderStyle.None,Tag="search-input",
BackColor=palette.surface,ForeColor=palette.text,
- AccessibleName=tr Strings.TabSearch.prompt)
+ AccessibleName=prompt)
let searchBox = new SettingsSearchBox(input,Dock=DockStyle.Top,Height=boxHeight)
/// Smaller than the segments' text, as key caps are.
let keyFont = SettingsUi.font "Segoe UI" 8.5f FontStyle.Regular
@@ -280,7 +289,7 @@ type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISetti
e.Graphics.DrawPath(border,outline) }
// One size whatever is typed, so the box does not jump about while filtering.
let rows = max 1 (min visibleRows items.Length)
- let size = Size(min (Dpi.scale 640) (area.Width-Dpi.scale 32),padding*2+boxHeight+scopeHeight+rows*Dpi.scale rowHeight)
+ let size = Size(min (Dpi.scale (defaultArg width 640)) (area.Width-Dpi.scale 32),padding*2+boxHeight+scopeHeight+rows*Dpi.scale rowHeight)
f.AutoScaleMode <- AutoScaleMode.None
f.FormBorderStyle <- FormBorderStyle.None
f.ShowInTaskbar <- false
@@ -291,8 +300,14 @@ type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISetti
f.ForeColor <- palette.text
f.Padding <- Padding(padding)
f.ClientSize <- size
- // High on the screen, where a search box is expected, rather than centred.
- f.Location <- Point(area.Left+(area.Width-size.Width)/2,area.Top+area.Height/5)
+ // High on the screen, where a search box is expected, rather than centred; or centred
+ // over the area it was opened for, kept on the screen.
+ f.Location <-
+ match within with
+ | Some box ->
+ Point(max area.Left (min (area.Right-size.Width) (box.X+(box.Width-size.Width)/2)),
+ max area.Top (min (area.Bottom-size.Height) (box.Y+(box.Height-size.Height)/2)))
+ | None -> Point(area.Left+(area.Width-size.Width)/2,area.Top+area.Height/5)
// Docking runs from the last added: the box on top, then the scope, then the results.
f.Controls.Add(list)
f.Controls.Add(empty)
@@ -332,7 +347,7 @@ type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISetti
if not closed then
closed <- true
items |> Array.tryFind(fun (item,_) -> obj.ReferenceEquals(item,target))
- |> Option.iter(fun (_,entry) -> OS().windowFromHwnd(entry.hwnd).setForegroundOrRestore(false))
+ |> Option.iter(fun (_,entry) -> pick entry.hwnd)
shadow |> Option.iter(fun item -> (item :> IDisposable).Dispose())
shadow <- None
form.Hide()
@@ -356,7 +371,7 @@ type TabSearchForm(tabs:TabSearchEntry list, group:IntPtr list, ?settings:ISetti
list.SelectedItem <- shown.[max 0 (min (shown.Count-1) (current+delta))]
do
input.HandleCreated.Add(fun _ ->
- TabSearchNative.SendMessage(input.Handle,TabSearchNative.EM_SETCUEBANNER,IntPtr(1),tr Strings.TabSearch.prompt) |> ignore)
+ TabSearchNative.SendMessage(input.Handle,TabSearchNative.EM_SETCUEBANNER,IntPtr(1),prompt) |> ignore)
input.TextChanged.Add(fun _ -> apply())
// Tab would otherwise move the focus; here it switches between the group and all tabs.
input.PreviewKeyDown.Add(fun e -> if e.KeyCode=Keys.Tab then e.IsInputKey <- true)
diff --git a/WtProgram/TabStrip.fs b/WtProgram/TabStrip.fs
index 6b6d5ce6..b4c62174 100755
--- a/WtProgram/TabStrip.fs
+++ b/WtProgram/TabStrip.fs
@@ -26,7 +26,7 @@ type TabStrip(monitor:ITabStripMonitor) as this =
let foregroundCell = Cell.create(None:Tab option)
let prevForegroundCell = Cell.create(None)
let sizeCell = Bemo.Cell(Cell, Sz.empty, (=))
- let dimmedCell = Cell.create(false)
+ let dimmedCell = Bemo.Cell(Cell, false, (=))
// Position is presentation state, not an input to pixel rendering.
let mutable location = Pt.empty
let mutable renderedFrames = 0L
@@ -180,6 +180,7 @@ type TabStrip(monitor:ITabStripMonitor) as this =
numberBadge = if numberBadgesCell.value then lorderCell.value.list |> List.tryFindIndex ((=) tab) |> Option.filter(fun i -> i Option.map(fun i -> string numberBadgeKeysCell.value.[i]) else None
bgColor = tabBgColor.value.tryFind(tab)
TabDisplayInfo.text = ti.text
+ splitTrail = ti.splitTrail
icon = ti.iconSmall
textFont = if ti.isRenamed then renamedFont else normalFont
textBrush = SystemBrushes.MenuText
@@ -384,7 +385,7 @@ type TabStrip(monitor:ITabStripMonitor) as this =
// Used by native performance/regression hosts to verify that unchanged
// hover and movement do not regenerate pixels; not a user-facing setting.
member internal _.renderCount = renderedFrames
-
+
member private this.update() =
if not this.visible then this.hideTitle()
let target = if this.isShrunk then 0.0 else 1.0
@@ -714,6 +715,7 @@ type TabStrip(monitor:ITabStripMonitor) as this =
tabInfoCell.value.tryFind(tab).def({
text = ""
isRenamed = false
+ splitTrail = None
iconSmall = System.Drawing.SystemIcons.Application
iconBig = System.Drawing.SystemIcons.Application
preview = fun() -> Img(Sz(1,1))
@@ -726,22 +728,71 @@ type TabStrip(monitor:ITabStripMonitor) as this =
member this.tabLocation = this.ts.tabLocation
- /// The window capture is full size; release it here rather than waiting for the GC.
- member this.dragImage (tab:Tab) : Img=
- if this.isVertical then this.ts.renderTab(tab) else this.horizontalDragImage(tab)
-
- member private this.horizontalDragImage (tab:Tab) : Img=
- use bmpTab = this.tsBase(TabUp).renderTab(tab).bitmap
- use bmpHwnd = this.tabInfo(tab).preview().bitmap
- let bmpOverlay = Img(Sz(bmpHwnd.Width, bmpHwnd.Height + bmpTab.Height - this.contentOffset))
- try
- use gCapture = bmpOverlay.graphics
- gCapture.DrawImage(bmpTab, Point.Empty)
- gCapture.DrawImage(bmpHwnd, new Point(0, this.size.height - this.contentOffset))
- bmpOverlay
- with _ ->
- bmpOverlay.bitmap.Dispose()
- reraise()
+ /// The window capture is full size; release it here rather than waiting for the GC. The
+ /// window is drawn at `DragImage.windowScale` of the size it lands at on the desktop, the tab
+ /// at full size at `tabX` over it, where the strip will put it.
+ /// The window's picture takes a while to print, so the image comes back with the tab alone
+ /// and `later` gets the whole picture, the same size, from another thread a moment after:
+ /// printed first, a large window held the drag at its start.
+ member this.dragImage (tab:Tab, tabX:int, landing:Sz, later:Img -> unit) : Img=
+ if this.isVertical then this.ts.renderTab(tab) else this.horizontalDragImage tab tabX landing later
+
+ /// Where the tab sits over the window shown small in the drag image, as the strip's alignment
+ /// places a lone tab over that width. Scaled with the window from where it sits over the
+ /// full width, a tab drawn at full size sat off the middle.
+ member this.dragTabX(tab:Tab, landing:Sz) =
+ let tabWidth = this.tabSprites.tryFind(fun (_,sprite) -> sprite.id=tab) |> Option.map(fun (_,sprite) -> sprite.size.width) |> Option.defaultValue 0
+ let width = int(float landing.width*DragImage.windowScale)
+ if this.isVertical then 0
+ else
+ let x =
+ match this.getAlignment TabUp with
+ | TabCenter -> (width-tabWidth)/2
+ | TabRight -> width-tabWidth-int(60.0*DragImage.windowScale)
+ | TabLeft -> 0
+ max 0 (min x (width-tabWidth))
+
+ /// How a lone tab sits over its window once dropped: vertical strips keep it at the start.
+ member this.dragAlignment = if this.isVertical then TabLeft else this.getAlignment TabUp
+
+ member private this.horizontalDragImage (tab:Tab) (tabX:int) (landing:Sz) (later:Img -> unit) : Img=
+ let bmpTab = this.tsBase(TabUp).renderTab(tab).bitmap
+ let top = bmpTab.Height - this.contentOffset
+ let scaled value = max 1 (int(float value*DragImage.windowScale))
+ let compose (bmpHwnd:Bitmap option) =
+ let width = scaled (if landing.width>0 then landing.width else bmpHwnd |> Option.map(fun b -> b.Width) |> Option.defaultValue 1)
+ let height = scaled (if landing.height>0 then landing.height else bmpHwnd |> Option.map(fun b -> b.Height) |> Option.defaultValue 1)
+ let bmpOverlay = Img(Sz(max width (tabX+bmpTab.Width), height + top))
+ try
+ use gCapture = bmpOverlay.graphics
+ gCapture.InterpolationMode <- Drawing2D.InterpolationMode.HighQualityBilinear
+ bmpHwnd |> Option.iter(fun bmpHwnd ->
+ use fade = new Imaging.ImageAttributes()
+ fade.SetColorMatrix(Imaging.ColorMatrix(Matrix33=DragImage.windowOpacity))
+ gCapture.DrawImage(bmpHwnd, Rectangle(0, top, width, height), 0, 0, bmpHwnd.Width, bmpHwnd.Height, GraphicsUnit.Pixel, fade))
+ gCapture.DrawImage(bmpTab, Point(tabX, 0))
+ bmpOverlay
+ with _ ->
+ bmpOverlay.bitmap.Dispose()
+ reraise()
+ let (Tab hwnd) = tab
+ let preview = this.tabInfo(tab).preview
+ // A minimized window's picture is its icon, drawn from the strip's own state: here.
+ if _os.windowFromHwnd(hwnd).isMinimized || landing.width<=0 || landing.height<=0 then
+ try
+ use bmpHwnd = preview().bitmap
+ compose (Some bmpHwnd)
+ finally bmpTab.Dispose()
+ else
+ let first = compose None
+ Threading.ThreadPool.QueueUserWorkItem(fun _ ->
+ try
+ try
+ use bmpHwnd = preview().bitmap
+ later (compose (Some bmpHwnd))
+ with _ -> ()
+ finally bmpTab.Dispose()) |> ignore
+ first
member this.setTabBgColor((tab, color)) =
if tabBgColor.value.tryFind(tab) <> color then
diff --git a/WtProgram/TabStripDecorator.fs b/WtProgram/TabStripDecorator.fs
index 6deec3cf..8dcb2696 100755
--- a/WtProgram/TabStripDecorator.fs
+++ b/WtProgram/TabStripDecorator.fs
@@ -5,6 +5,99 @@ open System.Windows.Forms
open System.Diagnostics
open Bemo.Win32.Forms
+/// Where a dragged tab would go: a clear tint over that place, its edge drawn. Per-pixel
+/// layered, so the tint is see-through; the pointer passes through it to the window beneath.
+/// It fades in, glides to a new place as the aim moves, and fades out, rather than jumping.
+type private LayoutPreview() =
+ inherit Form(FormBorderStyle=FormBorderStyle.None,ShowInTaskbar=false,StartPosition=FormStartPosition.Manual)
+ /// How long a fade or a glide takes, in milliseconds.
+ let durationMs = 120.0
+ let clock = Stopwatch()
+ let ticker = new Timer(Interval=15)
+ /// Where it is drawn and how opaque; where it goes and how opaque it ends, and from where.
+ let mutable shown,alpha = Rectangle.Empty,0.0
+ let mutable fromRect,fromAlpha = Rectangle.Empty,0.0
+ let mutable toRect,toAlpha = Rectangle.Empty,0.0
+ let mutable drawn : (Rectangle * byte) option = None
+ let mutable ticking = false
+ /// The picture, drawn once per size: drawn again at every frame of the fade, a pane's worth
+ /// of pixels held up the strip's thread, and the drag with it, as the preview came on.
+ let surface = new LayeredSurface()
+ override _.ShowWithoutActivation = true
+ override _.CreateParams =
+ let cp = base.CreateParams
+ cp.ExStyle <- cp.ExStyle ||| 0x08000000 ||| 0x80 ||| 0x20 ||| WindowsExtendedStyles.WS_EX_LAYERED
+ cp
+ member private this.draw() =
+ let opacity = byte(Math.Round(255.0*alpha))
+ if alpha<=0.0 then
+ ticker.Stop()
+ drawn <- None
+ this.Hide()
+ elif drawn<>Some(shown,opacity) && shown.Width>0 && shown.Height>0 then
+ drawn <- Some(shown,opacity)
+ if surface.Size<>shown.Size then
+ let accent = SettingsColors.current().accent
+ use bitmap = new Bitmap(shown.Width,shown.Height,Imaging.PixelFormat.Format32bppArgb)
+ use g = Graphics.FromImage(bitmap)
+ use tint = new SolidBrush(Color.FromArgb(70,int accent.R,int accent.G,int accent.B))
+ g.FillRectangle(tint,0,0,shown.Width,shown.Height)
+ let edge = max 2 (Dpi.scale 2)
+ use pen = new Pen(Color.FromArgb(230,int accent.R,int accent.G,int accent.B),float32 edge)
+ g.DrawRectangle(pen,float32 edge/2.0f,float32 edge/2.0f,float32(shown.Width-edge),float32(shown.Height-edge))
+ surface.Render bitmap
+ surface.Update(this.Handle,shown.Location,opacity)
+ member private this.step() =
+ let t = min 1.0 (clock.Elapsed.TotalMilliseconds/durationMs)
+ let eased = 1.0-(1.0-t)*(1.0-t)*(1.0-t)
+ let between (a:int) (b:int) = a+int(Math.Round(float(b-a)*eased))
+ shown <- Rectangle.FromLTRB(between fromRect.Left toRect.Left,between fromRect.Top toRect.Top,
+ between fromRect.Right toRect.Right,between fromRect.Bottom toRect.Bottom)
+ alpha <- fromAlpha+(toAlpha-fromAlpha)*eased
+ if t>=1.0 then ticker.Stop()
+ this.draw()
+ /// From where it is now to `target` at `opacity`; at once without the system's animations.
+ member private this.animate(target:Rectangle, opacity:float) =
+ if target<>toRect || opacity<>toAlpha then
+ fromRect <- shown
+ fromAlpha <- alpha
+ toRect <- target
+ toAlpha <- opacity
+ if SystemInformation.UIEffectsEnabled then
+ // Hooked up here: a handler naming the form from its constructor made every
+ // member check it was built, those the base constructor calls among them.
+ if not ticking then
+ ticking <- true
+ ticker.Tick.Add(fun _ -> this.step())
+ clock.Restart()
+ ticker.Start()
+ this.step()
+ else
+ shown <- target
+ alpha <- opacity
+ this.draw()
+ /// Shows the place: from nothing it fades in there; shown elsewhere, it glides over.
+ member this.showAt(bounds:Rectangle, owner:IWin32Window) =
+ if not this.Visible then
+ shown <- bounds
+ alpha <- 0.0
+ toAlpha <- 0.0
+ drawn <- None
+ this.Bounds <- bounds
+ this.Show(owner)
+ this.animate(bounds,1.0)
+ /// Fades out where it is.
+ member this.fadeOut() =
+ if this.Visible then this.animate(shown,0.0)
+ /// Makes the window ahead of its first show, as a drag begins, so the first place offered
+ /// comes on without the pause of creating it.
+ member this.prepare() = this.Handle |> ignore
+ override this.Dispose(disposing) =
+ if disposing then
+ ticker.Dispose()
+ surface.Dispose()
+ base.Dispose(disposing)
+
type TabStripDecorator(group:WindowGroup) as this =
let os = OS()
let Cell = CellScope(false, true)
@@ -17,6 +110,16 @@ type TabStripDecorator(group:WindowGroup) as this =
let mouseEvent = Event<_>()
let _ts = TabStrip(this :> ITabStripMonitor)
let mutable contextMenu : ThemedContextMenu option = None
+ let mutable layoutPreview : LayoutPreview option = None
+ /// The pane the pointer is over during a drag, as the last preview found it.
+ let mutable layoutDrop : LayoutDrop option = None
+ /// The tab on top when a drag began here, its tab and where in the strip it sat.
+ let mutable dragPartner = IntPtr.Zero
+ let mutable dragSource : IntPtr option = None
+ let mutable dragStartIndex : int option = None
+ /// Whether the press that began the drag parked the panes: shown before it, they come back
+ /// as the tab leaves; parked earlier, the tab shown before the dragged one comes back instead.
+ let mutable dragParked = false
do this.init()
@@ -27,9 +130,24 @@ type TabStripDecorator(group:WindowGroup) as this =
group.init(this.ts)
Services.dragDrop.registerTarget(this.ts.hwnd, this:>IDragDropTarget)
-
+ // The group's windows, and the helper windows the strip owns, are its drop surface.
+ Services.dragDrop.registerLayoutTarget(this.ts.hwnd, this:>ILayoutDropTarget)
+ group.windows.items.iter(fun hwnd -> Services.dragDrop.registerLayoutTarget(hwnd, this:>ILayoutDropTarget))
+ group.added.Add(fun hwnd -> Services.dragDrop.registerLayoutTarget(hwnd, this:>ILayoutDropTarget))
+ group.removed.Add(fun hwnd -> Services.dragDrop.unregisterLayoutTarget(hwnd, this:>ILayoutDropTarget))
+ // The empty pane is owned by nothing, so it is found by its own window.
+ // A shortcut's window list, beside the tab in front, as the tab menu's.
+ group.pickRequested.Add(fun (axis,side) ->
+ let top = group.topWindow
+ this.pickBeside(top,group.splitCandidates top,axis,side))
+ group.emptyPaneChanged.Add(fun (previous,current) ->
+ if previous<>IntPtr.Zero then Services.dragDrop.unregisterLayoutTarget(previous, this:>ILayoutDropTarget)
+ if current<>IntPtr.Zero then Services.dragDrop.registerLayoutTarget(current, this:>ILayoutDropTarget))
+
dropTarget.set(Some(new OleDropTarget(this.ts)))
this.ts.destroying.Add(fun () ->
+ layoutPreview |> Option.iter(fun window -> window.Dispose())
+ layoutPreview <- None
dropTarget.value.iter(fun target -> (target :> IDisposable).Dispose())
dropTarget.set(None))
@@ -98,6 +216,10 @@ type TabStripDecorator(group:WindowGroup) as this =
widthSubscription.Dispose()
geometrySubscription.Dispose()
Services.dragDrop.unregisterTarget(this.ts.hwnd)
+ let unregister hwnd = Services.dragDrop.unregisterLayoutTarget(hwnd, this:>ILayoutDropTarget)
+ unregister this.ts.hwnd
+ group.windows.items.iter unregister
+ group.emptyPaneHwnds |> List.iter unregister
member private this.tabSlide =
@@ -115,6 +237,8 @@ type TabStripDecorator(group:WindowGroup) as this =
else
this.ts.setPlacement(this.placement)
this.ts.visible <- true
+ // An empty pane keeps clear of tabs shown inside the title bars, wherever they now are.
+ group.refreshSplitChrome()
member private this.invokeAsync f = group.invokeAsync f
member private this.invokeSync f = group.invokeSync f
@@ -238,6 +362,39 @@ type TabStripDecorator(group:WindowGroup) as this =
this.sortedTabs() |> List.iteri(fun index hwnd ->
if group.lorder.list.[index]<>hwnd then this.ts.moveTab(Tab(hwnd),index))
+ /// The split's menu, from the button between its two tabs.
+ /// The menu of the split a seam button stands for, the one parting its tab from the pane tab
+ /// before it; without a button, the focused pane's split.
+ /// The window list over the group; the window picked goes on `side` of the tab `beside`.
+ member private this.pickBeside(beside:IntPtr, entries, axis:SplitAxis, side:Side) =
+ match Services.tryGet() with
+ | Some picker when not(List.isEmpty entries) ->
+ picker.showWithin(group.layoutFrame.Rectangle,entries,fun chosen -> group.placeBeside(beside,chosen,axis,side))
+ | Some _ -> Alert.show AlertKind.Info (tr Strings.TabMenu.split) (tr Strings.TabMenu.splitNoWindows)
+ | None -> ()
+
+ member private this.showSplitMenu(ptScreen:Pt, button:IntPtr option) =
+ let execute command = group.execute command
+ let items =
+ let parting =
+ button |> Option.bind(fun owner ->
+ SplitView.layoutOf group.layout |> Option.bind(fun layout ->
+ let panes = group.lorder.list |> List.filter(fun hwnd -> SplitView.contains hwnd layout)
+ List.tryFindIndex ((=) owner) panes |> Option.filter(fun index -> index>0)
+ |> Option.bind(fun index -> SplitView.commonSplit panes.[index-1] owner layout)))
+ match parting with
+ | Some(path,axis) -> SplitMenu.ofSplit axis (match group.layout with Parked _ -> true | _ -> false) (Some path) execute
+ | None -> SplitMenu.items group.layout execute
+ if items.count>0 then
+ contextMenu |> Option.iter(fun menu -> menu.Dispose())
+ group.bb.write("contextMenuVisible", true)
+ let menuClosed () =
+ this.ts.refreshHover()
+ group.bb.write("contextMenuVisible", false)
+ let menu = new ThemedContextMenu(items,menuClosed,group.windows.contains)
+ contextMenu <- Some menu
+ menu.Show(this.ts.hwnd,ptScreen.x,ptScreen.y)
+
member private this.contextMenu(hwnd,images:ResizeArray![]()
) =
let checkedFlag(isChecked) = if isChecked then List2([MenuFlags.MF_CHECKED]) else List2()
let grayed(isGrayed) = if isGrayed then List2([MenuFlags.MF_GRAYED]) else List2()
@@ -317,6 +474,25 @@ type TabStripDecorator(group:WindowGroup) as this =
flags = grayed(this.sortedTabs() = group.lorder.list)
})
+ let top = group.topWindow
+ // A window is chosen first and goes straight beside the clicked tab, so no empty pane
+ // waits for one: the list opens over the group, and Esc leaves things as they were.
+ let candidates = lazy(group.splitCandidates hwnd)
+ let pickItem text axis side =
+ CmiRegular({text=tr text;image=None;flags=List2();click=fun () -> this.pickBeside(hwnd,candidates.Force(),axis,side)})
+ // In a split, the same commands as a divider's menu, the direction switched by one item
+ // as there; with none, they would all be greyed out, so they are left out.
+ let splitItems = SplitMenu.items group.layout (fun command -> group.execute(command,current=top))
+ let splitMenu = CmiPopUp({text=tr Strings.TabMenu.split;image=None;items=List2([
+ yield pickItem Strings.TabMenu.splitPickRight SideBySide Second
+ yield pickItem Strings.TabMenu.splitPickLeft SideBySide First
+ yield pickItem Strings.TabMenu.splitPickAbove Stacked First
+ yield pickItem Strings.TabMenu.splitPickBelow Stacked Second
+ if splitItems.count>0 then
+ yield CmiSeparator
+ yield! splitItems.list
+ ])})
+
let combineIconsInTaskbar =
CmiRegular({
text = tr Strings.TabMenu.combineTaskbarIcons
@@ -467,6 +643,7 @@ type TabStripDecorator(group:WindowGroup) as this =
Some(renameTabItem)
(if group.isRenamed(hwnd) then Some(restoreTabNameItem) else None)
Some(colorMenu)
+ Some(splitMenu)
Some(CmiSeparator)
Some(positionItem)
Some(alignmentItem)
@@ -568,10 +745,14 @@ type TabStripDecorator(group:WindowGroup) as this =
this.ts.isShrunk <- false
interface ITabStripMonitor with
- member x.tabClick((btn, tab, part, action, pt)) =
+ member x.tabClick((btn, tab, part, action, pt)) =
let (Tab(hwnd)) = tab
- mouseEvent.Trigger(hwnd, btn, action, pt)
let ptScreen = os.windowFromHwnd(this.ts.hwnd).ptToScreen(pt)
+ // The button between a split's tabs is not its tab: no activation, drag, rename or tab menu.
+ if part=TabSplit then
+ if action=MouseDown && (btn=MouseLeft || btn=MouseRight) then this.showSplitMenu(ptScreen,Some hwnd)
+ else
+ mouseEvent.Trigger(hwnd, btn, action, pt)
match action with
| MouseDown ->
group.flashTab(tab, false)
@@ -579,13 +760,29 @@ type TabStripDecorator(group:WindowGroup) as this =
| MouseRight ->
os.windowFromHwnd(group.topWindow).setForeground(false)
| MouseLeft ->
+ dragPartner <- group.topWindow
+ dragSource <- Some hwnd
+ dragStartIndex <- group.lorder.list |> List.tryFindIndex ((=) hwnd)
+ dragParked <- (match group.layout with Split _ -> true | _ -> false)
group.tabActivate(tab, false)
if part <> TabClose then
let dragOffset = pt.sub(this.ts.tabLocation tab)
- let dragImage = fun() -> this.ts.dragImage(tab)
let _,sprite = this.ts.tabSprites.pick(fun (location,sprite) -> if sprite.id=tab then Some(location,sprite) else None)
- let dragInfo = box({ tab = tab; tabOffset = dragOffset; tabSize=sprite.size; tabInfo = this.ts.tabInfo(tab)})
- Services.dragDrop.beginDrag(this.ts.hwnd, dragImage, dragOffset, ptScreen, dragInfo)
+ // The image shows the window at the size it lands at on this monitor, and the
+ // tab where the strip will put it over that width.
+ let window = os.windowFromHwnd(hwnd)
+ let landing =
+ DragOutPlacement.monitorAt ptScreen
+ |> Option.map(fun mon -> DragOutPlacement.size window.visibleBounds.size mon.workRect)
+ |> Option.defaultValue window.visibleBounds.size
+ let info = { tab = tab; tabOffset = dragOffset; tabSize=sprite.size; tabInfo = this.ts.tabInfo(tab); tabShift = 0; tabAlignment = this.ts.dragAlignment }
+ let shift = info.shiftFor landing.width
+ // The tab at full size over its window shown small: the pointer keeps the
+ // point of the tab it pressed.
+ let tabX = this.ts.dragTabX(tab,landing)
+ let dragImage = fun later -> this.ts.dragImage(tab,tabX,landing,later)
+ let dragInfo = box({ info with tabShift = shift })
+ Services.dragDrop.beginDrag(this.ts.hwnd, dragImage, dragOffset.add(Pt(tabX,0)), ptScreen, dragInfo)
| MouseMiddle ->
group.tabActivate(tab, false)
| _ -> ()
@@ -602,11 +799,138 @@ type TabStripDecorator(group:WindowGroup) as this =
member x.windowMsg(msg) =
()
+ /// What a drag at this point meets, on this thread: the strip's row first; else what a drop
+ /// would do (an empty pane, or one at an empty pane's edge, is filled; anything else
+ /// splits), the place shown when `show` says so or at once for an empty pane.
+ member private this.probeLayout(data:obj,pt:Pt,show:bool) =
+ match this.nearTabs pt with
+ | Some strip -> NearStrip strip
+ | None ->
+ let proposal = this.layoutProposal(data,pt)
+ let aim =
+ match proposal with
+ | None -> NoAim
+ | Some(FillEmpty _,_) -> FillAim
+ | Some(SplitAt(path,_,_),_) ->
+ match group.splitLayout |> Option.bind(SplitView.pane path) with
+ | Some Empty -> FillAim
+ | _ -> SplitAim
+ let shown =
+ if aim=FillAim || (aim=SplitAim && show) then
+ layoutDrop <- proposal |> Option.map fst
+ this.showProposal proposal
+ else false
+ Aimed(aim,shown)
+
+ member private this.layoutProposal(data:obj,pt:Pt) =
+ let drag = unbox data
+ let (Tab hwnd) = drag.tab
+ // A tab of this group, still in it or taken out by this drag, may split the group; a tab
+ // from elsewhere may too, or fill an empty pane, if it is on the same desktop.
+ let own = dragSource=Some hwnd || group.windows.contains hwnd
+ let gap = Dpi.scale SplitMetrics.gap
+ // Only refused when both desktops are known and differ; a window hidden for the drag may report none.
+ let sameDesktop() =
+ own ||
+ (match VirtualDesktop.groupingDesktopId hwnd,VirtualDesktop.groupingDesktopId group.topWindow with
+ | Some a,Some b -> a=b
+ | _ -> true)
+ // At the group's own edge the whole group splits; further in, the pane under the pointer.
+ // Panes parked behind the tab shown are out of sight and not aimed at: the drop goes
+ // beside the window shown. (Panes parked by the drag's own tab came back as it left
+ // the strip.)
+ let edge() =
+ group.bounds.value |> Option.bind(fun bounds ->
+ SplitGeometry.dropAt pt (Dpi.scale SplitMetrics.edgeZone) (Dpi.scale SplitMetrics.outerZone) gap bounds group.splitLayout
+ |> Option.map(fun ((path,axis,side),rect) -> SplitAt(path,axis,side),rect))
+ if not(WinUserApi.IsWindow hwnd) then None
+ else
+ match group.emptyPaneAt(pt) with
+ | Some(path,bounds) -> if sameDesktop() then Some(FillEmpty path,bounds) else None
+ | None when group.windows.count>0 && sameDesktop() -> edge()
+ | None -> None
+
+ member private this.showProposal(proposal:(LayoutDrop * Rect) option) =
+ match proposal with
+ | Some(_,bounds) ->
+ if layoutPreview.IsNone then layoutPreview <- Some(new LayoutPreview())
+ layoutPreview.Value.showAt(bounds.Rectangle,{new IWin32Window with member _.Handle=this.ts.hwnd})
+ true
+ | None ->
+ layoutPreview |> Option.iter(fun window -> window.fadeOut())
+ false
+
+ member private this.resetLayoutDrop() =
+ layoutDrop <- None
+ layoutPreview |> Option.iter(fun window -> window.fadeOut())
+
+ /// The strip, when the point lies within `DragRouting.stripMargin` of its row of tabs in
+ /// sight. The row runs the group's whole width (a column of tabs its whole height): a tab
+ /// carried to the top of the window joins the group anywhere along it, and the window's
+ /// top edge offers a split only below that. Around the tabs alone, the rest of the row
+ /// offered the edge, and a tab meant for the group split it.
+ member private this.nearTabs(pt:Pt) =
+ let sprites = this.ts.tabSprites.list
+ match group.bounds.value with
+ | Some frame when not sprites.IsEmpty && this.ts.visible && WinUserApi.IsWindowVisible this.ts.hwnd ->
+ let strip = os.windowFromHwnd(this.ts.hwnd)
+ let rects = sprites |> List.map(fun (location:Pt,sprite) -> Rect(strip.ptToScreen(location),sprite.size))
+ let margin = Dpi.scale DragRouting.stripMargin
+ let tabsLeft,tabsRight = (rects |> List.map(fun r -> r.left) |> List.min),(rects |> List.map(fun r -> r.right) |> List.max)
+ let tabsTop,tabsBottom = (rects |> List.map(fun r -> r.top) |> List.min),(rects |> List.map(fun r -> r.bottom) |> List.max)
+ let left,right =
+ if this.ts.isVertical then tabsLeft-margin,tabsRight+margin
+ else (min frame.left tabsLeft)-margin,(max frame.right tabsRight)+margin
+ let top,bottom =
+ if this.ts.isVertical then (min frame.top tabsTop)-margin,(max frame.bottom tabsBottom)+margin
+ else tabsTop-margin,tabsBottom+margin
+ if pt.x>=left && pt.x=top && pt.y None
+
+ interface ILayoutDropTarget with
+ member this.probe(data,pt,show) =
+ if not(WinUserApi.IsWindow(this.ts.hwnd)) then Aimed(NoAim,false)
+ else this.invokeSync(fun () -> this.probeLayout(data,pt,show))
+
+ member this.clearPreview() =
+ if WinUserApi.IsWindow(this.ts.hwnd) then this.invokeSync(fun () -> this.resetLayoutDrop())
+
+ member this.commit(data,pt) =
+ if not(WinUserApi.IsWindow(this.ts.hwnd)) then false
+ else this.invokeSync(fun () ->
+ let drag = unbox data
+ let (Tab hwnd) = drag.tab
+ let dropped =
+ match layoutDrop with
+ | Some drop when WinUserApi.IsWindow hwnd ->
+ let own = dragSource=Some hwnd || group.windows.contains hwnd
+ // The dragged tab went on top at mouse-down, so the tab shown before is its
+ // partner; a tab from another group, or a pane's own tab that was already in
+ // front, joins the tab shown now. The first other tab of the strip was taken
+ // before: a tab behind, waiting pane-sized under a pane, whose rectangle the
+ // group then took for its frame.
+ let partner =
+ if not own then group.topWindow
+ elif dragPartner<>hwnd && group.windows.contains dragPartner then dragPartner
+ elif group.topWindow<>hwnd && group.windows.contains group.topWindow then group.topWindow
+ else group.lorder.list |> List.tryFind((<>) hwnd) |> Option.defaultValue hwnd
+ // Let go: the drop's own transition plays.
+ group.transitionsPaused <- false
+ group.dropTab(hwnd,drop,partner)
+ true
+ | _ -> false
+ this.resetLayoutDrop()
+ dropped)
+
interface IDragDropTarget with
member this.dragBegin() =
- this.invokeAsync <| fun() ->
+ this.invokeAsync <| fun() ->
isDraggingCell.value <- true
this.ts.transparent <- false
+ group.transitionsPaused <- true
+ if WinUserApi.IsWindow this.ts.hwnd then
+ if layoutPreview.IsNone then layoutPreview <- Some(new LayoutPreview())
+ layoutPreview.Value.prepare()
member this.dragEnter dragInfo pt =
this.invokeSync <| fun() ->
@@ -650,18 +974,46 @@ type TabStripDecorator(group:WindowGroup) as this =
let window = os.windowFromHwnd(hwnd)
group.removeWindow(hwnd)
window.hideOffScreen(None)
+ // Out on its drag, the tab is no longer the one shown. Panes its press
+ // parked come back, so a drop can aim at them; panes parked before it, by
+ // another tab chosen over them, stay parked, and the tab shown before this
+ // one comes back: brought back, their focused pane took the place of the
+ // tab the user had left for this one.
+ (match group.layout with
+ | Parked _ when dragParked -> group.execute FocusOther
+ | Parked _ -> group.showTabBefore hwnd
+ | _ -> ())
+ dragParked <- false
joinedByDrag <- false
| None -> ()
this.updateTsSlide()
+ /// The tab comes back to where the drag took it from; a tab that left is a member again.
+ member this.dragCancel(data) =
+ this.invokeSync <| fun() ->
+ let drag = unbox data
+ let (Tab hwnd) = drag.tab
+ dragInfoCell.set(None)
+ this.ts.dragScrollPoint <- None
+ if WinUserApi.IsWindow hwnd then
+ if not(group.windows.contains hwnd) then group.addWindow(hwnd,false)
+ dragStartIndex |> Option.iter(fun index -> this.ts.moveTab(drag.tab,index))
+ group.tabActivate(drag.tab,false)
+ joinedByDrag <- false
+ this.updateTsSlide()
+
member this.dragEnd() =
this.invokeAsync <| fun() ->
+ group.transitionsPaused <- false
+ dragSource <- None
+ dragStartIndex <- None
this.ts.dragScrollPoint <- None
isDraggingCell.value <- false
this.ts.transparent <- true
match this.ts.movedTab with
| Some(tab, index) ->
this.ts.moveTab(tab, index)
+ group.onTabsReordered()
| None -> ()
if joinedByDrag && dragInfoCell.value.IsSome then group.isManual <- true
joinedByDrag <- false
diff --git a/WtProgram/TabStripSprite.fs b/WtProgram/TabStripSprite.fs
index 9cdfe3ff..333f039f 100755
--- a/WtProgram/TabStripSprite.fs
+++ b/WtProgram/TabStripSprite.fs
@@ -205,6 +205,56 @@ type CloseButtonSprite = {
bitmap
member this.children = List2()
+/// Where the two tabs of a split view meet: it marks them as a pair and opens the split's menu.
+/// Two panes side by side or one above the other, in the tabs' text colour.
+type SplitJunctionSprite = {
+ /// The tab the button answers for, boxed: the strip is generic over its tab ids.
+ owner: obj
+ axis: SplitAxis
+ size: Sz
+ fill: Color
+ ink: Color
+ hover: bool
+ }
+ with
+ interface ISpriteHitTest with
+ member this.containsPoint(pt) =
+ pt.x>=0 && pt.y>=0 && pt.x = {
@@ -904,15 +956,50 @@ type TabStripSprite<'id> when 'id : equality = {
if plainAt 1 then yield Pt(location.x + tab.size.width, y), foot false ]
| _ -> []
+ /// A split button sits on each seam between a split view's tabs while they are next to each
+ /// other; not while a tab is being dragged along the strip.
+ member private this.junction =
+ if this.slide.IsSome then []
+ else
+ let order = this.adjustedLorder.list
+ let paired = order |> List.filter(fun tab -> (this.tabs.find tab).splitTrail.IsSome)
+ paired |> List.pairwise |> List.collect(fun (first,second) ->
+ // The split that parts the two panes: the deepest one both are in, where their
+ // trails first take different sides.
+ let parting =
+ Seq.zip (this.tabs.find first).splitTrail.Value (this.tabs.find second).splitTrail.Value
+ |> Seq.tryFind(fun (a,b) -> a<>b) |> Option.map(fst >> fst)
+ match parting with
+ | Some axis when List.findIndex ((=) second) order = List.findIndex ((=) first) order + 1 ->
+ let location = this.tabLocation first
+ let tab = this.tabSpriteOf first
+ let hover = this.hover |> Option.exists(fun (id,part) -> id=second && part=TabSplit)
+ let button side = { owner=box second; axis=axis; size=side; fill=this.appearance.tabActiveBgColor; ink=tab.textColor; hover=hover }
+ if this.isVertical then
+ let height = max (Dpi.scale 14) (this.rowHeight*45/100)
+ let side = Sz(height*3/2,height)
+ let y = location.y+tab.size.height+(this.rowStep-this.rowHeight)/2-side.height/2
+ let x = this.size.width-side.width-Dpi.scale (if this.scrollMaximum>0 then 22 else 12)
+ if y>=0 && y+side.height<=this.size.height then [Pt(x,y),button side :> ISprite] else []
+ else
+ // Small and down at the tabs' bottom edge, clear of the icon beside the seam.
+ let height = min (this.size.height-2) (max (Dpi.scale 11) (tab.size.height*38/100))
+ let side = Sz(height*3/2,height)
+ let seam = location.x+tab.size.width-int(this.tabOverlap/2.0)
+ // The strip's own bottom row: tabs stop a pixel or two short of it.
+ let y = this.size.height-side.height
+ [Pt(seam-side.width/2,y),button side :> ISprite]
+ | _ -> [])
+
member this.sprite =
{
new ISprite with
member x.image = this.bgImage
- // The feet come first so they are drawn over the tabs they reach into.
+ // The split button and the feet come first so they are drawn over the tabs.
member x.children =
let tabs = this.tabSprites.list |> List.filter(fun (location,tab) ->
not this.isVertical || (location.y0))
- List2(this.feet @ (tabs |> List.map(fun (location,tab) -> location,tab :> ISprite)))
+ List2(this.junction @ this.feet @ (tabs |> List.map(fun (location,tab) -> location,tab :> ISprite)))
}
member this.renderTab tab = this.tabSprite(tab).render
@@ -1006,8 +1093,11 @@ type TabStripSprite<'id> when 'id : equality = {
fillSegment ink x markWidth true true
image
- member this.tryHit pt =
+ member this.tryHit pt =
let path = if Rect(Pt(),this.size).containsPoint(pt) then this.sprite.hit(pt) else List2()
+ match path.tryHead with
+ | Some(:? SplitJunctionSprite as junction) -> Some(unbox<'id> junction.owner,TabSplit)
+ | _ ->
maybe {
let! tab = path.tryPick <| fun sprite ->
match sprite with
diff --git a/WtProgram/TaskSwitch.fs b/WtProgram/TaskSwitch.fs
index 43cd2b73..7355089f 100755
--- a/WtProgram/TaskSwitch.fs
+++ b/WtProgram/TaskSwitch.fs
@@ -94,7 +94,15 @@ type ITaskSwitchGroup =
type ITaskSwitchDesktop =
abstract member groups : List2
-type TaskWindowItem = TaskWindowItem of IntPtr * bool
+/// How a group listed as one item draws its icon: as its taskbar button does.
+type TaskWindowGroup =
+ /// The front app's icon with a window of each other app's lined up after it, or the
+ /// WindowTabs badge when every tab is of one app.
+ | GroupOfApps of others:IntPtr list
+ /// The picture the user chose for the group's taskbar button.
+ | GroupPicture of path:string
+
+type TaskWindowItem = TaskWindowItem of IntPtr * TaskWindowGroup option
/// What the Alt+Tab logic needs from either switcher style.
@@ -146,12 +154,36 @@ module private TaskWindowIcons =
| null -> fromWindow()
| icon -> Some icon
+ /// An item's icon at the given size; a group's is drawn as its taskbar button's.
+ let item (TaskWindowItem(hwnd,group)) (size:int) : Bitmap option =
+ let window = OS().windowFromHwnd(hwnd)
+ let apps others =
+ large window size |> Option.map(fun front ->
+ use front = front
+ let images = others |> List.truncate(GroupIconImage.maxApps-1) |> List.choose(fun hwnd -> large (OS().windowFromHwnd(hwnd)) size)
+ try GroupIconImage.compose size front images
+ finally images |> List.iter(fun image -> image.Dispose()))
+ match group with
+ | None -> large window size
+ | Some(GroupOfApps others) -> apps others
+ | Some(GroupPicture path) ->
+ match GroupIconFile.load path with
+ | Some icon ->
+ use icon = icon
+ use picture = icon.ToBitmap()
+ let bitmap = new Bitmap(size,size,Imaging.PixelFormat.Format32bppArgb)
+ use g = Graphics.FromImage(bitmap)
+ g.InterpolationMode <- Drawing2D.InterpolationMode.HighQualityBicubic
+ g.DrawImage(picture,Rectangle(0,0,size,size))
+ Some bitmap
+ | None -> apps []
+
module private TaskWindowItems =
- let create (TaskWindowItem(hwnd,isGroup)) =
+ let create (TaskWindowItem(hwnd,_) as item) =
let window = OS().windowFromHwnd(hwnd)
// Fetched at the size the list draws it in screen pixels; scaled up from 32 it blurs.
let size = Dpi.scale 32
- match TaskWindowIcons.large window size with
+ match TaskWindowIcons.item item size with
| Some icon ->
let image =
if icon.Width = size && icon.Height = size then Img(icon)
@@ -159,11 +191,6 @@ module private TaskWindowItems =
let resized = Img(icon).resize(Sz(size,size))
icon.Dispose()
resized
- if isGroup then
- use badgeIcon = Services.openIcon("Bemo.ico")
- use badge = Img(badgeIcon.ToBitmap()).resize(Sz(size/2,size/2)).bitmap
- use g = image.graphics
- g.DrawImage(badge, Point(size-badge.Width,size-badge.Height))
TreeListItem(window.text,Icon=image.bitmap)
| None -> TreeListItem(window.text,Glyph=WindowGlyph)
@@ -340,9 +367,8 @@ type TaskSwitchIconView(windows:List2) =
let titleHeight = Dpi.scale 36
let radius = Dpi.scale 12
let items =
- windows.list |> List.map(fun (TaskWindowItem(hwnd,isGroup)) ->
- let window = OS().windowFromHwnd(hwnd)
- window.text,TaskWindowIcons.large window iconSize,isGroup) |> Array.ofList
+ windows.list |> List.map(fun (TaskWindowItem(hwnd,_) as item) ->
+ OS().windowFromHwnd(hwnd).text,TaskWindowIcons.item item iconSize) |> Array.ofList
let area = Screen.FromHandle(WinUserApi.GetForegroundWindow()).WorkingArea
let columns = max 1 (min items.Length ((area.Width*9/10-padding*2+gap)/(cell+gap)))
let rows = max 1 ((items.Length+columns-1)/columns)
@@ -350,9 +376,6 @@ type TaskSwitchIconView(windows:List2) =
let width = max (Dpi.scale 360) (columns*cell+(columns-1)*gap+padding*2)
let height = padding+rows*cell+(rows-1)*gap+titleHeight+padding/2
let titleFont = SettingsUi.font "Segoe UI" 11.0f FontStyle.Regular
- let badge =
- use icon = Services.openIcon("Bemo.ico")
- new Bitmap(icon.ToBitmap(),Size(Dpi.scale 24,Dpi.scale 24))
let mutable selected = 0
let mutable closed = false
let mutable shadow : TaskSwitchShadow option = None
@@ -406,7 +429,7 @@ type TaskSwitchIconView(windows:List2) =
use outline = SettingsShapes.rounded (SettingsShapes.outlineRect width height) (float32 radius)
use border = new Pen(p.border)
g.DrawPath(border,outline)
- items |> Array.iteri(fun index (_,icon,isGroup) ->
+ items |> Array.iteri(fun index (_,icon) ->
let bounds = cellBounds index
if index=selected then
use shape = SettingsShapes.rounded (RectangleF(float32 bounds.X,float32 bounds.Y,float32 bounds.Width,float32 bounds.Height)) (float32(Dpi.scale 10))
@@ -417,11 +440,9 @@ type TaskSwitchIconView(windows:List2) =
| Some image -> g.DrawImage(image,iconBounds)
| None ->
use pen = new Pen(p.text,float32(Dpi.scale 2))
- g.DrawRectangle(pen,Rectangle.Inflate(iconBounds,-Dpi.scale 8,-Dpi.scale 12))
- // A tab group shows the WindowTabs badge on its icon.
- if isGroup then g.DrawImage(badge,iconBounds.Right-badge.Width+Dpi.scale 4,iconBounds.Bottom-badge.Height))
+ g.DrawRectangle(pen,Rectangle.Inflate(iconBounds,-Dpi.scale 8,-Dpi.scale 12)))
if items.Length>0 then
- let title,_,_ = items.[max 0 (min (items.Length-1) selected)]
+ let title,_ = items.[max 0 (min (items.Length-1) selected)]
let bottom = padding+rows*cell+(rows-1)*gap
TextRenderer.DrawText(g,title,titleFont,Rectangle(padding,bottom,width-padding*2,titleHeight),
(if highContrast then SystemColors.WindowText else p.text),p.surface,
@@ -459,9 +480,8 @@ type TaskSwitchIconView(windows:List2) =
shadow |> Option.iter(fun item -> (item :> IDisposable).Dispose())
form.Hide()
form.Dispose()
- badge.Dispose()
if not (isNull frame) then frame.Dispose()
- for _,icon,_ in items do icon |> Option.iter(fun image -> image.Dispose())
+ for _,icon in items do icon |> Option.iter(fun image -> image.Dispose())
member this.select index =
selected <- index
if form.IsHandleCreated then this.present()
@@ -602,23 +622,33 @@ type TaskSwitcher(settings:Settings, desktop:ITaskSwitchDesktop) as this=
)
let groupWindowsInSwitcher = settings.settings.groupWindowsInSwitcher
if groupWindowsInSwitcher then
- let hwndToGroup =
- let zorder =
- let zorders = Map2(windowsInZorder.enumerate.map(fun(i,w) -> w.hwnd,i))
- fun hwnd ->
- zorders.tryFind(hwnd).def(Int32.MaxValue)
- Map2(desktop.groups.where(fun g -> g.windows.count > 1).collect(fun g ->
- let windows = g.windows.items.sortBy(zorder)
- List2([(windows.head, (true, g))]).appendList(windows.tail.map(fun hwnd -> (hwnd, (false, g))))
- ))
+ let zorder =
+ let zorders = Map2(windowsInZorder.enumerate.map(fun(i,w) -> w.hwnd,i))
+ fun hwnd -> zorders.tryFind(hwnd).def(Int32.MaxValue)
+ /// As the group's taskbar button shows it: the picture chosen for it, else the front
+ /// app's icon with the other apps' lined up after it.
+ let icon (windows:IntPtr list) =
+ let front = List.head windows
+ // Only a group with a button of its own has a picture; its windows belong to its previews.
+ let picture = if TaskbarProxies.ownsWindow front then (try Services.program.groupIcon front with _ -> None) else None
+ match picture with
+ | Some path -> GroupPicture path
+ | None ->
+ let app hwnd = try AppIdentity.key(os.windowFromHwnd(hwnd).pid.processPath) with _ -> ""
+ let frontApp = app front
+ GroupOfApps(List.tail windows |> List.filter(fun hwnd -> app hwnd<>frontApp) |> List.distinctBy app)
+ let fronts,behind =
+ let groups = desktop.groups.where(fun g -> g.windows.count > 1).map(fun g -> g.windows.items.sortBy(zorder).list).list
+ Map.ofList(groups |> List.map(fun windows -> List.head windows,windows)),
+ Set.ofList(groups |> List.collect List.tail)
windowsInZorder.map(fun w ->
- let hwnd = w.hwnd
- match hwndToGroup.tryFind hwnd with
- | Some(isTop, group) -> if isTop then Some(TaskWindowItem(hwnd, true)) else None
- | None -> Some(TaskWindowItem(hwnd, false))
+ match Map.tryFind w.hwnd fronts with
+ | Some windows -> Some(TaskWindowItem(w.hwnd,Some(icon windows)))
+ | None when behind.Contains w.hwnd -> None
+ | None -> Some(TaskWindowItem(w.hwnd,None))
).choose(id)
else
- windowsInZorder.map(fun w -> TaskWindowItem(w.hwnd, false))
+ windowsInZorder.map(fun w -> TaskWindowItem(w.hwnd,None))
interface IDisposable with
member this.Dispose() = hook.Dispose()
diff --git a/WtProgram/WindowGroup.fs b/WtProgram/WindowGroup.fs
index 74e35d02..3dd76fca 100755
--- a/WtProgram/WindowGroup.fs
+++ b/WtProgram/WindowGroup.fs
@@ -145,6 +145,74 @@ module WindowTabLayout =
let dock = match int((value >>> 9) &&& 3L) with 0 -> TabDockTop | 1 -> TabDockBottom | 2 -> TabDockLeft | _ -> TabDockRight
Some {dock=dock;columnWidth=width;normalAlignment=alignment normal;insideAlignment=alignment inside}
+/// A pane window's place in its group's split view, kept on the window itself as the group
+/// token is, so a restarted WindowTabs shows the split again as the windows come back.
+/// Properties hold a pointer-sized value, so the place is spread over a few, each within 31
+/// bits for a 32-bit process: the path with its flags, a ratio per split above, and the frame.
+module WindowSplitLayout =
+ let private paneKey = "WindowTabs.Split.Pane.v1"
+ let private ratioKey depth = sprintf "WindowTabs.Split.Ratio.v1.%d" depth
+ let private frameKeys = ["WindowTabs.Split.Frame.v1.X";"WindowTabs.Split.Frame.v1.Y";"WindowTabs.Split.Frame.v1.W";"WindowTabs.Split.Frame.v1.H"]
+ let private marker = 0x40000000
+ /// Coordinates are kept positive; the frame is at most this far from the origin.
+ let private offset = 0x20000000
+ let maxDepth = 12
+ let private value hwnd key = int(WinUserApi.GetProp(hwnd,key).ToInt64() &&& 0x7FFFFFFFL)
+ let save hwnd (pane:SavedPane) (frame:Rect) =
+ if pane.levels.Length<=maxDepth && [frame.x;frame.y;frame.width;frame.height] |> List.forall(fun v -> abs v List.mapi(fun depth (axis,side) ->
+ ((if axis=Stacked then 1 else 0) ||| (if side=Second then 2 else 0)) <<< (4+2*depth))
+ |> List.fold (|||) 0
+ let flags = (if pane.focused then 1<<<28 else 0) ||| (if pane.parked then 1<<<29 else 0)
+ WinUserApi.SetProp(hwnd,paneKey,IntPtr(marker ||| pane.levels.Length ||| levels ||| flags)) |> ignore
+ pane.ratios |> List.iteri(fun depth ratio ->
+ WinUserApi.SetProp(hwnd,ratioKey depth,IntPtr(marker ||| int(Math.Round(ratio*10000.0)))) |> ignore)
+ for key,v in List.zip frameKeys [frame.x;frame.y;frame.width;frame.height] do
+ WinUserApi.SetProp(hwnd,key,IntPtr(v+offset)) |> ignore
+ let clear hwnd =
+ if WinUserApi.IsWindow hwnd && value hwnd paneKey &&& marker <> 0 then
+ WinUserApi.RemoveProp(hwnd,paneKey) |> ignore
+ for depth in 0..maxDepth-1 do WinUserApi.RemoveProp(hwnd,ratioKey depth) |> ignore
+ for key in frameKeys do WinUserApi.RemoveProp(hwnd,key) |> ignore
+ let read hwnd =
+ let packed = value hwnd paneKey
+ if packed &&& marker = 0 then None
+ else
+ let depth = packed &&& 15
+ let levels =
+ [for level in 0..depth-1 ->
+ let bits = (packed >>> (4+2*level)) &&& 3
+ (if bits &&& 1 = 1 then Stacked else SideBySide),(if bits &&& 2 = 2 then Second else First)]
+ let ratios =
+ [for level in 0..depth-1 ->
+ let stored = value hwnd (ratioKey level)
+ if stored &&& marker = 0 then 0.5 else float(stored &&& 0xFFFF)/10000.0]
+ match frameKeys |> List.map(fun key -> value hwnd key-offset) with
+ | [x;y;w;h] when w>0 && h>0 && depth<=maxDepth ->
+ Some({levels=levels;ratios=ratios;focused=(packed &&& (1<<<28))<>0;parked=(packed &&& (1<<<29))<>0},Rect(Pt(x,y),Sz(w,h)))
+ | _ -> None
+
+/// Where a tab dragged out onto the desktop puts its window. Sizes are of the visible frame.
+module DragOutPlacement =
+ /// The window's size now, as the group had it, maximized or not; where a side spans most of
+ /// the screen, the whole window is scaled down, its proportions kept, until that side spans
+ /// three fifths of it. Taken side by side, or from its size before any group, the window
+ /// and its image in the drag came out of proportion with what was dragged.
+ let size (current:Sz) (work:Rect) =
+ let reach = max (float current.width/float(max 1 work.width)) (float current.height/float(max 1 work.height))
+ if reach<=0.8 then current
+ else
+ let scale = 0.6/reach
+ Sz(max 1 (int(Math.Round(float current.width*scale))),max 1 (int(Math.Round(float current.height*scale))))
+ /// The monitor a drop at this point lands on: the one under it, else the nearest.
+ let monitorAt (pt:Pt) =
+ Mon.fromPoint pt |> Option.orElse(Mon.fromHMonitor(WinUserApi.MonitorFromPoint(pt.POINT,MonitorFlags.MONITOR_DEFAULTTONEAREST)))
+ /// The frame moved as little as needed to lie wholly in the work area.
+ let fit (work:Rect) (frame:Rect) =
+ let width,height = min frame.width work.width,min frame.height work.height
+ Rect(Pt(max work.left (min frame.x (work.right-width)),max work.top (min frame.y (work.bottom-height))),Sz(width,height))
+
/// Which group a window was in, kept on the window itself, so a restarted WindowTabs puts
/// windows back together as they were, however they came to be grouped.
module WindowGroupToken =
@@ -197,6 +265,74 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
/// Bounds to restore windows to, their placement, and the visible frame the tabs sit on.
let placement = Cell.create(None:Option)
let placementOwner = obj()
+ let mutable groupLayout : GroupLayout = GroupLayout.Single
+ /// The frame before the split filled the work area, for the toggle back.
+ let mutable splitRestore : Rect option = None
+ /// The split came from what the windows remembered before a restart: their places are left
+ /// as they are for a while, so a window still to arrive finds the layout it was saved with.
+ let mutable splitFromProps = false
+ let splitRestoreClock = Stopwatch()
+ /// A pane window moved or sized natively: the window, its frame and the group's at the start.
+ let mutable splitMove : (IntPtr * Rect * Rect * SplitTree) option = None
+ let mutable splitPending = false
+ let mutable splitDeadline = 0L
+ /// Collapsing to one window: the top window's bounds are not the frame until placement ends.
+ let mutable splitMerging = false
+ let splitSettleTimer = new System.Windows.Forms.Timer(Interval=100)
+ /// Looks, while split, for a pane raised over the tabs with no notice to the group.
+ let splitGuardTimer = new System.Windows.Forms.Timer(Interval=200)
+ /// One divider per split and one window per empty pane, by their place in the layout.
+ let mutable splitDividers : Map = Map.empty
+ let mutable emptySplitPanes : Map = Map.empty
+ /// The least size of each pane's window, read once per command: asking a window is a call
+ /// into its process.
+ let mutable paneLeastCache : Map = Map.empty
+ /// The images moving the windows of a split just started, until they are in place.
+ let mutable splitTransition : SplitTransition option = None
+ /// Windows already in the split before it changed: placed once the images have moved, so
+ /// their image shrinks smoothly from what they showed rather than jumping to their new size.
+ let mutable transitionHold : IntPtr list = []
+ /// Places the held windows once the images have moved.
+ let transitionRelease = new System.Windows.Forms.Timer(Interval=SplitTransition.DurationMs)
+ /// While a tab is dragged, the layout changes at once: the panes a dragged tab had parked
+ /// came back with a transition, started on the thread the drag runs on, and the drag paused.
+ let mutable dragPause = false
+ /// Whether the images moving now lead into a split; out of one, they stay until the windows
+ /// are placed.
+ let mutable transitionIntoSplit = false
+ /// A tab click put the cover up before activating its window; the layout change that
+ /// follows needs no second one.
+ let mutable coverAhead = false
+ /// How many covers have been shown: a cover with no steps can come and go within a few
+ /// milliseconds, too quick for a test to see it on screen.
+ let mutable coversShown = 0
+ /// The empty panes' handles, read by the desktop thread to recognize a native drop on one.
+ let mutable emptyPaneHandles : IntPtr list = []
+ /// The root split's divider, which the panes go just below.
+ let mutable dividerHandle = IntPtr.Zero
+ /// Behind every pane, over the tabs behind them; read by the placement workers as what those go below.
+ let mutable splitBackdrop : SplitBackdrop option = None
+ let mutable backdropHandle = IntPtr.Zero
+ /// What the chrome's thread was last told to show, for this thread to act on.
+ let mutable emptyPaneShown = false
+ let mutable dividerShown = false
+ /// The divider's and empty pane's own thread, made with the first split.
+ let mutable chromeInvoker : Invoker option = None
+ /// A new empty pane is opening out over the window, which takes its half once it has.
+ let mutable emptyReveal = false
+ /// The window the tabs behind were last placed under.
+ let mutable splitHost = IntPtr.Zero
+ let revealMs = 230
+ /// An empty pane's edges being dragged: its path, its bounds, the group's frame and the tree at the start.
+ let mutable emptyPaneResize : (PanePath * Rect * Rect * SplitTree) option = None
+ /// The latest size of that drag, waiting for the next turn.
+ let mutable pendingPaneBounds : Rect option = None
+ /// A pane, the empty pane or the divider is being dragged: only the panes follow, live.
+ let mutable liveResize = false
+ let layoutChangedEvent = Event()
+ let pickRequestedEvent = Event()
+ /// An empty pane's window gone (first) or made (second): a drop surface of its own, owned by nothing.
+ let emptyPaneChangedEvent = Event()
let windowsCell = Cell.create(Set2())
let _ts = ref None
let inMoveSize = Cell.create(false)
@@ -293,16 +429,45 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
this.saveZorder()
if not this.isEmpty then this.saveTopWindowPlacement()
this.updateIsVisible()
- this.foreground <- this.os.foreground.hwnd)
+ this.foreground <- this.os.foreground.hwnd
+ this.checkRestoredOrder(order))
+ if this.isSplit && not(this.windows.items.all isMinimized) then this.applyLayout()
if not this.isEmpty then this.setTsParent(this.topWindow)
if reconcilePlacementState && FollowerPlacement.queue.isIdle(placementOwner) then
reconcilePlacementState <- false
+ splitMerging <- false
+ // One window fills the group now: the images that covered the change can go.
+ if not this.isSplit then this.settleTransition()
this.withUpdate(fun () -> this.updateIsVisible())
if not this.isEmpty then this.setTsParent(this.topWindow)
+ if splitPending && FollowerPlacement.queue.isIdle(placementOwner) then this.checkSplitSettled()
if pendingMinimizeStates.Count=0 then minimizeStateTimer.Stop()
+ /// A tab can finish restoring after the order was put back, and Windows raises it as it does,
+ /// over another tab behind. Once that has had the time, the order is put back again, unless
+ /// another tab has come to the front meanwhile.
+ member private this.checkRestoredOrder(order:List2) =
+ let timer = new System.Windows.Forms.Timer(Interval=250)
+ timer.Tick.Add(fun _ ->
+ timer.Stop()
+ timer.Dispose()
+ if not isDestroyed.value && not reconcileMinimizeState && not this.isSplit then
+ let wanted = order.where(fun hwnd -> this.windows.contains hwnd && WinUserApi.IsWindow hwnd && not(isMinimized hwnd))
+ let actual : List2 = this.inZorder(wanted)
+ if wanted.list.Length>1 && wanted.tryHead=zorderCell.value.tryHead && actual.list<>wanted.list then
+ this.os.setZorder(wanted)
+ this.withUpdate(fun () -> this.saveZorder()))
+ timer.Start()
+
member this.init(ts:TabStrip) =
_ts := Some(ts)
+ splitSettleTimer.Tick.Add(fun _ -> this.checkSplitSettled())
+ splitGuardTimer.Tick.Add(fun _ -> this.guardSplitStrip())
+ transitionRelease.Tick.Add(fun _ ->
+ transitionRelease.Stop()
+ if not transitionHold.IsEmpty then
+ transitionHold <- []
+ if this.isSplit && not isDestroyed.value then this.withUpdate(fun () -> this.applyLayout()))
placementCompletion <- Some(FollowerPlacement.queue.Idle.Subscribe(fun owner ->
if obj.ReferenceEquals(owner,placementOwner) then
invoker.asyncInvoke(fun () -> this.finishPlacementReconciliation())))
@@ -348,6 +513,7 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if next <> appearanceSnapshot then
appearanceSnapshot <- next
this.ts.setTabAppearance(next)
+ this.updateSplitChrome()
if geometryChanged then geometryChangedEvent.Trigger()))
Cell.listen <| fun() ->
@@ -376,6 +542,7 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
with get() = foregroundCell.value
and set(value) =
let value = TabNavigation.currentForeground this.lorder.list value this.os.foreground.hwnd
+ if this.windows.contains(value) && not(isMinimized value) && not reconcileMinimizeState then this.onActivated(value)
let active = TabNavigation.rememberActive this.lorder.list isOpen lastActiveTab value
// Minimizing the active tab activates another tab that the group minimizes next.
let active =
@@ -444,9 +611,9 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
this.isEmpty.not &&
zorderCell.value.where(isMinimized >> not).tryHead.exists(fun hwnd -> not(WindowCloaking.IsCloaked hwnd)) &&
inMoveSize.value.not
-
- member private this.updatePlacements() =
- zorderCell.value.tail.iter(this.adjustWindowPlacement)
+ this.updateSplitChrome()
+
+ member private this.updatePlacements() = this.applyLayout()
member private this.adjustChildWindows = fun() ->
this.updatePlacements()
@@ -468,11 +635,23 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
windows.sortBy(fun hwnd -> order.tryFind(hwnd).def(9999))
member private this.setZorder(newZorder:List2<_>) =
+ // In a split the pane in focus leads: its tab shows as the one in front and the strip
+ // belongs to it. Read from the stacking alone, a background tab or the other pane could
+ // lead, and the focused app then covered the tabs as it raised itself.
+ let newZorder =
+ match groupLayout with
+ | Split s -> match this.paneFront s with Some front -> newZorder.where((<>) front).prepend front | None -> newZorder
+ | _ -> newZorder
if zorderCell.value.list <> newZorder.list then
- if newZorder.tryHead<>zorderCell.value.tryHead then
+ if not this.isSplit && newZorder.tryHead<>zorderCell.value.tryHead then
+ // In front now, the window no longer goes under another; a placement that leads
+ // stays: the frame a tab takes as the split parks behind it was cancelled here,
+ // whenever the worker had not started it yet, and the tab kept its pane's size.
newZorder.tryHead.iter(fun hwnd ->
FollowerPlacement.queue.cancel(placementOwner,hwnd,whenValue=(fun (_,request) ->
- match request with SetMinimized _ -> false | _ -> true)))
+ match request with
+ | SetMinimized _ | AlignWindow(_,_,None,_) -> false
+ | _ -> true)))
prevTop.set(zorderCell.value.tryHead)
zorderCell.set(newZorder)
@@ -526,6 +705,7 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
{
text = this.tabName hwnd
isRenamed = this.isRenamed hwnd
+ splitTrail = SplitView.trail hwnd groupLayout
iconSmall = small
iconBig = big
preview = fun() ->
@@ -601,7 +781,7 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if isNew then this.refreshTabColor(hwnd)
let info = this.getTabInfo(hwnd)
let previous = this.ts.tabInfo(Tab(hwnd))
- if isNew || info.text <> previous.text || info.isRenamed <> previous.isRenamed ||
+ if isNew || info.text <> previous.text || info.isRenamed <> previous.isRenamed || info.splitTrail <> previous.splitTrail ||
not(obj.ReferenceEquals(info.iconSmall,previous.iconSmall)) ||
not(obj.ReferenceEquals(info.iconBig,previous.iconBig)) then
this.ts.setTabInfo(Tab(hwnd),info)
@@ -634,7 +814,91 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if parentHwnd<>IntPtr.Zero && not parent.isMinimized then
let previous = parent.prevZorder
if previous.hwnd<>strip.hwnd then strip.insertAfter(previous)
+ this.keepPanesBelowStrip(parentHwnd)
this.ts.refreshShadow()
+
+ /// In a split the strip covers both panes but belongs to the focused one. The other pane,
+ /// raised by a click or by its own app, is put back just below the focused pane. Kept just
+ /// below the strip, over the focused pane, it led the group's order. Only stacking, and only
+ /// for a pane with no placement pending, so no move is replaced.
+ member private this.keepPanesBelowStrip(owner) =
+ match groupLayout with
+ | Split s when not liveResize && not inMoveSize.value ->
+ let front = this.paneFront s |> Option.defaultValue owner
+ let panes = SplitView.windows s |> List.filter(fun hwnd -> not(isMinimized hwnd))
+ for hwnd in panes do
+ if hwnd<>front && FollowerPlacement.queue.isWindowIdle(placementOwner,hwnd) && this.isAbove(hwnd,front) then
+ FollowerPlacement.queue.submit(placementOwner,hwnd,FollowerPlacement.stackBelowRequest hwnd front)
+ // The tabs behind go under every pane, not only the one they wait under: an app that
+ // keeps to its own grid is a little larger than that pane, and above another pane its
+ // edge showed through at the seam.
+ this.tabsBehindBelowPanes panes
+ // The divider and the empty pane, owned by nothing, are put back under the strip too.
+ this.updateSplitChrome()
+ | _ -> ()
+
+ /// A tab behind the panes found above any of them, or above the backdrop, goes below the backdrop.
+ member private this.tabsBehindBelowPanes(panes:IntPtr list) =
+ let lowest = panes |> List.sortByDescending(fun hwnd -> this.os.windowFromHwnd(hwnd).zorder) |> List.tryHead
+ lowest |> Option.iter(fun lowest ->
+ let under = if backdropHandle<>IntPtr.Zero && WinUserApi.IsWindow backdropHandle then backdropHandle else lowest
+ for hwnd in this.windows.items.list do
+ if not(List.contains hwnd panes) && not(isMinimized hwnd) && FollowerPlacement.queue.isWindowIdle(placementOwner,hwnd) &&
+ this.isAbove(hwnd,under) then
+ FollowerPlacement.queue.submit(placementOwner,hwnd,FollowerPlacement.stackBelowRequest hwnd under))
+
+ /// Where each of the handles stands in the z-order, from the top down: one walk for them
+ /// all. Walked once per pair instead, the guard's every tick cost a group of many tabs
+ /// thousands of steps. A handle not met, gone or never shown, has no rank.
+ member private this.zorderRanks(handles:IntPtr list) =
+ let wanted = Set.ofList handles
+ let rec walk (current:IntPtr) rank (found:Map) =
+ if current=IntPtr.Zero || found.Count=wanted.Count then found
+ else
+ let found = if wanted.Contains current then found.Add(current,rank) else found
+ walk (WinUserApi.GetWindow(current,GetWindowConstants.GW_HWNDNEXT)) (rank+1) found
+ walk (WinUserApi.GetTopWindow(IntPtr.Zero)) 0 Map.empty
+
+ member _.backdropHwnd = System.Threading.Volatile.Read(&backdropHandle)
+
+ /// The pane window in focus, which the strip belongs to and the other pane waits under.
+ member private this.paneFront(s:SplitLayout) =
+ SplitView.focusedWindow s |> Option.filter(fun hwnd -> this.windows.contains hwnd && not(isMinimized hwnd))
+
+ /// Whether a window is somewhere above another in the z-order, a few dozen windows up at most.
+ member private this.isAbove(hwnd:IntPtr, reference:IntPtr) =
+ let rec walk (current:IntPtr) steps =
+ if current=IntPtr.Zero || steps=0 then false
+ elif current=hwnd then true
+ else walk (WinUserApi.GetWindow(current,GetWindowConstants.GW_HWNDPREV)) (steps-1)
+ walk (WinUserApi.GetWindow(reference,GetWindowConstants.GW_HWNDPREV)) 64
+
+ /// The tabs stay over both panes. A pane raised over them with no notice to the group, by its
+ /// own app or with the taskbar window it belongs to, came with no foreground change: the
+ /// tabs stayed under it, cut short or hidden, until the next click. The order is read again
+ /// and the tabs go back over the window in front.
+ member private this.guardSplitStrip() =
+ match groupLayout with
+ | Split s when not isDestroyed.value ->
+ if isVisibleCell.value && not liveResize && not inMoveSize.value && not reconcileMinimizeState then
+ let panes = SplitView.windows s |> List.filter(fun hwnd -> not(isMinimized hwnd))
+ let behind = this.windows.items.list |> List.filter(fun hwnd -> not(List.contains hwnd panes) && not(isMinimized hwnd))
+ let covers = if backdropHandle<>IntPtr.Zero && WinUserApi.IsWindow backdropHandle then backdropHandle::panes else panes
+ let ranks = this.zorderRanks(this.ts.hwnd::behind@covers)
+ let above a b = match ranks.TryFind a,ranks.TryFind b with Some x,Some y -> x false
+ // A pane over the tabs, or a tab behind the panes over any of them or the backdrop.
+ let covered = panes |> List.exists(fun hwnd -> above hwnd this.ts.hwnd)
+ let behindAbove = behind |> List.exists(fun hwnd -> covers |> List.exists(fun over -> above hwnd over))
+ if covered || behindAbove then
+ this.withUpdate(fun () ->
+ this.saveZorder()
+ if covered && not this.isEmpty then this.setTsParent(this.topWindow)
+ elif behindAbove && not this.isEmpty then this.keepPanesBelowStrip(this.topWindow))
+ | _ -> splitGuardTimer.Stop()
+
+ /// What the panes go just below: the divider, which lies over their edges, or else the strip.
+ member private this.paneAnchor =
+ if dividerShown then System.Threading.Volatile.Read(÷rHandle) else this.ts.hwnd
member this.isIconOnly
with get() = this.ts.isIconOnly
@@ -672,6 +936,789 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
member this.placementBounds : Rect = placement.value.map(fun(bounds,_,_) -> bounds).def(Rect())
+ member _.layout = groupLayout
+ /// Set by the strip for the length of a tab drag, on this thread.
+ member _.transitionsPaused with get() = dragPause and set(value) = dragPause <- value
+ member this.splitLayout = match groupLayout with Split s -> Some s | _ -> None
+ member _.layoutChanged = layoutChangedEvent.Publish
+ member _.isSplitFilled = splitRestore.IsSome
+ member private this.isSplit = match groupLayout with Split _ -> true | _ -> false
+ member private this.splitGap = Dpi.scale SplitMetrics.gap
+
+ /// The least a pane may be: what its window lets itself be sized to, less the invisible
+ /// borders round it, and never under `SplitMetrics.minPane`.
+ member private this.paneLeast(pane:Pane) : Sz =
+ let floor = Dpi.scale SplitMetrics.minPane
+ match pane with
+ | Empty -> Sz(floor,floor)
+ | Occupied hwnd ->
+ match paneLeastCache.TryFind hwnd with
+ | Some size -> size
+ | None ->
+ let track = Win32Helper.GetMinTrackSize(hwnd)
+ let window = this.os.windowFromHwnd(hwnd)
+ let bounds,visible = window.bounds,window.visibleBounds
+ let size = Sz(max floor (track.Width-max 0 (bounds.width-visible.width)),
+ max floor (track.Height-max 0 (bounds.height-visible.height)))
+ paneLeastCache <- paneLeastCache.Add(hwnd,size)
+ size
+ /// The whole group's frame: what the panes divide and what one tab fills.
+ member this.layoutFrame : Rect = placement.value |> Option.map(fun (_,_,visible) -> visible) |> Option.defaultValue this.placementBounds
+
+ member private this.setFrame(frame:Rect) =
+ let wp =
+ match placement.value with
+ | Some(_,wp,_) -> wp
+ | None -> this.os.windowFromHwnd(this.topWindow).placement
+ placement.set(Some(frame,{wp with showCmd=ShowWindowCommands.SW_SHOWNORMAL},frame))
+
+ /// The empty pane under a point, while the panes are shown.
+ member this.emptyPaneAt(pt:Pt) =
+ match groupLayout with
+ | Split s when emptyPaneShown ->
+ SplitGeometry.leafRects this.splitGap this.layoutFrame (SplitView.root s) []
+ |> List.tryPick(fun (path,pane,rect) -> if pane=Empty && rect.containsPoint pt then Some(path,rect) else None)
+ | _ -> None
+
+ /// The divider and the empty pane run on a thread of their own, owned by nothing. The strip,
+ /// owned by an app window, ties this thread's input to that app's: dragged from here they
+ /// waited at every step for the app, busy resizing, and trailed the pointer by its paint.
+ /// Calls go there posted; their actions come back here posted too, so neither thread waits.
+ member private this.chrome =
+ match chromeInvoker with
+ | Some invoker -> invoker
+ | None ->
+ let invoker = ThreadHelper.startOnThreadAndWait(fun () -> InvokerService.invoker)
+ chromeInvoker <- Some invoker
+ invoker
+
+ /// The DPI is kept per thread: the chrome's takes the group's, monitor and all, with each call.
+ member private this.onChrome(action:unit -> unit) =
+ let dpi = Dpi.value()
+ this.chrome.asyncInvoke(fun () ->
+ Dpi.set dpi
+ action())
+
+ /// Back on the group's thread, inside an update, unless the group is gone.
+ member private this.fromChrome(action:unit -> unit) =
+ this.invokeAsync(fun () -> if not isDestroyed.value then action())
+
+ member private this.updateSplitChrome() =
+ match groupLayout with
+ | Split s ->
+ splitGuardTimer.Start()
+ let strip,gap,frame = this.ts.hwnd,this.splitGap,this.layoutFrame
+ let visible =
+ SplitView.windows s |> List.forall(fun hwnd -> this.windows.contains hwnd && not(isMinimized hwnd || WindowCloaking.IsCloaked hwnd)) &&
+ not inMoveSize.value
+ // No divider over the window while an empty pane is still opening out beside it.
+ let dividerVisible = visible && not emptyReveal
+ dividerShown <- dividerVisible
+ let dpi = Dpi.value()
+ // One divider per split, by its place; splits gone lose theirs. The root's stays for
+ // the next split, as the panes are placed just below it.
+ let seams = SplitGeometry.seams gap frame (SplitView.root s) []
+ for KeyValue(path,(divider,_)) in splitDividers do
+ if not path.IsEmpty && not(seams |> List.exists(fun (at,_,_,_) -> at=path)) then
+ splitDividers <- splitDividers.Remove path
+ this.onChrome(fun () -> divider.Dispose())
+ let execute command = this.fromChrome(fun () -> this.execute command)
+ let live active = this.fromChrome(fun () -> if active then this.beginLive() else this.endLive())
+ for path,branch,splitFrame,_ in seams do
+ // A handle is read on its window's own thread: read from here, the control refuses
+ // under a debugger, as the thread is not its own.
+ let divider =
+ match splitDividers.TryFind path with
+ | Some(divider,_) -> divider
+ | None ->
+ let divider,handle = this.chrome.invoke(fun () ->
+ Dpi.set dpi
+ let divider = new SplitDivider(execute,live)
+ divider.initialize()
+ divider,divider.Handle)
+ if path.IsEmpty then System.Threading.Volatile.Write(÷rHandle,handle)
+ splitDividers <- splitDividers.Add(path,(divider,handle))
+ divider
+ // While a divider is dragged it places the panes of its split itself, straight into
+ // the placement queue from its own thread. Sent through this thread, a ratio waited
+ // behind the storm of WinEvents the apps raise as they resize, delivered here first,
+ // and the panes trailed the pointer by a few steps.
+ let place =
+ match placement.value with
+ | Some(_,wp,_) ->
+ let front = this.paneFront s |> Option.defaultValue IntPtr.Zero
+ let anchor = this.paneAnchor
+ let minimized = SplitView.windows s |> List.filter isMinimized
+ fun (ratio:float) ->
+ for _,pane,rect in SplitGeometry.leafRects gap splitFrame (Branch {branch with ratio=ratio}) path do
+ match pane with
+ | Occupied hwnd when not(List.contains hwnd minimized) ->
+ let below = if hwnd<>front then Some(if front<>IntPtr.Zero then front else anchor) else None
+ FollowerPlacement.queue.submit(placementOwner,hwnd,FollowerPlacement.alignFrameRequest hwnd rect rect wp below)
+ | _ -> ()
+ | None -> ignore
+ this.onChrome(fun () -> if not divider.IsDisposed then divider.update(path,branch,gap,splitFrame,strip,dividerVisible,place))
+ // The backdrop goes just below the lowest pane; the tabs behind go below it. A drop
+ // surface of the group's too, registered as the empty panes are.
+ let backdrop =
+ match splitBackdrop with
+ | Some backdrop -> backdrop
+ | None ->
+ let backdrop,handle = this.chrome.invoke(fun () ->
+ Dpi.set dpi
+ let backdrop = new SplitBackdrop()
+ backdrop,backdrop.Handle)
+ System.Threading.Volatile.Write(&backdropHandle,handle)
+ splitBackdrop <- Some backdrop
+ emptyPaneChangedEvent.Trigger(IntPtr.Zero,handle)
+ backdrop
+ let lowestPane =
+ SplitView.windows s |> List.filter(fun hwnd -> this.windows.contains hwnd && not(isMinimized hwnd))
+ |> List.sortByDescending(fun hwnd -> this.os.windowFromHwnd(hwnd).zorder) |> List.tryHead |> Option.defaultValue IntPtr.Zero
+ this.onChrome(fun () -> if not backdrop.IsDisposed then backdrop.update(frame,lowestPane,visible))
+ // One window per empty pane, by its place; panes filled or gone lose theirs.
+ let empties = SplitGeometry.leafRects gap frame (SplitView.root s) [] |> List.filter(fun (_,pane,_) -> pane=Empty)
+ for path in emptySplitPanes |> Map.toList |> List.map fst do
+ if not(empties |> List.exists(fun (at,_,_) -> at=path)) then this.disposeEmptyPane path
+ let shown = visible || emptyPaneResize.IsSome
+ emptyPaneShown <- shown && not empties.IsEmpty
+ for path,_,rect in empties do
+ let pane =
+ match emptySplitPanes.TryFind path with
+ | Some(pane,_) -> pane
+ | None ->
+ // The pane asks by its window: its place in the layout can change while it stays.
+ let created : EmptySplitPane option ref = ref None
+ let at() = created.Value |> Option.bind this.emptyPanePath
+ let actions = {
+ candidates = (fun () -> Services.program.paneCandidates())
+ choose = (fun hwnd -> this.fromChrome(fun () -> at() |> Option.iter(fun path -> this.fillEmptyPane(path,hwnd))))
+ close = (fun () -> this.fromChrome(fun () -> at() |> Option.iter(fun path -> this.execute(ClosePane(Some path)))))
+ resizeStarted = (fun () -> this.fromChrome(fun () -> at() |> Option.iter this.beginEmptyPaneResize))
+ resized = (fun bounds -> this.fromChrome(fun () -> this.resizeEmptyPane bounds))
+ resizeEnded = (fun () -> this.fromChrome(fun () -> this.endEmptyPaneResize())) }
+ let pane,handle = this.chrome.invoke(fun () ->
+ Dpi.set dpi
+ let pane = new EmptySplitPane(actions)
+ pane.initialize()
+ pane,pane.Handle)
+ created.Value <- Some pane
+ emptySplitPanes <- emptySplitPanes.Add(path,(pane,handle))
+ this.addEmptyPaneHandle handle
+ pane
+ // Below the strip and its split's divider, so tabs shown inside the title bars cover
+ // its top as they do a window's. Its own drag keeps it on screen while the move-size
+ // puts the rest away.
+ let below =
+ if dividerVisible then splitDividers.TryFind(SplitTree.parent path) |> Option.map snd |> Option.defaultValue strip
+ else strip
+ // A sliver at its split's edge on its side, to open out from: from the right or the
+ // bottom for a second pane, the left or the top for a first.
+ let from =
+ if not emptyReveal then None
+ else
+ SplitView.position path s |> Option.map(fun (axis,side) ->
+ match axis,side with
+ | SideBySide,Second -> Rect(Pt(rect.right-1,rect.y),Sz(1,rect.height))
+ | SideBySide,First -> Rect(rect.location,Sz(1,rect.height))
+ | Stacked,Second -> Rect(Pt(rect.x,rect.bottom-1),Sz(rect.width,1))
+ | Stacked,First -> Rect(rect.location,Sz(rect.width,1)))
+ let occupied = SplitView.windows s
+ this.onChrome(fun () -> if not pane.IsDisposed then pane.update(rect,below,shown,from,occupied))
+ | _ ->
+ dividerShown <- false
+ for KeyValue(_,(divider,_)) in splitDividers do this.onChrome(fun () -> if not divider.IsDisposed then divider.Hide())
+ splitBackdrop |> Option.iter(fun backdrop -> this.onChrome(fun () -> if not backdrop.IsDisposed then backdrop.Hide()))
+ this.disposeEmptyPanes()
+
+ /// Where an empty pane's window stands in the layout now.
+ member private this.emptyPanePath(pane:EmptySplitPane) =
+ emptySplitPanes |> Map.tryPick(fun path (window,_) -> if obj.ReferenceEquals(window,pane) then Some path else None)
+
+ /// The empty pane's edges dragged: the same move-size as a pane window's, the strip and
+ /// divider put away and only the panes following until it ends.
+ member private this.beginEmptyPaneResize(path:PanePath) =
+ match groupLayout with
+ | Split s ->
+ let frame = this.layoutFrame
+ SplitGeometry.paneRect this.splitGap frame s path |> Option.iter(fun rect ->
+ emptyPaneResize <- Some(path,rect,frame,s.tree)
+ inMoveSize.set(true)
+ this.beginLive()
+ this.updateIsVisible())
+ | _ -> ()
+
+ /// Sizes arrive at every step of the drag; only the latest is applied, once per turn.
+ member private this.resizeEmptyPane(actual:Rect) =
+ let scheduled = pendingPaneBounds.IsSome
+ pendingPaneBounds <- Some actual
+ if not scheduled then
+ this.invokeAsync(fun () ->
+ let latest = pendingPaneBounds
+ pendingPaneBounds <- None
+ match groupLayout,emptyPaneResize,latest with
+ | Split s,Some(path,initial,startFrame,startTree),Some bounds ->
+ // A size the layout cannot take is skipped; the pane snaps back when the drag ends.
+ this.followSide(path,initial,startFrame,startTree,s,bounds) |> ignore
+ | _ -> ())
+
+ member private this.endEmptyPaneResize() =
+ if emptyPaneResize.IsSome then
+ emptyPaneResize <- None
+ pendingPaneBounds <- None
+ inMoveSize.set(false)
+ this.endLive()
+ this.updateIsVisible()
+
+ /// A window chosen from the empty pane's list: a tab of this group goes straight in, any
+ /// other window is handed over by the desktop first.
+ member private this.fillEmptyPane(path:PanePath,hwnd) =
+ match groupLayout with
+ | Split s when SplitView.pane path s=Some Empty ->
+ if this.windows.contains hwnd then this.execute(FillPane(hwnd,path))
+ else Services.desktop.adoptIntoPane(this.ts.hwnd,hwnd,path)
+ | _ -> ()
+
+ /// A window chosen from the list to go on one side of the tab `beside`: that tab's pane splits
+ /// to take it, or, with no split, the tab and the window share the group. A tab of this
+ /// group goes straight in; any other window is handed over by the desktop first. Chosen
+ /// first, the window needs no empty pane to wait in.
+ member this.placeBeside(beside:IntPtr, chosen:IntPtr, axis:SplitAxis, side:Side) =
+ if this.windows.contains beside && chosen<>beside && WinUserApi.IsWindow chosen && not isDestroyed.value then
+ let path =
+ match groupLayout with
+ | Split s -> SplitView.pathOf beside s |> Option.defaultValue []
+ | _ -> []
+ // Beside the tab asked for: with no split, it is the one shown, which the drop pairs with.
+ if not this.isSplit && this.topWindow<>beside then this.tabActivate(Tab beside,false)
+ let drop = SplitAt(path,axis,side)
+ if this.windows.contains chosen then this.dropTab(chosen,drop,beside)
+ else Services.desktop.adoptBeside(this.ts.hwnd,chosen,drop,beside)
+
+ /// What the list for a split offers: every window on this desktop but the tab it goes beside.
+ member this.splitCandidates(beside:IntPtr) =
+ Services.program.paneCandidates() |> List.filter(fun (hwnd,_,_) -> hwnd<>beside)
+
+ /// For the strip, once it has moved: the empty panes depend on where the tabs are.
+ member this.refreshSplitChrome() = if this.isSplit && not isDestroyed.value then this.updateSplitChrome()
+
+ member private this.addEmptyPaneHandle(hwnd:IntPtr) =
+ System.Threading.Volatile.Write(&emptyPaneHandles,hwnd::emptyPaneHandles)
+ emptyPaneChangedEvent.Trigger(IntPtr.Zero,hwnd)
+
+ member private this.disposeEmptyPane(path:PanePath) =
+ emptySplitPanes.TryFind path |> Option.iter(fun (pane,handle) ->
+ emptySplitPanes <- emptySplitPanes.Remove path
+ System.Threading.Volatile.Write(&emptyPaneHandles,emptyPaneHandles |> List.filter((<>) handle))
+ emptyPaneChangedEvent.Trigger(handle,IntPtr.Zero)
+ this.onChrome(fun () -> pane.Dispose()))
+
+ member private this.disposeEmptyPanes() =
+ emptyPaneShown <- false
+ for path in emptySplitPanes |> Map.toList |> List.map fst do this.disposeEmptyPane path
+
+ member _.emptyPaneHwnds = System.Threading.Volatile.Read(&emptyPaneHandles)
+ member this.isEmptyPane(hwnd:IntPtr) = hwnd<>IntPtr.Zero && List.contains hwnd this.emptyPaneHwnds
+
+ /// Closes an empty pane, as its close button does; Esc beside one comes here. The focused
+ /// pane's empty neighbour first. Checked again on this thread: it may have been filled since.
+ member this.closeEmptyPane() =
+ match groupLayout with
+ | Split s -> SplitView.emptyToClose s |> Option.iter(fun path -> this.execute(ClosePane(Some path)))
+ | _ -> ()
+ member _.emptyPaneChanged = emptyPaneChangedEvent.Publish
+
+ /// Badges follow the layout, and the panes' tabs stay next to each other in its order.
+ member private this.refreshLayoutTabs() =
+ this.windows.items.iter this.setTabInfo
+ for first,second in SplitView.paneOrder groupLayout |> List.pairwise do
+ let order = this.lorder.list
+ match List.tryFindIndex ((=) first) order,List.tryFindIndex ((=) second) order with
+ | Some a,Some b when b<>a+1 -> this.ts.moveTab(Tab(second),(if b ()
+ this.updateSplitChrome()
+ layoutChangedEvent.Trigger()
+
+ /// Every member goes where the layout says; a single layout keeps the follower path.
+ member private this.applyLayout() =
+ match groupLayout with
+ | Split _ when emptyReveal ->
+ // The window keeps the whole frame while the empty pane opens out over it.
+ this.setFrame this.layoutFrame
+ this.updateSplitChrome()
+ | Split _ when not reconcileMinimizeState ->
+ let frame = this.layoutFrame
+ this.setFrame frame
+ let _,wp,_ = placement.value.Value
+ let moving = splitMove |> Option.map(fun (source,_,_,_) -> source)
+ let pane hwnd = match groupLayout with Split s -> SplitView.contains hwnd s | _ -> false
+ // The tabs behind wait under the host pane. When another window becomes the host, a swap
+ // say, in the same place, they only need restacking under it: an unchanged placement
+ // restacks nothing.
+ let host = match groupLayout with Split s -> SplitView.window (SplitView.host s) s |> Option.defaultValue IntPtr.Zero | _ -> IntPtr.Zero
+ let hostChanged = host<>splitHost
+ splitHost <- host
+ // The tabs behind go under the backdrop, once there is one, which is under every pane.
+ let behind = if backdropHandle<>IntPtr.Zero then backdropHandle else host
+ for target in SplitView.plan groupLayout frame this.splitGap this.windows.items.list this.topWindow do
+ if hostChanged && not liveResize && not(pane target.hwnd) && host<>IntPtr.Zero && not(isMinimized target.hwnd) &&
+ FollowerPlacement.queue.isWindowIdle(placementOwner,target.hwnd) &&
+ this.os.windowFromHwnd(target.hwnd).visibleBounds=target.rect then
+ FollowerPlacement.queue.submit(placementOwner,target.hwnd,FollowerPlacement.stackBelowRequest target.hwnd behind)
+ else
+ // While dragging, the tabs behind are off screen until the drag ends, and a pane
+ // already in place is not asked again: each request moved and restacked windows
+ // under the pointer at every step.
+ let wanted =
+ if not liveResize then true
+ else pane target.hwnd &&
+ not(FollowerPlacement.queue.isWindowIdle(placementOwner,target.hwnd) &&
+ this.os.windowFromHwnd(target.hwnd).visibleBounds=target.rect)
+ // The strip rides above the focused pane, which it belongs to; the other pane goes
+ // just below that one, under the tabs over its title bar too.
+ let front = match groupLayout with Split s -> this.paneFront s | _ -> None
+ let below =
+ if pane target.hwnd && Some target.hwnd<>front then Some(front |> Option.defaultValue this.paneAnchor)
+ elif not(pane target.hwnd) && target.below.IsSome then Some behind
+ else target.below
+ if wanted && not(isMinimized target.hwnd) && moving<>Some target.hwnd && not(List.contains target.hwnd transitionHold) then
+ FollowerPlacement.queue.submit(placementOwner,target.hwnd,FollowerPlacement.alignFrameRequest target.hwnd target.rect target.rect wp below)
+ if not splitPending then splitDeadline <- transitionClock.ElapsedMilliseconds+int64 SplitMetrics.settleMs
+ splitPending <- true
+ splitSettleTimer.Start()
+ this.updateSplitChrome()
+ this.saveSplitProps()
+ | Split _ -> ()
+ | _ -> zorderCell.value.tail.iter(this.adjustWindowPlacement)
+
+ /// A drag of a pane, the empty pane or the divider: the other tabs go off screen, as a
+ /// single window's followers do while it moves, and come back when it ends.
+ member private this.beginLive() =
+ match groupLayout with
+ | Split s when not liveResize ->
+ liveResize <- true
+ for hwnd in this.windows.items.list do
+ if not(SplitView.contains hwnd s) && not(isMinimized hwnd) then
+ FollowerPlacement.queue.submit(placementOwner,hwnd,FollowerPlacement.hideRequest hwnd)
+ | _ -> ()
+
+ member private this.endLive() =
+ if liveResize then
+ liveResize <- false
+ this.applyLayout()
+
+ /// Both panes at their rectangles, within tolerance; DWM can report a frame after the worker finished.
+ member private this.panesSettled() =
+ match groupLayout with
+ | Split s when splitMove.IsNone && not reconcileMinimizeState ->
+ // In place, sized within what an app on a character grid rounds to.
+ let tolerance = Dpi.scale SplitMetrics.tolerance
+ let snap = Dpi.scale SplitMetrics.snap
+ let frame = this.layoutFrame
+ SplitView.windows s |> List.forall(fun hwnd ->
+ isMinimized hwnd ||
+ let expected = (SplitGeometry.paneRect this.splitGap frame s (SplitView.pathOf hwnd s).Value).Value
+ let actual = this.os.windowFromHwnd(hwnd).visibleBounds
+ abs(actual.x-expected.x)<=tolerance && abs(actual.y-expected.y)<=tolerance &&
+ abs(actual.width-expected.width)<=snap && abs(actual.height-expected.height)<=snap)
+ | _ -> true
+
+ /// The split changes: each window's image moves from where it was to its new place, one
+ /// coming in sliding from its side and fading in, one leaving the split fading where it was,
+ /// while the windows are placed underneath. A pane closed, the split ended, swapped, evened
+ /// out or turned all move so, and so does a tab clicked over the panes, growing from behind
+ /// them to the whole group while they fade, or the panes coming back from behind it: placed
+ /// at once, a tab behind rose pane-sized with the desktop showing round it. Not while a
+ /// divider is dragged, for the focus alone, for a window that has gone (`gone`), nor
+ /// without the system's animations.
+ member private this.beginTransition(before:GroupLayout, next:GroupLayout, current:IntPtr, ?focus:IntPtr, ?gone:IntPtr, ?durationMs:int) =
+ let gone = defaultArg gone IntPtr.Zero
+ let shown hwnd = hwnd<>gone && this.windows.contains hwnd && isOpen hwnd && not(isMinimized hwnd)
+ let frame = this.layoutFrame
+ let gap = this.splitGap
+ let paneOf (layout:SplitLayout) hwnd = SplitView.pathOf hwnd layout |> Option.bind(SplitGeometry.paneRect gap frame layout)
+ // The panes of the layout before, shown or parked behind the tab shown.
+ let inBefore = SplitView.layoutOf before |> Option.map SplitView.windows |> Option.defaultValue [] |> List.filter shown
+ // What was seen: the panes, or the one window shown, which the parked panes wait under.
+ let seenBefore = match before with Split b -> SplitView.windows b |> List.filter shown | _ -> List.filter shown [current]
+ // Where a window was: its pane; behind the panes, the host pane the tabs behind wait
+ // under; with no split shown, the frame.
+ let from hwnd =
+ match before with
+ | Split b -> paneOf b hwnd |> Option.orElse(SplitGeometry.paneRect gap frame b (SplitView.host b)) |> Option.defaultValue frame
+ | _ -> frame
+ let move hwnd from target fade =
+ let window = this.os.windowFromHwnd hwnd
+ let bounds,visible = window.bounds,window.visibleBounds
+ { hwnd=hwnd; from=from; target=target; fade=fade
+ border=Pt(visible.x-bounds.x,visible.y-bounds.y)
+ borderSize=Sz(bounds.width-visible.width,bounds.height-visible.height) }
+ let moves =
+ match before,next with
+ | _ when not SystemInformation.UIEffectsEnabled || liveResize || dragPause || this.isEmpty -> []
+ | _,Split s ->
+ let wasSplit = match before with Split _ -> true | _ -> false
+ let windows = SplitView.windows s |> List.filter shown
+ let into =
+ windows |> List.choose(fun hwnd ->
+ paneOf s hwnd |> Option.map(fun target ->
+ if List.contains hwnd inBefore || (not wasSplit && hwnd=current) then move hwnd (from hwnd) target NoFade
+ else
+ // In from its side: out past the split's edge by its own length.
+ let path = (SplitView.pathOf hwnd s).Value
+ let axis = match SplitTree.node (SplitTree.parent path) (SplitView.root s) with Some(Branch branch) -> branch.axis | _ -> s.tree.axis
+ let sign = if List.last path=Second then 1 else -1
+ let slid = if axis=SideBySide then target.move(sign*target.width,0) else target.move(0,sign*target.height)
+ move hwnd slid target FadeIn))
+ let leaving = seenBefore |> List.filter(fun hwnd -> not(List.contains hwnd windows)) |> List.map(fun hwnd -> move hwnd (from hwnd) (from hwnd) FadeOut)
+ into @ leaving
+ // Ended or parked: the window kept, or the tab clicked, grows to the frame and the
+ // panes fade where they were.
+ | Split b,(GroupLayout.Single | Parked _) ->
+ match focus |> Option.orElse(SplitView.focusedWindow b) |> Option.filter shown with
+ | Some keep ->
+ move keep (from keep) frame NoFade ::
+ (seenBefore |> List.filter((<>) keep) |> List.map(fun hwnd -> move hwnd (from hwnd) (from hwnd) FadeOut))
+ | None -> []
+ | _ -> []
+ if moves |> List.exists(fun move -> move.fade<>NoFade || move.from<>move.target) then
+ splitTransition |> Option.iter(fun previous -> this.onChrome(fun () -> previous.close()))
+ splitTransition <- None
+ transitionHold <- []
+ transitionIntoSplit <- (match next with Split _ -> true | _ -> false)
+ let dpi = Dpi.value()
+ let strip = this.ts.hwnd
+ let transition,shown = this.chrome.invoke(fun () ->
+ Dpi.set dpi
+ let transition = new SplitTransition(frame,moves,?durationMs=durationMs,strip=strip)
+ transition,transition.start())
+ if shown then coversShown <- coversShown+1
+ match next with
+ | Split _ when shown ->
+ splitTransition <- Some transition
+ // A window made smaller, or leaving, waits while its image moves, so the image
+ // shrinks from what it showed rather than the window jumping to its new size; one
+ // made larger, or coming in, goes to its place at once, so its image shows it at
+ // its new size, cut to the rectangle while that grows.
+ // Nothing waits when the images do not move.
+ transitionHold <-
+ if defaultArg durationMs SplitTransition.DurationMs<=0 then []
+ else
+ moves |> List.filter(fun move ->
+ move.fade=FadeOut || (move.fade=NoFade && move.target.width<=move.from.width && move.target.height<=move.from.height))
+ |> List.map(fun move -> move.hwnd)
+ // One timer, started afresh: a timer per transition let an earlier one, still
+ // running, place the windows a later transition was holding.
+ transitionRelease.Stop()
+ transitionRelease.Interval <- max 1 (defaultArg durationMs SplitTransition.DurationMs)
+ if not transitionHold.IsEmpty then transitionRelease.Start()
+ // Out of the split nothing waits for the windows: the images go once they have
+ // moved and the windows are placed.
+ | _ when shown -> splitTransition <- Some transition
+ | _ -> ()
+
+ /// The windows are in place: the images close once their steps are done.
+ member private this.settleTransition() =
+ splitTransition |> Option.iter(fun transition -> this.onChrome(fun () -> transition.settle()))
+ splitTransition <- None
+
+ member private this.checkSplitSettled() =
+ if splitPending && not isDestroyed.value then
+ let idle = FollowerPlacement.queue.isIdle(placementOwner)
+ if idle && this.panesSettled() then
+ this.settleTransition()
+ splitPending <- false
+ splitSettleTimer.Stop()
+ // Placement restacks the apps' windows; ours, owned by nothing, are put back over them.
+ if not this.isEmpty then this.keepPanesBelowStrip(this.topWindow)
+ elif transitionClock.ElapsedMilliseconds>=splitDeadline then
+ // A window that keeps a size of its own, a terminal on its character grid, an app
+ // with a larger minimum, stays where it put itself: the split goes on, with no
+ // message. Ending it here, with a dialog, came up every so often for such apps.
+ this.settleTransition()
+ splitPending <- false
+ splitSettleTimer.Stop()
+ if not this.isEmpty then this.keepPanesBelowStrip(this.topWindow)
+
+ /// One window fills the frame and the others line up under it, as a single layout has them.
+ member private this.collapseTo(target:IntPtr option) =
+ let frame = this.layoutFrame
+ splitMove <- None
+ liveResize <- false
+ splitPending <- false
+ splitSettleTimer.Stop()
+ let target =
+ match target with
+ | Some hwnd when this.windows.contains hwnd && isOpen hwnd -> Some hwnd
+ | _ -> this.lorder.list |> List.tryFind isOpen
+ target |> Option.iter(fun target ->
+ splitMerging <- true
+ let wp = {this.os.windowFromHwnd(target).placement with showCmd=ShowWindowCommands.SW_SHOWNORMAL}
+ placement.set(Some(frame,wp,frame))
+ this.windows.items.iter(fun window ->
+ FollowerPlacement.queue.submit(placementOwner,window,FollowerPlacement.alignFrameRequest window frame frame wp (if window=target then None else Some target)))
+ reconcilePlacementState <- true)
+
+ /// Moves to a layout and places the windows for it.
+ member private this.setLayout(next:GroupLayout, ?focus:IntPtr) =
+ let before = groupLayout
+ if next<>before then
+ groupLayout <- next
+ // Out of the split, the images of its start go at once: left until their wait ran
+ // out, they stayed over the group, topmost, in the way of what came next. Those
+ // covering the way out stay until the windows are placed.
+ match next with
+ | Split _ -> ()
+ | _ when transitionIntoSplit ->
+ splitTransition |> Option.iter(fun transition -> this.onChrome(fun () -> transition.close()))
+ splitTransition <- None
+ transitionHold <- []
+ | _ ->
+ transitionHold <- []
+ // A new empty pane opens out over the window first; the window takes its half after,
+ // under the pane, so no app is resized frame by frame.
+ match before,next with
+ | (GroupLayout.Single | Parked _),Split s when SplitView.hasEmpty s && SystemInformation.UIEffectsEnabled ->
+ emptyReveal <- true
+ let timer = new System.Windows.Forms.Timer(Interval=revealMs)
+ timer.Tick.Add(fun _ ->
+ timer.Stop()
+ timer.Dispose()
+ if emptyReveal && not isDestroyed.value then
+ emptyReveal <- false
+ this.withUpdate(fun () -> this.applyLayout())
+ else emptyReveal <- false)
+ timer.Start()
+ | _ -> ()
+ match before,next with
+ | Split s,GroupLayout.Single -> this.collapseTo(focus |> Option.orElse(SplitView.focusedWindow s))
+ | Split _,Parked _ -> this.collapseTo(focus)
+ // Only the focus moved between the panes: nothing needs placing, and placing every
+ // window again at each switch was work for nothing.
+ | Split a,Split b when {a with focused=b.focused}=b ->
+ this.setZorder(zorderCell.value)
+ this.keepPanesBelowStrip(this.topWindow)
+ | _,Split _ -> this.applyLayout()
+ | _ -> ()
+ // The same panes, only resized or focused differently: their tabs are as they were.
+ // Read again at every step of a divider drag, every tab's details, its name asked of
+ // the main thread among them, made each step slow and the steps pile up.
+ // Parked and shown again alike: a tab's place in the panes is the same either way, and
+ // reading every tab again at each such switch held the strip back a fifth of a second.
+ match before,next with
+ | Split a,Split b when SplitTree.sameShape (SplitView.root a) (SplitView.root b) -> layoutChangedEvent.Trigger()
+ | (Split a | Parked a),(Split b | Parked b) when SplitTree.sameShape (SplitView.root a) (SplitView.root b) ->
+ this.updateSplitChrome()
+ layoutChangedEvent.Trigger()
+ | _ -> this.refreshLayoutTabs()
+ this.saveSplitProps()
+
+ /// Runs a command for the window on top, or for `current` when the caller knows better.
+ member this.execute(command:SplitCommand, ?current:IntPtr, ?keepFrame:bool) = this.withUpdate(fun () ->
+ if not this.isEmpty && not isDestroyed.value then
+ // A command is the user's: the layout is theirs now, not the restart's.
+ splitFromProps <- false
+ match command with
+ | ToggleFill -> this.toggleFill()
+ | _ ->
+ let current = defaultArg current this.topWindow
+ let wasSplit = this.isSplit
+ if not wasSplit && not(defaultArg keepFrame false) then this.saveTopWindowPlacement()
+ // Each pane gets at least the size its window lets itself be sized to, the ratios
+ // moved as far as that takes. Asked again at every step of a divider drag, each
+ // pane's app, busy resizing, held the group thread up to the timeout per step.
+ (match command with SetRatio _ -> () | _ -> paneLeastCache <- Map.empty)
+ let least = this.paneLeast
+ let frame = this.layoutFrame
+ let fitsAll (tree:SplitTree) =
+ SplitGeometry.fits this.splitGap (Dpi.scale SplitMetrics.minPane) frame tree &&
+ SplitGeometry.fitsPanes this.splitGap least frame tree
+ let next =
+ match SplitView.apply current command groupLayout with
+ | Split s -> Split {s with tree=SplitGeometry.fitToPanes this.splitGap least frame s.tree}
+ | other -> other
+ // A layout that no longer fits, the group made smaller since, still takes commands.
+ let fitsNow = match groupLayout with Split s -> fitsAll s.tree | _ -> true
+ match next with
+ | Split s when fitsNow && not(fitsAll s.tree) ->
+ // A ratio or axis that does not fit is ignored; a split that cannot start says so.
+ if not wasSplit then Alert.show AlertKind.Warning (tr Strings.TabMenu.split) (tr Strings.TabMenu.splitFailed)
+ | _ ->
+ let keep = match command with EndSplit keep -> keep | _ -> None
+ (match command with EndSplit _ -> splitRestore <- None | _ -> ())
+ // A divider dragged is already where the user put it.
+ (match command with SetRatio _ -> () | _ -> this.beginTransition(groupLayout,next,current,?focus=keep))
+ this.setLayout(next,?focus=keep)
+ let activate hwnd =
+ if hwnd<>this.os.foreground.hwnd && this.windows.contains hwnd then this.tabActivate(Tab(hwnd),false)
+ match next with
+ | Split s -> SplitView.focusedWindow s |> Option.iter activate
+ | _ -> keep |> Option.iter activate)
+
+ /// A dragged tab dropped into a pane beside the tab shown, joining the group first if it is
+ /// not a member. The frame is read before it joins: it comes put away off screen by its drag
+ /// and, activated by it, as the top window, which the frame was read from after. The split
+ /// was laid out off screen then, and the dropped window seemed to vanish.
+ member this.dropTab(hwnd:IntPtr, drop:LayoutDrop, partner:IntPtr) = this.withUpdate(fun () ->
+ if not this.isEmpty && not isDestroyed.value then
+ // The pair is the dropped tab and the window shown: a drag takes its tab out of the
+ // group, so the pane left fills the group and is the one shown when the tab comes back.
+ let top = this.topWindow
+ let partner = if top<>hwnd && this.windows.contains top then top else partner
+ // The frame comes from the partner only once it is the window shown, in place: a
+ // tab behind waits pane-sized, and a window still being placed is where it was.
+ let frame =
+ if this.isSplit then None
+ else
+ if this.windows.contains partner && partner=this.topWindow && FollowerPlacement.queue.isWindowIdle(placementOwner,partner) then
+ this.saveWindowPlacement partner
+ placement.value
+ if not(this.windows.contains hwnd) then
+ this.addWindow(hwnd,false)
+ this.isManual <- true
+ frame |> Option.iter(fun saved -> placement.set(Some saved))
+ this.execute(SplitView.dropCommand hwnd drop,current=partner,keepFrame=frame.IsSome))
+
+ /// A shortcut asks for the list of windows to put beside the tab in front: the strip shows
+ /// it, as it does for the tab menu.
+ member this.requestPick(axis:SplitAxis, side:Side) =
+ if not this.isEmpty && not isDestroyed.value then pickRequestedEvent.Trigger(axis,side)
+ member _.pickRequested = pickRequestedEvent.Publish
+
+ /// A pane window coming to the front focuses its side; another tab parks the pair.
+ /// A tab clicked over the panes, or a pane's tab clicked to bring them back: the cover with
+ /// no steps, up before the window is activated where the click comes through `tabActivate`.
+ member private this.onActivated(hwnd) =
+ if this.windows.contains hwnd then
+ let next = SplitView.onActivated hwnd groupLayout
+ if next<>groupLayout && not coverAhead then this.beginTransition(groupLayout,next,hwnd,focus=hwnd,durationMs=SplitTransition.ClickMs)
+ coverAhead <- false
+ this.setLayout(next,focus=hwnd)
+
+ /// Losing a pane window: its neighbour takes its room, and the last other pane fills the frame.
+ member private this.onRemoved(hwnd) =
+ match groupLayout with
+ | Split s when SplitView.contains hwnd s ->
+ splitRestore <- None
+ match SplitView.onRemoved hwnd groupLayout with
+ | Split next ->
+ this.beginTransition(groupLayout,Split next,this.topWindow,gone=hwnd)
+ this.setLayout(Split next)
+ | _ ->
+ let survivor =
+ SplitView.windows s |> List.tryFind(fun window -> window<>hwnd && this.windows.contains window && isOpen window)
+ |> Option.orElse(this.lorder.list |> List.tryFind(fun window -> window<>hwnd && isOpen window))
+ this.beginTransition(groupLayout,GroupLayout.Single,this.topWindow,?focus=survivor,gone=hwnd)
+ this.setLayout(GroupLayout.Single,?focus=survivor)
+ | Parked s when SplitView.contains hwnd s ->
+ groupLayout <- SplitView.onRemoved hwnd groupLayout
+ this.refreshLayoutTabs()
+ | _ -> ()
+
+ /// The split fills the work area, or goes back to the frame it had.
+ member private this.toggleFill() =
+ match groupLayout with
+ | Split s ->
+ splitMove <- None
+ let frame =
+ match splitRestore with
+ | Some restore ->
+ splitRestore <- None
+ restore
+ | None ->
+ let current = this.layoutFrame
+ splitRestore <- Some current
+ SplitView.focusedWindow s |> Option.bind Mon.fromHwnd |> Option.map(fun monitor -> monitor.workRect) |> Option.defaultValue current
+ this.setFrame frame
+ this.applyLayout()
+ | _ -> ()
+
+ /// The frame follows a pane moved natively; a resize changes the frame or the ratio.
+ member private this.followPane(source,initial:Rect,startFrame:Rect,startTree:SplitTree,s:SplitLayout,actual:Rect) =
+ SplitView.pathOf source s |> Option.iter(fun path ->
+ if not(this.followSide(path,initial,startFrame,startTree,s,actual)) then this.leaveSplitNative source)
+
+ /// One pane, a window or an empty one, moved or sized from `initial`: a move carries the
+ /// whole frame, a resize changes the frame at an outer edge and a split's ratio at a seam.
+ /// Worked out from the frame and tree at the start of the drag at every step: from the
+ /// ratios of the step before, meant for a frame already grown, the other panes drifted.
+ /// False when the layout cannot take the new size.
+ member private this.followSide(path:PanePath,initial:Rect,startFrame:Rect,startTree:SplitTree,s:SplitLayout,actual:Rect) =
+ if actual.size=initial.size then
+ splitRestore <- None
+ this.setFrame(startFrame.move(actual.x-initial.x,actual.y-initial.y))
+ this.applyLayout()
+ true
+ else
+ let frame,tree = SplitGeometry.resizePane path initial actual this.splitGap startFrame startTree
+ let next = {s with tree=tree}
+ if SplitGeometry.fits this.splitGap (Dpi.scale SplitMetrics.minPane) frame tree then
+ splitRestore <- None
+ groupLayout <- Split next
+ this.setFrame frame
+ this.applyLayout()
+ true
+ else false
+
+ /// A pane went where the layout cannot follow: the group keeps that window's own frame.
+ member private this.leaveSplitNative(hwnd) =
+ groupLayout <- GroupLayout.Single
+ splitMove <- None
+ liveResize <- false
+ splitPending <- false
+ splitSettleTimer.Stop()
+ splitRestore <- None
+ this.windows.items.iter(fun window -> FollowerPlacement.queue.cancel(placementOwner,window))
+ this.setZorder(zorderCell.value.where((<>) hwnd).prepend hwnd)
+ this.refreshLayoutTabs()
+ this.saveTopWindowPlacement()
+ this.adjustChildWindows()
+
+ /// The split kept on its windows, saved as it changes and cleared as it ends. Not for a
+ /// few seconds after it was restored from them: the windows still to arrive were saved with
+ /// the whole layout, which a save of the part present would spoil.
+ member private this.saveSplitProps() =
+ if not(splitFromProps && splitRestoreClock.ElapsedMilliseconds<5000L) then
+ splitFromProps <- false
+ let entries = SplitPersistence.entries groupLayout
+ let frame = this.layoutFrame
+ for hwnd,pane in entries do WindowSplitLayout.save hwnd pane frame
+ let saved = entries |> List.map fst |> Set.ofList
+ for hwnd in this.windows.items.list do
+ if not(saved.Contains hwnd) then WindowSplitLayout.clear hwnd
+
+ /// A window arriving with a place in a split its windows remembered: the layout those present
+ /// remember together comes back, and grows as the rest arrive.
+ member private this.restoreSplitProps(hwnd) =
+ match WindowSplitLayout.read hwnd with
+ | Some(_,frame) when groupLayout=GroupLayout.Single || splitFromProps ->
+ let saved =
+ this.windows.items.list |> List.choose(fun member' ->
+ WindowSplitLayout.read member' |> Option.filter(fun (_,at) -> at=frame) |> Option.map(fun (pane,_) -> member',pane))
+ match SplitPersistence.rebuild saved with
+ | GroupLayout.Single -> ()
+ | layout ->
+ splitFromProps <- true
+ splitRestoreClock.Restart()
+ this.restoreLayout(layout,frame)
+ | _ -> ()
+
+ /// The split as a workspace keeps it: parked or shown, its frame, and each pane window's place.
+ member this.savedSplit =
+ match groupLayout with
+ | GroupLayout.Single -> None
+ | Split _ | Parked _ -> Some((match groupLayout with Parked _ -> true | _ -> false),this.layoutFrame,SplitPersistence.entries groupLayout)
+
+ /// A rebuilt group takes over the old one's layout once its members have arrived.
+ member this.restoreLayout(next:GroupLayout, frame:Rect) = this.withUpdate(fun () ->
+ match SplitView.prune this.windows.contains next with
+ | GroupLayout.Single -> ()
+ | pruned ->
+ if not frame.isEmpty then this.setFrame frame
+ groupLayout <- pruned
+ (match pruned with Split _ -> this.applyLayout() | _ -> ())
+ this.refreshLayoutTabs())
+
/// Where the group's windows are, for previews: nothing is saved for a group that has not
/// been on screen since WindowTabs started, minimized from the start, say.
member this.previewArea : Rect =
@@ -684,15 +1731,18 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
member private this.isTop(hwnd) = zorderCell.value.where(isMinimized >> not).tryHead = Some(hwnd)
- member private this.saveTopWindowPlacement() =
- let window = this.os.windowFromHwnd(zorderCell.value.head)
+ member private this.saveTopWindowPlacement() = this.saveWindowPlacement zorderCell.value.head
+
+ /// The group's frame from one of its windows.
+ member private this.saveWindowPlacement(hwnd:IntPtr) =
+ let window = this.os.windowFromHwnd(hwnd)
let dpi = Dpi.forMonitor window.hwnd
if dpi <> Dpi.value() then
Dpi.set dpi
appearanceSnapshot <- logicalAppearance.scaled
this.ts.setTabAppearance(appearanceSnapshot)
geometryChangedEvent.Trigger()
- if window.isMinimized.not &&
+ if not this.isSplit && not splitMerging && window.isMinimized.not &&
this.os.isOnScreen(window.bounds)
then
let monitorBounds =
@@ -703,6 +1753,8 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
let bounds = monitorBounds.def(window.bounds)
let visible = monitorBounds.def(window.visibleBounds)
placement.set(Some(bounds, window.placement, visible))
+ // Parked panes come back at the frame the group has now.
+ (match groupLayout with Parked _ -> this.saveSplitProps() | _ -> ())
if enableSuperBar then this.prepareMinimizeAnchor window.hwnd
member this.prepareMinimizeAnchor hwnd =
@@ -716,7 +1768,8 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
match requestedMinimizeStates.TryGetValue(hwnd) with
| true,expected -> this.os.windowFromHwnd(hwnd).isMinimized<>expected && FollowerPlacement.isChangingMinimizeState placementOwner hwnd
| _ -> false
- if placement.value.IsSome && not changingMinimizeState then
+ if this.isSplit then this.applyLayout()
+ elif placement.value.IsSome && not changingMinimizeState then
let bounds,wp,visible = placement.value.Value
let below = zorderCell.value.tryHead |> Option.filter((<>) hwnd)
let request = FollowerPlacement.alignFrameRequest hwnd bounds visible wp below
@@ -725,7 +1778,10 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
reconcilePlacementState <- true
this.finishPlacementReconciliation()
- member this.isPlacementIdle = FollowerPlacement.queue.isIdle(placementOwner) && not reconcileMinimizeState && not reconcilePlacementState
+ /// Minimizing or restoring, as Windows does it window by window.
+ member this.isChangingMinimizeState = reconcileMinimizeState || pendingMinimizeStates.Count>0
+
+ member this.isPlacementIdle = FollowerPlacement.queue.isIdle(placementOwner) && not reconcileMinimizeState && not reconcilePlacementState && not splitPending && not emptyReveal
member this.setTabColor(hwnd,color) =
Services.program.setTabColorOverride(hwnd,color)
@@ -767,16 +1823,33 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
Cell.endUpdate()
- member this.onEnterMoveSize() =
+ /// In a split the moved pane leads and the other follows; a single layout hides the followers.
+ member this.onEnterMoveSize(?source:IntPtr) =
inMoveSize.set(true)
- this.hideChildWindows()
+ match groupLayout with
+ | Split s ->
+ let source = defaultArg source this.os.foreground.hwnd
+ if SplitView.contains source s then
+ splitMove <- Some(source,this.os.windowFromHwnd(source).visibleBounds,this.layoutFrame,s.tree)
+ this.beginLive()
+ | _ -> this.hideChildWindows()
this.updateIsVisible()
member this.onExitMoveSize() =
inMoveSize.set(false)
+ // The final location notification may still be queued behind MOVESIZEEND.
+ splitMove |> Option.iter(fun (source,initial,frame,startTree) ->
+ match groupLayout with
+ | Split s ->
+ let window = this.os.windowFromHwnd(source)
+ if not window.isMaximized && not window.isMinimized then this.followPane(source,initial,frame,startTree,s,window.visibleBounds)
+ | _ -> ())
+ splitMove <- None
+ // Every window, the tabs behind included, goes back into place below.
+ liveResize <- false
this.saveTopWindowPlacement()
this.adjustChildWindows()
- this.makeTopWindowForeground()
+ if this.windows.contains(this.os.foreground.hwnd) then this.makeTopWindowForeground()
this.updateIsVisible()
member this.main(hwnd, evt) =
@@ -850,11 +1923,11 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
then
this.setTabInfo hwnd
| WinEvent.EVENT_SYSTEM_MOVESIZESTART ->
- if this.isTop(hwnd) then
- this.onEnterMoveSize()
+ if this.isTop(hwnd) || (this.splitLayout |> Option.exists(SplitView.contains hwnd)) then
+ this.onEnterMoveSize(hwnd)
| WinEvent.EVENT_SYSTEM_MOVESIZEEND ->
- if this.isTop(hwnd) then
+ if this.isTop(hwnd) || (this.splitLayout |> Option.exists(SplitView.contains hwnd)) then
this.onExitMoveSize()
//this is here to detect transitions between maximized and
@@ -863,7 +1936,29 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
//event when they loose focus, we don't want to automatically give them focus in this case
//so make sure that the window HAD focus before reapplying it
| WinEvent.EVENT_OBJECT_LOCATIONCHANGE ->
- if this.isTop(hwnd) && inMoveSize.value.not then
+ match groupLayout with
+ | Split s ->
+ let window = this.os.windowFromHwnd(hwnd)
+ let pane = SplitView.contains hwnd s
+ if pane && window.isMaximized && (not splitPending || FollowerPlacement.queue.isIdle(placementOwner)) && not reconcileMinimizeState then
+ // Native maximize of a pane fills the work area with the whole split.
+ this.toggleFill()
+ else
+ match splitMove with
+ | Some(source,initial,frame,startTree) when hwnd=source -> this.followPane(source,initial,frame,startTree,s,window.visibleBounds)
+ | None when pane && not splitPending && not reconcileMinimizeState && not window.isMinimized && FollowerPlacement.queue.isWindowIdle(placementOwner,hwnd) ->
+ // The application moved or sized itself: take its frame while the layout still fits.
+ // Not for a size a little off its pane: apps on a character grid round every
+ // size they are given, and following that rounding resized both panes again
+ // and again, a little smaller each time.
+ let expected = (SplitGeometry.paneRect this.splitGap this.layoutFrame s (SplitView.pathOf hwnd s).Value).Value
+ let actual = window.visibleBounds
+ let tolerance = Dpi.scale SplitMetrics.tolerance
+ let snap = Dpi.scale SplitMetrics.snap
+ if abs(actual.x-expected.x)>tolerance || abs(actual.y-expected.y)>tolerance || abs(actual.width-expected.width)>snap || abs(actual.height-expected.height)>snap then
+ this.followPane(hwnd,expected,this.layoutFrame,s.tree,s,actual)
+ | _ -> ()
+ | _ when this.isTop(hwnd) && inMoveSize.value.not ->
//you can miss EVENT_SYSTEM_MOVESIZESTART events
//when a window is created and is immediatly in move size, we subscribe
//to the event too late (Chrome tab dragging is prime example)
@@ -880,6 +1975,7 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
this.makeTopWindowForeground()
this.foreground <- this.os.foreground.hwnd
isMaximizedExport.update()
+ | _ -> ()
| WinEvent.EVENT_SYSTEM_FOREGROUND ->
// Activated some other way (Alt+Tab, its own window), an owned tab can stay under the
// others in the same way as one activated from the strip.
@@ -894,8 +1990,12 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if this.windows.contains(hwnd) then
this.saveTopWindowPlacement()
this.updateIsVisible()
+ // An app raised by a click comes over the divider and the empty pane, which are
+ // owned by nothing: its invisible resize border then took their edges.
+ this.keepPanesBelowStrip(this.topWindow)
this.ts.refreshShadow()
| WinEvent.EVENT_OBJECT_HIDE | WinEvent.EVENT_OBJECT_DESTROY ->
+ if evt=WinEvent.EVENT_OBJECT_DESTROY || not(isMinimized hwnd) then this.onRemoved(hwnd)
this.reclaimLeftTab(hwnd)
if lastActiveTab=Some hwnd then this.followClosedTab(this.os.foreground.hwnd)
| WinEvent.EVENT_OBJECT_CLOAKED | WinEvent.EVENT_OBJECT_UNCLOAKED ->
@@ -945,8 +2045,15 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if foreground=hwnd then
opener <- lastActiveTab |> Option.filter(fun owner -> owner<>hwnd && this.windows.contains(owner) && isOpen owner) |> Option.map(fun owner -> hwnd,owner)
lastActiveTab <- TabNavigation.rememberActive this.lorder.list isOpen lastActiveTab foreground
+ // Joining with the focus, as a tab dragged here has from its drag, a window from outside
+ // the panes parks them, as choosing it does: placed as a tab behind, it waited under the
+ // panes with the focus. A pane coming back with its place saved is put among them.
+ if foreground=hwnd && this.isSplit && (WindowSplitLayout.read hwnd).IsNone then
+ this.onActivated(hwnd)
+ this.setZorder(zorderCell.value.where((<>) hwnd).prepend hwnd)
StartupTrace.measure "group.add.placement" (fun () -> this.adjustWindowPlacement(hwnd))
if hasSavedTabLayout then WindowTabLayout.save hwnd this.tabLayout
+ this.restoreSplitProps(hwnd)
StartupTrace.measure "group.add.notify" (fun () -> addedEvent.Trigger(hwnd))
// A visible window joining a minimized group restores it, as restoring any tab does,
// so closing that window shows the previous tab instead of minimizing the group again.
@@ -961,6 +2068,8 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
member this.removeWindow(hwnd) = this.withUpdate <| fun() ->
inputOwnership.Remove hwnd |> ignore
if not isDestroyed.value && this.windows.contains(hwnd) then
+ this.onRemoved(hwnd)
+ WindowSplitLayout.clear hwnd
this.reclaimLeftTab(hwnd)
let foreground = this.os.foreground.hwnd
let next = TabNavigation.closeTarget this.lorder.list isOpen hwnd foreground lastActiveTab opener (this.leftOnClose hwnd)
@@ -994,6 +2103,16 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
if followedClose |> Option.exists(fun (closed,_) -> closed=hwnd) then followedClose <- None
else next |> Option.iter(fun target -> this.tabActivate(Tab(target),false))
+ /// The tab shown before `hwnd`, the one the foreground left for it, comes to the front, once
+ /// `hwnd` has left the group by a drag. Nothing else is known to have been shown: a tab
+ /// chosen over parked panes stacked every other tab under it in no particular order, so the
+ /// window on top then was any of them.
+ member this.showTabBefore(hwnd:IntPtr) =
+ match leftTab with
+ | Some(left,next,_) when next=hwnd && left<>hwnd && this.windows.contains left && isOpen left && not(isMinimized left) ->
+ this.tabActivate(Tab left,false)
+ | _ -> ()
+
/// The foreground left this tab just before it closed or minimized: it is still the active tab.
member private this.reclaimLeftTab(hwnd) =
if lastActiveTab<>Some hwnd && (not(isOpen hwnd) || isMinimized hwnd) &&
@@ -1049,6 +2168,30 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
member this.destroy() =
if isDestroyed.value.not then
isDestroyed.set(true)
+ splitSettleTimer.Dispose()
+ splitGuardTimer.Dispose()
+ transitionRelease.Dispose()
+ // The chrome's thread disposes its windows and ends; nothing here waits for it.
+ chromeInvoker |> Option.iter(fun invoker ->
+ let dividers = splitDividers |> Map.toList |> List.map(snd >> fst)
+ let panes = emptySplitPanes |> Map.toList |> List.map(snd >> fst)
+ let backdrop = splitBackdrop
+ let transition = splitTransition
+ invoker.asyncInvoke(fun () ->
+ transition |> Option.iter(fun window -> window.close(); window.Dispose())
+ for window in dividers do window.Dispose()
+ for window in panes do window.Dispose()
+ backdrop |> Option.iter(fun window -> window.Dispose())
+ System.Windows.Forms.Application.ExitThread()))
+ chromeInvoker <- None
+ splitTransition <- None
+ splitDividers <- Map.empty
+ emptySplitPanes <- Map.empty
+ splitBackdrop <- None
+ let handles = emptyPaneHandles@(if backdropHandle<>IntPtr.Zero then [backdropHandle] else [])
+ System.Threading.Volatile.Write(&emptyPaneHandles,[])
+ System.Threading.Volatile.Write(&backdropHandle,IntPtr.Zero)
+ for handle in handles do emptyPaneChangedEvent.Trigger(handle,IntPtr.Zero)
placementCompletion |> Option.iter(fun subscription -> subscription.Dispose())
placementCompletion <- None
this.windows.items.iter(fun hwnd -> FollowerPlacement.queue.release(placementOwner,hwnd))
@@ -1104,8 +2247,40 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
FollowerPlacement.queue.submit(placementOwner,hwnd,request)
this.watchMinimizeCompletion()
+ /// A plain switch to another tab, with no split shown: the window shown fades out over the
+ /// one coming up (`SplitTransition.CrossFadeMs`). An app that stops painting while covered,
+ /// as Chromium ones do, paints its background first when it comes up, and that blank showed
+ /// for a tenth of a second. The image is of the window shown, live, cut to the group's frame.
+ member private this.crossFadeTo(hwnd:IntPtr) =
+ let shown = this.topWindow
+ if SystemInformation.UIEffectsEnabled && not dragPause && not this.isSplit && shown<>hwnd &&
+ this.windows.contains shown && isOpen shown && not(isMinimized shown) && not(isMinimized hwnd) && isVisibleCell.value then
+ let frame = this.layoutFrame
+ let window = this.os.windowFromHwnd shown
+ let bounds,visible = window.bounds,window.visibleBounds
+ let move = { hwnd=shown; from=frame; target=frame; fade=NoFade
+ border=Pt(visible.x-bounds.x,visible.y-bounds.y)
+ borderSize=Sz(bounds.width-visible.width,bounds.height-visible.height) }
+ let dpi = Dpi.value()
+ let strip = this.ts.hwnd
+ let shownNow =
+ this.chrome.invoke(fun () ->
+ Dpi.set dpi
+ let fade = new SplitTransition(frame,[move],durationMs=SplitTransition.CrossFadeMs,crossFade=true,strip=strip)
+ fade.start())
+ if shownNow then coversShown <- coversShown+1
+
member this.tabActivate(Tab(hwnd), force) =
let window = this.os.windowFromHwnd(hwnd)
+ // The cover goes up before the window comes to the front: raised first, a parked pane
+ // showed at the group's size over the tab shown for a frame, and a tab clicked over the
+ // panes rose pane-sized among them, before the layout followed.
+ if this.windows.contains(hwnd) then
+ let next = SplitView.onActivated hwnd groupLayout
+ if next<>groupLayout then
+ this.beginTransition(groupLayout,next,hwnd,focus=hwnd,durationMs=SplitTransition.ClickMs)
+ coverAhead <- true
+ elif groupLayout=GroupLayout.Single then this.crossFadeTo hwnd
// The strip is owned by the top window and only follows a new top window once the
// foreground event comes back through the group. Until then the activated window
// covers it, which flashes whenever the tabs sit inside the title bar. Owned windows
@@ -1117,12 +2292,54 @@ type WindowGroup(enableSuperBar:bool, plugins:List2, initialAppearance:
// only once it is in front, as a refused activation leaves the strip with the real top window.
if this.os.foreground.hwnd=hwnd then window.raise()
if this.os.foreground.hwnd=hwnd then lastActiveTab <- Some hwnd
- // Activation can be refused (foreground lock); keep the strip with the real top window.
- this.inZorder(this.windows.items).tryHead |> Option.iter (fun top ->
- if top <> hwnd then this.setTsOwner(this.os.windowFromHwnd(top)))
+ // The layout follows once the tab is in front: parking a split first re-placed every window
+ // while the tab chosen was still under them, and a tab behind showed for a moment. Active,
+ // or raised over the other tabs, the tab is the group's front window at once, in the same
+ // update as the layout: the strip follows the front window, and seeing the layout change
+ // first it went back to the pane, which the rising tab then covered.
+ let top = this.inZorder(this.windows.items).tryHead
+ let inFront = this.os.foreground.hwnd=hwnd || top=Some hwnd
+ // The strip shows the tab as the one in front now, before the layout follows: told only
+ // when the update below ended, the tab behind stayed lit for as long as the layout took,
+ // a fifth of a second when a split parked or came back, and two tabs looked chosen.
+ if inFront && this.windows.contains(hwnd) then
+ this.ts.zorder <- zorderCell.value.where((<>) hwnd).prepend(hwnd).map(Tab)
+ this.withUpdate(fun () ->
+ if this.windows.contains(hwnd) then
+ this.onActivated(hwnd)
+ if inFront then this.setZorder(zorderCell.value.where((<>) hwnd).prepend hwnd))
+ if not inFront then
+ // Activation can be refused (foreground lock), and the strip then goes back to the real
+ // top window. Windows can also take a moment to raise it, so that is only decided once
+ // it has had the time: handed back at once, the strip went under the tab as it rose.
+ let timer = new System.Windows.Forms.Timer(Interval=300)
+ timer.Tick.Add(fun _ ->
+ timer.Stop()
+ timer.Dispose()
+ if not isDestroyed.value && this.os.foreground.hwnd<>hwnd then
+ this.inZorder(this.windows.items).tryHead |> Option.iter(fun top ->
+ if top<>hwnd then this.setTsOwner(this.os.windowFromHwnd(top))))
+ timer.Start()
member this.onTabMoved(hwnd, index) = movedEvent.Trigger(hwnd, index)
+ /// The pair's tabs dragged into the other order swap the panes to match. Kept as they were,
+ /// the tabs were put back in pane order at the next click, undoing the drag.
+ member this.onTabsReordered() =
+ match SplitView.layoutOf groupLayout with
+ | Some s ->
+ let order = this.lorder.list
+ // A split of two pane windows whose tabs are the other way round.
+ SplitTree.branches [] (SplitView.root s) |> List.tryPick(fun (path,branch) ->
+ match branch.first,branch.second with
+ | Leaf(Occupied a),Leaf(Occupied b) ->
+ match List.tryFindIndex ((=) a) order,List.tryFindIndex ((=) b) order with
+ | Some first,Some second when second Some path
+ | _ -> None
+ | _ -> None)
+ |> Option.iter(fun path -> this.execute(Swap(Some path)))
+ | None -> ()
+
member x.exited = exitedEvent.Publish
member this.bounds = boundsExport :> ICellOutput<_>
member this.isForeground = isForegroundExport :> ICellOutput<_>
diff --git a/WtProgram/Workspace/WorkspaceData.fs b/WtProgram/Workspace/WorkspaceData.fs
index ddb2440e..9284dc4a 100644
--- a/WtProgram/Workspace/WorkspaceData.fs
+++ b/WtProgram/Workspace/WorkspaceData.fs
@@ -2,6 +2,10 @@ namespace Bemo
open System
open Bemo.Json
+/// A group's split view as a workspace keeps it: each pane window by its place in the group's
+/// window list with what it remembers of the split, and the frame the panes divide.
+type SavedSplit = { parked: bool; frame: Rect; panes: (int * SavedPane) list }
+
module WorkspaceData =
let version = 3
/// Drops an entry that is harmless rather than damaged, without a warning.
@@ -36,12 +40,9 @@ module WorkspaceData =
JObject(JProperty("position",position),JProperty("columnWidth",between SettingsCatalog.columnWidthRange layout.columnWidth),
JProperty("normalAlignment",alignment layout.normalAlignment),JProperty("insideAlignment",alignment layout.insideAlignment))
- /// Normal placement uses workspace coordinates, including the taskbar offset.
- let fitPlacement (monitors:(Rect * Rect) list) (value:OSWindowPlacement) =
- let areas = monitors |> List.map(fun (display,work) ->
- work.move(display.x-work.x,display.y-work.y))
- let bounds = value.rcNormalPosition
- if areas.IsEmpty || areas |> List.exists(fun area -> area.completlyContains bounds) then value
+ /// A rectangle kept inside one of the areas: the one it overlaps most, else the nearest.
+ let fitRect (areas:Rect list) (bounds:Rect) =
+ if areas.IsEmpty || areas |> List.exists(fun area -> area.completlyContains bounds) then bounds
else
let distance (area:Rect) =
let dx = max 0L (max (int64 area.left-int64 bounds.right) (int64 bounds.left-int64 area.right))
@@ -53,8 +54,30 @@ module WorkspaceData =
let width,height = min bounds.width area.width,min bounds.height area.height
let x = max area.left (min bounds.x (area.right-width))
let y = max area.top (min bounds.y (area.bottom-height))
- { value with rcNormalPosition=Rect(Pt(x,y),Sz(width,height))
- ptMaxPosition=Pt(-1,-1);ptMinPosition=Pt(-1,-1) }
+ Rect(Pt(x,y),Sz(width,height))
+
+ /// Normal placement uses workspace coordinates, including the taskbar offset.
+ let fitPlacement (monitors:(Rect * Rect) list) (value:OSWindowPlacement) =
+ let areas = monitors |> List.map(fun (display,work) ->
+ work.move(display.x-work.x,display.y-work.y))
+ let bounds = fitRect areas value.rcNormalPosition
+ if bounds=value.rcNormalPosition then value
+ else { value with rcNormalPosition=bounds; ptMaxPosition=Pt(-1,-1);ptMinPosition=Pt(-1,-1) }
+
+ /// As fitPlacement, for a window whose frame (`bounds`) is larger than what shows
+ /// (`visible`) by an invisible border: only the visible part has to be on screen.
+ let fitPlacementOf (monitors:(Rect * Rect) list) (bounds:Rect) (visible:Rect) (value:OSWindowPlacement) =
+ if visible.size.isEmptyArea || bounds.size.isEmptyArea then fitPlacement monitors value
+ else
+ let left,top = visible.x-bounds.x,visible.y-bounds.y
+ let right,bottom = bounds.right-visible.right,bounds.bottom-visible.bottom
+ let frame = value.rcNormalPosition
+ let shown = Rect(Pt(frame.x+left,frame.y+top),Sz(frame.width-left-right,frame.height-top-bottom))
+ let fitted = fitPlacement monitors {value with rcNormalPosition=shown}
+ if fitted.rcNormalPosition=shown then value
+ else
+ let placed = fitted.rcNormalPosition
+ { fitted with rcNormalPosition=Rect(Pt(placed.x-left,placed.y-top),Sz(placed.width+left+right,placed.height+top+bottom)) }
let placement (obj:JObject) =
let point key fallback =
@@ -73,6 +96,51 @@ module WorkspaceData =
JProperty("ptMinPosition",point value.ptMinPosition),
JProperty("rcNormalPosition",JObject(JProperty("x",value.rcNormalPosition.x),JProperty("y",value.rcNormalPosition.y),
JProperty("width",value.rcNormalPosition.width),JProperty("height",value.rcNormalPosition.height))))
+ /// A pane's levels as letters: L and R for the sides of a side-by-side split, T and B of a stacked one.
+ let split (obj:JObject) : SavedSplit =
+ let frame =
+ match obj.["frame"] with
+ | :? JObject as f -> Rect(Pt(number f "x" 0,number f "y" 0),Sz(number f "width" 0,number f "height" 0))
+ | _ -> invalidArg "frame" "Missing frame."
+ if frame.width<=0 || frame.height<=0 || frame.width>100000 || frame.height>100000 then invalidArg "frame" "Invalid frame."
+ let parked = match obj.["parked"] with null -> false | value -> value.Value()
+ let panes =
+ match obj.["panes"] with
+ | :? JArray as panes ->
+ panes |> Seq.map(fun pane ->
+ match pane with
+ | :? JObject as pane ->
+ let levels =
+ match pane.["levels"] with
+ | :? JArray as levels ->
+ levels |> Seq.map(fun level ->
+ match level.Value() with
+ | "L" -> SideBySide,First | "R" -> SideBySide,Second
+ | "T" -> Stacked,First | "B" -> Stacked,Second
+ | other -> invalidArg "levels" ("Unknown level: "+other)) |> List.ofSeq
+ | _ -> invalidArg "levels" "Missing levels."
+ let ratios =
+ match pane.["ratios"] with
+ | :? JArray as ratios -> ratios |> Seq.map(fun ratio -> SplitMetrics.clampRatio(ratio.Value())) |> List.ofSeq
+ | _ -> levels |> List.map(fun _ -> 0.5)
+ let focused = match pane.["focused"] with null -> false | value -> value.Value()
+ number pane "window" -1,{levels=levels;ratios=ratios;focused=focused;parked=parked}
+ | _ -> invalidArg "panes" "Expected an object.") |> List.ofSeq
+ | _ -> invalidArg "panes" "Missing panes."
+ if panes.Length<2 || panes |> List.exists(fun (index,_) -> index<0) then invalidArg "panes" "A split needs two panes."
+ { parked=parked; frame=frame; panes=panes }
+
+ let writeSplit (split:SavedSplit) =
+ let level = function
+ | SideBySide,First -> "L" | SideBySide,Second -> "R"
+ | Stacked,First -> "T" | Stacked,Second -> "B"
+ JObject(JProperty("parked",split.parked),
+ JProperty("frame",JObject(JProperty("x",split.frame.x),JProperty("y",split.frame.y),
+ JProperty("width",split.frame.width),JProperty("height",split.frame.height))),
+ JProperty("panes",JArray(split.panes |> List.map(fun (index,pane) ->
+ JObject(JProperty("window",index),JProperty("levels",JArray(pane.levels |> List.map(level >> box))),
+ JProperty("ratios",JArray(pane.ratios |> List.map box)),JProperty("focused",pane.focused)) :> obj))))
+
/// Validate each entry independently. Callers retain the original JSON if anything is rejected.
let read (root:JObject) =
let warnings = ResizeArray()
@@ -121,6 +189,14 @@ module WorkspaceData =
with _ ->
warnings.Add(tr Strings.Workspaces.invalidTabLayout)
obj.Remove("tabLayout") |> ignore
+ try
+ match obj.["split"] with
+ | null -> ()
+ | :? JObject as saved -> obj.["split"] <- writeSplit (split saved)
+ | _ -> invalidArg "split" (tr Strings.Workspaces.invalidSplit)
+ with _ ->
+ warnings.Add(tr Strings.Workspaces.invalidSplit)
+ obj.Remove("split") |> ignore
obj
let workspace (obj:JObject) =
let groups = collect "Group" obj.["groups"] group
@@ -134,3 +210,10 @@ module WorkspaceData =
let result = collect "Workspace" root.["workspaces"] workspace
result,List.ofSeq warnings,false
with ex -> [],[ex.Message],true
+
+ /// One workspace kept on its own, the session, checked as the saved list is.
+ let readOne (obj:JObject) =
+ let root = JObject(JProperty("workspaceSchemaVersion",version),JProperty("workspaces",JArray(obj.DeepClone())))
+ match read root with
+ | [workspace],_,false -> Some workspace
+ | _ -> None
diff --git a/WtProgram/Workspace/WorkspaceModel.fs b/WtProgram/Workspace/WorkspaceModel.fs
index f8c3129e..c02e1716 100755
--- a/WtProgram/Workspace/WorkspaceModel.fs
+++ b/WtProgram/Workspace/WorkspaceModel.fs
@@ -124,6 +124,7 @@ and
let mutable _windows = System.Collections.Generic.List()
let removedEvent = Event<_>()
member val tabLayout : GroupTabLayout option = None with get,set
+ member val split : SavedSplit option = None with get,set
member this.addWindow(window) =
_windows.Add(window)
@@ -159,6 +160,7 @@ and
groupObj.setObject("placement", placementObj)
groupObj.setObjectArray("windows", windowObjects)
this.tabLayout |> Option.iter(fun layout -> groupObj.["tabLayout"] <- WorkspaceData.writeTabLayout layout)
+ this.split |> Option.iter(fun split -> groupObj.["split"] <- WorkspaceData.writeSplit split)
groupObj
static member deserialize(obj:JObject) =
@@ -169,6 +171,9 @@ and
match obj.["tabLayout"] with
| :? JObject as layout -> group.tabLayout <- Some(WorkspaceData.tabLayout layout)
| _ -> ()
+ match obj.["split"] with
+ | :? JObject as split -> group.split <- (try Some(WorkspaceData.split split) with _ -> None)
+ | _ -> ()
group
@@ -330,11 +335,14 @@ type WorkspaceRestoreResult = {
pending:(Dynamic*WorkspaceWindow) list
/// Where each saved group went, so another try adds to the same group.
groups:(Dynamic*IGroup) list
+ /// The window found for each saved window so far, so a split whose panes arrive over
+ /// several tries, one open and one started, is rebuilt once they are all there.
+ placed:(Dynamic*IntPtr) list
/// Apps of windows not found that are not running and can be started.
launchable:string list }
with
static member Of(workspace,restored,missing,failed) =
- { workspace=workspace; restored=restored; missing=missing; failed=failed; pending=[]; groups=[]; launchable=[] }
+ { workspace=workspace; restored=restored; missing=missing; failed=failed; pending=[]; groups=[]; placed=[]; launchable=[] }
/// A second try after starting apps: everything restored so far counts, what is still
/// missing is what the second try did not find, and apps that would not start count as failed.
member first.Then(second:WorkspaceRestoreResult,launchFailures) =
@@ -394,6 +402,11 @@ type WorkspaceModel() as this =
let mutable creating = false
let mutable readOnly = false
let mutable recovery : JToken option = None
+ /// Each group's tab layout and split as last read from its thread, by group token, so the
+ /// session can be written at exit without waiting on the groups. The split names its windows
+ /// by handle: by their places in the list read then, it named the wrong windows once a tab
+ /// had closed or moved since.
+ let layouts = Dictionary()
do
Observable.init(this)
@@ -415,7 +428,9 @@ type WorkspaceModel() as this =
let nextNumber = this.workspaces.choose(fun(w) -> w.name.Replace("Workspace ", "").tryToInt()).maxBy 0 id + 1
sprintf "Workspace %A" nextNumber
- member private this.createWorkspace(complete:Workspace -> unit) =
+ /// The groups as they are. Their tab layouts and splits are read on their own threads
+ /// unless `fromCache`, which takes what was last read, for a save that cannot wait.
+ member private this.createWorkspace(fromCache:bool, complete:Workspace -> unit) =
let zorder = os.windowZorders
let groups = Services.desktop.groups.where(fun group -> not group.windows.isEmpty).enumerate.map <| fun (i, group) ->
let windowsInZorder = group.windows.sortBy(zorder.find)
@@ -435,30 +450,48 @@ type WorkspaceModel() as this =
ww.zorder <- innerZorder.find(hwnd)
ww.matchType <- WorkspaceWindowTitleMatchType.ExactMatch
wsGroup.addWindow(ww)
- group :?> GroupInfo,wsGroup
-
+ // The split names its windows by their place in the list just saved.
+ let indexOf = Map2(group.windows.enumerate.map(fun (j,hwnd) -> hwnd,j))
+ let toSaved (parked:bool,frame:Rect,panes:(IntPtr * SavedPane) list) =
+ let panes = panes |> List.choose(fun (hwnd,pane) -> indexOf.tryFind hwnd |> Option.map(fun index -> index,pane))
+ if panes.Length>=2 then Some {parked=parked;frame=frame;panes=panes} else None
+ group :?> GroupInfo,wsGroup,toSaved
+
let ws = Workspace(
name = this.newWorkspaceName()
)
let mutable remaining = groups.count
if remaining=0 then complete ws
+ elif fromCache then
+ groups.iter(fun (info,saved,toSaved) ->
+ match layouts.TryGetValue info.group.groupToken with
+ | true,(layout,split) ->
+ saved.tabLayout <- layout
+ saved.split <- split |> Option.bind toSaved
+ | _ -> ()
+ ws.addGroup(saved))
+ complete ws
else
// Group STAs read their own layout; saving never blocks them from reading settings.
- groups.iter(fun (info,saved) ->
- info.captureTabLayout(fun layout ->
- saved.tabLayout <- layout
+ groups.iter(fun (info,saved,toSaved) ->
+ info.captureLayout(fun captured ->
+ captured |> Option.iter(fun (layout,split) ->
+ saved.tabLayout <- Some layout
+ saved.split <- split |> Option.bind toSaved
+ layouts.[info.group.groupToken] <- (saved.tabLayout,split))
remaining <- remaining-1
if remaining=0 then
- groups.iter(fun (_,group) -> ws.addGroup(group))
+ groups.iter(fun (_,group,_) -> ws.addGroup(group))
complete ws))
/// Restores saved groups of windows; a group already restored into (by an earlier try)
/// takes the windows found now.
- member private this.restoreInto(name:string, saved:List2>, existing:(Dynamic*IGroup) list) =
+ member private this.restoreInto(name:string, saved:List2>, existing:(Dynamic*IGroup) list, placedBefore:(Dynamic*IntPtr) list) =
let resolver = WindowResolver()
let errors = ResizeArray()
let mutable restored = 0
+ let placedAll = ResizeArray(placedBefore)
let missing = ResizeArray()
let notFound = HashSet(HashIdentity.Reference)
let lost (item:Dynamic) =
@@ -472,14 +505,17 @@ type WorkspaceModel() as this =
if not resolved.isEmpty then
let mutable destination = used |> Seq.tryFind(fun (each,_) -> obj.ReferenceEquals(each,groupInfo)) |> Option.map snd
let successful = ResizeArray()
- let placement = WorkspaceData.fitPlacement (Mon.all.map(fun mon -> mon.displayRect,mon.workRect).list) (groupInfo?placement)
+ let monitors = Mon.all.map(fun mon -> mon.displayRect,mon.workRect).list
+ let placement = WorkspaceData.fitPlacement monitors (groupInfo?placement)
resolved.iter(fun (saved,hwnd) ->
try
let window = os.windowFromHwnd(hwnd)
if window.isWindow then
// Complete native placement before detaching from the old group.
WinUserApi.ShowWindow(hwnd,ShowWindowCommands.SW_RESTORE) |> ignore
- window.setPlacement(placement)
+ // Kept on screen by its visible frame: the window frame sticks out of the
+ // work area by its invisible border, which pulled every edge window in.
+ window.setPlacement(WorkspaceData.fitPlacementOf monitors window.bounds window.visibleBounds (groupInfo?placement))
if destination.IsNone then
let next = Services.desktop.createGroup(Services.settings.getValue("combineIconsInTaskbar").cast())
(groupInfo :?> WorkspaceGroup).tabLayout |> Option.iter(fun layout ->
@@ -492,7 +528,30 @@ type WorkspaceModel() as this =
restored <- restored+1
else lost saved
with ex -> errors.Add(fst (WorkspaceRestore.describe saved),ex.Message))
- try os.setZorder(WorkspaceRestore.zorder (List2(successful))) with ex -> errors.Add("",ex.Message)))
+ try os.setZorder(WorkspaceRestore.zorder (List2(successful))) with ex -> errors.Add("",ex.Message)
+ // The split comes back among the windows found, those of an earlier try too,
+ // once they are all in the group, its frame kept on screen on its own: the
+ // placement's correction allows for a window frame that sticks out by its
+ // invisible border, which a visible frame does not.
+ let windows = (groupInfo?windows : List2).list
+ let found = successful |> Seq.map(fun (saved,hwnd) -> saved :> Dynamic,hwnd) |> List.ofSeq
+ placedAll.AddRange found
+ let present =
+ (placedBefore |> List.filter(fun (saved,_) -> windows |> List.exists(fun item -> obj.ReferenceEquals(item,saved)))) @ found
+ match destination,(groupInfo :?> WorkspaceGroup).split with
+ | Some group,Some split when present.Length>=2 ->
+ let byIndex =
+ present |> List.choose(fun (saved,hwnd) ->
+ windows |> List.tryFindIndex(fun item -> obj.ReferenceEquals(item,saved)) |> Option.map(fun index -> index,hwnd))
+ |> Map.ofList
+ let panes = split.panes |> List.choose(fun (index,pane) -> byIndex.TryFind index |> Option.map(fun hwnd -> hwnd,pane))
+ match SplitPersistence.rebuild panes with
+ | GroupLayout.Single -> ()
+ | layout ->
+ let frame = WorkspaceData.fitRect (Mon.all.map(fun mon -> mon.workRect).list) split.frame
+ let info = group :?> GroupInfo
+ info.invokeGroup(fun () -> info.group.restoreLayout(layout,frame))
+ | _ -> ()))
let pending =
saved.list |> List.collect(fun (groupInfo,windows) ->
windows.list |> List.choose(fun item ->
@@ -502,15 +561,16 @@ type WorkspaceModel() as this =
let openPaths = Services.program.appWindows.choose(fun hwnd -> try Some(os.windowFromHwnd(hwnd).pid.processPath) with _ -> None).list
{ workspace=name; restored=restored; missing=List.ofSeq missing; failed=List.ofSeq errors; pending=pending
groups=List.ofSeq used
+ placed=List.ofSeq placedAll
launchable=WorkspaceRestore.launchable openPaths File.Exists (pending |> List.map(fun (_,window) -> window.processPath)) }
member private this.restoreWorkspace(workspace:Workspace) =
- this.restoreInto(workspace.name,workspace.children.map(fun groupInfo -> groupInfo,(groupInfo?windows : List2)),[])
+ this.restoreInto(workspace.name,workspace.children.map(fun groupInfo -> groupInfo,(groupInfo?windows : List2)),[],[])
/// Tries the windows an earlier restore did not find again, after their apps have started.
member this.retry(result:WorkspaceRestoreResult) =
let saved = result.pending |> List.groupBy fst |> List.map(fun (groupInfo,windows) -> groupInfo,List2(windows |> List.map(fun (_,window) -> window :> Dynamic)))
- this.restoreInto(result.workspace,List2(saved),result.groups)
+ this.restoreInto(result.workspace,List2(saved),result.groups,result.placed)
member this.addWorkspace(ws:Workspace) =
ws.cast().removed.Add <| fun() -> this.onWorkspaceRemoved(ws)
@@ -522,12 +582,43 @@ type WorkspaceModel() as this =
if not readOnly && not creating then
creating <- true
try
- this.createWorkspace(fun ws ->
+ this.createWorkspace(false,fun ws ->
creating <- false
if not readOnly then this.addWorkspace(ws))
with _ ->
creating <- false
reraise()
+
+ /// The windows as they are now, kept on their own as the session: written as the groups
+ /// change and brought back at the next start after a sign-in, when no window is left from
+ /// the last run. Apart from the saved workspaces, which are the user's.
+ member private this.writeSession(ws:Workspace) =
+ ws.name <- "Session"
+ let root = Services.settings.root
+ root.["session"] <- ws.serialize()
+ Services.settings.root <- root
+
+ member this.saveSession() = this.createWorkspace(false,this.writeSession)
+
+ /// Written at once from the layouts last read, for an exit that cannot wait on the groups.
+ member this.saveSessionNow() = this.createWorkspace(true,this.writeSession)
+
+ member this.loadSession() =
+ match Services.settings.root.["session"] with
+ | :? JObject as saved -> WorkspaceData.readOne saved |> Option.map Workspace.deserialize
+ | _ -> None
+
+ /// Brings the session back among the windows open, and, when `launch`, starts the apps of
+ /// the windows not found and tries those again; `launching` is told how many.
+ member this.restoreSession(launch:bool, launching:int -> unit, complete:WorkspaceRestoreResult -> unit) =
+ match this.loadSession() with
+ | None -> ()
+ | Some ws ->
+ let first = this.restoreWorkspace ws
+ if launch && not first.launchable.IsEmpty then
+ launching first.launchable.Length
+ WorkspaceLaunch.start first.launchable (fun failures -> complete (first.Then(this.retry first,failures)))
+ else complete first
member this.remove() =
if not readOnly && this.selected <> null then
diff --git a/WtProgram/WtProgram.fsproj b/WtProgram/WtProgram.fsproj
index 3b42aff5..48983b49 100755
--- a/WtProgram/WtProgram.fsproj
+++ b/WtProgram/WtProgram.fsproj
@@ -50,6 +50,7 @@
+
@@ -95,6 +96,8 @@
+
+
@@ -129,6 +132,7 @@
+
diff --git a/docs/architecture.md b/docs/architecture.md
index 333a8ea9..e7c3cacc 100644
--- a/docs/architecture.md
+++ b/docs/architecture.md
@@ -383,6 +383,11 @@ file writes. Events contain phase names and durations rather than window titles
or executable paths. The isolated comparison host is documented in
`tests/StartupPerf/README.md`.
+`WINDOWTABS_CHECK_THREADS=1` makes WinForms refuse a control touched from a thread not
+its own, as it does under a debugger, in the app and in the test hosts. The suites pass
+with it set; a run with it finds what a debugging session would stop at, such as a helper
+window's handle read on the group thread instead of the chrome thread that owns it.
+
App grouping rules map each executable to one persistent target group ID and name,
with an enabled flag. Paths ignore case; titles do not participate. Older exports
normalize title rows into the first application mapping per executable. The main
diff --git a/docs/settings-architecture.md b/docs/settings-architecture.md
index 8558ca0a..38eb0a29 100644
--- a/docs/settings-architecture.md
+++ b/docs/settings-architecture.md
@@ -107,7 +107,7 @@ resized width when these defaults change.
| Tab shortcuts (next/previous tab, switch windows, new tab, close tab) | Registers immediately. A conflict rejects the edit and preserves the working shortcut. Close tab closes the window of the tab in front, and only a tab's. Each box is the editors' width; its × shows on hover or focus. | `Program.setHotKey` → `HotKeyManager` |
| Switch tabs by number (Off / Ctrl + 1–9 / Alt + 1–9) | One choice; enables/disables on existing groups immediately. The plugin is always installed and checks the current setting on key-down; key-up does not activate a tab. Off, an app switched on from the tab menu still uses the last key, shown on a row of its own only then. | `NumericTabHotKeyPlugin`; `HotKeyView` |
| Hover activation; Shift + scroll; middle-click closes a tab | Used on the next matching pointer/wheel event. | `TabStrip.processMouse`; `MouseScrollPlugin`; `TabStripDecorator` |
-| Group taskbar icon | Chosen from the tab menu of a group with combined taskbar icons (an .ico, a picture or a program's icon) and shown on its taskbar button at once, without the second app's badge. Kept in `groupIcons` by a named group's id, a dragged group's token, or the app of an automatic group. A dragged group's icon is dropped once the group is ungrouped or forgotten. | `Program.setGroupIcon`; `SuperBarPlugin.chosenIcon` |
+| Group taskbar icon | Chosen from the tab menu of a group with combined taskbar icons (an .ico, a picture or a program's icon) and shown on its taskbar button at once, without the other apps' icons beside it. Kept in `groupIcons` by a named group's id, a dragged group's token, or the app of an automatic group. A dragged group's icon is dropped once the group is ungrouped or forgotten. | `Program.setGroupIcon`; `SuperBarPlugin.chosenIcon` |
| Theme, colors, presets, layout and resets | Updates existing tab strips and settings UI immediately. Color changes affect the current light/dark profile; state-specific colors appear when that state occurs. Centered tabs use the side margin when they fill the row. | `ThemeService.changed` → `WindowGroup`; `ThemeBinding` |
| Language | Recreates the open settings window on the same page and rebuilds tray text; tab menus use the language when opened. | `Program`, `ManagerViewService`, `NotifyIconPlugin` |
| Per-app automatic grouping | Enabling requests regrouping of current windows. Disabling affects future grouping and preserves existing groups; the UI explains this. | `Program.setAutoGroupingEnabled` |
diff --git a/docs/split-view-design.md b/docs/split-view-design.md
new file mode 100644
index 00000000..d804ad04
--- /dev/null
+++ b/docs/split-view-design.md
@@ -0,0 +1,470 @@
+# In-group split view: design (second version)
+
+Status: rewritten on 2026-10-18 and kept current with the implementation. The first
+implementation (commit `cacad60`) showed that two windows side by side work on the existing
+placement queue, but its structure and its drag and drop needed redoing; this document is the
+basis of that rework. Scope: a tree of panes within one group. The rework began with two panes
+and a model left open for more; since 2026-10-20 any pane can be split again, side by side or
+stacked, as in tmux and VS Code, with no fixed limit on their number: only the 120px minimum
+per pane. [Issue #48](https://github.com/leafOfTree/WindowTabs/issues/48).
+
+## 1. Reference behaviour and choices
+
+| Behaviour | Edge / Brave / Chrome split view | tmux / Windows Terminal | This design |
+| --- | --- | --- | --- |
+| Panes | Always two | Any nested tree | Any nested tree |
+| What owns the split | A pair of tabs in one window | A tree inside one tab | One tree per group |
+| Another tab activated | It fills the window, the pair is parked; choosing either tab of the pair shows both again | Not applicable | The same (`Parked`) |
+| Ways in | "Add to split view" on a tab, dragging a tab to the page edge, an empty pane first | Shortcuts | Tab menu with a window list, edge drop (the group's edge or a pane's), shortcuts |
+| Divider | Drag to set the ratio; Edge's divider has a menu (swap, close) | Keyboard ratio, equalize, zoom | Drag, double-click to equalize, a menu on each seam button, shortcuts; one divider per split |
+| Closing one side | The other fills the window and the split ends | The other fills | The neighbour takes the room; the last other pane fills the group |
+| Focus | The side clicked takes focus | Arrow keys move between panes | Clicking; shortcuts for the next pane and for the pane in each direction |
+
+The browsers' "pair of tabs" model was the starting point: two windows are enough for most work,
+such as writing code against a reference or copying files between folders. The tree came after,
+for a terminal or a chat beside the pair: each split divides one node in two, so two panes are
+the tree's simplest case and keep their behaviour.
+
+## 2. What the user sees
+
+### 2.1 Entering a split
+
+- However a window comes into a split, it moves in rather than appearing: for 220ms
+ (`SplitTransition.DurationMs`) a cover over the group, topmost and click-through, shows live
+ DWM thumbnails of the panes' windows moving from where they were to their panes with an
+ ease-out, the one coming in sliding from its side and fading in. Each image shows its window
+ 1:1 from the top left, cut to its rectangle, so nothing is stretched. The window coming in is
+ placed at once, so its image shows it at its new size; the windows already there wait until
+ the images have moved (`transitionHold`), so theirs shrink smoothly from what they showed
+ rather than jumping. The cover goes once the windows are in place, or 600ms after its steps.
+ Moved step by step instead, apps laid themselves out again at every step, and slow ones
+ jerked. Without the system's animations, or where a window has no thumbnail (no desktop
+ composition, as on the tests' hidden desktop), there is no cover and the windows are placed
+ as before. Any other change that moves the panes moves them the same way: a pane closed or
+ its window gone, its neighbour growing into the room; panes swapped, evened out, made larger
+ or smaller, or turned; a window leaving the split, fading where it was; the split ended, the
+ window kept growing to the whole group while the others fade. A window made smaller or
+ leaving waits for its image as above; one made larger goes to its place at once, its image cut
+ to the rectangle while that grows. Out of the split nothing waits for the windows, so that
+ cover goes once its steps are done and the windows are placed, and a moment more
+ (`SplitTransition.HoldAfterMs`): its images are live, so staying over windows already placed
+ shows nothing, while going at once showed a window not yet painted at its new size. A tab
+ clicked over the panes, and a pane's tab clicked to bring them back, get the cover with no
+ steps (`ClickMs`), up before the window is activated: the images stand at their places from
+ the first frame, the ones leaving kept under the rest, so the cover only hides the windows
+ being placed. Placed with no cover, the tab rose pane-sized with the desktop showing round
+ it; moved with the images, the switch felt slow. With no split at all, a click on another tab
+ fades the window shown out over the one coming up in 120ms (`SplitTransition.CrossFadeMs`):
+ an app that stops painting while covered, as Chromium ones do, paints its background first
+ when it comes up, and that blank showed for a tenth of a second. A divider dragged, a pane
+ resized at its own edge, a tab dragged and the focus alone do not animate.
+ Every transition keeps its native window and DWM thumbnail destinations in the content
+ rectangle below the live tabs (or beside a side dock). Both source and destination are
+ cropped by the same amount, preserving 1:1 pixels. This follows the strip while placement
+ settles instead of relying on a region cutout in a full-frame topmost cover.
+- Right-click any tab, then Split in group, then a window on the right, on the left, above or below:
+ the searchable window list below opens over the group first, and the window picked goes on
+ that side of the clicked tab, its pane split when the group is split already
+ (`WindowGroup.placeBeside`; a window from elsewhere is handed over through
+ `IDesktop.adoptBeside`). Esc leaves the group as it was. Chosen first, the window needs no
+ empty pane to wait in, so the menu no longer opens one. While split, the same menu goes on
+ with the divider menu's items for the focused pane's split: swap, equalize, switch direction
+ and end split (`SplitMenu.items`), so both menus read alike; with no split they are left out
+ rather than greyed.
+- The empty pane, a place for a window to come later, has no way in any more: the window list
+ comes first, and the shortcuts that opened one went with the cut to six keys (section 5). What
+ it was stays in the model (`Empty`, `NewEmptyPane`, `FillPane`), in `EmptySplitPane` and in
+ the drop handling, covered by the suites through the model, for an entry that brings it back:
+ a 1px frame in Explorer's colours, a dashed drop box, an "or" line and a "Choose window…"
+ button, a close button that closes it (Esc does the same while a tab of its group is the active
+ window, and goes no further), an opening animation from the group's edge, edges that resize it
+ as a window's do, and drops of this group's tabs, other groups' tabs and native windows dragged
+ by their title bar, the last handed over by the desktop thread (`IDesktop.adoptIntoPane`).
+- Drag a tab to the left, right, top or bottom edge of a group's window: a half-window preview
+ fades in, a clear tint with its edge drawn, glides to the next place as the aim moves and fades
+ out when it goes (120ms each). No words go with it: the place lit up says what
+ letting go does, and a label beside the dragged tab added little to it. The dragged image shows the
+ window at half the size it would land at (`DragImage.windowScale`), a little see-through
+ (`DragImage.windowOpacity`), and the tab solid and at full size, placed over that half-size
+ window as the strip places a lone tab, so it stays readable. The window's picture is printed
+ on a worker thread and slots in a moment after the drag starts, under the tab shown at once:
+ printed first, a large window held the drag up as it began. Letting go splits the group. The
+ preview changes no membership; only the drop commits. Tabs
+ of this group and of other groups on the same virtual desktop alike are offered the edge once
+ the pointer has rested in its zone for 100ms, within 6px (`LayoutDwell`); from then on the
+ preview follows the pointer over that window until it leaves the zones. A tab carried over a
+ window on its way elsewhere, or let go over one where no free desktop was left, split it at
+ once before; let go before the preview shows, it comes out as a window of its own. An empty
+ pane takes a drop at once. Pressing a tab behind the panes parks them; once its drag takes
+ it out of the group, the panes come back, so the drop aims at what is seen. A tab held in one
+ strip moves to another group's strip in sight under the pointer: strips of groups at the top
+ of the screen lie over one another, and the first strip crossed kept the tab across its whole
+ width, so it joined a group out of sight. Within 24px of a group's row of tabs in sight
+ (`DragRouting.stripMargin`), across the group's whole width, a tab counts as in their strip,
+ joining it there and leaving it only beyond: just below another group's tabs, over its title
+ bar, a tab carried to join them was offered that window's top edge instead, and so was one
+ carried to the top of the window beside the tabs.
+- A tab dragged out onto the desktop becomes a window of its own at the size its group has
+ now. Where a side spans most of the screen, a maximized group's or the height of one snapped
+ to half the screen, the whole window is scaled down, its proportions kept, until that side
+ spans three fifths of the work area: it came out as a second screenful before, and sized side
+ by side, or at its size before any group, it came out of proportion with what was dragged. The own size alone,
+ read once at joining, brought back a size the group had long left. The
+ monitor under the pointer decides (`DragOutPlacement`); the window lands with its tab under the
+ pointer at that size, as the strip's alignment places a lone tab, wholly inside the work area,
+ and the drag image shows it at that size. It comes in front, active: its old group took the
+ foreground as the tab left it, to show panes the tab had parked, and the window landed under
+ them.
+- Splitting again: while split, the same ways apply to a pane. Split in group on a tab divides
+ that tab's pane; a tab dragged to
+ a pane's edge splits that pane (as VS Code does), and at the group's own edge (`outerZone`:
+ 36px at an edge's ends, up to 72px at its middle) a new column or row for the whole group.
+ With another tab shown over parked panes, the drop goes beside that window, the
+ one in sight, and the parked panes are let go as by any new split; panes parked by the
+ dragged tab's own press come back as the tab leaves the strip, so they are aimed at.
+ A pane window dropped elsewhere leaves its pane, whose neighbour takes the room. There is no
+ fixed number of panes. Each pane is at least 120px and at least what its window lets itself
+ be sized to (its `WM_GETMINMAXINFO` least track size, read with a 100ms timeout, less the
+ invisible borders): every command's ratios move as little as that takes
+ (`SplitGeometry.fitToPanes`), and a split with no room for it is refused. A terminal of 600px
+ at least, put in a 400px pane, kept its width and lay over the pane beside it.
+- Shortcuts: a window on the right or below opens the same list for the tab in front
+ (section 5).
+
+### 2.2 While split
+
+- The panes' tabs stay next to each other in the strip in layout order (as in Brave), and a
+ split button sits on each seam between them at the bottom of the strip. It marks the panes
+ and opens the split menu: swap, equalize, toggle direction, end split, and "Show split" while
+ parked. Tab titles get no prefix. The button between two pane tabs shows the split that parts
+ those two panes, the deepest one holding both (`SplitView.commonSplit`): in two rows of two,
+ the button between the top row's tabs shows side by side and the one between the rows
+ stacked, and its menu acts on that split.
+ The focused pane keeps the selected tab style. While split, the group's front window is
+ always the focused pane and the other panes are stacked just below it, so the tabs belong to
+ the focused pane and stay over all of them. Dragging two neighbouring panes' tabs into the
+ other order in the strip swaps those panes (`onTabsReordered`) instead of being put back at
+ the next click.
+- Clicking a shown tab only moves the focus. Clicking another tab C makes C fill the group and
+ parks the panes; choosing any pane's tab again restores the whole tree, the directions, the
+ ratios and any empty pane. Shortcuts, tab search and taskbar activation follow the same rule.
+ A tab chosen from outside the panes comes to the front before they are parked, so no tab
+ behind shows over it while the windows are re-placed, and the strip stays over it. A window
+ joining with the focus, as a tab dragged onto the strip has from its drag, parks the panes
+ the same way: placed as a tab behind, it waited under the panes with the focus.
+- Dividers: one per split, each dragged for its own ratio, double-clicked to return that split
+ to 50:50, right-clicked for the same menu as the seam button, acting on that split. The 4px
+ bar shows only when hovered or dragged, inside a 14px band (`dividerGrab`) that takes the
+ pointer and just covers both panes' invisible resize borders at the seam: a press near the
+ seam always drags the divider, and no more of a pane than that, a scroll bar at the seam say,
+ is covered. With the band no wider than the bar, a press a few pixels off it
+ started a pane's own resize, which the other pane followed (`resizePane`); that was kept for
+ a while as the smoother drag, but it could not be told apart from the divider by eye, and the
+ divider's drag has since been made to keep up with the pointer.
+ While dragged, the bar follows the pointer itself and places the panes itself, straight into
+ the placement queue from its own thread, which keeps only the newest request for a window.
+ Sent through the group's thread, a ratio waited behind the storm of WinEvents the apps raise
+ as they resize, which reach that thread first, and the panes trailed the pointer by a few
+ steps. The group's own layout follows one ratio at a time, the next sent only once the group
+ reports the one before: taken as the word for any ratio, every pointer move sent one and they
+ queued up on the group's thread for hundreds of milliseconds. A ratio-only change also leaves
+ the tabs' details alone.
+- Ending the split: the divider menu, the tab menu or a shortcut. The focused tab fills the group;
+ no window closes and no tab is removed. The first version's "merge" drop zone next to the strip
+ is gone: no browser has it, and it competed with the zones for reordering tabs.
+
+### 2.3 Leaving the split, and failures
+
+- Closing or moving away a pane window, or closing its pane from the menu or by shortcut: its
+ neighbour in that split takes the room, and the focus if it was there; losing the last other
+ pane ends the split and the survivor fills the group. Closing a tab behind does not affect the
+ layout.
+- A member closed or moved away while the panes are parked leaves the parked tree without it.
+ Starting a new split or ending the split clears it too.
+- An app that does not fully accept the size it is given (a terminal rounding to its character
+ grid, a larger minimum size): after two seconds the group stops waiting, and the split stays
+ with no message. Only a window off its pane by more than 3px in position or 40px in size counts
+ as moved or resized by its app; the layout is then recomputed from its actual rectangle
+ (`resizePane`), and the split ends only when the panes no longer fit. A message appears only
+ when the group itself is too small for two panes as the split starts.
+- Dragging a tab out of the group or onto another group's strip keeps the existing behaviour;
+ if it was a shown side, the split ends.
+
+## 3. Model (pure state, no Win32)
+
+```fsharp
+type SplitAxis = SideBySide | Stacked
+type Side = First | Second
+type Pane = Empty | Occupied of IntPtr // not `Window`, which Win32 already uses
+type PanePath = Side list // a node named from the root: the side taken at each split; the root is []
+type SplitNode = Leaf of Pane | Branch of SplitTree
+and SplitTree = { axis: SplitAxis; ratio: float; first: SplitNode; second: SplitNode }
+type SplitLayout = { tree: SplitTree; focused: PanePath }
+type GroupLayout =
+ | Single // the existing behaviour
+ | Split of SplitLayout // the panes shown
+ | Parked of SplitLayout // another tab fills the group; the panes wait
+```
+
+Invariants: the root is a split, so there are at least two panes; at least one is `Occupied`;
+no HWND is in two panes; and `focused` is the path of an `Occupied` pane (`refocus` puts it on
+the first one when its pane goes). A node is addressed by its path, so a node's path can change
+when a pane elsewhere goes and its neighbour moves up a level: the helper windows look their
+path up again by their window, and commands that name a pane are issued at the time they act.
+The group's frame lives only in WindowGroup's existing `placement`; the layout keeps no copy of
+bounds or restore bounds. "Fill the work area / restore" is group-level state, `splitRestore`,
+at the same level as maximizing a single window.
+
+Commands (menus, the dividers, shortcuts and drag and drop only ever produce commands):
+
+```fsharp
+type SplitCommand =
+ | SplitWith of partner:IntPtr * SplitAxis // the shown tab's pane splits again for the partner, which leaves its own pane
+ | NewEmptyPane of SplitAxis // the shown tab's pane splits again, the new half empty
+ | DropInto of hwnd:IntPtr * PanePath * SplitAxis * Side // the node makes room on that side; [] is the whole group
+ | FillPane of hwnd:IntPtr * PanePath // an empty pane takes the window
+ | FocusPane of PanePath | FocusToward of PaneDirection | FocusOther
+ | Swap of PanePath option | Equalize of PanePath option | ToggleAxis of PanePath option // a split, or the focused pane's
+ | SetRatio of PanePath * float
+ | ClosePane of PanePath option // the pane goes; its neighbour takes the room
+ | EndSplit of keep:IntPtr option | ToggleFill
+```
+
+`LayoutDrop = FillEmpty of PanePath | SplitAt of PanePath * SplitAxis * Side` is what a drop at
+a point means, turned into a command by `SplitView.dropCommand`.
+
+Events (WindowGroup translates OS events for the model): a window activated, a window removed,
+and a pane moved or resized natively.
+
+Pure functions:
+
+- `SplitView.apply : current:IntPtr -> SplitCommand -> GroupLayout -> GroupLayout`
+- `SplitView.onActivated / onRemoved : IntPtr -> GroupLayout -> GroupLayout`, and `prune`.
+- `SplitView.plan : GroupLayout -> frame:Rect -> gap -> members:IntPtr list -> top:IntPtr -> Placement list`,
+ where `Placement = { hwnd; rect; below: IntPtr option }`. For `Single` and `Parked` the plan is
+ the followers' placement under the top window; for `Split` each pane window takes its own
+ rectangle and the tabs behind wait under the host pane (`SplitView.host`, the first occupied
+ pane) at its rectangle. The host does not follow the focus, so moving between the panes moves
+ none of them. Both modes go through the same `applyLayout`.
+- `SplitTree`: the tree alone, with `node`, `leaves` and `branches` by path, and the two edits
+ every command is made of: `insert`, which wraps a node in a new split, and `remove`, which
+ lets a pane's neighbour take their parent's place.
+- Geometry: `rectangles` for one split, `leafRects` and `seams` for the whole tree, `nodeRect`,
+ `ratioAt`, `fits`, `resizePane` and `dropAt` (`edgeDrop` for one rectangle). `resizePane`
+ takes the pane's rectangle when its native move or resize began and its rectangle now: a move
+ carries the frame; an edge moved is either the seam of the nearest split above the pane along
+ that axis, whose ratio follows, or the group's own edge, which moves with it while every split
+ on the way gives the room to the pane's side so the other side keeps its size. Constants live
+ in `SplitMetrics`, in logical pixels: no gap between the panes, a 4px divider bar inside a
+ 14px band that takes the pointer, panes at
+ least 120px, ratios from 0.15 to 0.85, a 3px position tolerance, a 40px size tolerance for
+ apps on a character grid, a 2000ms wait for panes to settle, edge drop zones 36px deep at
+ their ends that deepen to a fifth of the window (`edgeShare`) at the middle of each edge, and
+ an `outerZone` at the group's own edge, 36px at an edge's ends and 8% of the frame
+ (`outerShare`, at most 72px) at its middle, where a drop splits the whole group rather than
+ the pane there. Where two zones overlap, the one the point is relatively deeper in wins.
+
+## 4. Drag and drop
+
+Before this rework the strip had an `IDeferredDragTarget` that polled the preview across STAs on
+a 16ms timer, while the older `dragEnter/dragMove/dragExit` state machine stayed in place and the
+commit still called back into the old path. A tab over another group's strip showed a block
+covering the whole strip rather than an insertion point; a tab from another group could only land
+on an empty pane's helper window, never on the edge of another group's window; and Esc was found
+by polling `GetAsyncKeyState`.
+
+The plan: **the strip keeps its existing join-at-once model** (as in Chrome, a tab dragged over
+another group's strip joins it at once and leaves again when dragged off; this path has test
+coverage), and **only the windows themselves get a new kind of drop target**.
+
+- `IDragDrop` gains `registerLayoutTarget(hwnd, target)` and `unregisterLayoutTarget(hwnd, target)`,
+ which removes only that target's registration: a window that moved to another group is that
+ group's surface, and the old group's late removal leaves it. TabStripDecorator registers the strip,
+ every member HWND and the empty pane's window as drop surfaces, and keeps the registrations in
+ step with membership. The empty pane runs on a thread of its own with no owner, so it is
+ registered by its own window as it appears and removed as it goes (`emptyPaneChanged`).
+ Hit-testing takes the top-level window under the pointer (`DragRouting.windowsAt`), since the
+ pointer is often over an app's child window such as a browser page, then one dictionary
+ lookup, with the window's owner as a second chance for helper windows the strip owns.
+- `ILayoutDropTarget`: `probe(data, pt, show) : LayoutProbe`, `clearPreview()` and
+ `commit(data, pt) : bool`. In `DragFloatingState.mouseMove`, a hit on a strip goes through the
+ existing `dragEnter`; a hit on a window goes to `probe`, one call per pointer move, which
+ answers the strip to join when the point lies near its tabs, or else what a drop would do
+ and, when the dwell says so or for an empty pane at once, shows the half-window or
+ empty-pane preview; leaving clears it. Asked the strip, the aim and the preview in three
+ calls, the drag waited on the group's thread three times a move. Letting go over a window
+ calls `commit`, which returns false when no pane was offered so the drop then ends as one
+ anywhere else.
+- A dropped tab joins and takes its pane through `WindowGroup.dropTab`. A tab dragged from
+ elsewhere arrives put away off screen by its drag and, activated by it, as the top window, so
+ the group's frame is read from the tab shown before the dropped tab joins; read afterwards,
+ the split was laid out off screen.
+- `IDeferredDragTarget`, the `deferred` branch of `DragAction` and the 16ms polling are gone;
+ the timer is back to a 500ms watchdog.
+- Cancelling: the existing low-level keyboard hook (`InputManagerPlugin` to `group.keyboardLL`)
+ takes Esc during a drag, with no polling of key state. Losing capture cancels rather than
+ commits.
+- A tab from another group joins the group it is dropped on and pairs with the tab shown there.
+ Into an empty pane it goes through that pane's registration to `probe`, and `Desktop` hands
+ it over between groups (the first version's `addAfterDetaching(afterAdd)`).
+- Native windows dragged onto an empty pane: the first version put a pair of global WinEvent
+ hooks on every empty pane and polled the mouse buttons. Instead, `Desktop`'s existing
+ MOVESIZEEND handling checks whether the window was let go over some group's empty pane, and
+ then uses the same handover.
+
+## 5. Keyboard
+
+Shortcuts and menus share `SplitCommand`. Shortcuts use the existing `hotKeyInfo` and
+`SettingsCatalog.Shortcut`, act on the foreground group, and are all unbound (0) by default so
+that no global hotkey is taken. The entries:
+
+Six keys, in a card of their own on the Shortcuts page: two ways in, which open the tab
+menu's window list for the tab in front, and the focus by direction. The rest of the commands (the other two sides, swap, equalize, closing a pane,
+ending the split) are on the tab menu, the seam buttons and the dividers; a dozen split
+entries once crowded the page, and the next tab's shortcut already walks the panes in order.
+
+| Setting id | hotKeys key | Command |
+| --- | --- | --- |
+| split-pick-right / split-pick-below | splitPickRight / splitPickBelow | `IGroup.pickPane`: the strip's window list for the tab in front; the window chosen goes on that side (`placeBeside`) |
+| split-focus-left / -right / -up / -down | splitFocusLeft … splitFocusDown | `FocusToward`: the nearest pane in that direction sharing most of the focused pane's edge |
+
+Wiring: `Program.hotKeyInfo` to `Services.desktop.foregroundGroup` to `IGroup.executeSplit` or
+`pickPane` (`GroupInfo` passes them to the group's STA; `pickPane` raises the group's
+`pickRequested`, which the strip answers with the list). The settings page's
+`HotKeyView.actions` lists the same keys, with the existing conflict checks and reset to
+defaults; with the default 0, `HotKeyBindings.Register` only unbinds.
+
+tmux's `resize-pane -Z` (zoom) is the same as choosing another tab and coming back, so it gets
+no command of its own.
+
+## 6. Window behaviour
+
+| Situation | Behaviour |
+| --- | --- |
+| Dragging the strip or either shown window's title bar | The whole group moves by the same offset and keeps its ratio; the offset comes from the source window's starting rectangle and the group's starting frame |
+| Resizing a shown window by its native edge | An outer edge changes the group's frame, an inner edge the ratio (`resizePane`); the split ends only when the panes no longer fit |
+| An app resizing itself (a terminal keeping to its character grid) | Recomputed the same way; nothing is judged while the placement queue is busy |
+| An app's native maximize | The whole group fills the work area and keeps both panes; maximizing again goes back to the previous frame |
+| A pane snapped with Win+Left or Win+Right | Both of a pair of opposite edges move at once, which no drag at an edge does: the whole group takes the pane's new rectangle and the panes keep their shares (`SplitGeometry.resizePane`). Read as one edge moving the frame and the other the seam, a snap sent the other pane off the screen |
+| Windows Snap, exclusive full screen | Back to a single window, keeping the tabs and the group's frame |
+| Minimize and restore | The whole group; both sides and the focused side come back |
+| An app's dialogs | Owner relationships are kept; focus handling never takes a dialog for a pane |
+| Changing how taskbar buttons combine (the group is rebuilt) | The layout is captured asynchronously and applied once the members have moved over; a missing member means a single window |
+| Exiting WindowTabs | Every member is visible natively again; the dividers and the empty panes are released. Each pane window keeps its place in the split on itself (`WindowSplitLayout`, window properties beside the group token: its path with the axis at each level, a ratio per split above, the frame, focus and parked), so the next start shows the split again as the windows regroup, growing as each arrives; a window closed meanwhile leaves its room to its neighbour, and empty panes are not kept. Across a sign-in the windows are new: workspaces keep each group's split by the windows' places in its list (`SavedSplit`), and the session, a workspace written on its own as the groups change, brings groups, positions and splits back at a start that finds no window from the last run, when the setting asks for it |
+| DPI or monitor changes | Logical sizes are scaled again for the monitor holding the group's frame |
+| A pane raised over the tabs by its own app, with no foreground change | A 200ms guard while split notices it and puts the tabs back over both panes |
+| A tab behind the panes above one of them | Put below the backdrop once placement settles, and by the same guard: an app that keeps to its own grid is a little larger than the pane it waits under, and above another pane its edge showed at the seam |
+| An app that paints less than its frame (a frameless Electron window's clear resize margin, about 4px inside the frame DWM reports), or one still catching up with a size | A backdrop window (`SplitBackdrop`) the colour of the theme's surface covers the group's frame just below the lowest pane and above the tabs behind, so the seam shows it rather than whatever waits behind |
+
+## 7. Modules and threads
+
+- `Shared/SplitView.fs` (done): the types of section 3, `SplitMetrics`, `SplitGeometry` and the
+ pure `SplitView` functions. It references no WinForms and is checked by `tests/SplitView.fsx`
+ with no native windows. It is compiled before `TabStripTypes.fs`, so that `TabInfo.splitTrail`
+ can refer to `SplitAxis` and `Side`.
+- `SplitViewChrome.fs`: two kinds of helper window, `SplitDivider` (one per split, told its
+ path with each update; drag, double-click to equalize, right-click menu for its own split;
+ per-pixel layered so its transparent band still takes the mouse) and `EmptySplitPane` (one
+ per empty pane; dashed drop box, "Choose window…" button, close button, resizable edges,
+ opening animation; it asks the group by its window, since its path can change while it
+ stays). They only draw and turn mouse actions into commands, and hook nothing
+ globally. Both run on a UI thread of their own per group, owned by nothing: the strip is owned
+ by an app window, which joins the group thread's input queue to that app's, so dragging from
+ the group thread waited at every step for the app to repaint (beside a slow app the empty pane
+ trailed the pointer by about 55ms instead of about 2ms). The group keeps their stacking itself,
+ strip over divider over panes, once placement settles, when a member comes to the foreground
+ and when the order changes; otherwise an app window raised by a click covers the empty pane's
+ edges with its invisible resize border. Calls are posted to that thread with the group
+ thread's DPI, and their actions are posted back.
+- `SplitPanePicker.fs`: the "Choose window…" list, a tab search box with a picking mode, sorted by
+ app with system apps last and sized to show most rows without scrolling.
+- `WindowGroup.fs` (done): holds `groupLayout` and `splitRestore`. `execute : SplitCommand -> unit`
+ calls `SplitView.apply`; `setLayout` places the windows for Split, Single and Parked
+ (`applyLayout`, `collapseTo`); `dropTab` takes a dragged tab into a pane. OS events come in at
+ four points: foreground changes and `tabActivate` (`onActivated`), member removal and
+ HIDE/DESTROY (`onRemoved`), MOVESIZE and LOCATIONCHANGE (`followPane`), and minimize/restore
+ (`applyLayout`). While split, the focused pane leads the group's order (`paneFront`), so its
+ tab shows in front and the strip belongs to it. Settling is checked on the placement queue's
+ Idle event, with a 100ms timer only as a fallback while DWM catches up, for at most 2 seconds.
+ When the order changes outside a split, the window coming to the front loses only the
+ placements that put it under another window; one that leads (`below=None`), the whole frame
+ `collapseTo` gives the tab that parks the pair, stays, or the tab kept its pane's size whenever
+ the worker had not started it before the order changed.
+- `TabStripDecorator.fs`: menu items only issue commands; each pane tab carries
+ `TabInfo.splitTrail`, the splits above its pane with the side taken at each, from which the
+ strip finds the split parting two neighbouring tabs for the button on their seam, while
+ `TabInfo.text` stays clean; `refreshLayoutTabs`
+ keeps the pair's tabs adjacent; it implements `ILayoutDropTarget` and registers the strip,
+ every member and the empty pane as drop surfaces; `dragCancel` puts a cancelled tab back where
+ it started.
+- `DragDropController.fs`: the state machine. `DragFloatingState` decides by `DragRouting.resolve`
+ whether to join a strip, preview a pane or float; letting go commits the pane offered, or else
+ hands the tab to the desktop for a new group; cancelling, losing capture and the source strip
+ disappearing each have a path.
+- `Desktop.fs`: the MOVESIZE hooks recognise a window dragged by its title bar onto an empty pane
+ and hand it over (including `addAfterDetaching` between groups); a rebuilt group receives a
+ snapshot of the layout.
+- Threads: `probe` and `commit` are synchronous calls from the drag's source STA to the target
+ group's STA, in the same direction as the existing `dragEnter`, as the architecture document
+ allows. The main thread gains no waits on group threads.
+- Possible follow-up, not done: the WinEvent hooks of every member are registered from the group
+ thread and filtered by process and thread, so every event of the app's other windows on that
+ thread (child windows while a pane resizes, the cursor while the pointer moves over it) is
+ delivered to the group thread and dropped there. Delivered as sent messages, they go before
+ the group's own posted work: while both panes resized, each posted ratio waited about 20ms
+ behind them, which is why the divider now places the panes itself. Registering the hooks on a
+ thread of their own that forwards only the member's own events would free the group thread of
+ the rest. In ordinary use the thread is idle and the drops cost microseconds, so there is no
+ measured benefit yet; worth doing only against a reproducible delay, measured first by
+ counting the dropped events per second.
+
+## 8. Stages
+
+Each stage was committed on its own, and each built before the next began. Tests were run
+together once the design had settled.
+
+1. **Pure model** (done): `SplitView.fs` with `Pane`, `Side`, `GroupLayout`, `SplitCommand`,
+ `SplitMetrics`, `SplitGeometry` and `SplitView.apply/onActivated/onRemoved/prune/plan`. The
+ `SplitView` suite checks the pure logic: rectangles, rounding, ratio limits, native resize
+ conversion, edge zones, replacing, swapping, parking and restoring, members going away, badges
+ and pair order, and plans covering every member.
+2. **WindowGroup** (done): `execute`, `setLayout` and `applyLayout` replace the first version's
+ members; `SplitViewChrome.fs` holds the helper windows; the split button's menu; the
+ `TabInfo.splitSide` badge; adjacent pair tabs; `GroupLayout.fs` and the "merge" drop zone
+ removed; a rebuilt group passes its layout through `restoreLayout(layout, frame)`.
+3. **Drag and drop** (done): `DragAction` is a state machine again, and the hover state tells a
+ strip, a window and empty space apart by `DragRouting.resolve`; `TabStripDecorator`
+ implements `ILayoutDropTarget` and registers the strip and the member windows;
+ `IDeferredDragTarget` is gone; Esc reaches `IDragDrop.cancelDrag` through
+ `InputManagerPlugin`'s low-level keyboard hook, losing capture cancels too, and the source
+ strip puts the tab back with `dragCancel`; native windows dropped onto an empty pane are
+ recognised by `Desktop`'s MOVESIZE hooks.
+4. **Keyboard** (done): eight `Shortcut` entries in `SettingsCatalog`, unbound by default, with
+ their text in `Strings.Settings` in three languages; `hotKeyInfo` reaches the foreground
+ group through `IGroup.executeSplit` and `splitWithNext`; `HotKeyView` lists the editors.
+5. **Verification** (done, ongoing as issues come up): the SplitView, GroupOperations,
+ TabInteraction and GroupLifecycle suites, the opt-in `SplitViewDesktop` suite on the real
+ desktop, and trials with Explorer, editors, terminals and WebView2 apps; see
+ [split-view-testing.md](split-view-testing.md).
+6. **Nested splits** (done): the pair became a tree of splits addressed by path; `WindowGroup`
+ keeps a divider per split and a window per empty pane, each looking its path up again by its
+ window; drops split the pane under the pointer or, at the group's own edge, the whole group;
+ the strip puts a seam button between every two neighbouring pane tabs, showing the split
+ that parts them; shortcuts came for focus by direction, and the Shortcuts page was then
+ cut back to six split keys in a card of their own (section 5).
+
+## 9. Differences from the first version
+
+| First version | This design |
+| --- | --- |
+| `IntPtr.Zero` stood for an empty pane | `Pane = Empty \| Occupied` |
+| The layout stored bounds and restore bounds, a second truth beside `placement` | The group's frame lives only in `placement`; filling the work area is group-level state |
+| Split logic spread over a dozen places in WindowGroup | A pure `SplitView`, four entry points and one `applyLayout` |
+| Constants such as `Dpi.scale 6` repeated 27 times | `SplitMetrics` |
+| "[Left] " written into tab titles, leaking into Alt+Tab and search | The `TabInfo.splitSide` badge |
+| `IDeferredDragTarget`, 16ms polling and the old state machine side by side | The strip keeps joining at once; windows get a new kind of drop target |
+| A "merge" drop zone | The split button's menu, the tab menu and shortcuts |
+| A global hook and key polling on every empty pane | Handled once by `Desktop` |
+| A 100ms timer polling the placement queue | The queue's Idle event |
+| A 3px difference ended the split | Recomputed by `resizePane`; it ends only when the panes no longer fit |
+| No keyboard entry | `SplitCommand` and shortcuts unbound by default |
diff --git a/docs/split-view-testing.md b/docs/split-view-testing.md
new file mode 100644
index 00000000..718f75c0
--- /dev/null
+++ b/docs/split-view-testing.md
@@ -0,0 +1,98 @@
+# Split view testing
+
+How in-group split view is checked: the automated suites, a walkthrough with real apps, the
+known limits, and what to note when reporting a problem. The design is in
+[split-view-design.md](split-view-design.md).
+
+## Automated suites
+
+| Suite | Desktop | Covers |
+| --- | --- | --- |
+| `SplitView` | none | The pure model: geometry and rounding of one split and of a nested tree, ratio limits, native resize conversion at seams and at the group's edge, drop zones at the group's edge and at a pane's, commands by path, parking and restoring, members going away with their neighbour taking the room, badges and pane order, placement plans and the seam buttons |
+| `GroupOperations` | hidden | Native placement of the panes: empty panes, parking, a third tab shown again after a pane (with every thread-pool worker held, so its placement cannot win the race against the order change that used to cancel it), drops into panes and at edges from this group and from another, a third tab nested into a pane with a divider of its own and closed again, a dropped window put away off screen, swapping by reordering neighbouring tabs, the focused pane leading the group, a pane raised over the tabs, the empty pane as a drop surface, drag routing over an app's child window |
+| `TabInteraction`, `GroupLifecycle` | hidden | The strip, tab clicks and drags, and the taskbar previews that own grouped windows |
+| `SplitViewDesktop` | visible, opt-in | Real pointer input: the empty pane opening out, its frame colour, edge and divider drags with live following beside a slow app and beside another process, the tabs over both panes after clicks, quick switching between the panes, and leaving the split for a tab behind with the tabs never under it |
+
+```powershell
+powershell -NoProfile -ExecutionPolicy Bypass -Command "& ./tests/Run-Tests.ps1 -Suites SplitView,GroupOperations,TabInteraction,GroupLifecycle"
+```
+
+```powershell
+powershell -NoProfile -ExecutionPolicy Bypass -Command "& ./tests/Run-Tests.ps1 -Suites SplitViewDesktop -VisibleDesktop"
+```
+
+`SplitViewDesktop` moves the real pointer: leave the desktop unlocked and idle for about a
+minute. It stops as soon as anyone else moves the pointer. See [testing.md](testing.md) for how
+it runs.
+
+The hidden desktop has no foreground window and no DWM effects, so the suites there cover
+placement and the program's interfaces but not how a switch looks. Flicker, a window showing
+for a moment and stacking against real apps need the visible desktop: the desktop suite, or a
+recording of the screen while switching.
+
+## Trying it by hand
+
+Build and start the Debug copy:
+
+```powershell
+dotnet build WindowTabs.sln
+```
+
+Then run `WtProgram\bin\Debug\WindowTabs.exe`. Starting it asks a running copy to exit as from
+its tray menu and takes over. A split comes back after a restart as its windows regroup.
+
+1. Put two resizable windows in one group, two Explorer windows for example, and make the group
+ large.
+2. With A shown, right-click tab A and choose Split in group, then Window on the right, and pick
+ B. The pair's tabs sit together with a split button on their seam, and their titles carry no prefix.
+3. Click each pane: the focused pane's tab shows as selected. Click a third tab: it fills the
+ group and the pair is parked. Click either tab of the pair: both panes, the direction and the
+ ratio come back. While switching, the row of tabs stays steady and no other tab shows.
+4. Drag the divider, double-click it to equalize, and right-click it for swap, equalize, toggle
+ direction and end split. A press a few pixels either side of the bar drags the divider too,
+ never a pane's own border.
+5. Right-click a tab, Split in group, and pick a window on the right, on the left, above or below: the
+ list opens over the group and the window picked goes on that side of the tab; Esc changes
+ nothing. The shortcut for a window on the right or below opens the same list for the tab in
+ front.
+6. Drag a tab to the edges of a group's window, from this group and from another one, and rest
+ there a moment: a preview lights up the half the tab would take and letting go splits. Let
+ go on the way instead, before the preview shows: the tab comes out as a window of its own,
+ in front. With a third tab shown over
+ the pair, the drop goes beside that tab, not the parked panes, and the pair is let go.
+ While split, drop a third tab at a pane's edge: that pane
+ splits again, with a divider of its own and a seam button between every two pane tabs; drop
+ it just inside the group's own edge instead and a new column or row spans the group. Drag
+ one pane's tab past its neighbour's in the strip: the panes swap. Close the nested pane from
+ the tab menu or with the shortcut: its neighbour takes the room.
+7. During a drag, press Esc, drag back into the strip, drag onto another group, and drag out to
+ a window of its own.
+8. Minimize and restore the group, close or move away one shown window, change whether taskbar
+ buttons combine, and maximize a pane natively.
+9. Try apps that raise or size themselves: WebView2 and Electron apps such as the GitHub Copilot
+ app, and terminals such as Alacritty that keep to a character grid. The tabs stay over both
+ panes and the focused pane's tab shows as selected.
+
+## Known limits
+
+- A split comes back after an exit or restart as its windows regroup, at the frame it had;
+ an empty pane does not, and a window closed meanwhile leaves its room to its neighbour.
+ After a sign-in the windows are new, so that needs the session: with "Restore the last
+ session after sign-in" on, groups, positions and splits are kept as the windows change and put
+ back once the first scan after a start finds no window from the last run, with a notice at
+ the top of the main monitor while it happens. Saved workspaces keep splits too. To try it
+ without signing out: exit WindowTabs, remove the `WindowTabs.*` window properties from
+ every window, move a pane away and start WindowTabs again. After a restart the windows stay at their pane
+ rectangles, and the group takes the size of the window in front.
+- An app that keeps a size of its own stays where it put itself, within 40px of its pane, with
+ no message.
+- Panes keep their native title bars and borders. With the tabs inside the title bars at the top
+ of the screen, the tabs span the group and may cover the left pane's caption buttons.
+- During a drag the group may extend partly outside the work area; letting go does not push it
+ back.
+
+## When reporting
+
+Note the apps, side by side or stacked, whether taskbar buttons combine, the monitors and their
+scaling, and the step at which windows overlapped, jumped, flickered or lost focus. Explorer
+with an editor or a terminal is the combination most worth checking.
diff --git a/docs/testing.md b/docs/testing.md
index 91900d14..f0307e85 100644
--- a/docs/testing.md
+++ b/docs/testing.md
@@ -26,6 +26,10 @@ hosts are excluded. HTML, Cobertura and a text summary are generated under
`tests/coverage//report`. F# sequence points, branches and generated code
mean that line percentages and AltCover's sequence-point percentages differ.
+With `WINDOWTABS_CHECK_THREADS=1` set, the suites and the app refuse a control touched
+from a thread not its own, as WinForms does under a debugger; the suites pass with it, and a
+run with it finds what a debugging session would stop at.
+
Each suite is still a standalone STA executable, not an individual test-case
runner. `tests/Debug/test-results.jsonl` records suite attempts and exit codes.
Process failures are not retried. A zero exit code also requires the final
@@ -78,12 +82,12 @@ parallel on separate runners. The final build check requires Release and every
regression group to succeed. A failing group does not cancel the other groups.
Each group uploads its own diagnostics. Groups are balanced by observed execution
and compilation time rather than suite
-count: Architecture/WindowIcon, GroupOperations/SettingsEditors, and the remaining
+count: Architecture/SplitView/WindowIcon, GroupOperations/SettingsEditors, and the remaining
nine suites.
Each job caches downloaded NuGet packages; each regression group restores the shared test-host
dependencies once, and the Release job reuses its exe when compiling the desktop driver.
Interactive desktop E2E still builds its own isolated Release copy. Native suites
-remain serial within each runner, with all 13 suites retained across the groups.
+remain serial within each runner, with all 14 suites retained across the groups.
Push and pull request builds run without
coverage instrumentation. The Monthly coverage workflow measures the full suite
on the default branch at 08:00 China Standard Time on the first day of each month,
@@ -95,6 +99,25 @@ the release draft requires the build, every regression group and Full E2E to pas
The first cache miss still downloads dependencies; compare warm runs when measuring
the improvement.
+## Split view on the real desktop
+
+`SplitViewDesktop` is opt-in and not in the default list: it moves the real pointer, so it
+needs an unlocked desktop left idle for about a minute, and fails as soon as anyone else moves
+the pointer.
+
+```powershell
+powershell -NoProfile -ExecutionPolicy Bypass -Command "& ./tests/Run-Tests.ps1 -Suites SplitViewDesktop -VisibleDesktop"
+```
+
+It runs its own group in the test process with windows kept out of the taskbar and Alt+Tab, so
+a WindowTabs already running leaves them alone. It drives Windows' own move-size loops through
+the empty pane's edges, a pane window's edge and the divider, and records for every step how
+long the dragged edge trailed the pointer and how long the other pane took to follow. It also
+checks the panes meet, the tabs stay over both panes after clicks, the tabs behind come back
+after a drag, and the empty pane's frame colour. One pass sits beside a window that spends 40ms
+on each resize, and one beside a window of another process, clicked first so that it is raised,
+as a slow app such as Explorer is in use.
+
## Remaining coverage plan
The separate [desktop E2E suite](desktop-e2e.md) exercises the actual Release
@@ -114,6 +137,7 @@ for run evidence, activation requirements and remaining limitations.
| DPI | DpiLayout message transitions, settings page layout passes | Physical mixed-monitor movement and docking |
| Release packaging | Isolated assembly smoke; desktop E2E startup, exit and restart | UI-driven settings edits and import-triggered restart |
| Window grouping | GroupLifecycle plus desktop E2E drag/focus on foreign helper HWNDs | Third-party application scenarios, drag-out and cancellation |
+| Split view | SplitView pure model: geometry, commands, parking, placement plans; GroupOperations native pair placement | Drag transactions, native resize reconciliation, third-party applications |
| Frequent tab switching | Desktop E2E clicks, numeric and next/previous shortcuts, maximized/closed tabs; deterministic stale-focus and Ctrl snapshot checks | Mixed-monitor switching, minimize/restore, prolonged soak |
| Long-running desktop | Short resource-cycle tests | Multi-hour soak, sleep/resume, Explorer restart |
diff --git a/tests/Architecture.fsx b/tests/Architecture.fsx
index 022a20be..4d1eb105 100644
--- a/tests/Architecture.fsx
+++ b/tests/Architecture.fsx
@@ -258,7 +258,8 @@ let main() =
member _.newTab _ = ()
member _.suspendTabMonitoring() = ()
member _.resumeTabMonitoring() = ()
- member _.llMouse = mouse.Publish})
+ member _.llMouse = mouse.Publish
+ member _.paneCandidates() = []})
let desktop = Desktop({new IDesktopNotification with
member _.dragDrop _ = ()
member _.dragEnd() = ()},api,dispatcher)
diff --git a/tests/GroupLifecycle.fsx b/tests/GroupLifecycle.fsx
index b5a44b93..433c534f 100644
--- a/tests/GroupLifecycle.fsx
+++ b/tests/GroupLifecycle.fsx
@@ -7,6 +7,7 @@ open System.IO
open System.Threading
open System.Windows.Forms
open Bemo
+open Bemo.Json
let check condition message = if not condition then failwith message
/// Checks the state it saw rather than asking again, which can catch a later change.
@@ -85,7 +86,8 @@ let main() =
member _.newTab _ = ()
member _.suspendTabMonitoring() = ()
member _.resumeTabMonitoring() = ()
- member _.llMouse = mouse.Publish})
+ member _.llMouse = mouse.Publish
+ member _.paneCandidates() = []})
let desktop = Desktop({new IDesktopNotification with
member _.dragDrop _ = ()
member _.dragEnd() = ()}, api, InvokerService.invoker :> IDispatcher,
@@ -339,10 +341,11 @@ let main() =
check (attempts>=2 && not(onGroup fixture (fun _ -> plugin.isAwaitingDesktopPlacement)))
"Successful desktop placement retained a retry timer"
let failedStart = attempts
+ let secondHandle = second.Handle
onGroup fixture (fun group ->
placeSucceeded <- false
- group.removeWindow second.Handle
- group.addWindow(second.Handle,false))
+ group.removeWindow secondHandle
+ group.addWindow(secondHandle,false))
pumpUntil "Failed placement did not reach its attempt limit" (fun () ->
attempts-failedStart=3 && not(onGroup fixture (fun _ -> plugin.isAwaitingDesktopPlacement)))
onGroup fixture (fun _ ->
@@ -423,6 +426,13 @@ let main() =
releaseSource.Set() |> ignore
pumpUntil "Source exit discarded a staged transfer" (fun () ->
oldGroup.isExited && nativeOrder newGroup=[d;e;a;b;c] && WinUserApi.IsWindow c)
+ // A window gone before it could attach is reported so, on the group's thread: a
+ // rebuilt group waits for every transfer to be settled before it restores its split.
+ let outcome = ref None
+ newGroup.addAfterDetaching(oldGroup,IntPtr 0x5555,afterAdd=(fun added -> outcome.Value <- Some added))
+ pumpUntil "A transfer of a window that is gone was never reported" (fun () -> outcome.Value.IsSome)
+ check (outcome.Value=Some false && nativeOrder newGroup=[d;e;a;b;c] && not((newGroup :> IGroup).windows.contains((=) (IntPtr 0x5555))))
+ "A transfer of a window that is gone was reported as added or kept as a member"
finally
releaseSource.Set() |> ignore
for fixture in [oldGroup;newGroup] do
@@ -592,6 +602,23 @@ let main() =
pumpUntil "A reordered follower swallowed move-end and left the strip hidden" (fun () ->
onGroup combined (fun group -> group.ts.visible))
check (nativeOrder combined = tabsBeforeMove) "Moving a combined group changed its tab positions"
+ // Activating a window raises every window of the group's taskbar window, each just above
+ // its preview, in the previews' order. The group stacks its windows without their owners;
+ // previews left behind brought an old order back at the next activation, a tab behind
+ // a split over a pane.
+ for hwnd in [a;b;d] do WinUserApi.ShowWindow(hwnd,ShowWindowCommands.SW_SHOWNOACTIVATE) |> ignore
+ let stacked = onGroup combined (fun group -> group.zorder.value.list) |> List.rev
+ OS().windowFromHwnd(stacked.Head).insertAfter(WindowHandleTypes.HWND_TOP)
+ for above,hwnd in List.pairwise stacked do OS().windowFromHwnd(hwnd).insertAfter(above)
+ onGroup combined (fun group -> group.main(stacked.Head,WinEvent.EVENT_OBJECT_REORDER))
+ pumpUntil "A preview stayed where its window was before it was stacked" (fun () ->
+ [a;b;d] |> List.forall(fun hwnd -> WinUserApi.GetWindow(hwnd,GetWindowConstants.GW_HWNDNEXT)=owner hwnd))
+ let raised = stacked.[1]
+ WinUserApi.SetWindowPos(raised,WindowHandleTypes.HWND_TOP,0,0,0,0,
+ SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE ||| SetWindowPosFlags.SWP_NOACTIVATE) |> ignore
+ let rank hwnd = OS().windowFromHwnd(hwnd).zorder
+ check (rank raised < rank stacked.[0] && rank stacked.[0] < rank stacked.[2])
+ (sprintf "Raising a tab reordered the others: %A" ([a;b;d] |> List.sortBy rank))
// Exercise the group hooks as well as the worker: no mouse move events
// or later tab click are available to repair keyboard snapping.
let keyboardSource = OS().windowFromHwnd(a)
@@ -900,7 +927,7 @@ let main() =
group.ts.setPlacement({bounds=Rect(Pt(-20000,-20000),size);showInside=false})
let tab = Tab b
let _,sprite = group.ts.tabSprites.pick(fun (location,sprite) -> if sprite.id=tab then Some(location,sprite) else None)
- let data = {tab=tab;tabSize=sprite.size;tabOffset=Pt(sprite.size.width/2,sprite.size.height/2);tabInfo=group.ts.tabInfo tab}
+ let data = {tab=tab;tabSize=sprite.size;tabOffset=Pt(sprite.size.width/2,sprite.size.height/2);tabInfo=group.ts.tabInfo tab;tabShift=0;tabAlignment=TabLeft}
let proportional = {data with tabSize=Sz(200,32);tabOffset=Pt(100,16)}
check (proportional.offsetIn(Sz(300,48))=Pt(150,24)) "Cross-DPI drag lost its grabbed point"
check (proportional.offsetIn(Sz(120,64))=Pt(60,32)) "Cross-orientation drag lost its grabbed point"
@@ -925,7 +952,167 @@ let main() =
onGroup info (fun group -> for hwnd in group.windows.items.list do group.removeWindow hwnd)
(info :> IGroup).destroy()
pumpUntil "Drag groups did not exit" (fun () -> dragSource.isExited && dragTarget.isExited)
- printfn "PASS: real HWND grouping, duplicate add, reorder, cross-STA transfer, six cross-orientation drags, destroyed-window removal, ungrouping, taskbar recovery and taskbar icon rebuilds."
+ // A split is kept with a workspace by the windows' places in the group, and the session,
+ // the same record written on its own, puts the groups and their splits back.
+ do
+ use d = new Form(Text="Pane D",ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,Location=Drawing.Point(-20000,-20000),Size=Drawing.Size(640,480))
+ use e = new Form(Text="Pane E",ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,Location=Drawing.Point(-20000,-20000),Size=Drawing.Size(640,480))
+ let hd,he = d.Handle,e.Handle
+ workspaceWindows <- List2([a;b;hd;he])
+ let pair = desktopApi.createGroup(false) :?> GroupInfo
+ for hwnd in [hd;he] do (pair :> IGroup).addWindow(hwnd,false)
+ pumpUntil "Pair did not form" (fun () -> nativeOrder pair=[hd;he])
+ let frame = Rect(Pt(100,100),Sz(900,700))
+ let tree = {axis=Stacked;ratio=0.3;first=Leaf(Occupied hd);second=Leaf(Occupied he)}
+ onGroup pair (fun group -> group.restoreLayout(Split {tree=tree;focused=[Second]},frame))
+ pumpUntil "The pair did not split" (fun () -> onGroup pair (fun group -> group.splitLayout.IsSome && group.isPlacementIdle))
+ let sessions = WorkspaceModel()
+ sessions.saveSession()
+ pumpUntil "The session was not written" (fun () -> match api.root.["session"] with :? JObject as saved -> (saved.["groups"] :? JArray) | _ -> false)
+ let savedPair =
+ sessions.loadSession() |> Option.bind(fun ws ->
+ ws.groups.list |> List.tryPick(fun group ->
+ let group = group :?> WorkspaceGroup
+ if group.windows.list |> List.exists(fun window -> (window :?> WorkspaceWindow).title="Pane D") then Some group else None))
+ check (savedPair |> Option.exists(fun group ->
+ group.split |> Option.exists(fun split ->
+ not split.parked && split.frame=frame && (split.panes |> List.map fst)=[0;1] &&
+ (snd split.panes.[1]).levels=[Stacked,Second] && abs((snd split.panes.[0]).ratios.[0]-0.3)<0.001 && (snd split.panes.[1]).focused)))
+ (sprintf "The session did not keep the pair's split: %A" (savedPair |> Option.map(fun group -> group.split)))
+ // A save that cannot wait on the groups takes the split last read, by window: with
+ // the group's list changed since, the panes went to the wrong places by index.
+ do
+ onGroup pair (fun group -> group.removeWindow hd)
+ pumpUntil "The pane did not leave the pair" (fun () -> (pair :> IGroup).windows.list=[he])
+ (pair :> IGroup).addWindow(hd,false)
+ pumpUntil "The pair's list did not change order" (fun () -> (pair :> IGroup).windows.list=[he;hd])
+ sessions.saveSessionNow()
+ let cachedPair =
+ sessions.loadSession() |> Option.bind(fun ws ->
+ ws.groups.list |> List.tryPick(fun group ->
+ let group = group :?> WorkspaceGroup
+ if group.windows.list |> List.exists(fun window -> (window :?> WorkspaceWindow).title="Pane D") then Some group else None))
+ let titleAt (group:WorkspaceGroup) index = (group.windows.list.[index] :?> WorkspaceWindow).title
+ check (cachedPair |> Option.exists(fun group ->
+ group.split |> Option.exists(fun split ->
+ split.panes |> List.exists(fun (index,pane) -> pane.levels=[Stacked,First] && titleAt group index="Pane D") &&
+ split.panes |> List.exists(fun (index,pane) -> pane.levels=[Stacked,Second] && titleAt group index="Pane E"))))
+ (sprintf "A session written from the cache named the panes by stale places: %A" (cachedPair |> Option.map(fun group -> group.split,group.windows.list |> List.map(fun window -> (window :?> WorkspaceWindow).title))))
+ // Taken apart and put away, as a sign-in leaves them, the session puts them back split.
+ onGroup pair (fun group -> group.removeWindow hd; group.removeWindow he)
+ (pair :> IGroup).destroy()
+ pumpUntil "The pair did not exit" (fun () -> pair.isExited)
+ for hwnd in [hd;he] do OS().windowFromHwnd(hwnd).move(Rect(Pt(-20000,-20000),Sz(640,480)))
+ let mutable restored : WorkspaceRestoreResult option = None
+ sessions.restoreSession(false,ignore,fun result -> restored <- Some result)
+ pumpUntil "The session did not restore" (fun () -> restored.IsSome)
+ let groupOf hwnd = desktopApi.groups.list |> List.tryFind(fun group -> group.windows.contains((=) hwnd)) |> Option.map(fun group -> group :?> GroupInfo)
+ // The frame comes back fitted to a work area, as a restore keeps it on screen: on a
+ // small screen, a single one of 768 lines say, that is not the frame saved.
+ let fitted = WorkspaceData.fitRect (Mon.all.map(fun mon -> mon.workRect).list) frame
+ pumpUntil "The pair did not come back split from the session" (fun () ->
+ match groupOf hd with
+ | Some info ->
+ onGroup info (fun group ->
+ group.splitLayout |> Option.exists(fun s -> SplitView.windows s=[hd;he] && s.tree.axis=Stacked && abs(s.tree.ratio-0.3)<0.001) &&
+ group.layoutFrame=fitted)
+ | None -> false)
+ groupOf hd |> Option.iter(fun info ->
+ onGroup info (fun group -> for hwnd in group.windows.items.list do group.removeWindow hwnd)
+ (info :> IGroup).destroy())
+ pumpUntil "The restored pair did not exit" (fun () -> (groupOf hd).IsNone && (groupOf he).IsNone)
+ // One pane open and the other found only on a later try, after its app started:
+ // the split is rebuilt once both are there. Rebuilt from each try's own windows,
+ // neither try had two of them, and the pair came back as plain tabs.
+ do
+ for hwnd in [hd;he] do OS().windowFromHwnd(hwnd).move(Rect(Pt(-20000,-20000),Sz(640,480)))
+ // Only the first pane is open: the other is not among the windows at all, as
+ // any window of its app would stand in for it by the title-free pass.
+ workspaceWindows <- List2([hd])
+ let mutable first : WorkspaceRestoreResult option = None
+ sessions.restoreSession(false,ignore,fun result -> first <- Some result)
+ pumpUntil "The session did not restore its first try" (fun () -> first.IsSome && (groupOf hd).IsSome)
+ check (first.Value.pending |> List.exists(fun (_,window) -> window.title="Pane E") && (groupOf he).IsNone)
+ (sprintf "The first try did not leave the other pane pending: %A" (first.Value.pending |> List.map(fun (_,window) -> window.title)))
+ workspaceWindows <- List2([he])
+ let again = sessions.retry first.Value
+ check (again.restored>=1) (sprintf "The later try did not find the other pane: %A" again.missing)
+ pumpUntil "The pair did not come back split over two tries" (fun () ->
+ match groupOf hd with
+ | Some info -> onGroup info (fun group -> group.splitLayout |> Option.exists(fun s -> SplitView.windows s=[hd;he] && s.tree.axis=Stacked))
+ | None -> false)
+ workspaceWindows <- List2([a;b;hd;he])
+ groupOf hd |> Option.iter(fun info ->
+ onGroup info (fun group -> for hwnd in group.windows.items.list do group.removeWindow hwnd)
+ (info :> IGroup).destroy())
+ // A tab dragged out onto the desktop keeps the size the group had; where a side spans most
+ // of the screen, the whole window is scaled down with its proportions kept.
+ do
+ use f = new Form(Text="Own size",ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,Location=Drawing.Point(-20000,-20000),Size=Drawing.Size(640,480))
+ let hwnd = f.Handle
+ let alone = desktopApi.createGroup(false) :?> GroupInfo
+ (alone :> IGroup).addWindow(hwnd,false)
+ pumpUntil "Own-size window did not group" (fun () -> nativeOrder alone=[hwnd])
+ let work = Screen.PrimaryScreen.WorkingArea
+ let workRect = Rect(Pt(work.X,work.Y),Sz(work.Width,work.Height))
+ let tabSize = Sz(100,24)
+ let centred = {tab=Tab hwnd;tabSize=tabSize;tabOffset=Pt(10,10);tabInfo=onGroup alone (fun group -> group.ts.tabInfo(Tab hwnd));tabShift=0;tabAlignment=TabCenter}
+ let dropAt (pt:Pt) (size:Sz) =
+ OS().windowFromHwnd(hwnd).move(Rect(Pt(-20000,-20000),size))
+ // The image's shift, as the strip computed it for the group's width.
+ let data = {centred with tabShift=centred.shiftFor size.width}
+ (desktop :> IDragDropParent).dragDrop((pt,box data))
+ pumpUntil "The dropped window was not placed" (fun () -> OS().windowFromHwnd(hwnd).placement.rcNormalPosition.x<> -20000)
+ // Shown, as the program shows a dropped window, so its frame can be read.
+ OS().windowFromHwnd(hwnd).showWindow(ShowWindowCommands.SW_SHOWNOACTIVATE)
+ OS().windowFromHwnd(hwnd).visibleBounds
+ let dropped (size:Sz) = (dropAt (Pt(work.X+200,work.Y+200)) size).size
+ // Resized since it joined, the group's size is what comes out; read once at joining,
+ // the window's own size brought back a size the group had long left.
+ let modestGroup = Sz(work.Width/2,work.Height/2)
+ OS().windowFromHwnd(hwnd).move(Rect(Pt(-20000,-20000),modestGroup))
+ let groupVisible = OS().windowFromHwnd(hwnd).visibleBounds.size
+ let landed = dropped modestGroup
+ check (landed=groupVisible) (sprintf "A tab dragged out of a modest group did not keep the group's size: %dx%d instead of %dx%d" landed.width landed.height groupVisible.width groupVisible.height)
+ // Screen-sized, maximized or snapped to half the screen, the window comes out scaled
+ // as a whole, its widest share of the screen at three fifths. Taken side by side, a
+ // half-screen group came out squashed; judged whole without scaling, it came out the
+ // screen's full height, pushed up to its top.
+ for group in [Sz(work.Width,work.Height);Sz(work.Width/2,work.Height)] do
+ OS().windowFromHwnd(hwnd).move(Rect(Pt(-20000,-20000),group))
+ let before = OS().windowFromHwnd(hwnd).visibleBounds.size
+ let landed = dropAt (Pt(work.X+work.Width/2,work.Y+work.Height/2)) group
+ let ratio (size:Sz) = float size.width/float size.height
+ let share = max (float landed.width/float work.Width) (float landed.height/float work.Height)
+ check (abs(ratio landed.size-ratio before)<0.01 && abs(share-0.6)<0.01 && landed.top>work.Y)
+ (sprintf "A tab dragged out of a %dx%d group did not keep its proportions at three fifths of the screen: %A, %dx%d" before.width before.height landed landed.width landed.height)
+ // Made smaller, the window lands with its centred tab still under the pointer: placed
+ // by the group's width, it came out hundreds of pixels to the left. Dropped near the
+ // work area's edges, it stays wholly inside it.
+ let mid = Pt(work.X+work.Width/2,work.Y+work.Height/3)
+ let landed = dropAt mid (Sz(work.Width,work.Height))
+ let tabLeft = mid.x-centred.tabOffset.x
+ let expectedLeft = tabLeft-centred.shiftFor landed.width+(desktop.GetType().GetProperty("windowOffset",Reflection.BindingFlags.Instance|||Reflection.BindingFlags.NonPublic).GetValue(desktop) :?> Pt).x
+ check (abs(landed.x-expectedLeft)<=2) (sprintf "A smaller dropped window did not keep its tab under the pointer: left %d, expected %d" landed.x expectedLeft)
+ for corner in [Pt(work.Right-5,work.Bottom-5);Pt(work.X+5,work.Bottom-5);Pt(work.Right-5,work.Y+5)] do
+ let at = dropAt corner (Sz(work.Width,work.Height))
+ check (DragOutPlacement.fit workRect at=at) (sprintf "A tab dropped at %A landed outside the work area: %A in %A" corner at work)
+ // Let go, the window comes in front of what lay over it: its old group took the
+ // foreground as the tab left it, showing the panes the tab had parked, and the window
+ // landed under them.
+ do
+ use cover = new Form(Text="Cover",ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,Location=Drawing.Point(work.X,work.Y),Size=Drawing.Size(work.Width,work.Height))
+ cover.Show()
+ OS().windowFromHwnd(cover.Handle).insertAfter(WindowHandleTypes.HWND_TOP)
+ let isAbove (upper:IntPtr) (lower:IntPtr) =
+ let rec walk (current:IntPtr) = current<>IntPtr.Zero && (current=upper || walk (WinUserApi.GetWindow(current,GetWindowConstants.GW_HWNDPREV)))
+ walk (WinUserApi.GetWindow(lower,GetWindowConstants.GW_HWNDPREV))
+ check (isAbove cover.Handle hwnd) "The test could not put a window over the one it drops"
+ dropAt mid (Sz(work.Width,work.Height)) |> ignore
+ pumpUntil "The dropped window did not come in front" (fun () -> isAbove hwnd cover.Handle)
+ onGroup alone (fun group -> group.removeWindow hwnd)
+ (alone :> IGroup).destroy()
+ printfn "PASS: real HWND grouping, duplicate add, reorder, cross-STA transfer, six cross-orientation drags, destroyed-window removal, ungrouping, taskbar recovery, taskbar icon rebuilds and the session's splits."
finally
let rest = desktopApi.groups.list |> List.map(fun g -> g :?> GroupInfo)
for info in List.distinct([source;target;combined] @ rest) do
diff --git a/tests/GroupOperations.fsx b/tests/GroupOperations.fsx
index f090518f..803c18d1 100644
--- a/tests/GroupOperations.fsx
+++ b/tests/GroupOperations.fsx
@@ -17,6 +17,25 @@ module Timer =
extern uint32 timeBeginPeriod(uint32 period)
let check condition message = if not condition then failwith message
+/// Holds every thread-pool worker while `action` runs, so a placement it submits cannot start
+/// before the group thread has finished the operation that submitted it.
+let withPoolHeld (action:unit -> unit) =
+ let mutable maxWorkers,maxIo = 0,0
+ let mutable minWorkers,minIo = 0,0
+ ThreadPool.GetMaxThreads(&maxWorkers,&maxIo)
+ ThreadPool.GetMinThreads(&minWorkers,&minIo)
+ let held = Environment.ProcessorCount
+ use hold = new ManualResetEvent(false)
+ use started = new CountdownEvent(held)
+ check (ThreadPool.SetMinThreads(held,minIo) && ThreadPool.SetMaxThreads(held,maxIo)) "The thread pool could not be limited"
+ try
+ for _ in 1..held do ThreadPool.QueueUserWorkItem(fun _ -> started.Signal() |> ignore; hold.WaitOne() |> ignore) |> ignore
+ check (started.Wait(5000)) "The thread-pool workers did not all start"
+ action()
+ finally
+ hold.Set() |> ignore
+ ThreadPool.SetMaxThreads(maxWorkers,maxIo) |> ignore
+ ThreadPool.SetMinThreads(minWorkers,minIo) |> ignore
/// Each wait sleeps at least one timer tick; main shortens it to 1ms. At the default 15.6ms a
/// sampled operation's half a dozen waits cost about 95ms and the suite ran past its timeout.
/// Checks the state it saw: asking again after the loop can catch a later, transient change,
@@ -35,10 +54,12 @@ type HelperWindow() =
inherit Form(ShowInTaskbar=false, StartPosition=FormStartPosition.Manual,
Location=Point(-20000,-20000), Size=Size(640,480))
let mutable changes = 0
+ let mutable pinned = true
let mutable delay = 0
let mutable iconDelay = 0
let mutable positionPause : (ManualResetEventSlim * ManualResetEventSlim) option = None
member _.Changes = Volatile.Read(&changes)
+ member _.Pinned with set value = pinned <- value
member _.Delay with set value = delay <- value
member _.IconDelay with set value = iconDelay <- value
member _.HoldNextPositionChanged(entered,resume) = positionPause <- Some(entered,resume)
@@ -55,10 +76,10 @@ type HelperWindow() =
position.flags <- position.flags ||| SetWindowPosFlags.SWP_NOACTIVATE
// Keep maximize tests off screen; measure native synchronization,
// not full-screen painting or the compositor's transition.
- if position.IsMove && (position.x > -10000 || position.y > -10000) then
+ if pinned && position.IsMove && (position.x > -10000 || position.y > -10000) then
position.x <- -20000
position.y <- -20000
- if position.IsSize then
+ if pinned && position.IsSize then
position.cx <- min position.cx 660
position.cy <- min position.cy 500
Marshal.StructureToPtr(position,message.LParam,false)
@@ -74,7 +95,80 @@ type HelperWindow() =
// DPI drops, pins MinimumSize to the clamped size, so it no longer takes the group's size.
if message.Msg <> 0x2E0 then base.WndProc(&message)
+/// Whether a drop surface shows a place for the drag at the point, asked as a rested pointer is.
+let previewed (target:ILayoutDropTarget) (data:obj,pt:Pt) =
+ match target.probe(data,pt,true) with
+ | Aimed(_,shown) -> shown
+ | NearStrip _ -> false
+
let main() =
+ // A pointer over a strip joins; over a group's window or a helper window owned by its
+ // strip it previews a pane; anywhere else it floats.
+ let strip =
+ {new IDragDropTarget with
+ member _.dragBegin() = ()
+ member _.dragEnd() = ()
+ member _.dragEnter _ _ = true
+ member _.dragMove _ = ()
+ member _.dragExit() = ()
+ member _.dragCancel _ = ()}
+ let surface = {new ILayoutDropTarget with
+ member _.probe(_,_,_) = Aimed(SplitAim,true)
+ member _.clearPreview() = ()
+ member _.commit(_,_) = true}
+ let strips = Map2(List2([IntPtr 1,strip]))
+ let surfaces = Map2(List2([IntPtr 1,surface;IntPtr 2,surface]))
+ check (DragRouting.resolve strips surfaces (IntPtr 1) IntPtr.Zero=StripHit(IntPtr 1)) "The strip itself did not join the dragged tab"
+ check (DragRouting.resolve strips surfaces (IntPtr 2) IntPtr.Zero=LayoutHit(IntPtr 2)) "A group window did not offer a pane"
+ check (DragRouting.resolve strips surfaces (IntPtr 9) (IntPtr 1)=LayoutHit(IntPtr 1)) "A helper window owned by the strip did not offer its group's panes"
+ check (DragRouting.resolve strips surfaces (IntPtr 9) (IntPtr 8)=FreeHit) "An unrelated window took the drag"
+ check (DragRouting.resolve strips surfaces IntPtr.Zero IntPtr.Zero=FreeHit) "The desktop took the drag"
+ // A tab held in one strip goes to another group's strip in sight under the pointer, though
+ // still within the first strip's width: strips at the top of the screen lie over one another,
+ // and the first one crossed kept the tab, which then joined a group out of sight.
+ do
+ let twoStrips = Map2(List2([IntPtr 1,strip;IntPtr 3,strip]))
+ check (DragRouting.movesToStrip twoStrips (IntPtr 1) (IntPtr 3)) "A tab held in one strip did not move to another group's strip under the pointer"
+ check (not(DragRouting.movesToStrip twoStrips (IntPtr 1) (IntPtr 1))) "A tab left the strip it is in"
+ check (not(DragRouting.movesToStrip twoStrips (IntPtr 1) (IntPtr 9))) "A tab left its strip for a window that is no strip"
+ check (not(DragRouting.movesToStrip twoStrips (IntPtr 1) IntPtr.Zero)) "A tab left its strip for nothing"
+ // A split is offered once the pointer rests in a drop zone, not as it passes: let go on the
+ // way, the tab comes out as a window of its own. An empty pane takes a drop at once.
+ do
+ let w,v = IntPtr 2,IntPtr 3
+ let rest = LayoutDwell.restMs
+ let step now pt key aim state = LayoutDwell.step now 6 pt key aim state
+ let s0,shown0 = step 0L (Pt(100,100)) w SplitAim None
+ check (not shown0) "A split was offered as soon as the pointer reached a drop zone"
+ let s1,shown1 = step (rest-1L) (Pt(104,103)) w SplitAim s0
+ check (not shown1) "A split was offered before the pointer had rested"
+ let s2,shown2 = step rest (Pt(103,104)) w SplitAim s1
+ check shown2 "A pointer resting in a drop zone was not offered the split"
+ let _,shown3 = step (rest+10L) (Pt(300,140)) w SplitAim s2
+ check shown3 "Once offered, the split did not follow the pointer over the same window"
+ let _,moving = step rest (Pt(130,100)) w SplitAim s0
+ check (not moving) "A pointer moving through a drop zone was offered the split"
+ let _,other = step (rest*3L) (Pt(100,100)) v SplitAim s2
+ check (not other) "Another window's split was offered without resting over it"
+ let left,shownLeft = step (rest+20L) (Pt(500,300)) w NoAim s2
+ check (left.IsNone && not shownLeft) "Leaving the drop zones kept the split offered"
+ let _,again = step (rest+30L) (Pt(100,100)) w SplitAim left
+ check (not again) "Coming back into a drop zone offered the split without resting again"
+ check (snd (step 0L (Pt(100,100)) w FillAim None)) "An empty pane did not take the drop at once"
+ // The pointer over an app's child window, a browser's page say, is over the group's window.
+ do
+ use app = new Form(Text="Routing app",ShowInTaskbar=false,TopMost=true,StartPosition=FormStartPosition.Manual,
+ FormBorderStyle=FormBorderStyle.None,Location=Point(120,120),Size=Size(320,240))
+ use page = new Panel(Dock=DockStyle.Fill)
+ app.Controls.Add(page)
+ app.Show()
+ for _ in 1..5 do Application.DoEvents()
+ let centre = Pt(280,240)
+ check (WinUserApi.WindowFromPoint(centre.POINT)=page.Handle) "The routing fixture's child window is not under the pointer"
+ let hit,owner = DragRouting.windowsAt centre
+ check (hit=app.Handle) (sprintf "A drag over an app's child window found %A, not its window %A" hit app.Handle)
+ let appSurfaces = Map2(List2([app.Handle,surface]))
+ check (DragRouting.resolve strips appSurfaces hit owner=LayoutHit app.Handle) "A drag over an app's child window did not offer a pane"
// Lasts until the test process exits.
Timer.timeBeginPeriod 1u |> ignore
// Hold a native-like call in flight, then replace its queued successors and
@@ -143,6 +237,7 @@ let main() =
let mouse = Event()
let newTabRequests = Collections.Concurrent.ConcurrentQueue()
let names = Collections.Concurrent.ConcurrentDictionary()
+ let nameReads = ref 0
Services.register({new IProgram with
member _.version = "test"
member _.isFirstRun = false
@@ -153,7 +248,9 @@ let main() =
match name with
| Some name -> names.[hwnd] <- name
| None -> names.TryRemove(hwnd) |> ignore
- member _.getWindowNameOverride hwnd = match names.TryGetValue(hwnd) with | true,name -> Some name | _ -> None
+ member _.getWindowNameOverride hwnd =
+ Threading.Interlocked.Increment(&nameReads.contents) |> ignore
+ match names.TryGetValue(hwnd) with | true,name -> Some name | _ -> None
member _.getTabColorOverride _ = None
member _.setTabColorOverride _ = ()
member _.getTabColor(_,_) = None
@@ -171,7 +268,8 @@ let main() =
member _.newTab hwnd = newTabRequests.Enqueue(hwnd)
member _.suspendTabMonitoring() = ()
member _.resumeTabMonitoring() = ()
- member _.llMouse = mouse.Publish})
+ member _.llMouse = mouse.Publish
+ member _.paneCandidates() = []})
Services.register({new IFilterService with
member _.isAppWindow _ = false
member _.isAppWindowStyle _ = false
@@ -239,6 +337,618 @@ let main() =
if not((info :> IGroup).windows.contains ((=) hwnd)) then (info :> IGroup).addWindow(hwnd,false)
pumpUntil(fun () -> onGroup(fun group -> group.windows.count=count))
if count=2 then
+ waitOperation()
+ let source = onGroup(fun group -> group.topWindow)
+ onHelper(fun () -> for form in forms |> List.take 2 do form.Pinned <- false; form.Show())
+ onHelper(fun () -> OS().windowFromHwnd(source).move(Rect(Pt(60,60),Sz(900,600))))
+ pumpUntil(fun () -> onGroup(fun group -> group.placementBounds.width>=890 && group.isPlacementIdle))
+ let partner = handles |> List.take 2 |> List.find((<>) source)
+ let gap = Dpi.scale SplitMetrics.gap
+ let paneRect (group:WindowGroup) side = (SplitGeometry.paneRect gap group.layoutFrame group.splitLayout.Value [side]).Value
+ let pair first second axis focused = {tree={axis=axis;ratio=0.5;first=Leaf first;second=Leaf second};focused=[focused]}
+ let sides (group:WindowGroup) = let s = group.splitLayout.Value in s.tree.first,s.tree.second
+ let emptyPaneOf (group:WindowGroup) = group.emptyPaneHwnds |> List.tryHead |> Option.defaultValue IntPtr.Zero
+ let decoratorOf (group:WindowGroup) =
+ typeof.GetFields(flags) |> Array.find(fun field -> field.FieldType=typeof)
+ |> fun field -> field.GetValue(group.ts) :?> ILayoutDropTarget
+ let adjacent (group:WindowGroup) first second = group.lorder.list |> List.pairwise |> List.exists((=) (first,second))
+ onGroup(fun group -> group.execute(NewEmptyPane SideBySide))
+ waitOperation()
+ check (onGroup(fun group -> group.splitLayout=Some(pair (Occupied source) Empty SideBySide First))) "A tab could not open an empty pane beside itself"
+ // Owned by nothing, the empty pane is a drop surface of its own while it is there.
+ let emptyPane = onGroup emptyPaneOf
+ let surfaces = Services.get() :?> DragDropController
+ check (emptyPane<>IntPtr.Zero && surfaces.isLayoutTarget emptyPane) "A tab dragged over the empty pane found no drop surface"
+ onGroup(fun group -> group.tabActivate(Tab(partner),false))
+ waitOperation()
+ check (onGroup(fun group -> match group.layout with Parked s -> s.tree.second=Leaf Empty | _ -> false)) "Selecting an unrelated tab did not park the empty split"
+ check (OS().windowFromHwnd(partner).visibleBounds=onGroup(fun group -> group.layoutFrame)) "The unrelated tab did not fill the frame"
+ onGroup(fun group -> group.tabActivate(Tab(source),false))
+ waitOperation()
+ onGroup(fun group ->
+ group.execute(Swap None)
+ let s = group.splitLayout.Value
+ check (s.tree.first=Leaf Empty && s.tree.second=Leaf(Occupied source)) "Swapping lost the empty pane"
+ let a = paneRect group First
+ let point = Pt(a.x+a.width/2,a.y+a.height/2)
+ let decorator = decoratorOf group
+ let drag = box {tab=Tab(partner);tabOffset=Pt();tabSize=Sz(100,24);tabInfo=group.ts.tabInfo(Tab(partner));tabShift=0;tabAlignment=TabLeft}
+ check (previewed decorator (drag,point)) "The centre of an empty pane rejected a tab"
+ decorator.clearPreview()
+ check (group.splitLayout=Some s) "Cancelling an empty-pane preview changed the layout"
+ check (previewed decorator (drag,point)) "The empty pane could not be targeted again"
+ check (decorator.commit(drag,point)) "A previewed pane took no drop"
+ decorator.clearPreview()
+ check (sides group=(Leaf(Occupied partner),Leaf(Occupied source))) "Dropping did not fill the empty pane"
+ check (adjacent group partner source) "The pair's tabs did not end up next to each other")
+ waitOperation()
+ check (not(surfaces.isLayoutTarget emptyPane)) "A filled empty pane stayed a drop surface"
+ // A window that moved to another group is that group's drop surface: the old
+ // group's removal, which can run late, leaves the new registration alone.
+ do
+ let hwnd = IntPtr 0x7777
+ let later = {new ILayoutDropTarget with
+ member _.probe(_,_,_) = Aimed(NoAim,false)
+ member _.clearPreview() = ()
+ member _.commit(_,_) = false}
+ let api = surfaces :> IDragDrop
+ api.registerLayoutTarget(hwnd,surface)
+ api.registerLayoutTarget(hwnd,later)
+ api.unregisterLayoutTarget(hwnd,surface)
+ check (surfaces.isLayoutTarget hwnd) "The old group's removal took the window's drop surface from its new group"
+ api.unregisterLayoutTarget(hwnd,later)
+ check (not(surfaces.isLayoutTarget hwnd)) "The new group's removal left the window a drop surface"
+ check (onGroup(fun group -> group.ts.tabInfo(Tab(partner)).splitTrail=Some [SideBySide,First] && group.ts.tabInfo(Tab(source)).splitTrail=Some [SideBySide,Second])) "Pane tabs carry no badge"
+ check (onGroup(fun group -> group.ts.tabInfo(Tab(partner)).text=group.tabName partner)) "The badge leaked into the tab's name"
+ onGroup(fun group -> group.execute(EndSplit(Some source)))
+ waitOperation()
+ check (onGroup(fun group -> group.layout=GroupLayout.Single && group.ts.tabInfo(Tab(partner)).splitTrail=None)) "Ending the split kept a badge"
+ onGroup(fun group -> group.removeWindow(partner); group.execute(NewEmptyPane Stacked))
+ waitOperation()
+ check (onGroup(fun group -> group.windows.count=1 && group.splitLayout.Value.tree.second=Leaf Empty)) "A singleton could not create an empty pane"
+ // Esc beside the empty pane closes it, as its close button does.
+ onGroup(fun group -> group.closeEmptyPane())
+ waitOperation()
+ check (onGroup(fun group -> group.layout=GroupLayout.Single && group.emptyPaneHwnds.IsEmpty)) "Closing an empty pane left the split"
+ onGroup(fun group -> group.execute(NewEmptyPane Stacked))
+ waitOperation()
+ onGroup(fun group ->
+ group.addWindow(partner,false)
+ group.execute(FillPane(partner,[Second])))
+ waitOperation()
+ check (onGroup(fun group -> sides group=(Leaf(Occupied source),Leaf(Occupied partner)))) "A joining window did not fill the empty pane"
+ // Once filled, there is no empty pane for Esc to close.
+ onGroup(fun group -> group.closeEmptyPane())
+ check (onGroup(fun group -> group.splitLayout.Value.tree.second=Leaf(Occupied partner))) "Esc ended a split with no empty pane"
+ onGroup(fun group -> group.execute(EndSplit(Some source)))
+ waitOperation()
+ onGroup(fun group -> group.execute(SplitWith(partner,SideBySide)))
+ pumpUntil(fun () -> onGroup(fun group -> group.isPlacementIdle && group.splitLayout.IsSome))
+ let waitSplit() =
+ let placed () = onGroup(fun group ->
+ match group.splitLayout with
+ | Some s ->
+ SplitView.windows s |> List.forall(fun hwnd ->
+ OS().windowFromHwnd(hwnd).visibleBounds=(SplitGeometry.paneRect gap group.layoutFrame s (SplitView.pathOf hwnd s).Value).Value)
+ | None -> failwith "Split layout unexpectedly ended")
+ try pumpUntil placed
+ with _ ->
+ let report = onGroup(fun group ->
+ let s = group.splitLayout.Value
+ SplitView.windows s |> List.map(fun hwnd ->
+ sprintf "%A actual=%A wanted=%A" hwnd (OS().windowFromHwnd(hwnd).visibleBounds) ((SplitGeometry.paneRect gap group.layoutFrame s (SplitView.pathOf hwnd s).Value).Value))
+ |> String.concat "; ")
+ failwithf "The panes did not reach their places: %s" report
+ waitSplit()
+ check (onGroup(fun group -> adjacent group source partner)) "Splitting did not bring the pair's tabs together"
+ // The divider's band is centred on the seam and covers both panes' invisible resize
+ // borders, so a press near the seam drags the divider and never a pane's own edge.
+ do
+ let divider = onGroup(fun group ->
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="splitDividers")
+ snd (field.GetValue(group) :?> Map).[[]])
+ let seam = (onGroup(fun group -> paneRect group First)).right
+ let band() = OS().windowFromHwnd(divider).bounds
+ pumpUntil(fun () -> (band()).width=Dpi.scale SplitMetrics.dividerGrab)
+ let border = Dpi.scale 6
+ check ((band()).left<=seam-border && (band()).right>=seam+border)
+ (sprintf "The divider's band %A leaves a pane's resize border bare at the seam %d" (band()) seam)
+ let firstFrame = onGroup(fun group -> group.layoutFrame)
+ onHelper(fun () -> OS().windowFromHwnd(source).showWindow(ShowWindowCommands.SW_SHOWMAXIMIZED))
+ pumpUntil(fun () -> onGroup(fun group -> group.isSplitFilled))
+ waitOperation()
+ waitSplit()
+ let filled = onGroup(fun group -> group.layoutFrame)
+ check (filled=Mon.fromHwnd(source).Value.workRect) "Native maximize did not fill the split work area"
+ onHelper(fun () -> OS().windowFromHwnd(source).showWindow(ShowWindowCommands.SW_SHOWMAXIMIZED))
+ pumpUntil(fun () -> onGroup(fun group -> not group.isSplitFilled))
+ waitOperation()
+ waitSplit()
+ check (onGroup(fun group -> group.layoutFrame=firstFrame)) "A second maximize did not restore the split size"
+ onGroup(fun group -> group.execute ToggleFill)
+ waitOperation()
+ waitSplit()
+ onGroup(fun group -> invoke "handleWindowEvent" group [|box source;box WinEvent.EVENT_SYSTEM_MOVESIZESTART|] |> ignore)
+ onHelper(fun () ->
+ let window = OS().windowFromHwnd(source)
+ window.move(window.bounds.move(12,48)))
+ pumpUntil(fun () -> onGroup(fun group -> group.layoutFrame=filled.move(12,48)))
+ onGroup(fun group -> invoke "handleWindowEvent" group [|box source;box WinEvent.EVENT_SYSTEM_MOVESIZEEND|] |> ignore)
+ waitOperation()
+ waitSplit()
+ check (onGroup(fun group -> group.layoutFrame=filled.move(12,48))) "Moving a work-area-sized split snapped it back to the top"
+ onGroup(fun group -> group.restoreLayout(group.layout,firstFrame))
+ waitOperation()
+ waitSplit()
+ onGroup(fun group -> invoke "handleWindowEvent" group [|box source;box WinEvent.EVENT_SYSTEM_MOVESIZESTART|] |> ignore)
+ onHelper(fun () ->
+ let window = OS().windowFromHwnd(source)
+ window.move(window.bounds.move(12,8)))
+ pumpUntil(fun () -> onGroup(fun group -> group.layoutFrame=firstFrame.move(12,8)))
+ onGroup(fun group -> invoke "handleWindowEvent" group [|box source;box WinEvent.EVENT_SYSTEM_MOVESIZEEND|] |> ignore)
+ waitSplit()
+ let movedFrame = onGroup(fun group -> group.layoutFrame)
+ for hwnd in [source;partner;source] do
+ onGroup(fun group -> group.foreground <- hwnd)
+ waitSplit()
+ check ((onGroup(fun group -> group.layoutFrame))=movedFrame) "Selecting a pane changed the group frame"
+ onGroup(fun group -> group.execute(SetRatio([],0.6)))
+ waitSplit()
+ onGroup(fun group -> group.execute(Swap None))
+ waitSplit()
+ check ((onGroup(fun group -> group.splitLayout.Value.tree.first))=Leaf(Occupied partner)) "Swap did not exchange panes"
+ onGroup(fun group -> group.execute(SplitWith(partner,Stacked)))
+ waitSplit()
+ check ((onGroup(fun group -> group.splitLayout.Value.tree.axis))=Stacked) "Splitting with an existing pane did not change the axis"
+ let third = handles.[2]
+ onHelper(fun () -> forms.[2].Pinned <- false; forms.[2].Show())
+ onGroup(fun group -> group.addWindow(third,false))
+ waitSplit()
+ let beforeThird = onGroup(fun group -> group.splitLayout.Value)
+ // Parking the panes and bringing them back reads no tab again: their places
+ // are the same either way, and reading every tab held the strip back.
+ let readsBefore = nameReads.Value
+ onGroup(fun group -> group.tabActivate(Tab(third),false))
+ waitOperation()
+ check (onGroup(fun group -> group.layout=Parked beforeThird)) "Third tab replaced a split member"
+ check (OS().windowFromHwnd(third).visibleBounds=movedFrame) "Third tab did not occupy the whole group"
+ check (onGroup(fun group -> group.ts.zorder.head=Tab third)) "The strip did not show the tab chosen over the panes as the one in front"
+ onGroup(fun group -> group.tabActivate(Tab(SplitView.window [First] beforeThird |> Option.get),false))
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout=Some {beforeThird with focused=[First]})) "Returning to a split did not restore both panes and their ratio"
+ check (nameReads.Value=readsBefore) (sprintf "Parking the panes and bringing them back read the tabs again: %d reads" (nameReads.Value-readsBefore))
+ // A fourth tab chosen over the parked panes, then the third again, and the third
+ // dragged out: the fourth comes back, not the panes' focused window, which the
+ // park stacked just under the third as it did every other tab.
+ do
+ let fourth = handles.[3]
+ onHelper(fun () -> forms.[3].Pinned <- false; forms.[3].Show())
+ onGroup(fun group -> group.addWindow(fourth,false))
+ waitOperation()
+ onGroup(fun group -> group.tabActivate(Tab(fourth),false))
+ waitOperation()
+ onGroup(fun group -> group.tabActivate(Tab(third),false))
+ waitOperation()
+ check (onGroup(fun group -> group.topWindow=third && (match group.layout with Parked _ -> true | _ -> false))) "The third tab did not show over the parked panes"
+ onGroup(fun group ->
+ group.removeWindow third
+ OS().windowFromHwnd(third).hideOffScreen(None)
+ group.showTabBefore third)
+ waitOperation()
+ check (onGroup(fun group -> group.topWindow=fourth && (match group.layout with Parked _ -> true | _ -> false))) (sprintf "Dragging the shown tab out did not bring back the tab shown before it: top %A, fourth %A, layout %A" (onGroup(fun group -> group.topWindow)) fourth (onGroup(fun group -> group.layout)))
+ onGroup(fun group -> group.addWindow(third,false))
+ waitOperation()
+ onGroup(fun group -> group.removeWindow fourth)
+ waitOperation()
+ onHelper(fun () -> forms.[3].Hide(); forms.[3].Pinned <- true; forms.[3].Bounds <- Rectangle(-20000,-20000,640,480))
+ onGroup(fun group -> group.tabActivate(Tab(third),false))
+ waitOperation()
+ // Back and forth between a pane and the third tab, which waits pane-sized under
+ // the host pane while the split shows: shown again, it must fill the whole group.
+ for delay in [0;80] do
+ onHelper(fun () -> for form in forms |> List.take 3 do form.Delay <- delay)
+ try
+ for pane in [Second;First] do
+ onGroup(fun group -> group.tabActivate(Tab(SplitView.window [pane] beforeThird |> Option.get),false))
+ waitSplit()
+ onGroup(fun group -> group.tabActivate(Tab(third),false))
+ waitOperation()
+ let parked = onGroup(fun group -> group.layout)
+ check (parked=Parked {beforeThird with focused=[pane]}) (sprintf "Third tab shown again (delay %d) replaced a split member: %A" delay parked)
+ check (OS().windowFromHwnd(third).visibleBounds=movedFrame) (sprintf "Third tab shown again (delay %d) kept the pane size: %A instead of %A" delay (OS().windowFromHwnd(third).visibleBounds) movedFrame)
+ check ((onGroup(fun group -> group.layoutFrame))=movedFrame) (sprintf "Third tab shown again (delay %d) changed the group frame" delay)
+ // Switched before the panes have been placed, the third tab still fills the group.
+ onGroup(fun group -> group.tabActivate(Tab(SplitView.window [First] beforeThird |> Option.get),false))
+ onGroup(fun group -> group.tabActivate(Tab(third),false))
+ waitOperation()
+ check (OS().windowFromHwnd(third).visibleBounds=movedFrame) (sprintf "Third tab shown at once (delay %d) kept the pane size: %A instead of %A" delay (OS().windowFromHwnd(third).visibleBounds) movedFrame)
+ finally onHelper(fun () -> for form in forms |> List.take 3 do form.Delay <- 0)
+ onGroup(fun group -> group.tabActivate(Tab(SplitView.window [First] beforeThird |> Option.get),false))
+ waitSplit()
+ // Shown again while no worker can start its placement before the group has put
+ // it in front: that order change cancelled the placement, and the tab kept its
+ // pane's size whenever the worker lost the race.
+ withPoolHeld(fun () -> onGroup(fun group -> group.tabActivate(Tab(third),false)))
+ waitOperation()
+ check (OS().windowFromHwnd(third).visibleBounds=movedFrame) (sprintf "Third tab shown again with its placement delayed kept the pane size: %A instead of %A" (OS().windowFromHwnd(third).visibleBounds) movedFrame)
+ onGroup(fun group -> group.tabActivate(Tab(SplitView.window [First] beforeThird |> Option.get),false))
+ waitSplit()
+ onGroup(fun group -> group.minimizeAll())
+ pumpUntil(fun () -> handles |> List.take 3 |> List.forall(fun hwnd -> OS().windowFromHwnd(hwnd).isMinimized))
+ waitOperation()
+ onGroup(fun group -> group.restoreAll())
+ waitOperation()
+ waitSplit()
+ onGroup(fun group -> group.removeWindow(third))
+ waitOperation()
+ check (onGroup(fun group -> group.splitLayout.IsSome && group.windows.count=2)) "Removing an unrelated tab ended the split"
+ onHelper(fun () -> forms.[2].Hide(); forms.[2].Pinned <- true; forms.[2].Bounds <- Rectangle(-20000,-20000,640,480))
+ onGroup(fun group ->
+ group.execute(ToggleAxis None)
+ group.execute(DropInto(partner,[],SideBySide,Second)))
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout.Value.tree.axis=SideBySide && group.splitLayout.Value.tree.second=Leaf(Occupied partner))) "Dropping a pane on the other side did not move it there"
+ onGroup(fun group ->
+ let decorator = decoratorOf group
+ let before = group.splitLayout.Value
+ let order = group.lorder.list
+ let drag = box {tab=Tab(partner);tabOffset=Pt();tabSize=Sz(100,24);tabInfo=group.ts.tabInfo(Tab(partner));tabShift=0;tabAlignment=TabLeft}
+ let frame = group.layoutFrame
+ let point = Pt(frame.left+2,frame.y+frame.height/2)
+ check (previewed decorator (drag,point)) "Own edge did not accept a split preview"
+ decorator.clearPreview()
+ check (group.splitLayout=Some before && group.lorder.list=order) "Cancelling a preview changed layout or membership"
+ check (previewed decorator (drag,point)) "Repeated split preview failed"
+ check (decorator.commit(drag,point)) "A previewed pane took no drop"
+ decorator.clearPreview()
+ check (group.splitLayout.Value.tree.first=Leaf(Occupied partner)) "Dragging a pane to the opposite edge did not swap it")
+ waitSplit()
+ waitOperation()
+ // The drop preview fades out rather than vanishing, and is gone once it has.
+ do
+ let previewShown () = onGroup(fun group ->
+ let decorator = decoratorOf group
+ let field = decorator.GetType().GetFields(flags) |> Array.find(fun field -> field.Name="layoutPreview")
+ match field.GetValue(decorator) with
+ | null -> false
+ | value -> (value.GetType().GetProperty("Value").GetValue(value) :?> Form).Visible)
+ onGroup(fun group ->
+ let drag = box {tab=Tab(partner);tabOffset=Pt();tabSize=Sz(100,24);tabInfo=group.ts.tabInfo(Tab(partner));tabShift=0;tabAlignment=TabLeft}
+ let frame = group.layoutFrame
+ check (previewed (decoratorOf group) (drag,Pt(frame.left+2,frame.y+frame.height/2))) "A drop preview did not show")
+ check (previewShown()) "A drop preview was not visible"
+ onGroup(fun group -> (decoratorOf group).clearPreview())
+ if SystemInformation.UIEffectsEnabled then check (previewShown()) "The drop preview vanished at once rather than fading out"
+ pumpUntil(fun () -> not(previewShown()))
+ check (not(previewShown())) "The drop preview stayed after its fade"
+ // A third tab dropped at a pane's edge splits that pane again: three panes at their
+ // rectangles, a divider per split, the tabs in layout order; closed, the pane gives
+ // its room back to its neighbour.
+ do
+ let dividers (group:WindowGroup) =
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="splitDividers")
+ (field.GetValue(group) :?> Map).Count
+ onHelper(fun () -> forms.[2].Pinned <- false; forms.[2].Show())
+ onGroup(fun group -> group.addWindow(third,false))
+ waitOperation()
+ let shown = onGroup(fun group -> group.topWindow)
+ onGroup(fun group -> group.dropTab(third,SplitAt([Second],Stacked,Second),shown))
+ waitSplit()
+ let s,order = onGroup(fun group -> group.splitLayout.Value,group.lorder.list)
+ check (SplitView.pathOf third s=Some [Second;Second] && List.length(SplitView.windows s)=3) (sprintf "The third tab did not take the lower half of the second pane: %A" s)
+ check (onGroup dividers=2) "A nested split did not get a divider of its own"
+ check (SplitView.windows s |> List.pairwise |> List.forall(fun (a,b) -> List.findIndex ((=) b) order=List.findIndex ((=) a) order+1)) (sprintf "The panes' tabs are not next to each other in layout order: %A" order)
+ let lower = OS().windowFromHwnd(third).visibleBounds
+ let upper = OS().windowFromHwnd((SplitView.window [Second;First] s).Value).visibleBounds
+ check (lower.top>upper.top && lower.x=upper.x && lower.width=upper.width) (sprintf "The nested panes are not one above the other: %A %A" upper lower)
+ onGroup(fun group -> group.execute(ClosePane(Some [Second;Second])))
+ waitSplit()
+ check (onGroup(fun group -> List.length(SplitView.windows group.splitLayout.Value)=2 && group.windows.count=3 && dividers group=1)) "Closing the nested pane did not give its room back"
+ // A tab behind, raised over the panes by its own app, goes back under all of
+ // them: a little larger than the pane it waits under, as an app on a character
+ // grid is, it showed at the seam over the other pane.
+ do
+ let panes = onGroup(fun group -> SplitView.windows group.splitLayout.Value)
+ let z hwnd = OS().windowFromHwnd(hwnd).zorder
+ let strip = onGroup(fun group -> group.ts.hwnd)
+ WinUserApi.SetWindowPos(third,strip,0,0,0,0,
+ SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE ||| SetWindowPosFlags.SWP_NOACTIVATE) |> ignore
+ check (panes |> List.forall(fun pane -> z third < z pane)) "The test could not raise the tab behind over the panes"
+ pumpUntil(fun () -> panes |> List.forall(fun pane -> z third > z pane))
+ // The backdrop lies between: under every pane, over the tabs behind.
+ let backdrop = onGroup(fun group -> group.backdropHwnd)
+ check (backdrop<>IntPtr.Zero && WinUserApi.IsWindowVisible backdrop) "No backdrop behind the panes"
+ pumpUntil(fun () -> panes |> List.forall(fun pane -> z pane < z backdrop) && z backdrop < z third)
+ check (OS().windowFromHwnd(backdrop).bounds=onGroup(fun group -> group.layoutFrame)) "The backdrop does not cover the group's frame"
+ onGroup(fun group -> group.removeWindow(third))
+ waitOperation()
+ onHelper(fun () -> forms.[2].Hide(); forms.[2].Pinned <- true; forms.[2].Bounds <- Rectangle(-20000,-20000,640,480))
+ waitSplit()
+ // What the windows remember of their split comes back in another group, as after
+ // a restart: the panes, the ratio and the frame, once both windows have arrived.
+ do
+ let frameBefore,before = onGroup(fun group -> group.layoutFrame,group.splitLayout.Value)
+ onGroup(fun group -> group.execute(SetRatio([],0.6)))
+ waitSplit()
+ let shape = onGroup(fun group -> group.splitLayout.Value)
+ let saved = [source;partner] |> List.map(fun hwnd -> hwnd,WindowSplitLayout.read hwnd)
+ check (saved |> List.forall(fun (_,place) -> place |> Option.exists(fun (_,frame) -> frame=frameBefore))) (sprintf "The pane windows do not remember their split at its frame: %A" saved)
+ // Taken apart, which clears the windows, and put on them again as a restart finds them.
+ onGroup(fun group -> group.removeWindow source; group.removeWindow partner)
+ waitOperation()
+ for hwnd,place in saved do WindowSplitLayout.save hwnd (fst place.Value) (snd place.Value)
+ let again = (desktop :> IDesktop).createGroup(false) :?> GroupInfo
+ let onAgain action =
+ let mutable result = None
+ again.invokeGroup(fun () -> result <- Some(try Choice1Of2(action again.group) with e -> Choice2Of2 e))
+ pumpUntil(fun () -> result.IsSome)
+ match result.Value with Choice1Of2 value -> value | Choice2Of2 error -> raise error
+ try
+ onAgain(fun group -> group.addWindow(source,false))
+ check (onAgain(fun group -> group.layout=GroupLayout.Single)) "One window alone brought a split back"
+ onAgain(fun group -> group.addWindow(partner,false))
+ pumpUntil(fun () -> onAgain(fun group -> group.splitLayout=Some shape))
+ pumpUntil(fun () -> onAgain(fun group -> group.isPlacementIdle))
+ check (onAgain(fun group -> group.layoutFrame)=frameBefore) (sprintf "The split did not come back at its frame: %A instead of %A" (onAgain(fun group -> group.layoutFrame)) frameBefore)
+ for hwnd in [source;partner] do
+ let wanted = (SplitGeometry.paneRect gap frameBefore shape (SplitView.pathOf hwnd shape).Value).Value
+ check (OS().windowFromHwnd(hwnd).visibleBounds=wanted) (sprintf "A pane did not come back in place: %A instead of %A" (OS().windowFromHwnd(hwnd).visibleBounds) wanted)
+ finally
+ // Back to the group the rest of the suite uses, as it was.
+ onAgain(fun group -> group.removeWindow source; group.removeWindow partner)
+ (again :> IGroup).destroy()
+ onGroup(fun group -> group.addWindow(source,false); group.addWindow(partner,false))
+ waitOperation()
+ onGroup(fun group -> group.restoreLayout(Split before,frameBefore))
+ waitSplit()
+ // A pane its own app raises over the tabs, with no foreground change and no notice
+ // to the group, is put back under them.
+ do
+ let strip,top,panes = onGroup(fun group -> group.ts.hwnd,group.topWindow,SplitView.windows group.splitLayout.Value)
+ let raised = panes |> List.find((<>) top)
+ let z hwnd = OS().windowFromHwnd(hwnd).zorder
+ // Just over the tabs, as an app raising itself lands at the top.
+ let over = WinUserApi.GetWindow(strip,GetWindowConstants.GW_HWNDPREV)
+ let moved = WinUserApi.SetWindowPos(raised,over,0,0,0,0,
+ SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE ||| SetWindowPosFlags.SWP_NOACTIVATE)
+ check (z raised < z strip) (sprintf "The test could not raise a pane over the tabs: moved %A, pane %d, strip %d, top %d, strip topmost %b, owner %A, raised %A"
+ moved (z raised) (z strip) (z top) (OS().windowFromHwnd(strip).isTopMost) (WinUserApi.GetWindow(strip,GetWindowConstants.GW_OWNER)) raised)
+ let clock = Stopwatch.StartNew()
+ pumpUntil(fun () -> panes |> List.forall(fun hwnd -> z strip < z hwnd))
+ printfn "METRIC raised-pane-covered-tabs=%dms" clock.ElapsedMilliseconds
+ // The pane in focus leads the group whichever pane its app or a click raised last:
+ // its tab shows in front and the strip belongs to it. Led by the other pane, the
+ // focus showed on the wrong tab and the focused app covered the tabs.
+ for side in [First;Second;First] do
+ onGroup(fun group -> group.execute(FocusPane [side]))
+ waitOperation()
+ let strip,focused,other = onGroup(fun group ->
+ let s = group.splitLayout.Value
+ group.ts.hwnd,(SplitView.window [side] s).Value,(SplitView.window [Side.other side] s).Value)
+ // The other pane, raised over both as its app may, without a foreground change.
+ let over = WinUserApi.GetWindow(strip,GetWindowConstants.GW_HWNDPREV)
+ WinUserApi.SetWindowPos(other,over,0,0,0,0,
+ SetWindowPosFlags.SWP_NOMOVE ||| SetWindowPosFlags.SWP_NOSIZE ||| SetWindowPosFlags.SWP_NOACTIVATE) |> ignore
+ let z hwnd = OS().windowFromHwnd(hwnd).zorder
+ pumpUntil(fun () -> z strip < z focused && z strip < z other)
+ onGroup(fun group -> group.main(group.topWindow,WinEvent.EVENT_OBJECT_REORDER))
+ waitOperation()
+ let top,owner,shareable = onGroup(fun group -> group.topWindow,WinUserApi.GetWindow(group.ts.hwnd,GetWindowConstants.GW_OWNER),group.canShareInput focused)
+ check (top=focused && (owner=focused || not shareable))
+ (sprintf "The %A pane in focus does not lead the group: top %A, strip owner %A, focused %A" side top owner focused)
+ // The pair's tabs dragged into the other order swap the panes; a click after does
+ // not put the tabs back.
+ do
+ let first,second = onGroup(fun group -> let s = group.splitLayout.Value in (SplitView.window [First] s).Value,(SplitView.window [Second] s).Value)
+ onGroup(fun group ->
+ group.ts.moveTab(Tab(second),group.lorder.list |> List.findIndex((=) first))
+ group.onTabsReordered())
+ waitSplit()
+ onGroup(fun group -> group.tabActivate(Tab(first),false))
+ waitOperation()
+ let s,order = onGroup(fun group -> group.splitLayout.Value,group.lorder.list)
+ check (s.tree.first=Leaf(Occupied second) && s.tree.second=Leaf(Occupied first)
+ && List.findIndex((=) second) order < List.findIndex((=) first) order)
+ (sprintf "Dragging the pair's tabs into the other order did not swap the panes: %A, tabs %A" s order)
+ let mergedFrame = onGroup(fun group -> group.layoutFrame)
+ onGroup(fun group -> group.execute(EndSplit(Some source)))
+ waitOperation()
+ check (onGroup(fun group -> group.layout=GroupLayout.Single && group.windows.count=2)) "Merging lost a member"
+ check (handles |> List.take 2 |> List.forall(fun hwnd -> OS().windowFromHwnd(hwnd).visibleBounds=mergedFrame)) "Merging did not restore the full group bounds"
+ // A window chosen from the list goes on the side asked for, beside the tab the
+ // menu was opened on, with no empty pane waiting for it.
+ do
+ let shown = onGroup(fun group -> group.topWindow)
+ let other = handles |> List.take 2 |> List.find((<>) shown)
+ onGroup(fun group -> group.placeBeside(shown,other,SideBySide,First))
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout |> Option.exists(fun s -> s.tree.axis=SideBySide && s.tree.first=Leaf(Occupied other) && s.tree.second=Leaf(Occupied shown))))
+ (sprintf "A window chosen to go on the left did not take the left of the tab: %A" (onGroup(fun group -> group.layout)))
+ check (onGroup(fun group -> group.emptyPaneHwnds.IsEmpty)) "Choosing a window first left an empty pane"
+ // The images moving the windows into the split go once they are in place:
+ // left over the group, topmost, they would hide the panes and take no clicks.
+ let frame = onGroup(fun group -> group.layoutFrame)
+ let pid = Diagnostics.Process.GetCurrentProcess().Id
+ // With the tab strip cut out of it the cover is most of the frame, not all of it.
+ let overlay () =
+ OS().windowsInZorder.list |> List.exists(fun window ->
+ let mutable owner = 0
+ WinUserApi.GetWindowThreadProcessId(window.hwnd,&owner) |> ignore
+ let bounds = window.bounds
+ owner=pid && window.isVisible && frame.completlyContains bounds &&
+ int64 bounds.width*int64 bounds.height*2L>int64 frame.width*int64 frame.height &&
+ (WinUserApi.GetWindowLong(window.hwnd,WindowLongFieldOffset.GWL_EXSTYLE).ToInt64() &&& int64 WindowsExtendedStyles.WS_EX_TOPMOST)<>0L)
+ pumpUntil(fun () -> not(overlay()))
+ onGroup(fun group -> group.execute(EndSplit(Some shown)))
+ waitOperation()
+ // Above, as the menu offers too: the window chosen takes the top pane.
+ onGroup(fun group -> group.placeBeside(shown,other,Stacked,First))
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout |> Option.exists(fun s -> s.tree.axis=Stacked && s.tree.first=Leaf(Occupied other) && s.tree.second=Leaf(Occupied shown))))
+ (sprintf "A window chosen to go above did not take the top of the tab: %A" (onGroup(fun group -> group.layout)))
+ pumpUntil(fun () -> not(overlay()))
+ onGroup(fun group -> group.execute(EndSplit(Some shown)))
+ waitOperation()
+ // A window with a least size of its own gets a pane at least that size, the
+ // ratio moved for it: in a narrower pane it kept its size and lay over the pane
+ // beside it. With no room for it, the split is refused.
+ do
+ let shown = onGroup(fun group -> group.topWindow)
+ let other = handles |> List.take 2 |> List.find((<>) shown)
+ let form = forms |> List.find(fun form -> onHelper(fun () -> form.Handle)=other)
+ let frame = onGroup(fun group -> group.layoutFrame)
+ let wide = frame.width*3/5
+ // Said, not shown: a message box would wait on the group's thread.
+ let alerts = ref []
+ Alert.install(fun _ _ message -> lock alerts (fun () -> alerts.Value <- message::alerts.Value))
+ onHelper(fun () -> form.MinimumSize <- Size(wide,100))
+ try
+ onGroup(fun group -> group.execute(SplitWith(other,SideBySide),current=shown))
+ waitSplit()
+ let s = onGroup(fun group -> group.splitLayout)
+ check s.IsSome "A window with a least size that fits beside the other was refused a split"
+ let pane = (SplitGeometry.paneRect (Dpi.scale SplitMetrics.gap) frame s.Value (SplitView.pathOf other s.Value).Value).Value
+ let visibleLeast = wide-(OS().windowFromHwnd(other).bounds.width-OS().windowFromHwnd(other).visibleBounds.width)
+ check (pane.width>=visibleLeast) (sprintf "A window's pane was narrower than its least width: %d of %d" pane.width visibleLeast)
+ // A divider's ratio keeps the least sizes read before: asked again at every
+ // step of a drag, each pane's app held the group thread up to the timeout.
+ let cacheOf (group:WindowGroup) =
+ (typeof.GetFields(flags) |> Array.find(fun field -> field.Name="paneLeastCache")).GetValue(group) :?> Map
+ let cached = onGroup cacheOf
+ // Smaller, so the window takes any pane: read again, the cache would change.
+ onHelper(fun () -> form.MinimumSize <- Size(wide-40,100))
+ onGroup(fun group -> group.execute(SetRatio([],0.45)))
+ waitSplit()
+ check (onGroup cacheOf=cached) "A divider's ratio asked every pane for its least size again"
+ onGroup(fun group -> group.execute(EndSplit(Some shown)))
+ waitOperation()
+ onHelper(fun () -> form.MinimumSize <- Size(frame.width-Dpi.scale 60,100))
+ onGroup(fun group -> group.execute(SplitWith(other,SideBySide),current=shown))
+ waitOperation()
+ check (onGroup(fun group -> group.splitLayout.IsNone)) "A split with no room for a window's least width was not refused"
+ check (lock alerts (fun () -> alerts.Value)=[tr Strings.TabMenu.splitFailed]) (sprintf "A refused split did not say so once: %A" alerts.Value)
+ finally
+ onHelper(fun () -> form.MinimumSize <- Size(0,0))
+ onGroup(fun group -> if group.splitLayout.IsSome then group.execute(EndSplit(Some shown)))
+ waitOperation()
+ let dragOf (group:WindowGroup) hwnd = box {tab=Tab(hwnd);tabOffset=Pt();tabSize=Sz(100,24);tabInfo=group.ts.tabInfo(Tab(source));tabShift=0;tabAlignment=TabLeft}
+ // A tab from another group splits at an edge too, beside the tab shown.
+ let foreign = handles.[2]
+ onHelper(fun () -> forms.[2].Pinned <- false; forms.[2].Show())
+ let edgePoint = onGroup(fun group -> let frame = group.layoutFrame in Pt(frame.right-2,frame.y+frame.height/2))
+ // Just below a group's tabs, over its title bar, a tab is taken into the strip:
+ // it was offered that window's top edge, and let go there, split the group.
+ onGroup(fun group ->
+ let decorator = decoratorOf group
+ let strip = OS().windowFromHwnd(group.ts.hwnd)
+ let first = group.ts.tabSprites.list |> List.head |> fun (location,sprite) -> Rect(strip.ptToScreen(location),sprite.size)
+ let below = Pt(first.x+first.width/2,first.bottom+Dpi.scale 10)
+ let away = Pt(first.x+first.width/2,first.bottom+Dpi.scale 60)
+ // The row runs the group's whole width: at its far end, beside the tabs, too.
+ let frame = group.layoutFrame
+ let along = Pt(frame.right-Dpi.scale 10,first.y+first.height/2)
+ let near pt = match decorator.probe(dragOf group foreign,pt,false) with NearStrip strip -> Some strip | Aimed _ -> None
+ check (near below=Some group.ts.hwnd) (sprintf "A point just below a group's tabs was not taken as its strip: %A below %A" below first)
+ check (near along=Some group.ts.hwnd) (sprintf "A point at the far end of a group's row of tabs was not taken as its strip: %A beside %A in %A" along first frame)
+ check (near away=None) (sprintf "A point well below a group's tabs was taken as its strip: %A below %A" away first))
+ let shown = onGroup(fun group ->
+ let decorator = decoratorOf group
+ check (previewed decorator (dragOf group foreign,edgePoint)) "A tab from another group was not offered an edge"
+ decorator.clearPreview()
+ check (group.layout=GroupLayout.Single) "Cancelling another group's edge preview changed the layout"
+ check (previewed decorator (dragOf group foreign,edgePoint)) "Another group's edge could not be targeted again"
+ group.topWindow)
+ check (onGroup(fun group -> (decoratorOf group).commit(dragOf group foreign,edgePoint))) "A tab from another group was not dropped at an edge"
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout |> Option.exists(fun s -> s.tree.axis=SideBySide && s.tree.first=Leaf(Occupied shown) && s.tree.second=Leaf(Occupied foreign))))
+ (sprintf "A tab from another group did not take the edge's pane beside the tab shown: %A, shown %A, foreign %A" (onGroup(fun group -> group.layout)) shown foreign)
+ // With a tab behind chosen over the panes, a drop aims at that tab, the one shown,
+ // not at the panes parked out of sight: it splits the window shown and lets the
+ // parked panes go.
+ do
+ let behind = onGroup(fun group -> group.windows.items.list |> List.find(fun hwnd -> hwnd<>shown && hwnd<>foreign))
+ onGroup(fun group -> group.tabActivate(Tab(behind),false))
+ waitOperation()
+ check (onGroup(fun group -> (match group.layout with Parked _ -> true | _ -> false) && group.topWindow=behind)) "Choosing the tab behind did not park the panes"
+ let fourth = handles.[3]
+ onHelper(fun () -> forms.[3].Pinned <- false; forms.[3].Show())
+ let leftPoint = onGroup(fun group -> let frame = group.layoutFrame in Pt(frame.left+2,frame.y+frame.height/2))
+ check (onGroup(fun group -> previewed (decoratorOf group) (dragOf group fourth,leftPoint))) "The window shown over parked panes was not offered an edge"
+ check (onGroup(fun group -> (decoratorOf group).commit(dragOf group fourth,leftPoint))) "A drop beside the window shown over parked panes was refused"
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout |> Option.exists(fun s -> s.tree.first=Leaf(Occupied fourth) && s.tree.second=Leaf(Occupied behind))))
+ (sprintf "The drop did not split the window shown, letting the parked panes go: %A" (onGroup(fun group -> group.layout)))
+ onGroup(fun group -> group.execute(EndSplit None); group.removeWindow fourth)
+ waitOperation()
+ onHelper(fun () -> forms.[3].Hide(); forms.[3].Pinned <- true; forms.[3].Bounds <- Rectangle(-20000,-20000,640,480))
+ // The split of the tab shown with the other group's tab again, as the next steps expect.
+ onGroup(fun group -> group.tabActivate(Tab(shown),false))
+ waitOperation()
+ onGroup(fun group -> group.dropTab(foreign,SplitAt([],SideBySide,Second),shown))
+ waitSplit()
+ check (onGroup(fun group -> group.splitLayout |> Option.exists(fun s -> s.tree.first=Leaf(Occupied shown) && s.tree.second=Leaf(Occupied foreign)))) "The split did not come back as it was"
+ // A tab behind chosen right after a swap, while the panes are still moving, fills
+ // the group's frame. It waited at the host pane's rectangle, and the change of front
+ // window dropped its placement as it would a stale follower's: it stayed pane-sized,
+ // and the group took that for its frame.
+ do
+ let frameBefore = onGroup(fun group -> group.layoutFrame)
+ // Slow to place, as a browser and an editor are, so the swap is still under way.
+ onHelper(fun () -> for form in forms |> List.take 3 do form.Delay <- 80)
+ try
+ // Swapping the sides by dragging a pane's tab to the other edge: the tab
+ // leaves the strip, which takes its window out of the group, so the other
+ // pane fills the group; dropped, it joins again and splits the group anew.
+ for round in 1..3 do
+ let left = onGroup(fun group -> (SplitView.window [First] group.splitLayout.Value).Value)
+ let other = onGroup(fun group -> (SplitView.window [Second] group.splitLayout.Value).Value)
+ onGroup(fun group ->
+ group.removeWindow left
+ OS().windowFromHwnd(left).hideOffScreen(None))
+ for _ in 1..40 do (Application.DoEvents(); Thread.Sleep(1))
+ // Dropped at once, while the other pane is still filling the group, and
+ // named with the tab behind as its partner, as the strip did when the
+ // dragged tab was the one in front.
+ onGroup(fun group -> group.dropTab(left,SplitAt([],SideBySide,Second),partner))
+ waitOperation()
+ let frame,s = onGroup(fun group -> group.layoutFrame,group.splitLayout)
+ check (frame=frameBefore) (sprintf "Swap %d by drag changed the group's frame from %A to %A" round frameBefore frame)
+ check (s |> Option.exists(fun s -> s.tree.first=Leaf(Occupied other) && s.tree.second=Leaf(Occupied left)))
+ (sprintf "Swap %d by drag did not pair the dropped tab with the pane shown: %A" round s)
+ onGroup(fun group -> group.tabActivate(Tab(partner),false))
+ waitOperation()
+ finally onHelper(fun () -> for form in forms |> List.take 3 do form.Delay <- 0)
+ let frameAfter,shown = onGroup(fun group -> group.layoutFrame),OS().windowFromHwnd(partner).visibleBounds
+ check (frameAfter=frameBefore && shown=frameBefore)
+ (sprintf "A tab behind chosen after swaps did not fill the group: frame %A then %A, tab at %A" frameBefore frameAfter shown)
+ onGroup(fun group -> group.tabActivate(Tab(source),false))
+ waitSplit()
+ onGroup(fun group -> group.execute(EndSplit(Some source)))
+ waitOperation()
+ onGroup(fun group -> group.removeWindow foreign)
+ // A tab dragged here joins put away off screen, and on top, as the window the drag
+ // activated. The split takes its frame from the tab shown, which it pairs with:
+ // taken from the top window, it was laid out off screen and that window vanished.
+ do
+ let frameBefore = onGroup(fun group -> group.layoutFrame)
+ let away = OS().windowFromHwnd(foreign)
+ away.hideOffScreen(None)
+ for hwnd in onGroup(fun group -> group.windows.items.list) do OS().windowFromHwnd(hwnd).insertAfter(foreign)
+ check (OS().isOnScreen away.bounds) "The test put the joining window wholly off screen"
+ onGroup(fun group -> group.dropTab(foreign,SplitAt([],SideBySide,Second),shown))
+ waitSplit()
+ check (onGroup(fun group -> group.layoutFrame)=frameBefore)
+ (sprintf "A dropped tab's split was laid out at %A, not over the group at %A" (onGroup(fun group -> group.layoutFrame)) frameBefore)
+ onGroup(fun group -> group.execute(EndSplit(Some source)))
+ waitOperation()
+ onGroup(fun group -> group.removeWindow foreign)
+ onHelper(fun () -> forms.[2].Hide(); forms.[2].Pinned <- true; forms.[2].Bounds <- Rectangle(-20000,-20000,640,480))
+ waitOperation()
+ onHelper(fun () ->
+ for form in forms |> List.take 2 do
+ form.Pinned <- true
+ form.Hide()
+ form.Bounds <- Rectangle(-20000,-20000,640,480))
for _ in 1..5 do
onHelper(fun () -> OS().windowFromHwnd(handles.Head).showWindow(ShowWindowCommands.SW_SHOWMINNOACTIVE))
pumpUntil(fun () -> handles |> List.take count |> List.forall(fun hwnd -> OS().windowFromHwnd(hwnd).isMinimized))
@@ -313,8 +1023,17 @@ let main() =
cell.GetType().GetMethod("set").Invoke(cell,[|box (Some(top.bounds,top.placement,top.visibleBounds))|]) |> ignore
invoke "updatePlacements" group [||] |> ignore)
check (entered.Wait(10000)) "Follower placement did not enter its stacking-correction phase"
+ let topmost () =
+ let pid = Diagnostics.Process.GetCurrentProcess().Id
+ OS().windowsInZorder.list |> List.filter(fun window ->
+ let mutable owner = 0
+ WinUserApi.GetWindowThreadProcessId(window.hwnd,&owner) |> ignore
+ owner=pid && window.isVisible &&
+ (WinUserApi.GetWindowLong(window.hwnd,WindowLongFieldOffset.GWL_EXSTYLE).ToInt64() &&& int64 WindowsExtendedStyles.WS_EX_TOPMOST)<>0L)
+ |> List.map(fun window -> window.hwnd,window.bounds)
check (OS().windowFromHwnd(follower).zorder < OS().windowFromHwnd(source).zorder)
- "Placement fixture did not temporarily raise the follower"
+ (sprintf "Placement fixture did not temporarily raise the follower: follower %d source %d, our topmost windows %A, foreground %A"
+ (OS().windowFromHwnd(follower).zorder) (OS().windowFromHwnd(source).zorder) (topmost()) (WinUserApi.GetForegroundWindow()))
onGroup(fun group -> invoke "handleWindowEvent" group [|box follower;box WinEvent.EVENT_OBJECT_REORDER|] |> ignore)
check (onGroup(fun group -> group.topWindow=source && group.ts.zorder.head=Tab(source)))
"A placement reorder changed the selected tab before completion"
diff --git a/tests/RenderingPerf/Native.fs b/tests/RenderingPerf/Native.fs
index 66f34225..73a4e679 100644
--- a/tests/RenderingPerf/Native.fs
+++ b/tests/RenderingPerf/Native.fs
@@ -36,7 +36,7 @@ let run (measure:string -> int -> (int -> unit) -> JObject) iterations =
let tab = Tab(IntPtr(100+id))
strip.addTab(tab)
strip.setTabInfo(tab,{
- text=sprintf "Window %d" id;isRenamed=false
+ text=sprintf "Window %d" id;isRenamed=false;splitTrail=None
iconSmall=SystemIcons.Application;iconBig=SystemIcons.Application
preview=fun () -> Img(Sz(1,1)) })
let size = Dpi.scaleSize(Sz(1050,28))
diff --git a/tests/RenderingPerf/Program.fs b/tests/RenderingPerf/Program.fs
index b5bb7c2c..4c6c9d66 100644
--- a/tests/RenderingPerf/Program.fs
+++ b/tests/RenderingPerf/Program.fs
@@ -32,7 +32,7 @@ let strip count dpi font =
let ids = [1..count]
{ TabStripSprite.tabs=Map2(List2(ids |> List.map(fun id -> id, {
tint=None; colorStyle="Stripe"; numberBadge=None; bgColor=None; text=sprintf "Window %d" id; icon=SystemIcons.Application
- textFont=font; textBrush=Brushes.Black })))
+ textFont=font; textBrush=Brushes.Black; splitTrail=None })))
lorder=List2(ids); zorder=List2(ids); size=Dpi.scaleSize(Sz(min 1800 (count*210),28))
slide=None; direction=TabUp; alignment=TabLeft; onlyIcons=false
transparent=true; held=None; centerShift=0.0; dock=TabDockTop; scrollOffset=0; appearance=appearance; hover=None; captured=None }
diff --git a/tests/Run-Tests.ps1 b/tests/Run-Tests.ps1
index adfc0a82..b82b339b 100644
--- a/tests/Run-Tests.ps1
+++ b/tests/Run-Tests.ps1
@@ -6,8 +6,8 @@ param([ValidateRange(1, 3600)][int]$TimeoutSeconds = 120, [switch]$Coverage,
[switch]$NoRetry,
# Run the suites on the current desktop instead of a hidden one, to watch them.
[switch]$VisibleDesktop,
- [ValidateSet('Reliability', 'Architecture', 'StartupGrouping', 'DpiLayout', 'SettingsTheme', 'SettingsEditors', 'TabShadow', 'WindowIcon', 'GroupLifecycle', 'GroupOperations', 'PopupRendering', 'TabInteraction', 'TaskbarPreview', 'PrintWindowProbe')]
- [string[]]$Suites = @('Reliability', 'Architecture', 'StartupGrouping', 'DpiLayout', 'SettingsTheme', 'SettingsEditors', 'TabShadow', 'WindowIcon', 'GroupLifecycle', 'GroupOperations', 'PopupRendering', 'TabInteraction', 'TaskbarPreview', 'PrintWindowProbe'))
+ [ValidateSet('Reliability', 'Architecture', 'SplitView', 'StartupGrouping', 'DpiLayout', 'SettingsTheme', 'SettingsEditors', 'TabShadow', 'WindowIcon', 'GroupLifecycle', 'GroupOperations', 'PopupRendering', 'TabInteraction', 'TaskbarPreview', 'PrintWindowProbe', 'SplitViewDesktop')]
+ [string[]]$Suites = @('Reliability', 'Architecture', 'SplitView', 'StartupGrouping', 'DpiLayout', 'SettingsTheme', 'SettingsEditors', 'TabShadow', 'WindowIcon', 'GroupLifecycle', 'GroupOperations', 'PopupRendering', 'TabInteraction', 'TaskbarPreview', 'PrintWindowProbe'))
$ErrorActionPreference = 'Stop'
$repo = Split-Path $PSScriptRoot -Parent
if (-not (Get-Command dotnet -ErrorAction SilentlyContinue)) { throw 'The .NET SDK (dotnet) is required.' }
diff --git a/tests/SettingsEditors.fsx b/tests/SettingsEditors.fsx
index 9ac8296a..26c86732 100644
--- a/tests/SettingsEditors.fsx
+++ b/tests/SettingsEditors.fsx
@@ -372,11 +372,13 @@ let main() =
lock grouping (fun () -> (if enabled then grouping.Add path else grouping.Remove path) |> ignore)
member _.tabAppearanceInfo = ThemeService.currentAppearance()
member _.setHotKey key value = (if value<>rejected then hotKeys.[key] <- value); value<>rejected
- member _.getHotKey key = hotKeys.[key]
+ // Shortcuts the test never set, such as the unbound split-view keys, read as none.
+ member _.getHotKey key = match hotKeys.TryGetValue key with | true,value -> value | _ -> 0
member _.newTab _ = ()
member _.suspendTabMonitoring() = ()
member _.resumeTabMonitoring() = ()
- member _.llMouse = mouse.Publish})
+ member _.llMouse = mouse.Publish
+ member _.paneCandidates() = []})
let command (control:Control) (keys:Keys) =
let mutable msg = Message()
let processKey = control.GetType().GetMethod("ProcessCmdKey",BindingFlags.Instance ||| BindingFlags.NonPublic ||| BindingFlags.Public,null,[|typeof.MakeByRefType();typeof|],null)
@@ -1104,10 +1106,22 @@ otepad.exe"]},
typeof.GetMethod("OnMouseMove",BindingFlags.Instance ||| BindingFlags.NonPublic ||| BindingFlags.Public).Invoke(tree,[|box mouse|]) |> ignore
typeof.GetField("tooltipText",BindingFlags.Instance ||| BindingFlags.NonPublic).GetValue(tree) :?> string
assertTrue ([0..4..tree.Width-1] |> List.exists(fun x -> tipAt x=longTitle)) "A chip cut short did not show its whole text on hover"
- // Its icon says what the row is and lights up on hover, as the row buttons do.
- let iconHovered = [0..2..Dpi.scale 80] |> List.exists(fun x -> tipAt x=tr Strings.AppRules.handMadeGroups)
- let lit = typeof.GetField("hoveredIcon",BindingFlags.Instance ||| BindingFlags.NonPublic).GetValue(tree)
- assertTrue (iconHovered && obj.ReferenceEquals(lit,handMadeRow)) "A dragged group's icon did not say what it is or light up on hover"
+ // Its icon says what the row is on hover and stays as it is: it cannot be pressed, so it
+ // does not light up as the row buttons do.
+ let iconX = [0..2..Dpi.scale 80] |> List.tryFind(fun x -> tipAt x=tr Strings.AppRules.handMadeGroups)
+ assertTrue iconX.IsSome "A dragged group's icon did not say what it is"
+ do
+ let snapshot x =
+ tipAt x |> ignore
+ let image = new Bitmap(tree.Width,tree.Height)
+ tree.DrawToBitmap(image,Rectangle(Point.Empty,image.Size))
+ image
+ use away = snapshot 1
+ use over = snapshot iconX.Value
+ let unchanged =
+ [max 0 (rowY-Dpi.scale 10)..min (tree.Height-1) (rowY+Dpi.scale 10)] |> List.forall(fun y ->
+ [0..min (tree.Width-1) (iconX.Value+Dpi.scale 20)] |> List.forall(fun x -> away.GetPixel(x,y)=over.GetPixel(x,y)))
+ assertTrue unchanged "A dragged group's icon lit up on hover, as if it could be pressed"
// With no name, its chips start where the names of the other rows start.
do
let layout = typeof.GetMethod("chipLayout",BindingFlags.Instance ||| BindingFlags.NonPublic)
@@ -1116,6 +1130,14 @@ otepad.exe"]},
let _,named = name.Invoke(tree,[|box tree.Roots.[0];box 0;box 0|]) :?> (Rectangle * Rectangle)
let _,first,_ = laid.Head
assertTrue (first.X=named.X) (sprintf "A dragged group's chips start at %d, names at %d" first.X named.X)
+ // Three to a line, one width, filling it, however short their titles.
+ handMadeRow.Chips <- [for i in 1..6 -> { Text=string i; Icon=null; Removable=false }]
+ let _,laid,_,lines = layout.Invoke(tree,[|box handMadeRow;box 0;box 0|]) :?> (Rectangle * (int * Rectangle * Rectangle option) list * Rectangle option * int)
+ let boxes = laid |> List.map(fun (_,box,_) -> box)
+ let widths = boxes |> List.map(fun box -> box.Width) |> List.distinct
+ assertTrue (lines=2 && widths.Length=1 && boxes.[2].Y=boxes.[0].Y && boxes.[3].Y>boxes.[0].Y && boxes.[3].X=boxes.[0].X
+ && named.Right-boxes.[2].Right < Dpi.scale 6+3)
+ (sprintf "A dragged group's chips are not three to a line filling it: %A, names end at %d" boxes named.Right)
tipAt 1 |> ignore
handMadeRow.Chips <- kept
tree.Rebuild()
diff --git a/tests/SettingsTheme.fsx b/tests/SettingsTheme.fsx
index 12d670a8..4d081aac 100644
--- a/tests/SettingsTheme.fsx
+++ b/tests/SettingsTheme.fsx
@@ -100,7 +100,7 @@ let main() =
let count = 6
let info index : TabDisplayInfo =
{ tint=Some palette.[Theme.tabAllocationOrder.[index]]; colorStyle="Fill"; numberBadge=None; bgColor=None
- text="Tab"; icon=SystemIcons.Application; textFont=font; textBrush=SystemBrushes.MenuText }
+ text="Tab"; icon=SystemIcons.Application; textFont=font; textBrush=SystemBrushes.MenuText; splitTrail=None }
let ids = [0..count-1]
let strip : TabStripSprite = {
tabs=Map2(List2(ids |> List.map(fun i -> i,info i))); lorder=List2(ids); zorder=List2(ids); size=Sz(900,27)
@@ -424,7 +424,9 @@ let main() =
member _.groupExited = Event().Publish
member _.groupRemoved = Event().Publish
member _.groupChanged = Event().Publish
- member _.foregroundGroup = None })
+ member _.foregroundGroup = None
+ member _.adoptIntoPane(_,_,_) = ()
+ member _.adoptBeside(_,_,_,_) = () })
// Closing a diagnostics page must not dispose the process-wide cached font.
for _ in 1..3 do
let disposableSupport = DiagnosticsView() :> ISettingsView
@@ -529,7 +531,7 @@ let main() =
member _.hovered = hovered.Publish
member _.clicked = clicked.Publish}
let handles = [for index in 1..count -> IntPtr(index)]
- let action = TaskSwitchAction(List2(handles |> List.map(fun hwnd -> TaskWindowItem(hwnd,false))),
+ let action = TaskSwitchAction(List2(handles |> List.map(fun hwnd -> TaskWindowItem(hwnd,None))),
style,backward=backward,view=view)
try
let expected = if count=0 then None elif backward then Some(count-1) else Some(1%count)
@@ -556,9 +558,9 @@ let main() =
let windows = [ for title in ["Inbox - Mail";"Project plan.docx - Word";"WindowTabs - Visual Studio"] ->
new Form(Text=title,StartPosition=FormStartPosition.Manual,Location=Point(-20000,-20000),ShowInTaskbar=false) ]
try
- let items count = List2([ for index in 0..count-1 -> TaskWindowItem(windows.[index%windows.Length].Handle,index=1) ])
- let plain = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,false)]))
- let grouped = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,true)]))
+ let items count = List2([ for index in 0..count-1 -> TaskWindowItem(windows.[index%windows.Length].Handle,(if index=1 then Some(GroupOfApps []) else None)) ])
+ let plain = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,None)]))
+ let grouped = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,Some(GroupOfApps []))]))
try
use before = plain.Render()
use after = grouped.Render()
@@ -571,6 +573,18 @@ let main() =
finally
(plain :> ITaskSwitchView).hide()
(grouped :> ITaskSwitchView).hide()
+ // A group with another app's tab shows that app's icon after the front one, as its
+ // taskbar button does, not the WindowTabs badge.
+ let mixed = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,Some(GroupOfApps [windows.[1].Handle]))]))
+ let badged = TaskSwitchIconView(List2([TaskWindowItem(windows.Head.Handle,Some(GroupOfApps []))]))
+ try
+ use corner = mixed.Render()
+ use badge = badged.Render()
+ let differs = seq { for y in 0..corner.Height-1 do for x in 0..corner.Width-1 -> corner.GetPixel(x,y)<>badge.GetPixel(x,y) }
+ check (Seq.exists id differs) "A group of two apps shows the WindowTabs badge in Alt+Tab instead of the other app's icon"
+ finally
+ (mixed :> ITaskSwitchView).hide()
+ (badged :> ITaskSwitchView).hide()
let three = TaskSwitchIconView(items 3)
let crowd = TaskSwitchIconView(items 60)
do
diff --git a/tests/SplitView.fsx b/tests/SplitView.fsx
new file mode 100644
index 00000000..256efa06
--- /dev/null
+++ b/tests/SplitView.fsx
@@ -0,0 +1,337 @@
+#r "System.Drawing"
+#r "System.Windows.Forms"
+#r "Debug/Win32.dll"
+#r "Debug/WindowTabs.exe"
+open System
+open System.Drawing
+open Bemo
+
+let check condition message = if not condition then failwith message
+
+/// Pure split-view model: geometry, commands, OS events and placement plans, no windows.
+let main() =
+ let a,b,c,d = IntPtr 11,IntPtr 22,IntPtr 33,IntPtr 44
+ let gap = 6
+ let frame = Rect(Pt(100,50),Sz(1000,600))
+ let covers (frame:Rect) (first:Rect,divider:Rect,second:Rect) axis =
+ if axis=SideBySide then
+ first.left=frame.left && first.right=divider.left && divider.right=second.left && second.right=frame.right &&
+ [first;divider;second] |> List.forall(fun r -> r.top=frame.top && r.height=frame.height)
+ else
+ first.top=frame.top && first.bottom=divider.top && divider.bottom=second.top && second.bottom=frame.bottom &&
+ [first;divider;second] |> List.forall(fun r -> r.left=frame.left && r.width=frame.width)
+ let pair first second axis focused = {tree={axis=axis;ratio=0.5;first=Leaf first;second=Leaf second};focused=[focused]}
+ let occupied hwnd = Leaf(Occupied hwnd)
+
+ // Geometry of one split
+ let half = pair (Occupied a) (Occupied b) SideBySide First
+ let rects = SplitGeometry.rectangles gap frame half.tree
+ check (covers frame rects SideBySide) "Side-by-side panes and divider do not exactly cover the frame"
+ let first,_,second = rects
+ check (first.width=497 && second.width=497) "Equal split did not share the width evenly"
+ for ratio in [0.15;0.333;0.5;0.701;0.85] do
+ for axis in [SideBySide;Stacked] do
+ let branch = {half.tree with axis=axis;ratio=ratio}
+ check (covers frame (SplitGeometry.rectangles gap frame branch) axis) (sprintf "Panes at ratio %g on %A leave a gap or overlap" ratio axis)
+ let tiny = Rect(Pt(),Sz(30,30))
+ let a1,_,b1 = SplitGeometry.rectangles gap tiny half.tree
+ check (a1.width>=1 && b1.width>=1) "A tiny frame produced an empty pane"
+ check (SplitGeometry.fits gap SplitMetrics.minPane frame half.tree) "A 1000px frame did not fit two 120px panes"
+ check (not(SplitGeometry.fits gap SplitMetrics.minPane (Rect(Pt(),Sz(200,600))) half.tree)) "A 200px frame claimed to fit two 120px panes"
+ // A window's own least size: the ratio moves as little as it takes, or stays where both
+ // halves cannot fit; the least size of a split adds up along it and takes the larger across.
+ do
+ let least wide = function Occupied hwnd when hwnd=a -> Sz(wide,100) | _ -> Sz(120,120)
+ let fitted = SplitGeometry.fitToPanes gap (least 600) frame half.tree
+ let first,_,_ = SplitGeometry.rectangles gap frame fitted
+ check (first.width=600 && SplitGeometry.fitsPanes gap (least 600) frame fitted) (sprintf "A pane was not widened to its window's least width: %d" first.width)
+ check (not(SplitGeometry.fitsPanes gap (least 600) frame half.tree)) "An even split claimed to fit a 600px window in a 497px pane"
+ check (SplitGeometry.fitToPanes gap (least 400) frame half.tree=half.tree) "A pane already wide enough had its ratio moved"
+ check (SplitGeometry.fitToPanes gap (least 900) frame half.tree=half.tree) "A split with no room for both halves had its ratio moved"
+ let rightSide = {half.tree with first=occupied b;second=occupied a}
+ let _,_,second = SplitGeometry.rectangles gap frame (SplitGeometry.fitToPanes gap (least 600) frame rightSide)
+ check (second.width>=600) (sprintf "A second pane was not widened to its window's least width: %d" second.width)
+ let stacked = Branch {axis=Stacked;ratio=0.5;first=occupied a;second=occupied c}
+ check (SplitGeometry.leastSize gap (least 600) stacked=Sz(600,100+gap+120)) "A stacked split's least size did not take the wider pane and add the heights"
+ check (SplitGeometry.leastSize gap (least 600) (Branch {half.tree with second=stacked})=Sz(600+gap+600,100+gap+120)) "A nested split's least size was wrong"
+ check (SplitGeometry.ratioAt (Pt(frame.x+497,0)) gap frame half.tree=0.5) "The divider's own position did not read back as 0.5"
+ check (SplitGeometry.ratioAt (Pt(frame.x,0)) gap frame half.tree=SplitMetrics.minRatio) "Dragging the divider off the left edge went below the minimum ratio"
+ check (SplitGeometry.ratioAt (Pt(frame.right+50,0)) gap frame half.tree=SplitMetrics.maxRatio) "Dragging the divider off the right edge went above the maximum ratio"
+ check (SplitGeometry.paneRect gap frame half [Second]=Some second) "paneRect did not return the second pane"
+ check (SplitGeometry.paneRect gap frame half []=Some frame) "The root's rectangle is not the frame"
+ check (SplitGeometry.paneRect gap frame half [First;First]=None) "A path below a pane returned a rectangle"
+
+ // Geometry of a nested split: b's pane split again, c below b.
+ let nested = {tree={half.tree with second=Branch {axis=Stacked;ratio=0.5;first=occupied b;second=occupied c}};focused=[Second;Second]}
+ let leaves = SplitGeometry.leafRects gap frame (SplitView.root nested) []
+ check ((leaves |> List.map(fun (path,_,_) -> path))=[[First];[Second;First];[Second;Second]]) "Leaves did not come first to last"
+ let rectOf path = leaves |> List.find(fun (at,_,_) -> at=path) |> fun (_,_,rect) -> rect
+ check (rectOf [First]=first) "Nesting the second pane changed the first"
+ check ((rectOf [Second;First]).top=second.top && (rectOf [Second;Second]).bottom=second.bottom && (rectOf [Second;First]).width=second.width) "The nested panes do not share the second pane"
+ check ((rectOf [Second;First]).bottom+gap=(rectOf [Second;Second]).top) "The nested panes do not meet at their seam"
+ let seams = SplitGeometry.seams gap frame (SplitView.root nested) []
+ check ((seams |> List.map(fun (path,_,_,_) -> path))=[[];[Second]]) "Seams did not come parents first"
+ check (seams |> List.exists(fun (path,branch,own,seam) -> path=[Second] && branch.axis=Stacked && own=second && seam.width=second.width && seam.height=gap)) "The nested seam is not inside the second pane"
+ check (SplitView.windows nested=[a;b;c] && SplitView.pathOf c nested=Some [Second;Second] && SplitView.position [Second;Second] nested=Some(Stacked,Second)) "Nested panes were not found by window"
+ check (SplitView.focusedWindow nested=Some c) "The focused path did not name its window"
+
+ // Native resize: an inner edge changes the ratio, an outer edge grows the frame; nested, the
+ // nearest seam along the edge.
+ let innerGrown = Rect(first.location,Sz(first.width+100,first.height))
+ let frame2,tree2 = SplitGeometry.resizePane [First] first innerGrown gap frame half.tree
+ check (frame2=frame) "Resizing the inner edge of the first pane changed the frame"
+ check (tree2.ratio>0.59 && tree2.ratio<0.61) (sprintf "Inner-edge resize gave ratio %g instead of about 0.6" tree2.ratio)
+ let outerGrown = Rect(Pt(first.x-50,first.y),Sz(first.width+50,first.height))
+ let frame3,tree3 = SplitGeometry.resizePane [First] first outerGrown gap frame half.tree
+ check (frame3.left=frame.left-50 && frame3.right=frame.right) "Resizing the outer edge of the first pane did not extend the frame"
+ check (abs(tree3.ratio-float(first.width+50)/float(frame.width+50-gap))<0.001) "Outer-edge resize kept the wrong ratio"
+ let secondOuter = Rect(second.location,Sz(second.width+80,second.height))
+ let frame4,tree4 = SplitGeometry.resizePane [Second] second secondOuter gap frame half.tree
+ check (frame4.right=frame.right+80 && frame4.left=frame.left) "Resizing the outer edge of the second pane did not extend the frame"
+ check (abs(tree4.ratio-float first.width/float(frame.width+80-gap))<0.001) "Second-pane outer resize changed the first pane's share"
+ let stacked = {half.tree with axis=Stacked}
+ let upper,_,lower = SplitGeometry.rectangles gap frame stacked
+ let stackedFrame,stackedTree = SplitGeometry.resizePane [Second] lower (Rect(Pt(frame.x,frame.y+400),Sz(frame.width,200))) gap frame stacked
+ check (stackedFrame=frame && abs(stackedTree.ratio-float(400-gap)/float(frame.height-gap))<0.001) "Stacked inner resize did not update the ratio"
+ let moved = Rect(Pt(first.x+30,first.y+20),first.size)
+ let frame5,tree5 = SplitGeometry.resizePane [First] first moved gap frame half.tree
+ check (frame5=frame.move(30,20) && tree5=half.tree) "Moving a pane did not carry the frame"
+ // Both opposite edges moved at once, as a snap does: the whole group takes the pane's new
+ // rectangle with the shares kept, rather than one edge moving the frame and the other the seam.
+ let snapped = Rect(Pt(frame.x-300,frame.y-40),Sz(frame.width/2,frame.height+80))
+ let frame6,tree6 = SplitGeometry.resizePane [First] first snapped gap frame half.tree
+ check (frame6=snapped && tree6=half.tree) (sprintf "A snapped pane did not carry the whole group with its shares kept: %A %A" frame6 tree6)
+ // c's top edge is the nested seam; its left edge is the root's seam; its bottom the frame's.
+ let cRect = rectOf [Second;Second]
+ let cTaller = Rect(Pt(cRect.x,cRect.y-50),Sz(cRect.width,cRect.height+50))
+ let frame6,tree6 = SplitGeometry.resizePane [Second;Second] cRect cTaller gap frame nested.tree
+ check (frame6=frame && tree6.ratio=nested.tree.ratio) "Resizing the nested seam touched the frame or the root's ratio"
+ let inner6 = match tree6.second with Branch branch -> branch | Leaf _ -> failwith "The nested split was lost"
+ check (abs(inner6.ratio-float(cRect.y-50-gap-second.y)/float(second.height-gap))<0.001) (sprintf "The nested seam did not follow c's top edge: %g" inner6.ratio)
+ let cWider = Rect(Pt(cRect.x-40,cRect.y),Sz(cRect.width+40,cRect.height))
+ let frame7,tree7 = SplitGeometry.resizePane [Second;Second] cRect cWider gap frame nested.tree
+ check (frame7=frame && abs(tree7.ratio-float(cRect.x-40-gap-frame.x)/float(frame.width-gap))<0.001) "c's left edge did not move the root's seam"
+ let cLower = Rect(cRect.location,Sz(cRect.width,cRect.height+25))
+ let frame8,tree8 = SplitGeometry.resizePane [Second;Second] cRect cLower gap frame nested.tree
+ check (frame8.bottom=frame.bottom+25 && frame8.top=frame.top && tree8.ratio=nested.tree.ratio) "c's bottom edge did not grow the frame alone"
+ let inner8 = match tree8.second with Branch branch -> branch | Leaf _ -> failwith "The nested split was lost"
+ check (abs(inner8.ratio-float(second.height-gap)*0.5/float(second.height-gap+25))<0.001) (sprintf "Growing the frame at c's bottom did not leave b its size: %g" inner8.ratio)
+
+ // Edge drop zones
+ let edge = SplitMetrics.edgeZone
+ let outer = SplitMetrics.outerZone
+ let drop pt layout = SplitGeometry.dropAt pt edge outer gap frame layout |> Option.map fst
+ check (SplitGeometry.edgeDrop (Pt(frame.x+5,frame.y+300)) edge frame=Some(SideBySide,First)) "Left edge did not offer the first pane"
+ check (drop (Pt(frame.x+5,frame.y+300)) None=Some([],SideBySide,First)) "A single window's left edge did not offer a split"
+ check (drop (Pt(frame.right-5,frame.y+300)) None=Some([],SideBySide,Second)) "Right edge did not offer the second pane"
+ check (drop (Pt(frame.x+500,frame.y+5)) None=Some([],Stacked,First)) "Top edge did not offer the upper pane"
+ check (drop (Pt(frame.x+500,frame.bottom-5)) None=Some([],Stacked,Second)) "Bottom edge did not offer the lower pane"
+ check (drop (Pt(frame.x+500,frame.y+300)) None=None) "The frame's centre offered a pane"
+ // At an edge's middle the zone reaches a fifth of the frame in; towards its ends it narrows,
+ // so near a corner the closer edge wins and further in nothing does.
+ check (drop (Pt(frame.x+150,frame.y+300)) None=Some([],SideBySide,First)) "The middle of the left edge was not reachable from further in"
+ check (drop (Pt(frame.right-150,frame.y+300)) None=Some([],SideBySide,Second)) "The middle of the right edge was not reachable from further in"
+ check (drop (Pt(frame.x+500,frame.bottom-100)) None=Some([],Stacked,Second)) "The middle of the bottom edge was not reachable from further in"
+ check (drop (Pt(frame.x+250,frame.y+300)) None=None) "The left edge's zone reached past a fifth of the frame"
+ check (drop (Pt(frame.x+150,frame.y+20)) None=Some([],Stacked,First)) "Near the top-left corner the top edge did not win"
+ check (drop (Pt(frame.x+150,frame.y+150)) None=None) "The zones did not narrow towards a corner"
+ check (drop (Pt(frame.x-1,frame.y+300)) None=None) "A point outside the frame offered a pane"
+ // Split: the group's own edge splits the whole group; further in, the pane under the point.
+ check (drop (Pt(frame.x+5,frame.y+300)) (Some half)=Some([],SideBySide,First)) "The group's left edge did not offer a new first column"
+ // The group's zone is `outer` deep at an edge's ends and twice that at its middle; a pane's
+ // zone takes over further in, and at the corners.
+ check (drop (Pt(frame.x+2*outer-2,frame.y+300)) (Some half)=Some([],SideBySide,First)) "The middle of the group's left edge was not reachable from further in"
+ check (drop (Pt(frame.x+2*outer+8,frame.y+300)) (Some half)=Some([First],SideBySide,First)) "Inside the group's edge the first pane did not split at its left"
+ check (drop (Pt(frame.x+48,frame.y+45)) (Some half)=Some([First],Stacked,First)) "Near the group's corner its zone did not narrow to the pane's"
+ check (drop (Pt(first.right-5,frame.y+300)) (Some half)=Some([First],SideBySide,Second)) "The first pane's inner edge did not split it"
+ check (drop (Pt(second.left+5,frame.y+300)) (Some half)=Some([Second],SideBySide,First)) "The second pane's inner edge did not split it"
+ check (drop (Pt(second.x+second.width/2,frame.y+60)) (Some half)=Some([Second],Stacked,First)) "The second pane's top did not split it above"
+ check (drop (Pt(second.x+second.width/2,frame.y+5)) (Some half)=Some([],Stacked,First)) "The group's top edge did not offer a new row"
+ check (drop (Pt(first.x+first.width/2,first.y+first.height/2)) (Some half)=None) "A pane's centre offered a split"
+ let dropRect pt layout = SplitGeometry.dropAt pt edge outer gap frame layout |> Option.map snd
+ check (dropRect (Pt(frame.x+5,frame.y+300)) (Some half)=Some(Rect(frame.location,Sz((frame.width-gap)/2,frame.height)))) "A new column's preview is not the frame's left half"
+ check (dropRect (Pt(second.left+5,frame.y+300)) (Some half)=Some(Rect(second.location,Sz((second.width-gap)/2,second.height)))) "A pane's preview is not its own half"
+ check (drop (Pt(cRect.x+cRect.width/2,cRect.bottom-50)) (Some nested)=Some([Second;Second],Stacked,Second)) "A nested pane did not split at its own edge"
+
+ // Commands
+ let apply = SplitView.apply
+ check (apply a (SplitWith(a,SideBySide)) Single=Single) "Splitting a tab with itself changed the layout"
+ check (apply a (SplitWith(IntPtr.Zero,SideBySide)) Single=Single) "Splitting with a zero handle changed the layout"
+ let split = apply a (SplitWith(b,SideBySide)) Single
+ check (split=Split(pair (Occupied a) (Occupied b) SideBySide Second)) "SplitWith did not put the current tab first and focus the partner"
+ check (apply a (SplitWith(a,Stacked)) split=Split {half with tree={half.tree with axis=Stacked};focused=[First]}) "Splitting with the pane's own tab did not turn its split and refocus it"
+ // A third tab splits the current pane again; the partner comes out of its pane first.
+ let three = apply a (SplitWith(c,Stacked)) split
+ check (three=Split {tree={half.tree with first=Branch {axis=Stacked;ratio=0.5;first=occupied a;second=occupied c}};focused=[First;Second]}) (sprintf "Splitting with a third tab did not nest it beside the current pane: %A" three)
+ let bMoved = apply a (SplitWith(b,Stacked)) three
+ check (SplitView.windows (SplitView.layoutOf bMoved).Value=[a;b;c] && (SplitView.layoutOf bMoved).Value.tree.second=occupied c)
+ (sprintf "Splitting with a pane elsewhere did not bring it beside the current pane: %A" bMoved)
+ let empty = apply a (NewEmptyPane Stacked) Single
+ check (empty=Split(pair (Occupied a) Empty Stacked First)) "NewEmptyPane did not create an empty second pane"
+ let emptyLayout = (SplitView.layoutOf empty).Value
+ let emptyAgain = apply a (NewEmptyPane SideBySide) empty
+ check (emptyAgain=Split {tree={emptyLayout.tree with first=Branch {axis=SideBySide;ratio=0.5;first=occupied a;second=Leaf Empty}};focused=[First;First]}) "A second NewEmptyPane did not split the pane again"
+ check (SplitView.emptyPanes (SplitView.layoutOf emptyAgain).Value=[[First;Second];[Second]]) "Two empty panes were not both found"
+ check (apply a (SplitWith(b,Stacked)) empty=Split {tree={axis=Stacked;ratio=0.5;first=Branch {axis=Stacked;ratio=0.5;first=occupied a;second=occupied b};second=Leaf Empty};focused=[First;Second]}) "SplitWith beside an empty pane did not split the current pane"
+ check (apply a (FillPane(b,[Second])) empty=Split(pair (Occupied a) (Occupied b) Stacked Second)) "Filling the empty pane did not take the window"
+ check (apply a (DropInto(b,[Second],Stacked,First)) empty=Split(pair (Occupied a) (Occupied b) Stacked Second)) "Dropping on an empty pane did not fill it"
+ check (apply a (FillPane(b,[First])) empty=empty) "Filling an occupied pane changed the layout"
+ check (apply a (DropInto(b,[],SideBySide,First)) Single=Split(pair (Occupied b) (Occupied a) SideBySide First)) "Dropping on the left edge of a single window did not put it first"
+ check (apply a (DropInto(a,[],SideBySide,First)) Single=Single) "Dropping the only window on itself changed the layout"
+ // A third tab dropped at a pane's edge splits that pane; at the group's, the whole group.
+ let cRight = apply a (DropInto(c,[Second],SideBySide,Second)) split
+ check (cRight=Split {tree={half.tree with second=Branch {axis=SideBySide;ratio=0.5;first=occupied b;second=occupied c}};focused=[Second;Second]}) (sprintf "Dropping a third tab at a pane's edge did not split that pane: %A" cRight)
+ let cBelow = apply a (DropInto(c,[],Stacked,Second)) split
+ check (cBelow=Split {tree={axis=Stacked;ratio=0.5;first=Branch half.tree;second=occupied c};focused=[Second]}) (sprintf "Dropping a third tab at the group's edge did not split the whole group: %A" cBelow)
+ // A pane window dropped elsewhere leaves its pane, whose neighbour takes the room.
+ let aMoved = apply a (DropInto(a,[Second;Second],Stacked,Second)) cRight
+ check (aMoved=Split {tree={axis=SideBySide;ratio=0.5;first=occupied b;second=Branch {axis=Stacked;ratio=0.5;first=occupied c;second=occupied a}};focused=[Second;Second]}) (sprintf "Moving a pane window elsewhere did not close its pane: %A" aMoved)
+ check (apply a (DropInto(a,[First],SideBySide,First)) split=Split half) "Dropping a pane on itself did not just focus it"
+ check (apply a (DropInto(a,[],SideBySide,Second)) split=Split(pair (Occupied b) (Occupied a) SideBySide Second)) "Dropping a pane at the other edge did not move it across"
+ check (apply a (DropInto(c,[First;First],SideBySide,First)) split=split) "A path below a pane took a drop"
+ check (apply a (FocusPane [First]) split=Split half) "FocusPane did not move the focus"
+ check (apply a (FocusPane [Second]) empty=empty) "Focusing an empty pane changed the layout"
+ check (apply a FocusOther (Split half)=split) "FocusOther did not move to the other pane"
+ check (apply a FocusOther empty=empty) "FocusOther moved onto an empty pane"
+ let threeLayout = (SplitView.layoutOf three).Value
+ check (apply a FocusOther three=Split {threeLayout with focused=[Second]} && apply a FocusOther (Split {threeLayout with focused=[Second]})=Split {threeLayout with focused=[First;First]}) "FocusOther did not go round the panes in order"
+ // By direction in the nested layout: a beside b over c.
+ check (apply a (FocusToward PaneLeft) (Split nested)=Split {nested with focused=[First]}) "Left of c is not a"
+ check (apply a (FocusToward PaneUp) (Split nested)=Split {nested with focused=[Second;First]}) "Above c is not b"
+ check (apply a (FocusToward PaneDown) (Split nested)=Split nested) "Below c there is a pane"
+ check (apply a (FocusToward PaneRight) (Split {nested with focused=[First]})=Split {nested with focused=[Second;First]}) "Right of a the first pane along its edge is not b"
+ check (apply a (FocusToward PaneRight) (Split {nested with focused=[Second;First]})=Split {nested with focused=[Second;First]}) "Right of b there is a pane"
+ let ratioAt path layout = match SplitTree.node path (SplitView.root (SplitView.layoutOf layout).Value) with Some(Branch branch) -> branch.ratio | _ -> nan
+ check (apply a (Swap None) split=Split(pair (Occupied b) (Occupied a) SideBySide First)) "Swap did not keep the focused window focused"
+ check (apply a (Swap(Some [Second])) (Split nested)=Split {tree={nested.tree with second=Branch {axis=Stacked;ratio=0.5;first=occupied c;second=occupied b}};focused=[Second;First]}) "Swapping a nested split did not turn it about"
+ check (apply a (SetRatio([],0.95)) split=Split {tree={half.tree with ratio=SplitMetrics.maxRatio};focused=[Second]}) "SetRatio was not clamped"
+ check (ratioAt [Second] (apply a (SetRatio([Second],0.3)) (Split nested))=0.3 && ratioAt [] (apply a (SetRatio([Second],0.3)) (Split nested))=0.5) "SetRatio did not reach the nested split alone"
+ check (apply a (Equalize None) (apply a (SetRatio([],0.7)) split)=split) "Equalize did not restore 0.5"
+ check (apply a (ToggleAxis None) split=Split {tree={half.tree with axis=Stacked};focused=[Second]}) "ToggleAxis did not flip the axis"
+ check (apply a (ToggleAxis(Some [Second])) (Split nested)=Split {nested with tree={nested.tree with second=Branch {axis=SideBySide;ratio=0.5;first=occupied b;second=occupied c}}}) "ToggleAxis did not turn the nested split"
+ check (apply a (ClosePane None) (Split nested)=Split(pair (Occupied a) (Occupied b) SideBySide Second)) "Closing the focused nested pane did not give its room, and the focus, to its neighbour"
+ check (apply a (ClosePane(Some [First])) (Split nested)=Split {tree={axis=Stacked;ratio=0.5;first=occupied b;second=occupied c};focused=[Second]}) "Closing the first pane did not promote the nested split"
+ check (apply a (ClosePane None) split=Single) "Closing one of two panes did not end the split"
+ check (apply a (ClosePane(Some [Second])) empty=Single) "Closing the empty pane did not end the split"
+ check (apply a (ClosePane(Some [First;Second])) emptyAgain=empty) "Closing a nested empty pane did not give its room back"
+ check (apply a (EndSplit(Some a)) split=Single) "EndSplit did not return to Single"
+ check (apply a ToggleFill split=split) "ToggleFill changed the layout"
+ for command in [FocusOther;Swap None;Equalize None;ToggleAxis None;SetRatio([],0.3);FocusPane [First];ClosePane None;EndSplit None;FocusToward PaneLeft] do
+ check (apply a command Single=Single) (sprintf "%A on a single window changed the layout" command)
+
+ // Activation and parking
+ let pairB = pair (Occupied a) (Occupied b) SideBySide Second
+ let parked = SplitView.onActivated c split
+ check (parked=Parked pairB) "Activating a third tab did not park the panes"
+ check (SplitView.onActivated d parked=parked) "Activating another unrelated tab changed the parked panes"
+ check (SplitView.onActivated a parked=Split half) "Activating a parked pane did not restore the panes with that pane focused"
+ check (SplitView.onActivated a split=Split half) "Activating the other pane did not move the focus"
+ check (SplitView.onActivated c Single=Single) "Activation changed a single layout"
+ check (SplitView.onActivated c (Split nested)=Split {nested with focused=[Second;Second]} && SplitView.onActivated d (Split nested)=Parked nested) "Activation in a nested layout went wrong"
+ check (apply c FocusOther parked=Split pairB) "FocusOther while parked did not bring the panes back"
+ check (apply c (FillPane(c,[Second])) (Parked(pair (Occupied a) Empty SideBySide First))=Split(pair (Occupied a) (Occupied c) SideBySide Second)) "Filling while parked did not show the panes"
+ check (apply c (SplitWith(d,Stacked)) parked=Split(pair (Occupied c) (Occupied d) Stacked Second)) "A new split while parked did not discard the parked panes"
+ check (apply c (NewEmptyPane SideBySide) parked=Split(pair (Occupied c) Empty SideBySide First)) "An empty pane while parked did not discard the parked panes"
+ check (apply c (DropInto(d,[],SideBySide,First)) parked=Split {tree={axis=SideBySide;ratio=0.5;first=occupied d;second=occupied c};focused=[First]}) "A drop beside the window shown while parked did not split it and let the parked panes go"
+ check (apply c (DropInto(d,[Second],Stacked,Second)) parked=Split {tree={axis=Stacked;ratio=0.5;first=occupied c;second=occupied d};focused=[Second]}) "A drop while parked aimed at a parked pane"
+ check (apply c (Swap None) parked=Parked(pair (Occupied b) (Occupied a) SideBySide First)) "Swap while parked did not stay parked"
+ check (apply c (EndSplit None) parked=Single) "EndSplit while parked did not return to Single"
+
+ // Removal
+ check (SplitView.onRemoved a split=Single) "Closing a pane did not end the split"
+ check (SplitView.onRemoved b parked=Single) "Closing a parked pane did not drop the panes"
+ check (SplitView.onRemoved c split=split) "Closing an unrelated tab changed the split"
+ check (SplitView.onRemoved a empty=Single) "Closing the only window of an empty split did not end it"
+ check (SplitView.onRemoved b empty=empty) "Closing an unrelated tab changed an empty split"
+ check (SplitView.onRemoved b (Split nested)=Split(pair (Occupied a) (Occupied c) SideBySide Second)) "Losing a nested pane did not give its room to its neighbour"
+ check (SplitView.onRemoved a (Split nested)=Split {tree={axis=Stacked;ratio=0.5;first=occupied b;second=occupied c};focused=[Second]}) "Losing the first pane did not promote the nested split"
+ check (SplitView.onRemoved c (Parked nested)=Parked(pair (Occupied a) (Occupied b) SideBySide Second)) "Losing a parked nested pane did not stay parked"
+ check (SplitView.prune (fun h -> h<>b) split=Single) "Pruning a missing pane kept the split"
+ check (SplitView.prune (fun h -> h<>c) split=split) "Pruning an unrelated window changed the split"
+ check (SplitView.prune (fun _ -> true) empty=empty) "Pruning rejected an empty pane"
+ check (SplitView.prune (fun h -> h<>c) (Split nested)=Split(pair (Occupied a) (Occupied b) SideBySide Second)) "Pruning a nested pane did not promote its neighbour"
+
+ // Badges, pane order and the empty pane Esc closes
+ check (SplitView.badge a split=Some(SideBySide,First) && SplitView.badge b parked=Some(SideBySide,Second)) "Badges missing for pane windows"
+ check (SplitView.badge c (Split nested)=Some(Stacked,Second) && SplitView.badge a (Split nested)=Some(SideBySide,First)) "Nested badges do not show the pane's own split"
+ check (SplitView.badge c split=None && SplitView.badge a Single=None) "Badge shown for a non-pane window"
+ check (SplitView.paneOrder split=[a;b] && SplitView.paneOrder (apply a (Swap None) split)=[b;a] && SplitView.paneOrder empty=[a] && SplitView.paneOrder Single=[] && SplitView.paneOrder (Split nested)=[a;b;c]) "Pane order did not follow the layout"
+ check (SplitView.emptyToClose emptyLayout=Some [Second]) "Esc did not find the empty pane"
+ check (SplitView.emptyToClose (SplitView.layoutOf emptyAgain).Value=Some [First;Second]) "Esc did not pick the empty pane beside the focused one"
+ check (SplitView.emptyToClose half=None) "Esc found an empty pane where there is none"
+
+ // What the windows remember of a split, and the layout they rebuild together.
+ let remembered = SplitPersistence.entries (Split nested)
+ check ((remembered |> List.map fst)=[a;b;c]) "Not every pane window remembers its place"
+ let placeOf hwnd = remembered |> List.find(fun (h,_) -> h=hwnd) |> snd
+ check ((placeOf c).levels=[SideBySide,Second;Stacked,Second] && (placeOf c).ratios=[0.5;0.5] && (placeOf c).focused && not (placeOf c).parked) "A nested pane remembered the wrong place"
+ check (SplitPersistence.rebuild remembered=Split nested) "The windows did not rebuild their layout"
+ check (SplitPersistence.rebuild (SplitPersistence.entries (Parked nested))=Parked nested) "Parked panes did not come back parked"
+ check (SplitPersistence.rebuild (remembered |> List.filter(fun (h,_) -> h<>b))=Split(pair (Occupied a) (Occupied c) SideBySide Second)) "A window gone did not leave its room to its neighbour"
+ check (SplitPersistence.rebuild (remembered |> List.filter(fun (h,_) -> h=c))=Single) "One window alone made a split"
+ check (SplitPersistence.rebuild (SplitPersistence.entries empty)=Single) "An empty pane came back from a restart"
+ let ratios = SplitPersistence.entries (apply a (SetRatio([Second],0.3)) (apply a (SetRatio([],0.7)) (Split nested)))
+ check (ratioAt [] (SplitPersistence.rebuild ratios)=0.7 && ratioAt [Second] (SplitPersistence.rebuild ratios)=0.3) "The ratios did not come back"
+
+ // Placement plans
+ let members = [c;a;d;b]
+ let plan = SplitView.plan split frame gap members b
+ check (List.length plan=4 && (plan |> List.map(fun p -> p.hwnd) |> List.sort)=(List.sort members)) "A split plan did not cover every member once"
+ let placementOf h = plan |> List.find(fun p -> p.hwnd=h)
+ check ((placementOf a).rect=first && (placementOf a).below=None) "The first pane did not get its own rectangle"
+ check ((placementOf b).rect=second && (placementOf b).below=None) "The second pane did not get its own rectangle"
+ for h in [c;d] do
+ check ((placementOf h).rect=first && (placementOf h).below=Some a) "A background tab was not under the first pane"
+ // The focus moving between the panes moves none of the tabs behind them.
+ let refocused = SplitView.plan (Split half) frame gap members a
+ for h in [c;d] do
+ check ((refocused |> List.find(fun p -> p.hwnd=h))=(placementOf h)) "Moving the focus moved a tab behind the panes"
+ let emptyLeft = SplitView.plan (Split {tree={half.tree with first=Leaf Empty};focused=[Second]}) frame gap [b;c] b
+ check ((emptyLeft |> List.find(fun p -> p.hwnd=c)).rect=second && (emptyLeft |> List.find(fun p -> p.hwnd=c)).below=Some b)
+ "Beside an empty first pane a background tab was not under the second pane"
+ let emptyPlan = SplitView.plan empty frame gap [a;c] a
+ let emptyFirst,_,_ = SplitGeometry.rectangles gap frame emptyLayout.tree
+ check ((emptyPlan |> List.find(fun p -> p.hwnd=a)).rect=emptyFirst) "The window beside an empty pane did not keep its half"
+ check ((emptyPlan |> List.find(fun p -> p.hwnd=c)).below=Some a) "A background tab was not under the only pane window"
+ let nestedPlan = SplitView.plan (Split nested) frame gap [d;a;b;c] c
+ check ((nestedPlan |> List.find(fun p -> p.hwnd=c)).rect=cRect && (nestedPlan |> List.find(fun p -> p.hwnd=b)).rect=rectOf [Second;First]) "Nested panes did not get their own rectangles"
+ check ((nestedPlan |> List.find(fun p -> p.hwnd=d)).rect=first && (nestedPlan |> List.find(fun p -> p.hwnd=d)).below=Some a) "A tab behind a nested layout was not under the first pane"
+ let singlePlan = SplitView.plan Single frame gap members a
+ check (List.length singlePlan=3 && singlePlan |> List.forall(fun p -> p.hwnd<>a && p.rect=frame && p.below=Some a)) "A single plan did not put the followers under the top window at the frame"
+ check (SplitView.plan parked frame gap members c=SplitView.plan Single frame gap members c) "A parked plan differed from a single plan"
+ // The panes' tabs share a button on each seam, which answers for the tab after it.
+ let appearance : TabAppearanceInfo = {
+ tabStyle=JoinedTabs; tabHeight=Dpi.scale 26; tabMaxWidth=Dpi.scale 210; tabOverlap=0; tabHeightOffset=0
+ tabIndentFlipped=0; tabIndentNormal=0; tabTextColor=Color.Black; tabFlashBgColor=Color.Orange
+ tabNormalBgColor=Color.FromArgb(204,204,204); tabActiveBgColor=Color.White
+ tabHighlightBgColor=Color.FromArgb(228,228,228); tabBorderColor=Color.FromArgb(168,168,168) }
+ use font = new Font("Segoe UI",9.0f)
+ let strip sides : TabStripSprite =
+ { tabs=Map2(List2([1..3] |> List.map(fun id -> id, {
+ tint=None; colorStyle="Stripe"; numberBadge=None; bgColor=None; text=sprintf "Window %d" id; icon=SystemIcons.Application
+ textFont=font; textBrush=Brushes.Black; splitTrail=Map.tryFind id sides })))
+ lorder=List2([1;2;3]); zorder=List2([1;2;3]); size=Sz(630,Dpi.scale 28)
+ slide=None; direction=TabUp; alignment=TabLeft; onlyIcons=false
+ transparent=true; held=None; centerShift=0.0; dock=TabDockTop; scrollOffset=0; appearance=appearance; hover=None; captured=None }
+ let paired = strip (Map.ofList [1,[SideBySide,First];2,[SideBySide,Second]])
+ let seam = paired.tabLocation 2
+ // Near the bottom edge, where the button sits clear of the icons; the middle of the seam stays the tabs'.
+ let low = Pt(seam.x,Dpi.scale 28-Dpi.scale 5)
+ let middle = Pt(seam.x,Dpi.scale 28/2-Dpi.scale 4)
+ check (paired.tryHit low=Some(2,TabSplit)) "The seam between a split's tabs is not its button"
+ check (paired.tryHit middle |> Option.forall(fun (_,part) -> part<>TabSplit)) "The split button covers the middle of the tabs"
+ check ((strip Map.empty).tryHit low |> Option.forall(fun (_,part) -> part<>TabSplit)) "Unpaired tabs show a split button"
+ let apart = { (strip (Map.ofList [1,[SideBySide,First];3,[SideBySide,Second]])) with lorder=List2([1;2;3]) }
+ check (apart.tryHit (Pt((apart.tabLocation 3).x,Dpi.scale 28-Dpi.scale 5)) |> Option.forall(fun (_,part) -> part<>TabSplit)) "Paired tabs that are apart show a split button"
+ // Three panes, two in the top row and one below: the button between the top row's tabs shows
+ // their side-by-side split, the one before the lower pane's tab the stacked split parting the rows.
+ let trio = strip (Map.ofList [1,[Stacked,First;SideBySide,First];2,[Stacked,First;SideBySide,Second];3,[Stacked,Second]])
+ check (trio.tryHit (Pt((trio.tabLocation 2).x,Dpi.scale 28-Dpi.scale 5))=Some(2,TabSplit) && trio.tryHit (Pt((trio.tabLocation 3).x,Dpi.scale 28-Dpi.scale 5))=Some(3,TabSplit)) "Three panes' tabs do not have a button on each seam"
+ let seamAxis owner = trio.sprite.children.list |> List.pick(fun (_,sprite) -> match sprite with :? SplitJunctionSprite as junction when unbox junction.owner=owner -> Some junction.axis | _ -> None)
+ check (seamAxis 2=SideBySide && seamAxis 3=Stacked) "The seam buttons do not show the split parting their tabs"
+ check (SplitView.trail c (Split nested)=Some [SideBySide,Second;Stacked,Second] && SplitView.trail a (Split nested)=Some [SideBySide,First] && SplitView.trail d (Split nested)=None) "Trails do not follow the splits down to the pane"
+ check (SplitView.commonSplit a c nested=Some([],SideBySide) && SplitView.commonSplit b c nested=Some([Second],Stacked) && SplitView.commonSplit a d nested=None) "The split parting two panes was not found"
+ check (SplitMenu.items Single ignore).isEmpty "A single layout offers split commands"
+ check ((SplitMenu.items (Parked half) ignore).count=(SplitMenu.items (Split half) ignore).count+2) "Parked panes do not offer to come back"
+ printfn "PASS: split geometry, nested splits, native resizes, edge drops, commands, parking, removal, badges, placement plans and the seam buttons."
+TestInit.run main
diff --git a/tests/SplitViewDesktop.fsx b/tests/SplitViewDesktop.fsx
new file mode 100644
index 00000000..7ea03152
--- /dev/null
+++ b/tests/SplitViewDesktop.fsx
@@ -0,0 +1,693 @@
+#r "System.Drawing"
+#r "System.Windows.Forms"
+#r "Debug/Win32.dll"
+#r "Debug/WindowTabs.exe"
+open System
+open System.Diagnostics
+open System.Drawing
+open System.IO
+open System.Reflection
+open System.Runtime.InteropServices
+open System.Threading
+open System.Windows.Forms
+open Bemo
+
+/// Split view on the real desktop, with real mouse input: Windows' own move-size loops, the
+/// panes following live, stacking under the tabs and the empty pane's frame. Opt-in: it moves
+/// the pointer, so it needs an idle, unlocked desktop (Run-Tests -VisibleDesktop).
+module Native =
+ []
+ extern void mouse_event(uint32 flags, int dx, int dy, uint32 data, nativeint extra)
+ []
+ extern nativeint GetTopWindow(nativeint hwnd)
+ []
+ extern nativeint GetWindow(nativeint hwnd, uint32 command)
+ []
+ extern uint32 timeBeginPeriod(uint32 period)
+ []
+ extern nativeint FindWindow(string className, string title)
+
+let check condition message = if not condition then failwith message
+let pump milliseconds =
+ let clock = Stopwatch.StartNew()
+ while clock.ElapsedMilliseconds < int64 milliseconds do
+ Application.DoEvents()
+ Thread.Sleep(1)
+/// Milliseconds until the predicate holds, or None after the limit.
+let timeUntil limit predicate =
+ let clock = Stopwatch.StartNew()
+ let mutable satisfied = predicate()
+ while not satisfied && clock.ElapsedMilliseconds < int64 limit do
+ Application.DoEvents()
+ Thread.Sleep(1)
+ satisfied <- predicate()
+ if satisfied then Some clock.Elapsed.TotalMilliseconds else None
+let pumpUntil description predicate =
+ check (timeUntil 10000 predicate).IsSome description
+
+/// An application window stand-in: sizable, activatable, a solid colour, and kept out of
+/// the taskbar and Alt+Tab so a WindowTabs already running leaves it alone.
+type PaneWindow(color:Color, title:string) =
+ inherit Form(ShowInTaskbar=false,StartPosition=FormStartPosition.Manual,Text=title,BackColor=color,
+ FormBorderStyle=FormBorderStyle.Sizable,Location=Point(-20000,-20000),Size=Size(400,300))
+ let mutable positions = 0
+ let mutable delay = 0
+ let mutable grid = 0
+ member _.Positions = Volatile.Read(&positions)
+ /// Rounds every width down to this step, as a terminal keeps to its character grid.
+ member _.Grid with set value = grid <- value
+ /// Each resize costs this long, as a heavy app's layout and paint do.
+ member _.Delay with set value = delay <- value
+ override this.CreateParams =
+ let parameters = base.CreateParams
+ parameters.ExStyle <- parameters.ExStyle ||| 0x80
+ parameters
+ override this.WndProc(message:Message byref) =
+ if message.Msg=0x46 then
+ Interlocked.Increment(&positions) |> ignore
+ let position = Marshal.PtrToStructure(message.LParam,typeof) :?> WINDOWPOS
+ if delay>0 && position.IsSize then Thread.Sleep(delay)
+ if grid>0 && position.IsSize then
+ position.cx <- position.cx-position.cx%grid
+ Marshal.StructureToPtr(position,message.LParam,false)
+ // Stand in for a native window that ignores WM_DPICHANGED, as the group places it.
+ if message.Msg <> 0x2E0 then base.WndProc(&message)
+
+let percentile (values:float list) (p:float) =
+ match List.sort values with
+ | [] -> 0.0
+ | sorted -> sorted.[min (sorted.Length-1) (int(float sorted.Length*p))]
+
+let main() =
+ Native.timeBeginPeriod 1u |> ignore
+ let screen = Screen.PrimaryScreen
+ check (screen.WorkingArea.Width>=1400 && screen.WorkingArea.Height>=900) "The primary working area is too small for the split scenario"
+ let original = Environment.CurrentDirectory
+ let isolated = Path.Combine(__SOURCE_DIRECTORY__,"Debug","split-desktop-"+Guid.NewGuid().ToString("N"))
+ Directory.CreateDirectory(isolated) |> ignore
+ Environment.CurrentDirectory <- isolated
+ use settings = new Settings(true)
+ let api = settings :> ISettings
+ api.setValue("autoHideMode",box "Never")
+ let mouse = Event()
+ Services.register({new IProgram with
+ member _.version = "test"
+ member _.isFirstRun = false
+ member _.refresh() = ()
+ member _.regroupApplications _ = ()
+ member _.shutdown() = ()
+ member _.setWindowNameOverride _ = ()
+ member _.getWindowNameOverride _ = None
+ member _.getTabColorOverride _ = None
+ member _.setTabColorOverride _ = ()
+ member _.getTabColor(_,_) = None
+ member _.getTabColors(hwnds,_) = hwnds |> List.map(fun _ -> None)
+ member _.handMadeGroups() = []
+ member _.ungroupHandMade _ = ()
+ member _.groupIcon _ = None
+ member _.setGroupIcon(_,_) = ()
+ member _.appWindows = List2()
+ member _.getAutoGroupingEnabled _ = false
+ member _.setAutoGroupingEnabled _ _ = ()
+ member _.tabAppearanceInfo = ThemeService.currentAppearance()
+ member _.setHotKey _ _ = true
+ member _.getHotKey _ = 0
+ member _.newTab _ = ()
+ member _.suspendTabMonitoring() = ()
+ member _.resumeTabMonitoring() = ()
+ member _.llMouse = mouse.Publish
+ member _.paneCandidates() = []})
+ Services.register({new IFilterService with
+ member _.isAppWindow _ = false
+ member _.isAppWindowStyle _ = false
+ member _.isTabbableWindow _ = false
+ member _.isTabbingEnabledForAllProcessesByDefault with get()=false and set _=()
+ member _.setIsTabbingEnabledForProcess _ _ = ()
+ member _.setIsTabbingEnabledForProcesses _ _ = ()
+ member _.getIsTabbingEnabledForProcess _ = false})
+ let desktop = Desktop({new IDesktopNotification with
+ member _.dragDrop _ = ()
+ member _.dragEnd() = ()},api,InvokerService.invoker :> IDispatcher)
+ let info = (desktop :> IDesktop).createGroup(false) :?> GroupInfo
+ let onGroup action =
+ let mutable result = None
+ info.invokeGroup(fun () -> result <- Some(try Choice1Of2(action info.group) with e -> Choice2Of2 e))
+ pumpUntil "The group did not answer" (fun () -> result.IsSome)
+ match result.Value with Choice1Of2 value -> value | Choice2Of2 error -> raise error
+ let forms,dispatcher = ThreadHelper.startOnThreadAndWait(fun () ->
+ let forms = [PaneWindow(Color.FromArgb(40,90,160),"Split A"); PaneWindow(Color.FromArgb(150,70,40),"Split B"); PaneWindow(Color.FromArgb(60,130,70),"Split C")]
+ for form in forms do form.Handle |> ignore
+ forms,InvokerService.invoker)
+ let onHelper action =
+ let mutable result = None
+ dispatcher.asyncInvoke(fun () -> result <- Some(try Choice1Of2(action()) with error -> Choice2Of2 error))
+ pumpUntil "The helper thread did not answer" (fun () -> result.IsSome)
+ match result.Value with Choice1Of2 value -> value | Choice2Of2 error -> raise error
+ let a,b,c = forms.[0],forms.[1],forms.[2]
+ let ha,hb,hc = onHelper(fun () -> a.Handle,b.Handle,c.Handle)
+ let flags = BindingFlags.Instance ||| BindingFlags.NonPublic
+ let transitionTimer (group:WindowGroup) =
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="minimizeStateTimer")
+ field.GetValue(group) :?> System.Windows.Forms.Timer
+ let waitOperation() =
+ pumpUntil "Placement did not settle" (fun () -> onGroup(fun group -> group.isPlacementIdle && not((transitionTimer group).Enabled)))
+ pump 150
+ let os = OS()
+ let visible hwnd = os.windowFromHwnd(hwnd).visibleBounds
+ let bounds hwnd = os.windowFromHwnd(hwnd).bounds
+ let near (x:int) (y:int) = abs(x-y)<=1
+ /// Place in the top-level z-order, 0 at the top.
+ let zIndex (hwnd:nativeint) =
+ let rec walk (current:nativeint) index =
+ if current=IntPtr.Zero then Int32.MaxValue
+ elif current=hwnd then index
+ else walk (Native.GetWindow(current,2u)) (index+1)
+ walk (Native.GetTopWindow(IntPtr.Zero)) 0
+
+ // Real input. The pointer is checked before each step: anyone else moving it ends the run.
+ let primary = screen.Bounds
+ let mutable expected : Point option = None
+ let moveTo (x:int) (y:int) =
+ expected |> Option.iter(fun at ->
+ let now = Cursor.Position
+ if abs(now.X-at.X)>3 || abs(now.Y-at.Y)>3 then failwith "The pointer moved during the scenario; leave the desktop idle")
+ let nx = (x-primary.Left)*65535/max 1 (primary.Width-1)
+ let ny = (y-primary.Top)*65535/max 1 (primary.Height-1)
+ Native.mouse_event(0x8001u,nx,ny,0u,IntPtr.Zero)
+ expected <- Some(Point(x,y))
+ let down() = Native.mouse_event(0x0002u,0,0,0u,IntPtr.Zero)
+ let up() = Native.mouse_event(0x0004u,0,0,0u,IntPtr.Zero)
+ let click x y =
+ moveTo x y
+ pump 60
+ down()
+ pump 40
+ up()
+ pump 120
+ /// Drags from a point in steps. Each step waits for the dragged window to change, then times
+ /// how long `settled` takes to say the panes caught up again.
+ let drag name (x:int) (y:int) (dx:int) (dy:int) steps (dragged:unit -> Rect) (settled:unit -> bool) =
+ moveTo x y
+ pump 120
+ down()
+ pump 80
+ let lags = ResizeArray()
+ let responses = ResizeArray()
+ let mutable missed = 0
+ let mutable unmoved = 0
+ for step in 1..steps do
+ let before = dragged()
+ moveTo (x+dx*step/steps) (y+dy*step/steps)
+ match timeUntil 300 (fun () -> dragged()<>before) with
+ | None -> unmoved <- unmoved+1
+ | Some response ->
+ responses.Add response
+ match timeUntil 400 settled with
+ | Some lag -> lags.Add lag
+ | None -> missed <- missed+1
+ pump 10
+ up()
+ check (unmoved<=steps/4) (sprintf "%s: the drag moved nothing at %d of %d steps" name unmoved steps)
+ let answered = List.ofSeq responses
+ printfn "METRIC %s pointer-to-edge median=%.1fms p95=%.1fms" name (percentile answered 0.5) (percentile answered 0.95)
+ if not(name.StartsWith "probe") then
+ check (percentile answered 0.95<60.0) (sprintf "%s: the dragged edge trailed the pointer by %.0fms" name (percentile answered 0.95))
+ let values = List.ofSeq lags
+ printfn "METRIC %s steps=%d caught-up=%d median=%.1fms p95=%.1fms max=%.1fms" name steps values.Length (percentile values 0.5) (percentile values 0.95) (if values.IsEmpty then 0.0 else List.max values)
+ check (missed<=steps/10) (sprintf "%s: the other pane fell behind at %d of %d steps" name missed steps)
+ check (percentile values 0.95<200.0) (sprintf "%s: following took %.0fms at the 95th percentile" name (percentile values 0.95))
+
+ try
+ let work = screen.WorkingArea
+ let frame = Rectangle(work.Left+work.Width/8,work.Top+work.Height/5,work.Width*3/4,work.Height*3/5)
+ onHelper(fun () -> for form in forms do form.Bounds <- frame; form.Show())
+ for hwnd in [ha;hb;hc] do (info :> IGroup).addWindow(hwnd,false)
+ pumpUntil "Windows did not join" (fun () -> onGroup(fun group -> group.windows.count=3))
+ onHelper(fun () -> a.Activate())
+ pump 300
+ waitOperation()
+ let strip = onGroup(fun group -> group.ts.hwnd)
+ let paneOf () = onGroup(fun group -> group.emptyPaneHwnds |> List.tryHead |> Option.defaultValue IntPtr.Zero)
+
+ // An empty pane beside A: touching, below the strip, framed as Explorer is.
+ let fullWidth = (visible ha).width
+ onGroup(fun group -> group.execute(NewEmptyPane SideBySide,current=ha))
+ // It opens out from the right edge over A, which keeps the whole frame until it has.
+ let samples = ResizeArray()
+ let opening = Stopwatch.StartNew()
+ while opening.ElapsedMilliseconds < 400L do
+ let pane = paneOf()
+ if pane<>IntPtr.Zero && WinUserApi.IsWindowVisible(pane) then samples.Add((bounds pane).width,(visible ha).width)
+ pump 15
+ waitOperation()
+ let pane = paneOf()
+ if SystemInformation.UIEffectsEnabled then
+ let widths = samples |> Seq.map fst |> List.ofSeq
+ let finalWidth = (bounds pane).width
+ printfn "METRIC empty-pane-opening widths=%A" widths
+ check (widths.Length>=5) "The empty pane opened in too few frames to see"
+ check (List.head widths < finalWidth/3) (sprintf "The empty pane did not start narrow: %d of %d" (List.head widths) finalWidth)
+ check (widths |> List.pairwise |> List.forall(fun (a,b) -> b>=a)) "The empty pane shrank while opening"
+ let whileOpening = samples |> Seq.filter(fun (width,_) -> width < finalWidth*9/10) |> Seq.map snd |> List.ofSeq
+ check (whileOpening |> List.forall(fun width -> width=fullWidth)) "A was resized while the empty pane was still opening"
+ check (pane<>IntPtr.Zero && WinUserApi.IsWindowVisible(pane)) "No empty pane appeared"
+ let aligned () =
+ let left,right = visible ha,bounds pane
+ near left.right right.left && near left.top right.top && near left.bottom right.bottom
+ check (aligned()) (sprintf "The empty pane does not meet A: A=%A pane=%A" (visible ha) (bounds pane))
+ check (zIndex strip < zIndex ha && zIndex strip < zIndex pane) "The tabs are not above both panes"
+ check ((bounds strip).right > (bounds pane).left) (sprintf "Above the windows the tabs do not span the group: strip=%A pane=%A" (bounds strip) (bounds pane))
+ let edge =
+ let rect = bounds pane
+ use bitmap = new Bitmap(1,1)
+ use graphics = Graphics.FromImage(bitmap)
+ graphics.CopyFromScreen(rect.x+rect.width/2,rect.y,0,0,Size(1,1))
+ bitmap.GetPixel(0,0)
+ let wanted = EmptySplitPane.frameColor()
+ check (abs(int edge.R-int wanted.R)<=16 && abs(int edge.G-int wanted.G)<=16 && abs(int edge.B-int wanted.B)<=16)
+ (sprintf "The empty pane's frame is %A, not %A" edge wanted)
+
+ /// The drag's edge went about as far as the pointer did.
+ let travelled name (actual:int) (wanted:int) =
+ check (abs(actual-wanted)<=Dpi.scale 10) (sprintf "%s: the edge went %d, not about %d" name actual wanted)
+ // Its inner edge, where the divider's band lies over it: A follows the ratio.
+ let rect = bounds pane
+ let positionsBefore = a.Positions
+ drag "empty-inner-edge" (rect.left+Dpi.scale 5) (rect.y+rect.height/2) (-200) 0 20 (fun () -> bounds pane) aligned
+ waitOperation()
+ travelled "empty-inner-edge" ((bounds pane).left-rect.left) (-200)
+ check (aligned()) (sprintf "After the inner-edge drag the panes do not meet: A=%A pane=%A" (visible ha) (bounds pane))
+ printfn "METRIC empty-inner-edge positions-of-A=%d" (a.Positions-positionsBefore)
+ let behind = visible hc
+ check (behind=visible ha) (sprintf "The tab behind did not come back under A: C=%A A=%A" behind (visible ha))
+
+ // Its top and bottom edges: the frame changes and A follows.
+ let rect = bounds pane
+ drag "empty-top-edge" (rect.x+rect.width/2) (rect.top+Dpi.scale 3) 0 (-80) 16 (fun () -> bounds pane) aligned
+ waitOperation()
+ travelled "empty-top-edge" ((bounds pane).top-rect.top) (-80)
+ check (aligned()) "After the top-edge drag the panes do not meet"
+ let rect = bounds pane
+ drag "empty-bottom-edge" (rect.x+rect.width/2) (rect.bottom-Dpi.scale 2) 0 60 12 (fun () -> bounds pane) aligned
+ waitOperation()
+ travelled "empty-bottom-edge" ((bounds pane).bottom-rect.bottom) 60
+ check (aligned()) "After the bottom-edge drag the panes do not meet"
+ check (zIndex strip < zIndex ha && zIndex strip < zIndex pane) "After the drags the tabs are not above both panes"
+
+ // Beside a heavy app, 40ms a resize: the pane keeps up with the pointer, and the app
+ // trails by about one resize rather than falling further behind with each step.
+ onHelper(fun () -> a.Delay <- 40)
+ let rect = bounds pane
+ drag "empty-inner-edge-slow-app" (rect.left+Dpi.scale 5) (rect.y+rect.height/2) 160 0 20 (fun () -> bounds pane) aligned
+ waitOperation()
+ travelled "empty-inner-edge-slow-app" ((bounds pane).left-rect.left) 160
+ check (aligned()) "Beside a slow app the panes do not meet after the drag"
+ let rect = bounds pane
+ drag "empty-top-edge-slow-app" (rect.x+rect.width/2) (rect.top+Dpi.scale 3) 0 60 12 (fun () -> bounds pane) aligned
+ waitOperation()
+ check (aligned()) "Beside a slow app the panes do not meet after the top-edge drag"
+ onHelper(fun () -> a.Delay <- 0)
+
+ // Its outer edge: the frame grows, A stays.
+ let rect = bounds pane
+ let before = visible ha
+ drag "empty-outer-edge" (rect.right-Dpi.scale 2) (rect.y+rect.height/2) 120 0 12 (fun () -> bounds pane) aligned
+ waitOperation()
+ travelled "empty-outer-edge" ((bounds pane).right-rect.right) 120
+ check (aligned() && visible ha=before) "The outer-edge drag moved A"
+
+ // B fills the pane; dragging B's outer edge natively, and then the divider.
+ onGroup(fun group ->
+ match group.splitLayout with
+ | Some _ -> group.execute(FillPane(hb,[Second]),current=ha)
+ | None -> failwith "The split ended")
+ waitOperation()
+ let meet () = near (visible ha).right (visible hb).left && near (visible ha).top (visible hb).top
+ check (meet()) (sprintf "B did not take the pane: A=%A B=%A" (visible ha) (visible hb))
+ check (paneOf()=IntPtr.Zero) "The empty pane stayed after B filled it"
+ let right = visible hb
+ drag "window-outer-edge" (right.right+Dpi.scale 3) (right.y+right.height/2) (-100) 0 10 (fun () -> visible hb) meet
+ waitOperation()
+ travelled "window-outer-edge" ((visible hb).right-right.right) (-100)
+ check (meet()) "After B's own resize the panes do not meet"
+ let divider = onGroup(fun group ->
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="splitDividers")
+ snd (field.GetValue(group) :?> Map).[[]])
+ // The band takes the pointer across its whole width, and it covers both panes' invisible
+ // resize borders at the seam, so a press near the seam never starts a pane's own resize.
+ do
+ let band = bounds divider
+ let y = band.y+band.height/2
+ let missed = [band.left..band.right-1] |> List.filter(fun x -> WinUserApi.WindowFromPoint(POINT(x,y))<>divider)
+ let seam = (visible ha).right
+ let border = Dpi.scale 6
+ printfn "METRIC divider-band band=%A seam=%d" band seam
+ check missed.IsEmpty (sprintf "The divider's band does not take the pointer across its width: missed at %A" missed)
+ check (band.left<=seam-border && band.right>=seam+border)
+ (sprintf "The divider's band %A leaves a pane's resize border bare at the seam %d" band seam)
+ let band = bounds divider
+ let seam = (visible ha).right
+ drag "divider" (band.x+band.width/2) (band.y+band.height/2) 150 0 15 (fun () -> visible ha) meet
+ waitOperation()
+ travelled "divider" ((visible ha).right-seam) 150
+ check (meet()) "After the divider drag the panes do not meet"
+ let hostPane = onGroup(fun group -> let s = group.splitLayout.Value in SplitView.window (SplitView.host s) s |> Option.get)
+ check (visible hc=visible hostPane) (sprintf "The tab behind did not come back under the host pane: C=%A host=%A" (visible hc) (visible hostPane))
+
+ // Clicking either pane leaves the tabs over both.
+ for hwnd in [ha;hb;ha] do
+ let target = visible hwnd
+ click (target.x+target.width/2) (target.y+target.height/2)
+ waitOperation()
+ check (zIndex strip < zIndex ha && zIndex strip < zIndex hb)
+ (sprintf "After clicking %A the tabs are under a pane: strip=%d A=%d B=%d" hwnd (zIndex strip) (zIndex ha) (zIndex hb))
+ // Moving quickly between the panes: the tab behind neither moves nor shows over a pane.
+ let behindAt = visible hc
+ let behindMoves = c.Positions
+ let mutable shown = 0
+ for step in 1..8 do
+ let target = visible (if step%2=1 then hb else ha)
+ click (target.x+target.width/2) (target.y+target.height/2)
+ for _ in 1..6 do
+ if zIndex hc < zIndex ha || zIndex hc < zIndex hb then shown <- shown+1
+ pump 10
+ waitOperation()
+ printfn "METRIC quick-switch shown-over-pane=%d moves-of-tab-behind=%d" shown (c.Positions-behindMoves)
+ check (shown=0) (sprintf "The tab behind showed over a pane %d times while moving between the panes" shown)
+ check (visible hc=behindAt && c.Positions=behindMoves) "Moving between the panes moved the tab behind"
+ // Leaving the split for the tab behind, by its tab: the tabs stay over it the whole time.
+ // Parked before the tab was in front, a tab behind showed for a moment, and the strip went
+ // back to the pane under the rising tab.
+ let tabAt hwnd = onGroup(fun group ->
+ let location = group.ts.tabLocation(Tab(hwnd))
+ os.windowFromHwnd(group.ts.hwnd).bounds.location.add(location).add(Pt(Dpi.scale 24,Dpi.scale 12)))
+ for _ in 1..3 do
+ let at = tabAt hc
+ click at.x at.y
+ let mutable covered = 0
+ let clock = Stopwatch.StartNew()
+ while clock.ElapsedMilliseconds < 600L do
+ if os.foreground.hwnd=hc && zIndex strip > zIndex hc then covered <- covered+1
+ pump 2
+ waitOperation()
+ printfn "METRIC leave-split covered-samples=%d" covered
+ check (covered=0) (sprintf "Leaving the split for a tab behind put the tabs under it %d times" covered)
+ check (onGroup(fun group -> match group.layout with Parked _ -> true | _ -> false)) "Leaving the split by a tab behind did not park it"
+ let back = tabAt ha
+ click back.x back.y
+ waitOperation()
+ check (onGroup(fun group -> group.splitLayout.IsSome)) "Choosing a pane's tab did not show the split again"
+ // At the top of the screen the tabs sit inside the title bars. An empty pane opened from a
+ // tab behind: once it has opened, the tabs are over every window of the group, that tab
+ // fills the left pane and the others wait under it.
+ onGroup(fun group -> group.execute(EndSplit None))
+ waitOperation()
+ onHelper(fun () -> a.Activate())
+ pump 200
+ os.windowFromHwnd(ha).move(Rect(Pt(frame.X,work.Top),Sz(frame.Width,frame.Height)))
+ pump 300
+ waitOperation()
+ // As apps that refuse a foreign owner do (Windows Terminal among them): the strip is then
+ // owned by nothing, and only restacking keeps it over the panes.
+ onGroup(fun group ->
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="inputOwnership")
+ let ownership = field.GetValue(group) :?> Collections.Generic.Dictionary
+ for hwnd in [ha;hb;hc] do ownership.[hwnd] <- false)
+ let inside = onGroup(fun group -> group.ts.direction=TabDown)
+ printfn "METRIC tabs-inside=%b strip=%A A=%A" inside (bounds strip) (visible ha)
+ onGroup(fun group -> group.execute(NewEmptyPane SideBySide,current=hb))
+ pump 500
+ waitOperation()
+ let s = onGroup(fun group -> group.splitLayout.Value)
+ check (s.tree.first=Leaf(Occupied hb)) "The tab the empty pane was opened from is not in the left pane"
+ let left = visible hb
+ for hwnd in [ha;hc] do
+ check (visible hwnd=left) (sprintf "A tab behind is not under the left pane: %A=%A left=%A" hwnd (visible hwnd) left)
+ let strip = onGroup(fun group -> group.ts.hwnd)
+ let order = [ha;hb;hc] |> List.map(fun hwnd -> hwnd,zIndex hwnd)
+ check (order |> List.forall(fun (_,z) -> zIndex strip < z))
+ (sprintf "A window is over the tabs after the empty pane opened: strip=%d %A" (zIndex strip) order)
+ check (zIndex hb < zIndex ha && zIndex hb < zIndex hc) (sprintf "The left pane is not over the tabs behind it: %A" order)
+ // A click raises the app by Windows' own doing; the tabs, owned by nothing, come back over it.
+ let target = visible hb
+ click (target.x+target.width/2) (target.y+target.height/2)
+ waitOperation()
+ check (zIndex strip < zIndex hb) (sprintf "After a click on the left pane its window is over the tabs: strip=%d B=%d" (zIndex strip) (zIndex hb))
+ // Inside the title bars too the tabs span the whole group, over the left pane's buttons.
+ let tabs,leftPane = bounds strip,visible hb
+ printfn "METRIC tabs-inside-split strip=%A left=%A" tabs leftPane
+ check (tabs.x>=leftPane.x-Dpi.scale 2 && tabs.right>leftPane.right)
+ (sprintf "Inside the title bars the tabs keep to the left pane: strip=%A left=%A" tabs leftPane)
+
+ // A window on a character grid never takes its pane's exact width: the split goes on, with
+ // no message, and the panes do not shrink step by step chasing its rounding.
+ onGroup(fun group -> group.execute(EndSplit None))
+ waitOperation()
+ // A window coming into a split moves in smoothly: for a moment a cover over the group
+ // moves the windows' images to their panes, and goes once the windows are in place.
+ do
+ let frame = onGroup(fun group -> group.layoutFrame)
+ let pid = Process.GetCurrentProcess().Id
+ // The cover lies over the group with the tab strip cut out of it: inside the frame and
+ // most of it, not the whole frame once the tabs sit inside the window.
+ let covers () =
+ os.windowsInZorder.list |> List.exists(fun window ->
+ let mutable owner = 0
+ WinUserApi.GetWindowThreadProcessId(window.hwnd,&owner) |> ignore
+ let bounds = window.bounds
+ owner=pid && window.isVisible && frame.completlyContains bounds &&
+ int64 bounds.width*int64 bounds.height*2L>int64 frame.width*int64 frame.height &&
+ (WinUserApi.GetWindowLong(window.hwnd,WindowLongFieldOffset.GWL_EXSTYLE).ToInt64() &&& int64 WindowsExtendedStyles.WS_EX_TOPMOST)<>0L)
+ onGroup(fun group -> group.execute(SplitWith(hc,SideBySide),current=ha))
+ check (covers()) "No cover moved the windows into the new split"
+ let gone = timeUntil 3000 (fun () -> not(covers()))
+ printfn "METRIC split-transition cover-gone-after=%A" gone
+ check gone.IsSome "The cover over a new split stayed after its windows were in place"
+ waitOperation()
+ // Panes changing places move over smoothly too, and so does the window kept when the
+ // split ends, growing to the whole group while the other fades.
+ onGroup(fun group -> group.execute(Swap None))
+ check (covers()) "No cover moved the panes as they swapped"
+ check (timeUntil 3000 (fun () -> not(covers()))).IsSome "The cover over swapped panes stayed"
+ waitOperation()
+ onGroup(fun group -> group.execute(EndSplit(Some ha)))
+ check (covers()) "No cover moved the window kept as the split ended"
+ let ended = timeUntil 3000 (fun () -> not(covers()))
+ printfn "METRIC split-end-transition cover-gone-after=%A" ended
+ check ended.IsSome "The cover over an ended split stayed"
+ waitOperation()
+ check (visible ha=frame) (sprintf "The window kept did not fill the group after the split ended: %A of %A" (visible ha) frame)
+ // While a tab is dragged the layout changes at once, with no cover: the transition's
+ // start, on the thread the drag runs on, paused the drag.
+ onGroup(fun group -> group.transitionsPaused <- true; group.execute(SplitWith(hc,SideBySide),current=ha))
+ check (not(covers())) "A split started during a tab drag put a cover over the group"
+ waitOperation()
+ onGroup(fun group -> group.transitionsPaused <- false; group.execute(EndSplit(Some ha)))
+ waitOperation()
+ // A tab clicked over the panes parks them under a cover with no steps, and the panes
+ // come back the same way: placed with no cover, the tab rose pane-sized with the
+ // desktop showing round it. The cover is counted rather than looked for: it can come
+ // and go within the placement of two small windows.
+ onGroup(fun group -> group.execute(SplitWith(hc,SideBySide),current=ha))
+ waitOperation()
+ let coversShown () = onGroup(fun group -> (typeof.GetFields(flags) |> Array.find(fun field -> field.Name="coversShown")).GetValue(group) :?> int)
+ let before = coversShown()
+ onGroup(fun group -> group.tabActivate(Tab hb,false))
+ check (coversShown()>before) "No cover hid the tab clicked over the panes"
+ check (timeUntil 3000 (fun () -> not(covers()))).IsSome "The cover over a parked split stayed"
+ waitOperation()
+ check (onGroup(fun group -> match group.layout with Parked _ -> true | _ -> false) && visible hb=frame) "The tab clicked over the panes did not park them and fill the group"
+ let before = coversShown()
+ onGroup(fun group -> group.tabActivate(Tab ha,false))
+ check (coversShown()>before) "No cover hid the panes coming back from behind the tab"
+ check (timeUntil 3000 (fun () -> not(covers()))).IsSome "The cover over the panes coming back stayed"
+ waitOperation()
+ check (onGroup(fun group -> group.splitLayout.IsSome)) "The panes did not come back"
+ // With no split, a switch to another tab fades the window shown into the next.
+ onGroup(fun group -> group.execute(EndSplit(Some ha)))
+ waitOperation()
+ let before = coversShown()
+ onGroup(fun group -> group.tabActivate(Tab hb,false))
+ check (coversShown()>before) "A switch between tabs did not fade one into the other"
+ check (timeUntil 2000 (fun () -> not(covers()))).IsSome "The fade between tabs stayed"
+ waitOperation()
+ check (onGroup(fun group -> group.topWindow=hb && group.splitLayout.IsNone)) "The switch between tabs did not bring the tab up"
+ onGroup(fun group -> group.tabActivate(Tab ha,false))
+ waitOperation()
+ onGroup(fun group -> group.execute(SplitWith(hc,SideBySide),current=ha))
+ waitOperation()
+ onGroup(fun group -> group.execute(EndSplit(Some ha)))
+ waitOperation()
+ onHelper(fun () -> a.Grid <- 17)
+ onGroup(fun group -> group.execute(SplitWith(hc,SideBySide),current=ha))
+ pump 3000
+ let early = onGroup(fun group -> group.splitLayout.IsSome),(visible ha).width,(visible hc).width
+ pump 1500
+ let late = onGroup(fun group -> group.splitLayout.IsSome),(visible ha).width,(visible hc).width
+ printfn "METRIC grid-app early=%A late=%A" early late
+ check (let still,_,_ = late in still) "A window on a character grid ended the split"
+ check (early=late) (sprintf "The panes kept resizing beside a window on a character grid: %A then %A" early late)
+ onHelper(fun () -> a.Grid <- 0)
+
+ // Beside a window of another process, slow to resize as Explorer is: the empty pane's own
+ // drag must not wait for that process. A second group keeps it apart from A, B and C.
+ onGroup(fun group -> group.execute(EndSplit None))
+ waitOperation()
+ let script =
+ "Add-Type -AssemblyName System.Windows.Forms;" +
+ "$f=New-Object System.Windows.Forms.Form;$f.Text='Split External';$f.ShowInTaskbar=$false;" +
+ "$f.FormBorderStyle='SizableToolWindow';$f.StartPosition='Manual';$f.BackColor='DarkSlateGray';" +
+ "$f.Location=New-Object System.Drawing.Point(-20000,-20000);" +
+ "$f.add_Resize({Start-Sleep -Milliseconds 40});[System.Windows.Forms.Application]::Run($f)"
+ use external = Process.Start(ProcessStartInfo("powershell.exe","-NoProfile -Command \""+script+"\"",UseShellExecute=false,CreateNoWindow=true))
+ try
+ let mutable hx = IntPtr.Zero
+ // Not in the taskbar, so it is no main window of its process: found by its title.
+ pumpUntil "The other process's window did not open" (fun () ->
+ hx <- Native.FindWindow(null,"Split External")
+ hx<>IntPtr.Zero && WinUserApi.IsWindowVisible(hx))
+ let other = (desktop :> IDesktop).createGroup(false) :?> GroupInfo
+ let onOther action =
+ let mutable result = None
+ other.invokeGroup(fun () -> result <- Some(try Choice1Of2(action other.group) with e -> Choice2Of2 e))
+ pumpUntil "The second group did not answer" (fun () -> result.IsSome)
+ match result.Value with Choice1Of2 value -> value | Choice2Of2 error -> raise error
+ os.windowFromHwnd(hx).move(Rect(Pt(frame.X,frame.Y),Sz(frame.Width,frame.Height)))
+ (other :> IGroup).addWindow(hx,false)
+ pumpUntil "The other process's window did not join" (fun () -> onOther(fun group -> group.windows.count=1))
+ let settle() =
+ pumpUntil "The second group did not settle" (fun () -> onOther(fun group -> group.isPlacementIdle))
+ pump 300
+ settle()
+ onOther(fun group -> group.execute(NewEmptyPane SideBySide,current=hx))
+ settle()
+ let pane = onOther(fun group -> group.emptyPaneHwnds |> List.tryHead |> Option.defaultValue IntPtr.Zero)
+ check (pane<>IntPtr.Zero) "No empty pane beside the other process's window"
+ let besideOther () = near (visible hx).right (bounds pane).left && near (visible hx).top (bounds pane).top
+ check (besideOther()) (sprintf "The empty pane does not meet the other process's window: %A %A" (visible hx) (bounds pane))
+ // As in use: the app is clicked first, which raises it, and then the pane's edge dragged.
+ let app = visible hx
+ click (app.x+app.width/2) (app.y+app.height/2)
+ settle()
+ let rect = bounds pane
+ let grab = POINT(rect.left+Dpi.scale 5,rect.y+rect.height/2)
+ // The app's invisible resize border reaches over the pane's edge: the pane must be on top
+ // of it, or the drag takes the slow app's own edge instead.
+ let taken = WinUserApi.WindowFromPoint grab
+ let dividerHere = onOther(fun group ->
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="splitDividers")
+ (field.GetValue(group) :?> Map).TryFind [] |> Option.map snd |> Option.defaultValue IntPtr.Zero)
+ check (zIndex pane < zIndex hx && (taken=pane || taken=dividerHere))
+ (sprintf "The empty pane's edge is under the other process's window: pane=%d other=%d, pointer on %A" (zIndex pane) (zIndex hx) taken)
+ drag "cross-process-inner-edge" (rect.left+Dpi.scale 5) (rect.y+rect.height/2) (-160) 0 16 (fun () -> bounds pane) besideOther
+ settle()
+ check (besideOther()) "After the drag the empty pane does not meet the other process's window"
+ let rect = bounds pane
+ drag "cross-process-top-edge" (rect.x+rect.width/2) (rect.top+Dpi.scale 3) 0 (-60) 12 (fun () -> bounds pane) besideOther
+ settle()
+ check (besideOther()) "After the top-edge drag the empty pane does not meet the other process's window"
+ // Both panes windows of other processes, as Explorer beside Notepad: the divider keeps up
+ // with the pointer and the panes follow it.
+ let script2 = script.Replace("Split External","Split External Two").Replace("Start-Sleep -Milliseconds 40","")
+ use external2 = Process.Start(ProcessStartInfo("powershell.exe","-NoProfile -Command \""+script2+"\"",UseShellExecute=false,CreateNoWindow=true))
+ try
+ let mutable hy = IntPtr.Zero
+ pumpUntil "The second process's window did not open" (fun () ->
+ hy <- Native.FindWindow(null,"Split External Two")
+ hy<>IntPtr.Zero && WinUserApi.IsWindowVisible(hy))
+ onOther(fun group -> group.dropTab(hy,FillEmpty [Second],hx))
+ settle()
+ let meet () = near (visible hx).right (visible hy).left && near (visible hx).top (visible hy).top
+ check (meet()) (sprintf "The second process's window did not take the pane: %A %A" (visible hx) (visible hy))
+ let divider = onOther(fun group ->
+ let field = typeof.GetFields(flags) |> Array.find(fun field -> field.Name="splitDividers")
+ snd (field.GetValue(group) :?> Map).[[]])
+ let app = visible hy
+ click (app.x+app.width/2) (app.y+app.height/2)
+ settle()
+ let band = bounds divider
+ let seam = (visible hx).right
+ drag "cross-process-divider" (band.x+band.width/2) (band.y+band.height/2) 150 0 15 (fun () -> bounds divider) meet
+ settle()
+ check (abs((visible hx).right-seam-150)<=Dpi.scale 10 && meet()) (sprintf "The divider between two other processes went %d, not about 150" ((visible hx).right-seam))
+ // Again with the slow app in focus, so the tabs belong to it.
+ let app = visible hx
+ click (app.x+app.width/2) (app.y+app.height/2)
+ settle()
+ let band = bounds divider
+ drag "cross-process-divider-slow-focused" (band.x+band.width/2) (band.y+band.height/2) (-150) 0 15 (fun () -> bounds divider) meet
+ settle()
+ check (meet()) "After the divider drag beside the focused slow app the panes do not meet"
+ // As fast as a real pointer reports, about every 1.5ms: the divider keeps up with it.
+ // A ratio sent at every move piled up faster than the group placed them, and the
+ // divider trailed the pointer by seconds.
+ do
+ let band = bounds divider
+ let x,y = band.x+band.width/2,band.y+band.height/2
+ moveTo x y
+ pump 120
+ down()
+ pump 80
+ let start = (bounds divider).x
+ let steps,dx = 300,200
+ let mutable worst = 0
+ for step in 1..steps do
+ moveTo (x+dx*step/steps) y
+ let spin = Stopwatch.StartNew()
+ while spin.Elapsed.TotalMilliseconds < 1.5 do ()
+ if step%10=0 then worst <- max worst (abs(dx*step/steps-((bounds divider).x-start)))
+ let caught = timeUntil 3000 (fun () -> abs((bounds divider).x-start-dx)<=3)
+ up()
+ printfn "METRIC cross-process-divider-fast worst-behind=%dpx caught-up=%A" worst caught
+ check (worst Option.exists(fun ms -> ms<150.0)) (sprintf "Dragged fast, the divider reached the pointer only after %A ms" caught)
+ settle()
+ check (meet()) "After a fast divider drag the panes do not meet"
+ // A window joining with the focus, as a tab dragged here has from its drag, from
+ // outside the panes parks them and fills the group, as choosing its tab does. Placed
+ // as a tab behind, it waited under the panes with the focus.
+ do
+ onGroup(fun group -> group.removeWindow hc)
+ settle()
+ // Below the panes, where nothing of either group lies, so the click reaches it.
+ let spot = Rect(Pt(frame.X,frame.Bottom+10),Sz(300,140))
+ let joining = os.windowFromHwnd(hc)
+ joining.showWindow(ShowWindowCommands.SW_SHOWNORMAL)
+ joining.move(spot)
+ joining.raise()
+ pump 100
+ click (spot.x+spot.width/2) (spot.y+spot.height/2)
+ pumpUntil (sprintf "The joining window did not take the focus: visible=%b minimized=%b at %A z=%d, foreground %A" (WinUserApi.IsWindowVisible hc) joining.isMinimized (visible hc) (zIndex hc) (WinUserApi.GetForegroundWindow()))
+ (fun () -> WinUserApi.GetForegroundWindow()=hc)
+ let otherFrame = onOther(fun group -> group.layoutFrame)
+ (other :> IGroup).addWindow(hc,false)
+ pumpUntil "The joining window did not join" (fun () -> onOther(fun group -> group.windows.contains hc))
+ settle()
+ check (onOther(fun group -> (match group.layout with Parked _ -> true | _ -> false) && group.topWindow=hc))
+ (sprintf "A window joining with the focus did not park the panes: %A" (onOther(fun group -> group.layout)))
+ check (visible hc=otherFrame && zIndex hc < zIndex hx && zIndex hc < zIndex hy)
+ (sprintf "The joining window is not shown over the panes at the group's frame: %A, frame %A" (visible hc) otherFrame)
+ onOther(fun group -> group.removeWindow hc)
+ settle()
+ onOther(fun group -> group.execute FocusOther)
+ settle()
+ check (meet()) "The panes did not come back after the joined window left"
+ onOther(fun group -> group.removeWindow hy)
+ settle()
+ finally
+ if not external2.HasExited then external2.Kill()
+ onOther(fun group -> group.execute(EndSplit None))
+ settle()
+ onOther(fun group -> group.removeWindow hx)
+ (other :> IGroup).destroy()
+ finally
+ if not external.HasExited then external.Kill()
+ printfn "PASS: empty pane frame, edges and stacking; window and divider drags with live following; tabs over both panes after clicks; beside another process."
+ finally
+ try onGroup(fun group -> group.execute(EndSplit None)) with _ -> ()
+ pump 300
+ for hwnd in [ha;hb;hc] do (try onGroup(fun group -> group.removeWindow hwnd) with _ -> ())
+ (try (info :> IGroup).destroy() with _ -> ())
+ (try onHelper(fun () -> for form in forms do form.Close()) with _ -> ())
+ Environment.CurrentDirectory <- original
+TestInit.run main
diff --git a/tests/TabInteraction.fsx b/tests/TabInteraction.fsx
index 030df844..617ead3e 100644
--- a/tests/TabInteraction.fsx
+++ b/tests/TabInteraction.fsx
@@ -39,6 +39,34 @@ let main() =
try
use settings = new Settings(true,saveDelay=0)
let api = settings :> ISettings
+ // The topmost cover leaves live tabs visible and follows their native geometry.
+ do
+ let frame = Rect(Pt(-1200,100),Sz(600,400))
+ use strip = new Form(FormBorderStyle=FormBorderStyle.None,ShowInTaskbar=false,
+ StartPosition=FormStartPosition.Manual)
+ strip.Bounds <- Rectangle(-1100,100,300,30)
+ strip.Show()
+ use cover = new SplitTransition(frame,[],durationMs=5000,strip=strip.Handle)
+ check (cover.start()) "Transition fixture did not start"
+ try
+ let clearAt (x:int) (y:int) = not(cover.Bounds.Contains(Point(frame.x+x,frame.y+y)))
+ check (clearAt 150 15 && not(clearAt 150 100)) "Transition covered the top tabs or cut away the app"
+ for bounds,x,y in [Rectangle(-1200,130,90,300),40,100; Rectangle(-690,130,90,300),550,100] do
+ strip.Bounds <- bounds
+ let watch = Diagnostics.Stopwatch.StartNew()
+ while not(clearAt x y) && watch.ElapsedMilliseconds<1500L do
+ Application.DoEvents()
+ Threading.Thread.Sleep(5)
+ check (clearAt x y && not(clearAt 150 15)) "Transition did not follow the strip to its side dock"
+ strip.Hide()
+ let watch = Diagnostics.Stopwatch.StartNew()
+ while clearAt 550 100 && watch.ElapsedMilliseconds<1500L do
+ Application.DoEvents()
+ Threading.Thread.Sleep(5)
+ check (not(clearAt 550 100)) "A hidden strip left a hole in the transition"
+ finally
+ cover.close()
+ Application.DoEvents()
use sideFull = new Bitmap(220,120)
use sideBar = new Bitmap(4,120)
for y in 0..119 do
@@ -328,6 +356,20 @@ let main() =
check (not repeat && held.handle(WindowMessages.WM_KEYDOWN,vk,None)=(true,None)) "Held leader key leaked or activated twice after switching focus"
check (held.handle(WindowMessages.WM_KEYUP,vk,None)=(true,None)) "Leader selection release leaked"
check (held.handle(WindowMessages.WM_KEYDOWN,vk,None)=(false,None)) "A fresh press remained captured after release"
+ // Esc beside an empty pane closes it and goes no further, its release and its repeats
+ // with it; with a modifier held, or with no empty pane, it passes through.
+ do
+ let escape = EmptyPaneEscape()
+ let closed = ref 0
+ let pane present () = (if present then closed.Value <- closed.Value+1); present
+ let down,up = WindowMessages.WM_KEYDOWN,WindowMessages.WM_KEYUP
+ check (escape.handle(down,0x1B,false,pane true) && closed.Value=1) "Esc beside an empty pane did not close it"
+ check (escape.handle(down,0x1B,false,pane true) && closed.Value=1) "A held Esc closed again or reached the app"
+ check (escape.handle(up,0x1B,false,pane true)) "The release of the Esc that closed an empty pane reached the app"
+ check (not(escape.handle(down,0x1B,false,pane false)) && not(escape.handle(up,0x1B,false,pane false))) "Esc with no empty pane was taken"
+ check (not(escape.handle(down,0x1B,true,pane true)) && closed.Value=1) "Esc with a modifier closed an empty pane"
+ check (not(escape.handle(up,0x1B,true,pane true))) "The release of an Esc let through was taken"
+ check (not(escape.handle(down,0x41,false,pane true)) && closed.Value=1) "Another key closed an empty pane"
check (NumberLeaderKeys.tryNormalize "asdfghjkl;"=Some "ASDFGHJKL;") "Home-row keys did not normalize"
for value in ["";"AA";"aA";"A A";"ä¸æ–‡";"!"] do
check ((NumberLeaderKeys.tryNormalize value).IsNone) "Invalid or duplicate selection keys were accepted"
@@ -376,6 +418,9 @@ let main() =
strip.dimmed <- true
let dimmedSprite = snd strip.tabSprites.head
check (frames strip>brightFrames) "Dimming an inactive group did not repaint it"
+ let dimmedFrames = frames strip
+ for _ in 1..10 do strip.dimmed <- true
+ check (frames strip=dimmedFrames) "Repeated inactive notifications repainted the whole strip"
if not SystemInformation.HighContrast then
let dim = pixels()
check (dim.Length=bright.Length && Array.forall2(fun (a:Color) (b:Color) -> a.A=b.A) dim bright) "Inactive group became transparent"
@@ -385,6 +430,8 @@ let main() =
strip.dimmed <- false
check ((snd strip.tabSprites.head).fillColor=originalFill) "Reactivating a group did not restore its colours"
let selectionFrames = frames strip
+ for _ in 1..10 do strip.dimmed <- false
+ check (frames strip=selectionFrames) "Switching within an active group repainted unchanged dimming"
let order = strip.zorder
strip.setTabBgColor(order.head,None)
strip.zorder <- List2(order.list)
diff --git a/tests/TabShadow.fsx b/tests/TabShadow.fsx
index bdbe9a29..37eddfbc 100644
--- a/tests/TabShadow.fsx
+++ b/tests/TabShadow.fsx
@@ -103,7 +103,7 @@ let main () =
tabBorderColor=Color.FromArgb(168,168,168) }
let info text : TabDisplayInfo = {
tint=None; colorStyle="Stripe"; numberBadge=None; bgColor=None; text=text; icon=SystemIcons.Application
- textFont=SystemFonts.MenuFont; textBrush=Brushes.Black }
+ textFont=SystemFonts.MenuFont; textBrush=Brushes.Black; splitTrail=None }
let ts : TabStripSprite = {
tabs=Map2(List2([1,info "Active tab"; 2,info "Another window"]))
lorder=List2([1;2]); zorder=List2([1;2]); size=Sz(420,28)
@@ -286,7 +286,7 @@ let main () =
for h in [12;18;26] do
use font = TabMetrics.font h FontStyle.Regular
check (font.Height <= max h (SystemFonts.MenuFont.Height)) (sprintf "Text line does not fit a %dpx tab" h)
- let info text : TabDisplayInfo = { tint=None; colorStyle="Stripe"; numberBadge=None; bgColor=None; text=text; icon=SystemIcons.Application; textFont=font; textBrush=Brushes.Black }
+ let info text : TabDisplayInfo = { tint=None; colorStyle="Stripe"; numberBadge=None; bgColor=None; text=text; icon=SystemIcons.Application; textFont=font; textBrush=Brushes.Black; splitTrail=None }
let strip = { ts with appearance={ appearance with tabHeight=h }; size=Sz(420,h+1)
tabs=Map2(List2([1,info "Active tab"; 2,info "Another window"])) }
for _,tab in strip.sprite.children.list do
diff --git a/tests/TaskbarPreview.fsx b/tests/TaskbarPreview.fsx
index 540a39b1..3e965200 100644
--- a/tests/TaskbarPreview.fsx
+++ b/tests/TaskbarPreview.fsx
@@ -203,8 +203,10 @@ let main() =
(capped :> IDisposable).Dispose()
WinUserApi.DestroyIcon(hugeHandle) |> ignore
check (width = 64) (sprintf "A 256 pixel app icon made a %d pixel taskbar icon" width)
- // A group of several apps keeps the front app's icon whole and shows the next app's icon in
- // the bottom right corner, set apart by a one pixel clear ring.
+ // A group of several apps keeps the main app's icon at its full size, the other apps small
+ // along the bottom right, the last at the right edge, each after the first behind the one
+ // before with about a third showing, one clear ring round the row, so every app in
+ // the group can be told. One in the corner showed only the second.
do
use blue = new Bitmap(32,32)
do
@@ -215,16 +217,29 @@ let main() =
let stacked = new TaskbarBadgedIcon(app,[other])
use pixels = stacked.icon.ToBitmap()
let isOther (c:Color) = c.A=255uy && c.B>190uy && c.R<10uy && c.G<10uy
- check (pixels.Width=32 && isAppColour(pixels.GetPixel(2,2)) && isAppColour(pixels.GetPixel(29,2)) && isAppColour(pixels.GetPixel(2,29)))
- "The front app's icon is not shown at full size"
- check (isOther(pixels.GetPixel(25,25)) && isOther(pixels.GetPixel(30,30)) && isAppColour(pixels.GetPixel(16,16))) "The other app's icon is not in the bottom right corner"
- check (pixels.GetPixel(17,26).A=0uy && pixels.GetPixel(26,17).A=0uy) "No clear ring parts the corner icon from the front one"
- check (isAppColour(pixels.GetPixel(16,26)) && isAppColour(pixels.GetPixel(26,16)) && isOther(pixels.GetPixel(20,20))) "The ring round the corner icon is wider than a pixel"
- // Further apps add nothing: the corner holds one icon and the front one stays clear.
- let more = new TaskbarBadgedIcon(app,[other;other;other])
+ // Two apps: the other one 14 pixels square in the corner, a clear ring round it.
+ check (pixels.Width=32 && [4,4;28,4;4,28;12,12;28,12] |> List.forall(fun (x,y) -> isAppColour(pixels.GetPixel(x,y))))
+ "The main app's icon is not at its full size"
+ check (isOther(pixels.GetPixel(24,24)) && isOther(pixels.GetPixel(30,30))) "The other app's icon is not at the bottom right"
+ // An icon drawn on nothing sits on a plate of its own: the main icon does not show through it.
+ do
+ use clear = new Bitmap(32,32)
+ let clearHandle = clear.GetHicon()
+ use seeThrough = Icon.FromHandle(clearHandle)
+ let plated = new TaskbarBadgedIcon(app,[seeThrough])
+ use platedPixels = plated.icon.ToBitmap()
+ let under = platedPixels.GetPixel(24,24)
+ check (under.A=255uy && not(isAppColour under)) (sprintf "A see-through app icon in the corner had no plate under it: %A" under)
+ (plated :> IDisposable).Dispose()
+ WinUserApi.DestroyIcon(clearHandle) |> ignore
+ check (pixels.GetPixel(17,25).A=0uy && pixels.GetPixel(25,17).A=0uy) "No clear ring parts the other app's icon from the main one"
+ // Four apps: three along the bottom right, the first whole and each after it showing a third.
+ let more = new TaskbarBadgedIcon(app,[other;other;other;other])
use morePixels = more.icon.ToBitmap()
- check (more.stacked.Length = TaskbarBadgedIcon.maxStacked) "More app icons were kept than the taskbar icon shows"
- check (isAppColour(morePixels.GetPixel(16,22)) && isAppColour(morePixels.GetPixel(22,16))) "Further apps covered the front app's icon"
+ check (more.stacked.Length=3 && more.stacked.Length=TaskbarBadgedIcon.maxStacked) "The taskbar icon did not keep three other apps"
+ check (isAppColour(morePixels.GetPixel(4,25)) && isAppColour(morePixels.GetPixel(16,10))) "The other apps covered more than the bottom right of the main app's icon"
+ check ([9;20;24;29] |> List.forall(fun x -> isOther(morePixels.GetPixel(x,25))) && morePixels.GetPixel(7,25).A=0uy && morePixels.GetPixel(25,17).A=0uy)
+ "The other apps do not line up along the bottom right with one ring round the row"
(more :> IDisposable).Dispose()
(stacked :> IDisposable).Dispose()
WinUserApi.DestroyIcon(blueHandle) |> ignore
diff --git a/tests/TestInit.fsx b/tests/TestInit.fsx
index 5c70e040..a67f5665 100644
--- a/tests/TestInit.fsx
+++ b/tests/TestInit.fsx
@@ -13,6 +13,9 @@ printfn "TEST_APPLICATION_ASSEMBLY=%s" typeof.Assembly.Locatio
Bemo.ThemeService.moveSystemEventsOffMainThread()
// Initialize visual styles before Application.Run initializes WinForms DPI state.
Application.EnableVisualStyles()
+// The same opt-in as Bootstrap.main: fail where a debugger would stop at a control
+// touched from a thread not its own.
+if Environment.GetEnvironmentVariable("WINDOWTABS_CHECK_THREADS")="1" then Control.CheckForIllegalCrossThreadCalls <- true
/// ToolStrip dropdowns install a hosted WH_GETMESSAGE hook when MessageLoop is
/// false. DoEvents alone does not establish a WinForms message loop; that hook