diff --git a/Config/Curl.hs b/Config/Curl.hs --- a/Config/Curl.hs +++ b/Config/Curl.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/Config/Default.hs b/Config/Default.hs --- a/Config/Default.hs +++ b/Config/Default.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/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/Curl.hs b/Manatee/Extension/Curl.hs --- a/Manatee/Extension/Curl.hs +++ b/Manatee/Extension/Curl.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/Curl/CurlBuffer.hs b/Manatee/Extension/Curl/CurlBuffer.hs --- a/Manatee/Extension/Curl/CurlBuffer.hs +++ b/Manatee/Extension/Curl/CurlBuffer.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 @@ -18,6 +18,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} +{-# LANGUAGE TemplateHaskell #-} module Manatee.Extension.Curl.CurlBuffer where import Config.Import @@ -27,14 +28,13 @@ import Control.Monad import DBus.Client hiding (Signal) import Data.Binary +import Data.DeriveTH import Data.List import Data.Map (Map) import Data.Maybe import Data.Typeable import Foreign -import Graphics.UI.Gtk.General.Enums -import Graphics.UI.Gtk.General.General -import Graphics.UI.Gtk.ModelView.TreeSortable +import Graphics.UI.Gtk hiding (get) import Manatee.Core.Config import Manatee.Core.DBus import Manatee.Core.Dynload @@ -77,9 +77,15 @@ ,curlBufferMode :: PageMode ,curlBufferBroadcastChannel :: TChan CurlTChanSignal ,curlBufferCustomize :: CurlCustomize + ,curlBufferState :: TVar CurlState } deriving Typeable +data CurlState = + CurlState {curlStateSelectedPath :: (Maybe TreePath) + ,curlStateScrolledPosition :: (Double, Double) + } + data CurlTChanSignal = AddDownload DownloadFile | DeleteDownload String | UpdateStatus @@ -178,6 +184,11 @@ defaultCacheDir = "download/cache" +-- | Init state. +curlInitState :: CurlState +curlInitState = + CurlState Nothing (0, 0) + -- | New. curlBufferNew :: FilePath -> [String] -> Client -> PageId -> CustomizeWrap -> IO CurlBuffer curlBufferNew name urls client pageId c = do @@ -206,6 +217,7 @@ <*> pure curlMode <*> (newTChanIO :: IO (TChan CurlTChanSignal)) <*> pure customize + <*> newTVarIO curlInitState -- Scan cache file to resume. curlBufferScanCacheFile buffer @@ -449,33 +461,25 @@ -- | Get file size. getFileSize :: String -> IO Int getFileSize url = do - -- Init size var. - sizeTVar <- newTVarIO 0 - -- Init curl. h <- initialize -- Set option. setDefaultSSLOpts h url - setopt h (CurlFailOnError True) setopt h (CurlURL url) + setopt h (CurlNoProgress True) + setopt h (CurlNoBody True) + setopt h (CurlFailOnError True) setopt h (CurlWriteFunction (\ _ sz n _ -> return (sz * n))) - setopt h (CurlNoProgress False) - setopt h (CurlProgressData nullPtr) - setopt h (CurlProgressFunction - (\ _ size _ _ _ -> - if size > 0.0 - then - writeTVarIO sizeTVar (floor size) - -- Return non-zero value will abort transfer immediately. - >> return 1 - else return 0)) -- Perform. _ <- perform h -- Get file size. - readTVarIO sizeTVar + infoValue <- getInfo h ContentLengthDownload + return $ case infoValue of + IDouble s -> floor s + _ -> error "getFileSize: impossible type!" -- | Get file. getFile :: String -> DownloadFile -> CurlBuffer -> DownloadBuffer -> (Int, Int) -> IO () @@ -835,4 +839,18 @@ CurlCustomize <$> newTVarIO defaultThreadNumber <*> newTVarIO defaultCacheSize <*> newTVarIO autoStart + +-- | Write state. +curlBufferWriteState :: CurlBuffer -> FilePath -> IO () +curlBufferWriteState buffer path = do + state <- readTVarIO $ curlBufferState buffer + writeConfigPath path state + +-- | Read state. +curlBufferReadState :: CurlBuffer -> FilePath -> IO () +curlBufferReadState buffer path = do + state <- readConfigPath path curlInitState + writeTVarIO (curlBufferState buffer) state + +$(derive makeBinary ''CurlState) diff --git a/Manatee/Extension/Curl/CurlView.hs b/Manatee/Extension/Curl/CurlView.hs --- a/Manatee/Extension/Curl/CurlView.hs +++ b/Manatee/Extension/Curl/CurlView.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 @@ -28,7 +28,6 @@ import Data.Text.Lazy (Text) import Data.Typeable import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get) -import Graphics.UI.Gtk.Gdk.SerializedEvent import Manatee.Core.Config import Manatee.Core.DBus import Manatee.Core.FileOpenRule @@ -43,8 +42,8 @@ import Manatee.Toolkit.General.STM import Manatee.Toolkit.Gio.Gio import Manatee.Toolkit.Gtk.Concurrent -import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Gtk.ModelView +import Manatee.Toolkit.Gtk.ScrolledWindow import Paths_manatee_curl import System.Directory import System.FilePath @@ -73,16 +72,21 @@ pageBufferPackageName _ = fmap takeFileName getDataDir instance PageView CurlView where - pageViewBuffer = PageBufferWrap . curlViewBuffer - pageViewPlugId = curlViewPlugId - pageViewBox = pageFrameBox . curlViewFrame - pageViewScrolledWindow = curlViewScrolledWindow - pageViewFocus = treeViewFocus . curlViewTreeView - pageViewHandleKeyAction = curlViewHandleKeyAction - pageViewScrollToTop = curlViewScrollToTop - pageViewScrollToBottom = curlViewScrollToBottom - pageViewScrollVerticalPage = curlViewScrollVerticalPage - pageViewScrollVerticalStep = curlViewScrollVerticalStep + pageViewBuffer = PageBufferWrap . curlViewBuffer + pageViewPlugId = curlViewPlugId + pageViewFrame = curlViewFrame + pageViewLocalKeymap _ = curlViewLocalKeymap + pageViewLocalCommandMap _ = curlViewLocalCommandMap + pageViewFocus = treeViewFocus . curlViewTreeView + pageViewPropagateWidget = castToWidget . curlViewTreeView + pageViewSaveState view = curlViewSaveState view Nothing + pageViewRestoreState view = curlViewRestoreState view Nothing + pageViewWriteState view path = curlViewSaveState view (Just path) + pageViewReadState view path = curlViewRestoreState view (Just path) + pageViewScrollToTop = curlViewScrollToTop + pageViewScrollToBottom = curlViewScrollToBottom + pageViewScrollVerticalPage = curlViewScrollVerticalPage + pageViewScrollVerticalStep = curlViewScrollVerticalStep -- | New. curlViewNew :: CurlBuffer -> PagePlugId -> IO CurlView @@ -334,13 +338,6 @@ stepInc <- (<<<=) i2d treeViewGetSelectedCellHeight tv treeViewScrollVertical tv sw (if isDown then stepInc else (- stepInc)) --- | Handle key action. -curlViewHandleKeyAction :: CurlView -> Text -> SerializedEvent -> IO () -curlViewHandleKeyAction view keystoke sEvent = - case M.lookup keystoke curlViewKeymap of - Just action -> action view - Nothing -> widgetPropagateEvent (curlViewTreeView view) sEvent - -- | Next node. curlViewNextNode :: CurlView -> IO () curlViewNextNode = treeViewFocusNextToplevelNode . curlViewTreeView @@ -357,7 +354,7 @@ (curlViewListStore view) >?>= \ downloadFile -> do name <- readTVarIO (dfName downloadFile) - pageFrameUpdateStatusbar (curlViewFrame view) "Filename" ("Filename : " ++ name) + pageViewUpdateStatusbar view "Filename" ("Filename : " ++ name) -- | Sort column. curlViewSort :: CurlView -> DownloadFileOption -> IO () @@ -424,10 +421,10 @@ -- | Add download. curlViewAddDownload :: CurlView -> IO () curlViewAddDownload view@(CurlView {curlViewBuffer = buffer}) = - localInteractive view "sURL : " $ \ [url] -> do + interactive view [(IString, "URL : ", "")] $ \ [url] -> do files <- readTVarIO $ curlBufferFileInfos buffer if url `elem` map dfURL files - then pageFrameShowOutputbar (curlViewFrame view) ("Has exist " ++ url) Nothing + then pageViewShowOutputbar view ("Has exist " ++ url) Nothing else curlBufferAddDownload buffer url -- | Pause @@ -475,7 +472,7 @@ >?>= \ downloadFile -> do downloadStatus <- readTVarIO (dfDownloadStatus downloadFile) case downloadStatus of - Failed -> pageFrameShowOutputbar (curlViewFrame view) "No file." Nothing + Failed -> pageViewShowOutputbar view "No file." Nothing Finish -> do downloadDir <- fmap ( defaultDownloadDir) getConfigDirectory mkDaemonSignal (pageViewClient view) NewTab (NewTabArgs "PageFileManager" downloadDir []) @@ -506,14 +503,14 @@ (_, fileType) <- contentTypeGuess filePath "" 0 openRule <- fileOpenRule filePath fileType if null openRule - then pageFrameShowOutputbar (curlViewFrame view) ("Don't know how to open file : " ++ filePath) Nothing + then pageViewShowOutputbar view ("Don't know how to open file : " ++ filePath) Nothing else do let rule = snd $ head openRule -- use default open rule. rule (pageViewClient view) -- Otherwise print information. - else pageFrameShowOutputbar (curlViewFrame view) ("Can't find " ++ filePath) Nothing + else pageViewShowOutputbar view ("Can't find " ++ filePath) Nothing -- Otherwise print information. - else pageFrameShowOutputbar (curlViewFrame view) "Haven't download complete." Nothing + else pageViewShowOutputbar view "Haven't download complete." Nothing -- | Scrolled window. curlViewScrolledWindow :: CurlView -> ScrolledWindow @@ -521,32 +518,91 @@ pageFrameScrolledWindow . curlViewFrame -- | Keymap. -curlViewKeymap :: Map Text (CurlView -> IO ()) -curlViewKeymap = +curlViewLocalKeymap :: Map Text Text +curlViewLocalKeymap = M.fromList - [("j", curlViewNextNode) - ,("k", curlViewPrevNode) - ,("Down", curlViewNextNode) - ,("Up", curlViewPrevNode) - ,("J", curlViewScrollToBottom) - ,("K", curlViewScrollToTop) - ,(" ", curlViewScrollVerticalPage True) - ,("b", curlViewScrollVerticalPage False) - ,("PageDown", curlViewScrollVerticalPage True) - ,("PageUp", curlViewScrollVerticalPage False) - ,("a", curlViewAddDownload) - ,("d", curlViewDeleteDownload) - ,("p", curlViewPause) - ,("P", curlViewPauseAll) - ,("n", curlViewContinue) - ,("N", curlViewContinueAll) - ,("f", curlViewJumpToFile) - ,("m", curlViewOpenFile) - ,("3", curlViewSortByName) - ,("4", curlViewSortBySize) - ,("6", curlViewSortBySpeed) - ,("7", curlViewSortByRestTime) - ,("8", curlViewSortByThread) - ,("9", curlViewSortByUrl) + [("j", "Next") + ,("k", "Previous") + ,("Down", "Next") + ,("Up", "Previous") + ,("J", "Scroll to bottom") + ,("K", "Scroll to top") + ,(" ", "Scroll page up") + ,("b", "Scroll page down") + ,("PageDown", "Scroll page up") + ,("PageUp", "Scroll page down") + ,("a", "Add") + ,("d", "Delete") + ,("p", "Pause") + ,("P", "Pause all") + ,("n", "Continue") + ,("N", "Continue all") + ,("f", "Jump to file") + ,("m", "Open file") + ,("3", "Sort by name") + ,("4", "Sort by size") + ,("6", "Sort by speed") + ,("7", "Sort by rest time") + ,("8", "Sort by thread") + ,("9", "Sort by url") ] +-- | Keymap. +curlViewLocalCommandMap :: Map Text (CurlView -> IO ()) +curlViewLocalCommandMap = + M.fromList + [("Next", curlViewNextNode) + ,("Previous", curlViewPrevNode) + ,("Scroll to bottom", curlViewScrollToBottom) + ,("Scroll to top", curlViewScrollToTop) + ,("Scroll page up", curlViewScrollVerticalPage True) + ,("Scroll page down", curlViewScrollVerticalPage False) + ,("Add", curlViewAddDownload) + ,("Delete", curlViewDeleteDownload) + ,("Pause", curlViewPause) + ,("Pause all", curlViewPauseAll) + ,("Continue", curlViewContinue) + ,("Continue all", curlViewContinueAll) + ,("Jump to file", curlViewJumpToFile) + ,("Open file", curlViewOpenFile) + ,("Sort by name", curlViewSortByName) + ,("Sort by size", curlViewSortBySize) + ,("Sort by speed", curlViewSortBySpeed) + ,("Sort by rest time", curlViewSortByRestTime) + ,("Sort by thread", curlViewSortByThread) + ,("Sort by url", curlViewSortByUrl) + ] + +-- | Save state. +curlViewSaveState :: CurlView -> Maybe FilePath -> IO () +curlViewSaveState view@(CurlView {curlViewBuffer = buffer + ,curlViewTreeView = treeView}) + statePath = do + -- Get selected path. + selectedPath <- treeViewGetSelectedPath treeView + + -- Get scroll position. + scrolledWindowPosition <- scrolledWindowGetValue (curlViewScrolledWindow view) + + -- Save state. + let state = CurlState selectedPath scrolledWindowPosition + case statePath of + Nothing -> writeTVarIO (curlBufferState buffer) state + Just path -> writeConfigPath path state + +-- | Restore state. +curlViewRestoreState :: CurlView -> Maybe FilePath -> IO () +curlViewRestoreState view@(CurlView {curlViewBuffer = buffer + ,curlViewTreeView= treeView}) + statePath = do + bufferState <- readTVarIO (curlBufferState buffer) + (CurlState selectedPath scrolledWindowPosition) <- + case statePath of + Just path -> readConfigPath path bufferState + Nothing -> return bufferState + + -- Restore selected path. + selectedPath ?>= \path -> treeViewSetCursor treeView path Nothing + + -- Restore scroll position. + scrolledWindowSetValue (curlViewScrolledWindow view) scrolledWindowPosition diff --git a/Manatee/Extension/Curl/PageMode.hs b/Manatee/Extension/Curl/PageMode.hs --- a/Manatee/Extension/Curl/PageMode.hs +++ b/Manatee/Extension/Curl/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/Manatee/Extension/Curl/Types.hs b/Manatee/Extension/Curl/Types.hs --- a/Manatee/Extension/Curl/Types.hs +++ b/Manatee/Extension/Curl/Types.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 @@ -21,6 +21,7 @@ import Manatee.Core.Config import Manatee.Core.Dynload import Manatee.Core.Types +import Manatee.Toolkit.Cabal.Utils import Manatee.Toolkit.General.List import Manatee.Toolkit.General.Map import Manatee.Extension.Curl.PageMode @@ -35,7 +36,7 @@ ["defaultThreadNumber", "defaultCacheSize", "autoStart"] return emptyHookedBuildInfo -- 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 "PageCurl" "manatee-curl" typeRule)) @@ -46,5 +47,14 @@ -- Update ExtensionGloalKeymap. (ExtensionGloalKeymap keymap) <- readConfig extensionGlobalKeymapPath (ExtensionGloalKeymap M.empty) writeConfig extensionGlobalKeymapPath (ExtensionGloalKeymap - (M.insert "F8" ("PageCurl", "Download", []) keymap)) + (M.insert "F8" ("Download Manager", + ("PageCurl", "Download", [])) 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 + ("Download Manager", snapshotPath) + ("PageCurl", "Download", []) + 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-curl.cabal b/manatee-curl.cabal --- a/manatee-curl.cabal +++ b/manatee-curl.cabal @@ -1,9 +1,9 @@ name: manatee-curl -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: Download Manager extension for Manatee. description: manatee-curl is multithreads download manager extension for Manatee (Haskell/Gtk+ Integrated Live Environment) . @@ -11,7 +11,7 @@ . Note, you need re-install package to start the configuration file take effect the next time, . - Video at (Select 720p HD) at : + Video (Select 720p HD) at : . Screenshots at : . @@ -26,19 +26,20 @@ stability: provisional category: Manatee, Download Manager, Network -tested-with: GHC==6.12.3 +tested-with: GHC==7.0.2 build-type: Custom data-dir: "" data-files: Config/Curl.hs + data/welcome/snapshot.png Source-Repository head type: darcs location: http://patch-tag.com/r/AndyStewart/manatee-curl 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, 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, gtk >= 0.12.0, text >= 0.7.1.0, mtl >= 1.1.0.2, old-time, old-locale, glib >= 0.12.0, gio >= 0.12.0, filepath >= 1.1.0.3, utf8-string >= 0.3.4, bytestring, network, curl >= 1.3.5, directory, template-haskell, derive, binary, regex-tdfa, dbus-core