app/UI.hs

@@ -156,38 +156,22 @@ 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 _ _ -> do
+  _ <- on keyCtrl #keyPressed $ \keyval _ _ ->
-    -- The controller is in capture phase, so it sees keys before the focused
+    case keyval of
-    -- search box. While the user is typing a query, let every key through
+      Gdk.KEY_Right -> dispatch NextPage >> pure True
-    -- untouched (otherwise letters like `p`/`f` fire commands and the arrows
+      Gdk.KEY_Left -> dispatch PrevPage >> pure True
-    -- page the view — the latter crashes in scrolling mode via `turnPage`).
+      Gdk.KEY_Page_Down -> dispatch NextChapter >> pure True
-    searching <- searchFocused ctx
+      Gdk.KEY_Page_Up -> dispatch PrevChapter >> pure True
-    if searching
+      Gdk.KEY_equal -> dispatch ZoomIn >> pure True
-      then pure False
+      Gdk.KEY_minus -> dispatch ZoomOut >> pure True
-      else case keyval of
+      Gdk.KEY_p -> dispatch ToggleMode >> pure True
-        Gdk.KEY_Right -> dispatch NextPage >> pure True
+      Gdk.KEY_f -> dispatch SearchFocus >> pure True
-        Gdk.KEY_Left -> dispatch PrevPage >> pure True
+      _ -> pure False
-        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
@@ -201,14 +185,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)) >> snapPagination ctx >> pure True
+      Gdk.KEY_Escape -> Gtk.setEditableText entry "" >> WebKit.findControllerSearchFinish fc >> Gtk.widgetGrabFocus (appWebView (ctxWidgets 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 >> snapPagination ctx
+      then WebKit.findControllerSearchFinish fc
       else WebKit.findControllerSearch fc q findOpts maxBound
   let runfwd = runSearch ctx nextMatch
   _ <- on entry #activate $ runfwd -- pressing enter while having search text
@@ -226,7 +210,6 @@ wireEvents ctx = do
     case drop (fromIntegral i) (displayRows (stRefs st) (stToc st)) of
       (Row _ _ idx frag : _) -> dispatch (GoToChapter idx frag)
       [] -> pure ()
-
   pure ()
 
 --------------------------------------------------------------------------------
@@ -333,16 +316,10 @@ 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)
-    -- `turnPage` only exists in Paginated mode (it's injected by `pageScript`).
+    NextPage -> evalJSBool wv "turnPage(1)" $ \moved ->
-    -- In Scrolling mode there's nothing to page within, so move by chapter.
+      unless moved $ goto ctx (stIndex st + 1) StartTop
-    NextPage -> case stMode st of
+    PrevPage -> evalJSBool wv "turnPage(-1)" $ \moved ->
-      Paginated -> evalJSBool wv "turnPage(1)" $ \moved ->
+      unless moved $ goto ctx (stIndex st - 1) StartLast
-        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 }
@@ -525,36 +502,13 @@ wrapHtml (Html body) start mode =
       let safe = T.filter (\c -> c /= '"' && c /= '\\') f
        in "<script>var el=document.getElementById(\"" <> safe <> "\");if(el)goToPage(Math.floor(el.offsetLeft/window.innerWidth));</script>"
 
-
--- | 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)
   (Just $ \_ res -> do
-      -- A JS runtime error makes `...Finish` throw; treat that as `False`
+      val <- WebKit.webViewEvaluateJavascriptFinish wv res
-      -- rather than letting the exception abort the whole program.
+      b <- JSC.valueToBoolean val
-      r <- try (WebKit.webViewEvaluateJavascriptFinish wv res >>= JSC.valueToBoolean)
+      k b)
-      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