From 6f4a95eb4686528fb451609417df45472941617e Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Sat, 11 Jul 2026 19:22:19 +0100 Subject: [PATCH 1/2] fix search crash bug --- app/UI.hs | 62 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 44 insertions(+), 18 deletions(-) diff --git a/app/UI.hs b/app/UI.hs index 358e8f3..26cb21e 100644 --- a/app/UI.hs +++ b/app/UI.hs @@ -156,22 +156,38 @@ populateSidebar sidebar = -- Events -------------------------------------------------------------------------------- +-- | Delegates focus to an internal @GtkText@, so the window's focus widget +-- is a descendant of the entry. +searchFocused :: Ctx -> IO Bool +searchFocused ctx = do + mfocus <- Gtk.windowGetFocus (appWindow (ctxWidgets ctx)) + case mfocus of + Nothing -> pure False + Just f -> Gtk.widgetIsAncestor f (appSearch (ctxWidgets ctx)) + wireEvents :: Ctx -> IO () wireEvents ctx = do let dispatch = handleAction ctx keyCtrl <- Gtk.eventControllerKeyNew Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture - _ <- on keyCtrl #keyPressed $ \keyval _ _ -> - case keyval of - Gdk.KEY_Right -> dispatch NextPage >> pure True - Gdk.KEY_Left -> dispatch PrevPage >> pure True - Gdk.KEY_Page_Down -> dispatch NextChapter >> pure True - Gdk.KEY_Page_Up -> dispatch PrevChapter >> pure True - Gdk.KEY_equal -> dispatch ZoomIn >> pure True - Gdk.KEY_minus -> dispatch ZoomOut >> pure True - Gdk.KEY_p -> dispatch ToggleMode >> pure True - Gdk.KEY_f -> dispatch SearchFocus >> pure True - _ -> pure False + _ <- on keyCtrl #keyPressed $ \keyval _ _ -> do + -- The controller is in capture phase, so it sees keys before the focused + -- search box. While the user is typing a query, let every key through + -- untouched (otherwise letters like `p`/`f` fire commands and the arrows + -- page the view — the latter crashes in scrolling mode via `turnPage`). + searching <- searchFocused ctx + if searching + then pure False + else case keyval of + Gdk.KEY_Right -> dispatch NextPage >> pure True + Gdk.KEY_Left -> dispatch PrevPage >> pure True + Gdk.KEY_Page_Down -> dispatch NextChapter >> pure True + Gdk.KEY_Page_Up -> dispatch PrevChapter >> pure True + Gdk.KEY_equal -> dispatch ZoomIn >> pure True + Gdk.KEY_minus -> dispatch ZoomOut >> pure True + Gdk.KEY_p -> dispatch ToggleMode >> pure True + Gdk.KEY_f -> dispatch SearchFocus >> pure True + _ -> pure False Gtk.widgetAddController (appWindow (ctxWidgets ctx)) keyCtrl _ <- on (appFileBttn (ctxWidgets ctx)) #clicked $ epPicker (Just (appWindow (ctxWidgets ctx))) ctx @@ -210,6 +226,7 @@ wireEvents ctx = do case drop (fromIntegral i) (displayRows (stRefs st) (stToc st)) of (Row _ _ idx frag : _) -> dispatch (GoToChapter idx frag) [] -> pure () + pure () -------------------------------------------------------------------------------- @@ -316,10 +333,16 @@ handleAction ctx action = do NextChapter -> goto ctx (stIndex st + 1) StartTop PrevChapter -> goto ctx (stIndex st - 1) StartTop GoToChapter i frag -> goto ctx i (startOfFrag frag) - NextPage -> evalJSBool wv "turnPage(1)" $ \moved -> - unless moved $ goto ctx (stIndex st + 1) StartTop - PrevPage -> evalJSBool wv "turnPage(-1)" $ \moved -> - unless moved $ goto ctx (stIndex st - 1) StartLast + -- `turnPage` only exists in Paginated mode (it's injected by `pageScript`). + -- In Scrolling mode there's nothing to page within, so move by chapter. + NextPage -> case stMode st of + Paginated -> evalJSBool wv "turnPage(1)" $ \moved -> + unless moved $ goto ctx (stIndex st + 1) StartTop + Scrolling -> goto ctx (stIndex st + 1) StartTop + PrevPage -> case stMode st of + Paginated -> evalJSBool wv "turnPage(-1)" $ \moved -> + unless moved $ goto ctx (stIndex st - 1) StartLast + Scrolling -> goto ctx (stIndex st - 1) StartTop ToggleMode -> do let newMode = if stMode st == Paginated then Scrolling else Paginated atomically $ modifyTVar' (ctxState ctx) $ \s -> s { stMode = newMode } @@ -506,9 +529,12 @@ evalJSBool :: WebKit.WebView -> T.Text -> (Bool -> IO ()) -> IO () evalJSBool wv src k = WebKit.webViewEvaluateJavascript wv src (-1) Nothing Nothing (Nothing :: Maybe Gio.Cancellable) (Just $ \_ res -> do - val <- WebKit.webViewEvaluateJavascriptFinish wv res - b <- JSC.valueToBoolean val - k b) + -- A JS runtime error makes `...Finish` throw; treat that as `False` + -- rather than letting the exception abort the whole program. + r <- try (WebKit.webViewEvaluateJavascriptFinish wv res >>= JSC.valueToBoolean) + case r of + Right b -> k b + Left (_ :: SomeException) -> k False) chaptersMatching :: T.Text -> M.Map ChapterIndex PlainText -> [ChapterIndex] chaptersMatching q = map fst . filter (matches q . snd) . M.toAscList From 1f2a14c5f369dfc7660de2e52596faf6df11d442 Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Sat, 11 Jul 2026 19:36:09 +0100 Subject: [PATCH 2/2] add snap when finishing search --- app/UI.hs | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/app/UI.hs b/app/UI.hs index 26cb21e..4b4f609 100644 --- a/app/UI.hs +++ b/app/UI.hs @@ -201,14 +201,14 @@ wireEvents ctx = do case keyval of Gdk.KEY_Down -> WebKit.findControllerSearchNext fc >> pure True Gdk.KEY_Up -> WebKit.findControllerSearchPrevious fc >> pure True - Gdk.KEY_Escape -> Gtk.setEditableText entry "" >> WebKit.findControllerSearchFinish fc >> Gtk.widgetGrabFocus (appWebView (ctxWidgets ctx)) >> pure True + Gdk.KEY_Escape -> Gtk.setEditableText entry "" >> WebKit.findControllerSearchFinish fc >> Gtk.widgetGrabFocus (appWebView (ctxWidgets ctx)) >> snapPagination ctx >> pure True _ -> pure False Gtk.widgetAddController entry searchKeys _ <- on entry #searchChanged $ do q <- Gtk.editableGetText entry if T.null q - then WebKit.findControllerSearchFinish fc + then WebKit.findControllerSearchFinish fc >> snapPagination ctx else WebKit.findControllerSearch fc q findOpts maxBound let runfwd = runSearch ctx nextMatch _ <- on entry #activate $ runfwd -- pressing enter while having search text @@ -525,6 +525,26 @@ wrapHtml (Html body) start mode = let safe = T.filter (\c -> c /= '"' && c /= '\\') f in "" + +-- | Re-align the paginated view after an in-page find. WebKit reveals a match +-- by scrolling the (multi-column) layout, which leaves the transform-based +-- pager out of sync so several half-pages show at once once the search ends. +-- Reset the scroll offset back to zero and re-apply the current page transform. +-- No-op in scrolling mode, which scrolls natively and needs no fix-up. +snapPagination :: Ctx -> IO () +snapPagination ctx = do + mode <- getMode ctx + when (mode == Paginated) $ + evalJSBool + (appWebView (ctxWidgets ctx)) + ( T.concat + [ "var d=document.documentElement,b=document.body;", + "d.scrollLeft=0;d.scrollTop=0;if(b){b.scrollLeft=0;b.scrollTop=0;}", + "window.scrollTo(0,0);if(typeof apply==='function'){apply();}true" + ] + ) + (\_ -> pure ()) + evalJSBool :: WebKit.WebView -> T.Text -> (Bool -> IO ()) -> IO () evalJSBool wv src k = WebKit.webViewEvaluateJavascript wv src (-1) Nothing Nothing (Nothing :: Maybe Gio.Cancellable)