Selkie.git | t/ | 111-focus-ancestor-eligibility.rakutest

---

use Test;
use lib 'lib';

use Selkie::App;
use Selkie::App::Internal::FocusTree;
use Selkie::App::Internal::ScreenModalLifecycle;
use Selkie::Container;
use Selkie::Sizing;
use Selkie::Test::Store;
use Selkie::Widget;
use Selkie::Widget::Border;
use Selkie::Widget::Button;
use Selkie::Widget::Modal;

# Focus eligibility is an ANCESTOR question, not a per-widget one.
#
# `disabled` is how apps switch a whole region off, and in practice
# only the region's own container (or just its border) carries the
# flag — the controls inside it keep `disabled` at False. A rule that
# asked the focused widget alone would leave focus sitting inside a
# switched-off region: arrows and Enter reach a control the user can
# neither see nor act on, while global chords keep working. That is an
# input wedge, and it looks exactly like a hung app.
#
# This file pins the whole contract: the predicate itself, the Tab
# cycle, the per-frame invariant, per-screen focus memory, and the
# focus restored when a modal closes.

# Tiny container stub — same pattern as t/focus-invariant.rakutest.
class TestContainer does Selkie::Container {
    method render() { self!render-children; self.clear-dirty }
}

# A container whose focusable-descendants override does NOT prune
# disabled subtrees. Third-party containers are free to write their own
# traversal, and the framework cannot assume they remembered the skip —
# App's own eligibility filter is what makes the rule hold anyway.
class NaiveContainer does Selkie::Container {
    method render() { self!render-children; self.clear-dirty }
    method focusable-descendants(--> Seq) {
        gather {
            for self.children -> $child {
                take $child if $child.focusable;
                if $child ~~ Selkie::Container {
                    .take for $child.focusable-descendants;
                }
            }
        }
    }
}

# Stand-in for the App's screen surface: FocusTree only ever asks a
# screen manager for its focusable descendants and its active root.
class StubScreens {
    has $.root is rw;
    method focusable-descendants(--> Seq) {
        $!root.defined ?? $!root.focusable-descendants !! ().Seq;
    }
    method active-root() { $!root }
}

# FocusTree driven without notcurses. Everything the role reaches for
# outside itself is supplied here; the focus logic under test is the
# role's own.
class FocusHarness does Selkie::App::Internal::FocusTree {
    has $.store;
    has StubScreens $.screens .= new;

    method screen-manager() { $!screens }
    method store() { $!store }
    method focused() { self!focused-widget }
    method focus-eligible($w) { Selkie::App.focus-eligible($w) }

    method !active-modal() { Selkie::Widget }

    method focus($w --> Nil) {
        return if $w.defined && !self.focus-eligible($w);
        self!focus-widget($w);
    }
    method first-focusable-for-test() { self!first-focusable }
    method cycle-for-test(Int $d --> Nil) { self!do-focus-cycle($d) }
    method check-invariant-for-test(--> Nil) { self!check-focus-invariant }
    method remember-for-test($name, $root --> Nil) {
        self!remember-screen-focus($name, $root);
    }
    method restore-for-test($name, $root --> Nil) {
        self!restore-screen-focus($name, $root);
    }
}

# FocusTree plus the modal lifecycle, for the close-modal restore path.
# The modal stack is pushed directly rather than through `!show-modal`,
# which needs a terminal.
class ModalHarness does Selkie::App::Internal::FocusTree
                   does Selkie::App::Internal::ScreenModalLifecycle {
    has $.store;

    method screen-manager() { self!screen-manager }
    method root() { self!active-root }
    method store() { $!store }
    method focused() { self!focused-widget }
    method focus-eligible($w) { Selkie::App.focus-eligible($w) }
    method widget-attached($w, $root) { self!widget-attached-to($w, $root) }

    method focus($w --> Nil) {
        return if $w.defined && !self.focus-eligible($w);
        self!focus-widget($w);
    }

    method !mark-all-images-dirty(--> Nil) { }
    method !mark-all-dirty($w --> Nil) { }

    method push-modal-for-test($modal, $restore --> Nil) {
        @!modal-stack.push($modal);
        @!pre-modal-focus-stack.push($restore);
    }
    method close-modal-for-test(--> Nil) { self!close-modal }
}

plan 8;

subtest "focus-eligible walks the ancestor chain" => {
    plan 9;

    my $root = TestContainer.new;
    my $pane = TestContainer.new;
    my $deep = TestContainer.new;
    my $btn  = Selkie::Widget::Button.new(label => 'save');
    $root.add($pane);
    $pane.add($deep);
    $deep.add($btn);

    ok Selkie::App.focus-eligible($btn),
        'a widget in an all-enabled chain is eligible';
    nok Selkie::App.focus-eligible(Selkie::Widget),
        'an undefined widget is never eligible';

    $btn.set-disabled(True);
    nok Selkie::App.focus-eligible($btn), 'its own disabled flag rules it out';
    $btn.set-disabled(False);
    ok Selkie::App.focus-eligible($btn), 'and clearing the flag restores it';

    $deep.set-disabled(True);
    nok Selkie::App.focus-eligible($btn),
        'a disabled immediate parent rules it out';
    $deep.set-disabled(False);

    $root.set-disabled(True);
    nok Selkie::App.focus-eligible($btn),
        'a disabled root two levels up rules it out';
    nok Selkie::App.focus-eligible($pane),
        'and so does every widget between it and the root';
    $root.set-disabled(False);
    ok Selkie::App.focus-eligible($btn),
        're-enabling the ancestor makes the whole subtree eligible again';

    my $orphan = Selkie::Widget::Button.new(label => 'detached');
    ok Selkie::App.focus-eligible($orphan),
        'a widget with no parent at all is eligible — eligibility is not attachment';
};

subtest "focus() refuses a target inside a disabled subtree" => {
    plan 4;

    my $root = TestContainer.new;
    my $pane = TestContainer.new;
    my $a = Selkie::Widget::Button.new(label => 'A');
    my $b = Selkie::Widget::Button.new(label => 'B');
    $root.add($a);
    $root.add($pane);
    $pane.add($b);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;

    $h.focus($a);
    is $h.focused.label, 'A', 'preconditions: focus is on A';

    $pane.set-disabled(True);
    $h.focus($b);
    is $h.focused.label, 'A',
        'focusing into a disabled pane is a no-op — focus stays where it was';

    $pane.set-disabled(False);
    $h.focus($b);
    is $h.focused.label, 'B', 'the same call is accepted once the pane is live';

    ok $b.is-focused, 'and the widget itself was told it has focus';
};

subtest "the Tab cycle only lands on eligible widgets" => {
    plan 6;

    # A container that hands back its children without pruning disabled
    # subtrees: the App-level filter has to hold the line on its own.
    my $root = NaiveContainer.new;
    my $a    = Selkie::Widget::Button.new(label => 'A');
    my $pane = NaiveContainer.new;
    my $b    = Selkie::Widget::Button.new(label => 'B');
    my $c    = Selkie::Widget::Button.new(label => 'C');
    $root.add($a);
    $root.add($pane);
    $pane.add($b);
    $root.add($c);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;

    is $root.focusable-descendants.List.map(*.label).join(','), 'A,B,C',
        'preconditions: the naive walk really does yield all three';

    $pane.set-disabled(True);
    is $h.first-focusable-for-test.label, 'A',
        'first-focusable skips nothing while the first candidate is live';

    $h.focus($a);
    $h.cycle-for-test(1);
    is $h.focused.label, 'C',
        'Tab jumps over B, which sits inside the disabled pane';

    $h.cycle-for-test(1);
    is $h.focused.label, 'A', 'and wraps around the shortened cycle';

    $h.cycle-for-test(-1);
    is $h.focused.label, 'C', 'Shift-Tab honours the same filter';

    # Everything switched off: no eligible target anywhere.
    $root.set-disabled(True);
    nok $h.first-focusable-for-test.defined,
        'a fully disabled surface has no first-focusable';
};

subtest "a disabled Border evicts focus from the content it frames" => {
    plan 3;

    # The reported shape: a collapsible pane switches itself off by
    # disabling its border, and leaves the content widget's own flag
    # alone. Border.focusable-descendants asks about its CONTENT, so
    # this subtree stays in the Tab cycle unless the App-level rule
    # looks upward.
    my $root   = NaiveContainer.new;
    my $keep   = Selkie::Widget::Button.new(label => 'elsewhere');
    my $border = Selkie::Widget::Border.new(sizing => Sizing.flex);
    my $inner  = Selkie::Widget::Button.new(label => 'in-pane');
    $border.set-content($inner);
    $root.add($keep);
    $root.add($border);

    $border.set-disabled(True);
    is $border.focusable-descendants.List.map(*.label).join(','), 'in-pane',
        'preconditions: a disabled Border still offers its enabled content';
    $border.set-disabled(False);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;
    $h.focus($inner);
    is $h.focused.label, 'in-pane', 'preconditions: focus is inside the pane';

    $border.set-disabled(True);
    $h.check-invariant-for-test;
    is $h.focused.label, 'elsewhere',
        'the per-frame invariant re-homes focus out of the disabled pane';
};

subtest "the per-frame invariant re-homes on an ancestor disable" => {
    plan 6;

    my $root = TestContainer.new;
    my $a    = Selkie::Widget::Button.new(label => 'A');
    my $pane = TestContainer.new;
    my $b    = Selkie::Widget::Button.new(label => 'B');
    $root.add($a);
    $root.add($pane);
    $pane.add($b);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;
    $h.focus($b);
    is $h.focused.label, 'B', 'preconditions: focus is on B, inside the pane';

    $h.check-invariant-for-test;
    is $h.focused.label, 'B', 'a healthy focus is left exactly where it is';

    # Only the PANE is disabled; B's own flag stays False, which is
    # what the pre-fix check looked at.
    $pane.set-disabled(True);
    nok $b.disabled, 'preconditions: the focused widget itself is not disabled';

    $h.check-invariant-for-test;
    is $h.focused.label, 'A', 'focus is re-homed to the first eligible widget';

    # And the original reason the guard exists still works. Note that
    # `remove` destroys the child without clearing its `parent`, so the
    # removed subtree still walks up to the live root — it is the
    # is-destroyed half of the rule that catches this, not attachment.
    $pane.set-disabled(False);
    $h.focus($b);
    $root.remove($pane);
    ok $b.is-destroyed, 'preconditions: removal destroyed the focused widget';
    $h.check-invariant-for-test;
    is $h.focused.label, 'A', 'a removed focus is still re-homed';
};

subtest "the invariant leaves focus alone when nothing is eligible" => {
    plan 2;

    my $root = TestContainer.new;
    my $only = Selkie::Widget::Button.new(label => 'only');
    $root.add($only);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;
    $h.focus($only);
    is $h.focused.label, 'only', 'preconditions: focus is on the only control';

    $root.set-disabled(True);
    $h.check-invariant-for-test;
    nok $h.focused.defined,
        'with no eligible target anywhere, focus clears rather than staying stale';
};

subtest "per-screen focus memory re-validates before restoring" => {
    plan 3;

    my $root = TestContainer.new;
    my $a    = Selkie::Widget::Button.new(label => 'A');
    my $pane = TestContainer.new;
    my $b    = Selkie::Widget::Button.new(label => 'B');
    $root.add($a);
    $root.add($pane);
    $pane.add($b);

    my $h = FocusHarness.new(store => mock-store());
    $h.screens.root = $root;

    $h.focus($b);
    $h.remember-for-test('main', $root);
    $h.focus($a);
    $h.restore-for-test('main', $root);
    is $h.focused.label, 'B', 'a still-eligible memory is restored';

    $h.remember-for-test('main', $root);
    $pane.set-disabled(True);
    $h.focus($a);
    $h.restore-for-test('main', $root);
    is $h.focused.label, 'A',
        'a memory that became ineligible falls back to first-focusable';

    $pane.set-disabled(False);
    $h.restore-for-test('main', $root);
    is $h.focused.label, 'A',
        'and the stale memory was dropped rather than resurrected later';
};

subtest "closing a modal restores focus only to an eligible target" => {
    plan 3;

    my $root = TestContainer.new;
    my $a    = Selkie::Widget::Button.new(label => 'A');
    my $pane = TestContainer.new;
    my $b    = Selkie::Widget::Button.new(label => 'B');
    $root.add($a);
    $root.add($pane);
    $pane.add($b);

    my $h = ModalHarness.new(store => mock-store());
    $h.screen-manager.add-screen('main', $root);
    $h.screen-manager.switch-to('main');

    # Modal opens over a focused B, then closes with nothing changed.
    $h.focus($b);
    $h.push-modal-for-test(
        Selkie::Widget::Modal.new(
            content => Selkie::Widget::Button.new(label => 'ok')),
        $b);
    $h.close-modal-for-test;
    is $h.focused.label, 'B', 'an untouched pre-modal focus is restored';

    # Same again, but the pane behind the modal is switched off while
    # the modal is up — the restore target is no longer reachable.
    $h.focus($b);
    $h.push-modal-for-test(
        Selkie::Widget::Modal.new(
            content => Selkie::Widget::Button.new(label => 'ok')),
        $b);
    $pane.set-disabled(True);
    $h.close-modal-for-test;
    is $h.focused.label, 'A',
        'a pre-modal focus that became ineligible falls back to first-focusable';

    # A detached restore target keeps behaving as it always did.
    $pane.set-disabled(False);
    $h.focus($a);
    my $stray = Selkie::Widget::Button.new(label => 'stray');
    $h.push-modal-for-test(
        Selkie::Widget::Modal.new(
            content => Selkie::Widget::Button.new(label => 'ok')),
        $stray);
    $h.close-modal-for-test;
    is $h.focused.label, 'A',
        'a restore target outside the live tree falls back too';
};