fix search crash bug
This commit is contained in:
parent
9f9e59b450
commit
6f4a95eb46
1 changed files with 44 additions and 18 deletions
62
app/UI.hs
62
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue