diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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 diff --git a/Manatee/Extension/Browser.hs b/Manatee/Extension/Browser.hs --- a/Manatee/Extension/Browser.hs +++ b/Manatee/Extension/Browser.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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 diff --git a/Manatee/Extension/Browser/BrowserBuffer.hs b/Manatee/Extension/Browser/BrowserBuffer.hs --- a/Manatee/Extension/Browser/BrowserBuffer.hs +++ b/Manatee/Extension/Browser/BrowserBuffer.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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 . {-# 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) diff --git a/Manatee/Extension/Browser/BrowserView.hs b/Manatee/Extension/Browser/BrowserView.hs --- a/Manatee/Extension/Browser/BrowserView.hs +++ b/Manatee/Extension/Browser/BrowserView.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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 diff --git a/Manatee/Extension/Browser/PageMode.hs b/Manatee/Extension/Browser/PageMode.hs --- a/Manatee/Extension/Browser/PageMode.hs +++ b/Manatee/Extension/Browser/PageMode.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,7 +1,7 @@ -- Author: Andy Stewart -- Maintainer: Andy Stewart -- --- 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)) } diff --git a/data/welcome/snapshot.png b/data/welcome/snapshot.png new file mode 100644 Binary files /dev/null and b/data/welcome/snapshot.png differ diff --git a/manatee-browser.cabal b/manatee-browser.cabal --- a/manatee-browser.cabal +++ b/manatee-browser.cabal @@ -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 : + Video (Select 720p HD) at : . Screenshots at : . @@ -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