From 6f4a95eb4686528fb451609417df45472941617e Mon Sep 17 00:00:00 2001 From: Marko Andjelic Date: Sat, 11 Jul 2026 19:22:19 +0100 Subject: [PATCH] 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