spike 0.2 → 0.3

raw patch · 5 files changed

+42/−14 lines, 5 filesdep ~global-variablesdep ~rosezipper

Dependency ranges changed: global-variables, rosezipper

Files

• spike.cabal +3/−3
• src/BrowseTreeOperations.hs +11/−4
• src/NotebookSimple.hs +3/−3
• src/VisualBrowseTree.hs +1/−1
• src/spike.hs +24/−3

@@ -1,5 +1,5 @@ Name:                spike-Version:             0.2+Version:             0.3 Synopsis:            Experimental web browser Description:         Experimental web browser based on WebKit-Gtk+ License:             BSD3@@ -23,8 +23,8 @@                      Commands, BrowseTreeOperations   Hs-source-dirs:    src   Build-depends:     webkit == 0.12.*, containers, gtk, base == 4.*, -                     stm, mtl > 2, rosezipper, process, directory, -                     filepath, glib, random, global-variables+                     stm, mtl > 2, rosezipper == 0.2.*, process, directory, +                     filepath, glib, random, global-variables == 1.0.*   Ghc-options:       -rtsopts   C-sources:         cbits/cbits.c   pkgconfig-depends: libsoup-gnome-2.4

@@ -201,14 +201,15 @@   widgetShowAll page    let ww = (thisWidget,web)-      newChildPage = do+      newChildPageDefault = newChildPage "http://google.com"+      newChildPage url = do         print "[newChildPage called]"         btree <- readTVarIO btreeSt         debugBTree btree         case findPageWidget btree thisWidget of           Just p -> do-            ww' <- newWeb btreeSt refreshLayout "about:blank"-            p' <- newPage ww' "about:blank" -- TODO: win the battle over the power to navigate the web view.+            ww' <- newWeb btreeSt refreshLayout url+            p' <- newPage ww' url -- TODO: win the battle over the power to navigate the web view.             let btree' = addChild btree p p'             atomically $ writeTVar btreeSt btree'             refreshLayout@@ -216,7 +217,13 @@           Nothing -> do             error "findPageWidget returned Nothing, can't provide a new window" -  hookupWebView web newChildPage+  -- TODO: handle this more efficiently+  registerListener (\ (NewChildPageCommand pid url) -> do+                          p <- findPageByView pgWidget thisWidget+                          when ((fmap pgIdent p) == Just pid) (newChildPage url >> return ())+                   )++  hookupWebView web newChildPageDefault    return ww 

@@ -28,10 +28,10 @@ newScrolledWindowWithViewPort :: WidgetClass child => child -> IO ScrolledWindow newScrolledWindowWithViewPort child = do   sw <- scrolledWindowNew Nothing Nothing-  scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic+  scrolledWindowSetPolicy sw PolicyAlways PolicyNever   scrolledWindowAddWithViewport sw child   (wx,wy) <- widgetGetSizeRequest child-  widgetSetSizeRequest sw (wx+5) (wy+5)+  widgetSetSizeRequest sw (wx+5) (wy+40)   return sw  notebookSimpleNew :: (Page -> IO ()) -> IO NotebookSimple@@ -40,7 +40,7 @@   contentBox <- hBoxNew False 1   vbox <- vBoxNew False 1 -  widgetSetSizeRequest buttonsBox (-1) 40+  widgetSetSizeRequest buttonsBox (-1) 10    (\sw -> boxPackStart vbox sw PackNatural 1) =<< newScrolledWindowWithViewPort buttonsBox   boxPackStart vbox contentBox PackGrow 1

@@ -54,7 +54,7 @@        btreeZip = concatMap flattenToZipper' btree' -- ellipsis t 15       labels = unlines [ printf "d%d [URL=\"%s\", shape=polygon, fixedsize=true, fontsize=8, width=1.25, height=0.25, tooltip=\"%s\", label=\"%s\"];"-                                i link t (ellipsis t 10) | (i,(t,link)) <- map label btreeZip ]+                                i link t (ellipsis t 18) | (i,(t,link)) <- map label btreeZip ]       edges = unlines [ printf "d%d -> d%d;" (fst . label . fromJust . parent $ z ) (fst . label $ z)                             | z <- btreeZip,                               parent z /= Nothing]

@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports, FlexibleInstances, DoRec, ForeignFunctionInterface #-} module Main where  import Graphics.UI.Gtk@@ -14,6 +13,7 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Monad+import Control.Monad.Trans (liftIO)  import Data.IORef import Data.Maybe@@ -74,8 +74,8 @@  siblingsNotebookSimple <- notebookSimpleNew (\p -> do { fun <- readIORef viewPageRef; fun p}) :: IO NotebookSimple  childrenBox <- hBoxNew False 1  :: IO HBox - widgetSetSizeRequest parentsBox (-1) 40- widgetSetSizeRequest childrenBox (-1) 40+ widgetSetSizeRequest parentsBox (-1) 10+ widgetSetSizeRequest childrenBox (-1) 10   inside <- vBoxNew False 1  (\sw -> boxPackStart inside sw PackNatural 1) =<< newScrolledWindowWithViewPort parentsBox@@ -146,6 +146,27 @@               containerChild := inside,               windowAllowGrow := True ]  widgetShowAll window++ -- global shortcuts+ window `on` keyPressEvent $ do+         evM <- eventModifier+         evN <- (keyName . keyvalToLower) `fmap` eventKeyVal+         +         liftIO $ print (evM, evN)++         let newChildPage = liftIO $ do+               bt <- readTVarIO btreeVar+               cp <- readTVarIO currentPage+               case getPageParent bt cp of+                 Nothing -> sendCommand (NewTopLevelPageCommand "http://google.com")+                 Just par -> sendCommand (NewChildPageCommand (pgIdent $ rootLabel par) "http://google.com")++             newTopLevel = liftIO $ sendCommand (NewTopLevelPageCommand "http://google.com")++         case (evM, evN) of+           ([Control],"t") -> newChildPage >> return True+           ([Control],"n") -> newTopLevel >> return True+           _ -> return False   -- tree view window  visualBrowseTreeWindow viewPage btreeVar