manatee-browser 0.0.8 → 0.1.0
raw patch · 8 files changed
+132/−52 lines, 8 filesdep +binarydep +derivedep −gtk-serialized-eventdep ~manatee-coresetup-changedbinary-added
Dependencies added: binary, derive
Dependencies removed: gtk-serialized-event
Dependency ranges changed: manatee-core
Files
- Main.hs +1/−1
- Manatee/Extension/Browser.hs +1/−1
- Manatee/Extension/Browser/BrowserBuffer.hs +30/−1
- Manatee/Extension/Browser/BrowserView.hs +77/−39
- Manatee/Extension/Browser/PageMode.hs +1/−1
- Setup.hs +13/−3
- data/welcome/snapshot.png binary
- manatee-browser.cabal +9/−6
Main.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by
Manatee/Extension/Browser.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by
Manatee/Extension/Browser/BrowserBuffer.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by@@ -17,15 +17,20 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-} module Manatee.Extension.Browser.BrowserBuffer where import Control.Applicative import Control.Concurrent.STM import DBus.Client hiding (Signal)+import Data.Binary+import Data.DeriveTH import Data.Typeable+import Manatee.Core.Config import Manatee.Core.DBus import Manatee.Core.Types import Manatee.Extension.Browser.PageMode+import Manatee.Toolkit.General.STM import Manatee.Toolkit.Gtk.Concurrent data BrowserBuffer =@@ -34,13 +39,22 @@ ,browserBufferPageId :: PageId ,browserBufferMode :: PageMode ,browserBufferBroadcastChannel :: TChan BrowserBufferSignal+ ,browserBufferState :: TVar BrowserState } deriving Typeable +data BrowserState =+ BrowserState {browserStateScrolledPosition :: (Double, Double)}+ data BrowserBufferSignal = SyncUri String | SyncTitle String deriving (Show, Eq, Ord) +-- | Init state.+browserInitState :: BrowserState+browserInitState =+ BrowserState (0, 0)+ -- | New browser buffer. browserBufferNew :: String -> [String] -> Client -> PageId -> CustomizeWrap -> IO BrowserBuffer browserBufferNew uri _ client pageId _ = do@@ -51,6 +65,7 @@ <*> pure pageId <*> pure browserMode <*> (newTChanIO :: IO (TChan BrowserBufferSignal))+ <*> newTVarIO browserInitState -- Listen broadcast channel. browserBufferListenChannel buffer@@ -72,3 +87,17 @@ SyncTitle title -> -- Synchronization tab title. mkDaemonSignal client ChangeTabName (ChangeTabNameArgs (pageModeName mode) pageId title)++-- | Write state.+browserBufferWriteState :: BrowserBuffer -> FilePath -> IO ()+browserBufferWriteState buffer path = do+ state <- readTVarIO $ browserBufferState buffer+ writeConfigPath path state++-- | Read state.+browserBufferReadState :: BrowserBuffer -> FilePath -> IO () +browserBufferReadState buffer path = do+ state <- readConfigPath path browserInitState+ writeTVarIO (browserBufferState buffer) state+ +$(derive makeBinary ''BrowserState)
Manatee/Extension/Browser/BrowserView.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by@@ -29,16 +29,15 @@ import Data.Text.Lazy (Text) import Data.Typeable import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)-import Graphics.UI.Gtk.Gdk.SerializedEvent import Graphics.UI.Gtk.WebKit.Download import Graphics.UI.Gtk.WebKit.WebFrame+import Graphics.UI.Gtk.WebKit.WebResource import Graphics.UI.Gtk.WebKit.WebSettings import Graphics.UI.Gtk.WebKit.WebView-import Graphics.UI.Gtk.WebKit.WebResource+import Manatee.Core.Config import Manatee.Core.DBus import Manatee.Core.PageFrame import Manatee.Core.PageView-import Manatee.Core.Config import Manatee.Core.Types import Manatee.Extension.Browser.BrowserBuffer import Manatee.Toolkit.General.Basic@@ -46,8 +45,8 @@ import Manatee.Toolkit.General.Map import Manatee.Toolkit.General.Maybe import Manatee.Toolkit.General.STM-import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Gtk.Concurrent+import Manatee.Toolkit.Gtk.ScrolledWindow import Paths_manatee_browser import System.FilePath @@ -72,15 +71,20 @@ pageBufferPackageName _ = fmap takeFileName getDataDir instance PageView BrowserView where- pageViewBuffer = PageBufferWrap . browserViewBuffer- pageViewPlugId = browserViewPlugId- pageViewBox = pageFrameBox . browserViewFrame- pageViewScrolledWindow = browserViewScrolledWindow- pageViewFocus = widgetGrabFocus . browserViewView- pageViewCut = browserViewCut- pageViewCopy = browserViewCopy- pageViewPaste = browserViewPaste- pageViewHandleKeyAction = browserViewHandleKeyAction+ pageViewBuffer = PageBufferWrap . browserViewBuffer+ pageViewPlugId = browserViewPlugId+ pageViewFrame = browserViewFrame+ pageViewCut = browserViewCut+ pageViewCopy = browserViewCopy+ pageViewPaste = browserViewPaste+ pageViewLocalKeymap _ = browserViewLocalKeymap+ pageViewLocalCommandMap _ = browserViewLocalCommandMap+ pageViewFocus = widgetGrabFocus . browserViewView + pageViewPropagateWidget = castToWidget . browserViewView+ pageViewSaveState view = browserViewSaveState view Nothing+ pageViewRestoreState view = browserViewRestoreState view Nothing+ pageViewWriteState view path = browserViewSaveState view (Just path)+ pageViewReadState view path = browserViewRestoreState view (Just path) -- | New browser view. browserViewNew :: BrowserBuffer -> PagePlugId -> IO BrowserView @@ -122,23 +126,23 @@ -- Display link over mouse. webView `on` hoveringOverLink $ \ _ mouseUri -> mouseUri ?>= \ uri -> - pageFrameShowOutputbar (browserViewFrame browserView) uri (Just (browserViewStatusLengthLimit browserView))+ pageViewShowOutputbar browserView uri (Just (browserViewStatusLengthLimit browserView)) -- Display resource request status. webView `on` resourceRequestStarting $ \ _ resource _ _ -> do -- Get request uri. uri <- webResourceGetUri resource- pageFrameShowOutputbar (browserViewFrame browserView) uri (Just (browserViewStatusLengthLimit browserView))+ pageViewShowOutputbar browserView uri (Just (browserViewStatusLengthLimit browserView)) webView `on` progressChanged $ \ progress ->- pageFrameUpdateProgress (browserViewFrame browserView) (i2d progress)+ pageViewUpdateProgress browserView (i2d progress) -- Download request signal. webView `on` downloadRequested $ \ download -> do downloadGetUri download >?>= \url -> do -- Print downloading message.- pageFrameShowOutputbar (browserViewFrame browserView) ("Downloading " ++ url) Nothing+ pageViewShowOutputbar browserView ("Downloading " ++ url) Nothing -- Send download request to download manager. ifM (isBusNameExist $ packGenericBusName "curl") -- Send DBus signal if curl process exit.@@ -152,24 +156,30 @@ return browserView --- | Handle key action.-browserViewHandleKeyAction :: BrowserView -> Text -> SerializedEvent -> IO ()-browserViewHandleKeyAction view keystoke sEvent = - case M.lookup keystoke browserViewKeymap of- Just action -> action view- Nothing -> widgetPropagateEvent (browserViewView view) sEvent+-- -- | Handle key action.+-- | Local keymap.+browserViewLocalKeymap :: Map Text Text+browserViewLocalKeymap =+ M.fromList + [("M-r", "Reload")+ ,("M-R", "Reload pass cache")+ ,("XF86Back", "Go back")+ ,("XF86Forward", "Go forward")+ ,("M-,", "Go back")+ ,("M-.", "Go forward")+ ,("M--", "Zoom out")+ ,("M-=", "Zoom in")+ ] -- | Keymap.-browserViewKeymap :: Map Text (BrowserView -> IO ())-browserViewKeymap = - M.fromList [("M-r", browserViewReload)- ,("M-R", browserViewReloadBypassCache)- ,("XF86Back", browserViewGoBack)- ,("XF86Forward", browserViewGoForward)- ,("M-,", browserViewGoBack)- ,("M-.", browserViewGoForward)- ,("M--", browserViewZoomOut)- ,("M-=", browserViewZoomIn)+browserViewLocalCommandMap :: Map Text (BrowserView -> IO ())+browserViewLocalCommandMap = + M.fromList [("Reload", browserViewReload)+ ,("Reload pass cache", browserViewReloadBypassCache)+ ,("Go back", browserViewGoBack)+ ,("Go forward", browserViewGoForward)+ ,("Zoom out", browserViewZoomOut)+ ,("Zoom in", browserViewZoomIn) ] -- | New tab.@@ -258,7 +268,7 @@ browserViewCut view@ (BrowserView {browserViewView = webView}) = do ifM (webViewCanCutClipboard webView) (webViewCutClipboard webView)- (pageFrameShowOutputbar (browserViewFrame view) "Can't cut." Nothing)+ (pageViewShowOutputbar view "Can't cut." Nothing) return True -- | Browser copy.@@ -266,7 +276,7 @@ browserViewCopy view@ (BrowserView {browserViewView = webView}) = do ifM (webViewCanCopyClipboard webView) (webViewCopyClipboard webView)- (pageFrameShowOutputbar (browserViewFrame view) "Can't copy." Nothing)+ (pageViewShowOutputbar view "Can't copy." Nothing) return True -- | Browser paste.@@ -274,10 +284,38 @@ browserViewPaste view@ (BrowserView {browserViewView = webView}) = do ifM (webViewCanPasteClipboard webView) (webViewPasteClipboard webView)- (pageFrameShowOutputbar (browserViewFrame view) "Can't paste." Nothing)+ (pageViewShowOutputbar view "Can't paste." Nothing) return True --- | Browser scrolled window. -browserViewScrolledWindow :: BrowserView -> ScrolledWindow +-- | Scrolled window.+browserViewScrolledWindow :: BrowserView -> ScrolledWindow browserViewScrolledWindow = pageFrameScrolledWindow . browserViewFrame++-- | Save state.+browserViewSaveState :: BrowserView -> Maybe FilePath -> IO ()+browserViewSaveState view@(BrowserView {browserViewBuffer = buffer}) + statePath = do+ -- Get scroll position.+ scrolledWindowPosition <- scrolledWindowGetValue (browserViewScrolledWindow view)++ -- Save state.+ let state = BrowserState scrolledWindowPosition+ case statePath of+ Nothing -> writeTVarIO (browserBufferState buffer) state+ Just path -> writeConfigPath path state ++-- | Restore state.+browserViewRestoreState :: BrowserView -> Maybe FilePath -> IO ()+browserViewRestoreState view@(BrowserView {browserViewBuffer = buffer})+ statePath = do+ -- TODO, I think it's need some web technology to restore web page's position.+ -- Just set scrolledWindow's position can't work.+ bufferState <- readTVarIO (browserBufferState buffer)+ (BrowserState scrolledWindowPosition) <- + case statePath of+ Just path -> readConfigPath path bufferState+ Nothing -> return bufferState++ -- Restore scroll position.+ scrolledWindowSetValue (browserViewScrolledWindow view) scrolledWindowPosition
Manatee/Extension/Browser/PageMode.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by
Setup.hs view
@@ -1,7 +1,7 @@ -- Author: Andy Stewart <lazycat.manatee@gmail.com> -- Maintainer: Andy Stewart <lazycat.manatee@gmail.com> -- --- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by@@ -19,6 +19,7 @@ import Distribution.Simple import Manatee.Core.Config import Manatee.Core.Types+import Manatee.Toolkit.Cabal.Utils import Manatee.Toolkit.General.List import Manatee.Toolkit.General.Map import Manatee.Extension.Browser.PageMode@@ -28,7 +29,7 @@ main = defaultMainWithHooks simpleUserHooks { -- Update Rule after install successful.- postInst = \ _ _ _ _ -> do+ postInst = \ _ _ pack_des lbi -> do -- Update PageTypeRule. (PageTypeRule typeRule) <- readConfig pageTypeRulePath (PageTypeRule M.empty) writeConfig pageTypeRulePath (PageTypeRule (M.insert "PageBrowser" "manatee-browser" typeRule))@@ -52,5 +53,14 @@ -- Update ExtensionGloalKeymap. (ExtensionGloalKeymap keymap) <- readConfig extensionGlobalKeymapPath (ExtensionGloalKeymap M.empty) writeConfig extensionGlobalKeymapPath (ExtensionGloalKeymap- (M.insert "F5" ("PageBrowser", "http://www.google.com", []) keymap))+ (M.insert "F5" ("Browser", + ("PageBrowser", "http://www.google.com", [])) keymap))+ -- Update Application info.+ let snapshotPath = getDataFilePath pack_des lbi "data/welcome/snapshot.png"+ (WelcomeApplication apps) <- readConfig welcomeApplicationPath (WelcomeApplication M.empty)+ writeConfig welcomeApplicationPath (WelcomeApplication+ (M.insert + ("Web browser", snapshotPath)+ ("PageBrowser", "http://www.google.com", [])+ apps)) }
+ data/welcome/snapshot.png view
binary file changed (absent → 965999 bytes)
manatee-browser.cabal view
@@ -1,13 +1,13 @@ name: manatee-browser-version: 0.0.8+version: 0.1.0 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE-copyright: (c) 2009 ~ 2010 Andy Stewart+copyright: (c) 2010 ~ 2011 Andy Stewart synopsis: Browser extension for Manatee. description: manatee-browser is WebKit browser extension for Manatee (Haskell/Gtk+ Integrated Live Environment) .- Video at (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html>+ Video (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html> . Screenshots at : <http://goo.gl/MkVw> .@@ -22,16 +22,19 @@ stability: provisional category: Manatee, Browser, Network -tested-with: GHC==6.12.3+tested-with: GHC==7.0.2 build-type: Custom +data-dir: ""+data-files: data/welcome/snapshot.png+ Source-Repository head type: darcs location: http://patch-tag.com/r/AndyStewart/manatee-browser Library- build-depends: base >= 4 && < 5, manatee-core >= 0.0.8, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0,- containers >= 0.3.0.0, webkit >= 0.12.0, gtk-serialized-event >= 0.12.0, gtk >= 0.12.0,+ build-depends: base >= 4 && < 5, manatee-core >= 0.1.0, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0,+ containers >= 0.3.0.0, webkit >= 0.12.0, gtk >= 0.12.0, derive, binary, text >= 0.7.1.0, mtl >= 1.1.0.2, utf8-string, filepath exposed-modules: Manatee.Extension.Browser