manatee-curl 0.0.8 → 0.1.0
raw patch · 11 files changed
+172/−87 lines, 11 filesdep −gtk-serialized-eventdep ~manatee-coresetup-changedbinary-added
Dependencies removed: gtk-serialized-event
Dependency ranges changed: manatee-core
Files
- Config/Curl.hs +1/−1
- Config/Default.hs +1/−1
- Main.hs +1/−1
- Manatee/Extension/Curl.hs +1/−1
- Manatee/Extension/Curl/CurlBuffer.hs +37/−19
- Manatee/Extension/Curl/CurlView.hs +109/−53
- Manatee/Extension/Curl/PageMode.hs +1/−1
- Manatee/Extension/Curl/Types.hs +1/−1
- Setup.hs +13/−3
- data/welcome/snapshot.png binary
- manatee-curl.cabal +7/−6
Config/Curl.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
Config/Default.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
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/Curl.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/Curl/CurlBuffer.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@@ -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)
Manatee/Extension/Curl/CurlView.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@@ -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
Manatee/Extension/Curl/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
Manatee/Extension/Curl/Types.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@@ -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)) }
+ data/welcome/snapshot.png view
binary file changed (absent → 58860 bytes)
manatee-curl.cabal view
@@ -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 : <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> .@@ -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