pgdl 8.2 → 8.3
raw patch · 5 files changed
+51/−23 lines, 5 filesdep ~vty-ui
Dependency ranges changed: vty-ui
Files
- README.md +12/−16
- pgdl.cabal +4/−4
- src/Pgdl.hs +32/−0
- src/PrsVid.hs +1/−1
- src/RealWorld.hs +2/−2
README.md view
@@ -1,7 +1,7 @@ # pgdl -a terminal user interface program that downloads a video from html and call vlc to play it immediately.-(Linux: vlc -f "video.mp4", MACOSX: open "video.mp4" -a vlc)+a terminal user interface program that downloads a video (or a file) from webpage and xdg-open it immediately.+(Linux: xdg-open "video.mp4", MACOSX: open "video.mp4") Client: Only for Linux and MACOSX. Server: Only for nginx's file download page.@@ -10,22 +10,18 @@ ## Installing -cabal update <br>+cabal update cabal install pgdl ## Shortcut keys -q - quit-<br>-s - list files that similar with the highlighted video-<br>-Key Right - show the detailed information of the highlighted video-<br>-Key Left - go back to the previous page-<br>-Enter - play the video-<br>-/ - open a input box to enter a keyword to search-<br>-n - sort the current list by name+q - quit +s - list files that similar with the highlighted video +Key Right - show the detailed information of the highlighted video +Key Left - go back to the previous page +Enter - play the video +/ - open a input box to enter a keyword to search +n - sort the current list by name +v - show the videos already in the disk +u - show the videos not in the disk
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 8.2+version: 8.3 license: PublicDomain license-file: LICENSE author: sifmelcara@@ -15,11 +15,11 @@ Client: Only for Linux and MACOSX. Server: Only for nginx's file download page. .- The program will sort the video files and folders by date while files in nginx's download page just sort by name.+ The program will sort the files and folders by date while files in nginx's download page just sort by name. . For shortcut keys, please visit <https://github.com/sifmelcara/pgdl> -synopsis: simply download a video from webpage and play it.+synopsis: simply download a video (or a file) from a webpage and xdg-open it. source-repository head type: git@@ -34,7 +34,7 @@ build-depends: base == 4.*, process, directory, bytestring, tagsoup, network-uri, - vty, text, vty-ui >= 1.8,+ vty, text, vty-ui >= 1.9, configurator >= 0.3.0.0, HTTP, filepath, Cabal, array ghc-options: -threaded -O2
src/Pgdl.hs view
@@ -57,12 +57,16 @@ ifsfg <- newFocusGroup -- a focus group for information page+ + helpfg <- newFocusGroup+ -- a focus group of help page -- this function will show the focused item's information to user tmpLfg `onKeyPressed` tryExit dfcg `onKeyPressed` tryExit ifsfg `onKeyPressed` tryExit+ helpfg `onKeyPressed` tryExit -- colorDecide tmpLst @@ -142,6 +146,12 @@ return True _ -> return False + let chgHelp = do+ hp <- centered =<< plainText helpPage+ addToFocusGroup helpfg hp+ join $ addToCollection c hp helpfg+ onKeyPressed helpfg $ \_ _ _ -> (chgls >> return True)+ onKeyPressed lst $ \_ key _ -> case key of KRight -> do chgInf@@ -189,9 +199,17 @@ filterVListIO vlst $ \obj -> if isVid obj then downloaded obj else return False return True+ KChar 'u' -> do+ filterVListIO vlst $ \obj -> if isVid obj then not <$> (downloaded obj)+ else return False + return True KChar '/' -> do chgky return True+ KChar 'h' -> do+ chgHelp+ return True+ _ -> return False return ()@@ -200,4 +218,18 @@ runUi c $ defaultContext { normalAttr = white `on` black , focusAttr = black `on` blue }++helpPage :: T.Text+helpPage = T.unlines [ + "q - quit"+ ,"s - list files that similar with the highlighted video"+ ,"Key Right - show the detailed information of the highlighted video"+ ,"Key Left - go back to the previous page"+ ,"Enter - play the video"+ ,"/ - open a input box to enter a keyword to search"+ ,"n - sort the current list by name"+ ,"v - show the videos already in the disk"+ ,"u - show the videos not in the disk"+ ]+
src/PrsVid.hs view
@@ -19,7 +19,7 @@ filter isVidLn . map parseTags . T.lines where isVidLn = any isVidLnk isVidLnk tg- | isTagOpen tg = any (`T.isSuffixOf` fromAttrib "href" tg) fmts+ | isTagOpen tg = (not $ "/" `T.isSuffixOf` fromAttrib "href" tg) && (not . T.null $ fromAttrib "href" tg) | otherwise = False pullText tg | isTagOpen tg = fromAttrib "href" tg
src/RealWorld.hs view
@@ -40,7 +40,7 @@ checkFile case buildOS of OSX -> runCommand $ "open " ++ addq localloc ++ " "- Linux -> runCommand $ "xdg-open " ++ addq localloc ++ " &>/dev/null &"+ Linux -> runCommand $ "nohup xdg-open " ++ addq localloc ++ " &>/dev/null &" _ -> error "OS unsupported!" return () where vn = T.unpack . vidName $ vid@@ -56,7 +56,7 @@ let localloc = localdir </> vn case buildOS of OSX -> runCommand $ "open " ++ addq localloc ++ " "- Linux -> runCommand $ "xdg-open " ++ addq localloc ++ " &>/dev/null &"+ Linux -> runCommand $ "nohup xdg-open " ++ addq localloc ++ " &>/dev/null &" _ -> error "OS unsupported!" return () -- exitSuccess