diff --git a/Hbro/Core.hs b/Hbro/Core.hs --- a/Hbro/Core.hs +++ b/Hbro/Core.hs @@ -224,3 +224,11 @@ -- | Spawn a new instance of the browser. newWindow :: Browser -> IO () newWindow browser = runExternalCommand "hbro" + +-- | Execute a javascript file on current webpage. +executeJSFile :: String -> Browser -> IO () +executeJSFile filePath browser = do + script <- readFile filePath + let script' = unwords . map (\line -> line ++ "\n") . lines $ script + + webViewExecuteScript (mWebView $ mGUI browser) script' diff --git a/Hbro/Extra/Bookmarks.hs b/Hbro/Extra/Bookmarks.hs --- a/Hbro/Extra/Bookmarks.hs +++ b/Hbro/Extra/Bookmarks.hs @@ -1,4 +1,14 @@ -module Hbro.Extra.Bookmarks where +module Hbro.Extra.Bookmarks ( + addWithTags, + addAllWithTags, + load, + loadWithTag, + deleteWithTag, + add, + appendQueue, + popQueue, + popAndLoadQueue +) where -- {{{ Imports import Hbro.Core @@ -6,37 +16,45 @@ import Hbro.Types import Hbro.Util -import Data.ByteString.Char8 (pack, unpack) +import qualified Data.ByteString.Char8 as B import Data.List +import qualified Data.Text as T +import qualified Data.Text.IO as T import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.WebKit.WebView import System.Environment -import System.Exit import qualified System.Info as Sys +import System.IO import System.Posix.Process import System.Process import System.ZMQ -- }}} --- -addToBookmarks :: Browser -> IO () -addToBookmarks browser = do +-- | Add current URI to bookmarks. +-- Prompt for a tags list to apply. +addWithTags :: Browser -> IO () +addWithTags browser = do uri <- webViewGetUri (mWebView $ mGUI browser) case uri of - Just u -> prompt "Bookmark with tag:" "" False browser (\b -> do + Just u -> prompt "Bookmark with tags:" "" False browser (\b -> do tags <- entryGetText (mPromptEntry $ mGUI b) - bookmark u (words tags)) + add u (words tags)) _ -> return () --- -addAllInstancesToBookmarks :: Browser -> IO () -addAllInstancesToBookmarks browser = +-- | Add current URIs from all opened windows to bookmarks. +addAllWithTags :: Browser -> IO () +addAllWithTags browser = prompt "Bookmark all instances with tag:" "" False browser (\b -> do tags <- entryGetText (mPromptEntry $ mGUI b) + uri <- webViewGetUri (mWebView $ mGUI browser) + case uri of + Just u -> add u $ words tags + _ -> return () + (_, pids, _) <- readProcessWithExitCode "pidof" ["hbro"] [] (_, pids', _) <- readProcessWithExitCode "pidof" ["hbro-" ++ Sys.os ++ "-" ++ Sys.arch] [] myPid <- getProcessID @@ -49,103 +67,151 @@ in do connect reqSocket socketURI - send reqSocket (pack "getUri") [] + send reqSocket (B.pack "getUri") [] uri <- receive reqSocket [] - bookmark (unpack uri) (words tags) + add (B.unpack uri) (words tags) ) _ <- mapM bookmarkPID pidsList return ()) -- | -loadFromBookmarks :: Browser -> IO () -loadFromBookmarks browser = do +load :: Browser -> IO () +load browser = do + -- Load bookmarks file configHome <- getEnv "XDG_CONFIG_HOME" - file <- readFile $ configHome ++ "/hbro/bookmarks" + file <- T.readFile $ configHome ++ "/hbro/bookmarks" - let file' = unlines . sort . nub $ map reformat (lines file) + -- Reformat lines + let file' = T.unlines . sort . nub $ map reformat (T.lines file) - (code, result, e) <- readProcessWithExitCode "dmenu" ["-l", "10"] file' - case (code, result) of - (ExitSuccess, r) -> - let - uri:_ = reverse . words $ r - in - loadURL uri browser - _ -> putStrLn e + -- Let user select a URI + (Just input, Just output, _, _) <- createProcess (proc "dmenu" ["-l", "10"]) { + std_in = CreatePipe, + std_out = CreatePipe } + _ <- T.hPutStr input file' + entry <- catch (hGetLine output) (\e -> return "ERROR" ) + case reverse . words $ entry of + ["ERROR"] -> return () + uri:_ -> loadURL uri browser + _ -> return () + + +reformat :: T.Text -> T.Text +reformat line = + T.unwords $ tags' ++ [uri] where - reformat line = - let - uri:tags = words line - tags' = sort $ map (\tag -> "[" ++ tag ++ "]") tags - in - unwords $ tags' ++ [uri] + uri:tags = T.words line + tags' = sort $ map (\tag -> T.snoc (T.cons '[' tag) ']') tags -- | -loadTagFromBookmarks :: Browser -> IO () -loadTagFromBookmarks browser = do +loadWithTag :: Browser -> IO () +loadWithTag browser = do + -- Read bookmarks file configHome <- getEnv "XDG_CONFIG_HOME" - file <- readFile $ configHome ++ "/hbro/bookmarks" + file <- T.readFile $ configHome ++ "/hbro/bookmarks" - let list = unlines . sort . nub . words . unwords $ map getTags (lines file) + -- Filter tags list + let list = T.unlines . sort . nub . T.words . T.unwords $ map getTags (T.lines file) - (code, result, e) <- readProcessWithExitCode "dmenu" [] list - case (code, result) of - (ExitSuccess, tag) -> - let - file' = filter (tagFilter tag) (lines file) - uris = map getUri file' - in do - _ <- mapM (\uri -> runExternalCommand ("hbro -u \"" ++ uri ++ "\"")) uris + -- Let user select a tag + (Just input, Just output, _, _) <- createProcess (proc "dmenu" ["-l", "10"]) { + std_in = CreatePipe, + std_out = CreatePipe } + _ <- T.hPutStr input list + + tag <- catch (hGetLine output) (\e -> return "ERROR" ) + case tag of + "ERROR" -> return () + "" -> return () + t -> do + _ <- mapM (\uri -> runExternalCommand ("hbro -u \"" ++ (T.unpack uri) ++ "\"")) uris return () - - _ -> putStrLn e + where + file' = filter (tagFilter $ T.pack t) (T.lines file) + uris = map getUri file' - where - tagFilter tag line = let uri:tags = words line in case (intersect [tag] tags) of - [t] -> True - _ -> False +-- +tagFilter :: T.Text -> T.Text -> Bool +tagFilter tag line = let uri:tags = T.words line in case (intersect [tag] tags) of + [t] -> True + _ -> False -- | -deleteTagFromBookmarks :: Browser -> IO () -deleteTagFromBookmarks browser = do +deleteWithTag :: Browser -> IO () +deleteWithTag browser = do configHome <- getEnv "XDG_CONFIG_HOME" - file <- readFile $ configHome ++ "/hbro/bookmarks" + file <- T.readFile $ configHome ++ "/hbro/bookmarks" - let tagsList = unlines . sort . nub . words . unwords $ map getTags (lines file) + let tagsList = T.unlines . sort . nub . T.words . T.unwords $ map getTags (T.lines file) - (code, result, e) <- readProcessWithExitCode "dmenu" [] tagsList - case (code, result) of - (ExitSuccess, tag) -> - let - file' = unlines $ filter (tagFilter tag) (lines file) - in do - writeFile (configHome ++ "/hbro/bookmarks.old") file - writeFile (configHome ++ "/hbro/bookmarks") file' - return () - + (Just input, Just output, _, _) <- createProcess (proc "dmenu" []) { + std_in = CreatePipe, + std_out = CreatePipe } + _ <- T.hPutStr input tagsList - _ -> putStrLn e - where - tagFilter tag line = let uri:tags = words line in case (intersect [tag] tags) of - [t] -> False - _ -> True + tag <- catch (hGetLine output) (\e -> return "ERROR" ) + case tag of + "ERROR" -> return () + "" -> return () + t -> do + T.writeFile (configHome ++ "/hbro/bookmarks.old") file + T.writeFile (configHome ++ "/hbro/bookmarks") file' + return () + where + file' = T.unlines $ filter (not . (tagFilter $ T.pack tag)) (T.lines file) --- The elementary bookmark action -bookmark :: String -> [String] -> IO () -bookmark uri tags = do +-- | The elementary bookmark action +add :: String -> [String] -> IO () +add uri tags = do configHome <- getEnv "XDG_CONFIG_HOME" appendFile (configHome ++ "/hbro/bookmarks") $ uri ++ " " ++ (unwords tags) ++ "\n" -- | -getTags :: String -> String -getTags line = let _:tags = words line in unwords tags +getTags :: T.Text -> T.Text +getTags line = let _:tags = T.words line in T.unwords tags -- | -getUri :: String -> String -getUri line = let uri:_ = words line in uri +getUri :: T.Text -> T.Text +getUri line = let uri:_ = T.words line in uri + + +-- {{{ Queueing system +-- | +appendQueue :: Browser -> IO () +appendQueue browser = do + uri <- webViewGetUri (mWebView $ mGUI browser) + configHome <- getEnv "XDG_CONFIG_HOME" + + case uri of + Just u -> appendFile (configHome ++ "/hbro/queue") (u ++ "\n") + _ -> return () + +-- | +popQueue :: Browser -> IO String +popQueue browser = do + configHome <- getEnv "XDG_CONFIG_HOME" + file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty) + + if file == T.empty + then return "" + else do + let fileLines = T.lines file + let file' = T.unlines . tail . nub $ fileLines + + T.writeFile (configHome ++ "/hbro/queue.old") file + T.writeFile (configHome ++ "/hbro/queue") file' + + return $ T.unpack (head fileLines) + +popAndLoadQueue :: Browser -> IO () +popAndLoadQueue browser = do + uri <- popQueue browser + case uri of + "" -> return () + _ -> loadURL uri browser -- }}} diff --git a/Hbro/Extra/History.hs b/Hbro/Extra/History.hs --- a/Hbro/Extra/History.hs +++ b/Hbro/Extra/History.hs @@ -35,7 +35,7 @@ case (code, result) of (ExitSuccess, r) -> let - _:_:uri:_ = words $ r + uri:_ = words $ r in loadURL uri browser _ -> putStrLn e diff --git a/Hbro/Gui.hs b/Hbro/Gui.hs --- a/Hbro/Gui.hs +++ b/Hbro/Gui.hs @@ -131,14 +131,14 @@ promptEntry = (mPromptEntry $ mGUI browser) webView = (mWebView $ mGUI browser) in do - -- Show prompt - showPrompt True browser - -- Fill prompt labelSetText promptLabel label entrySetText promptEntry defaultText - + + -- Focus on prompt + showPrompt True browser widgetGrabFocus promptEntry + editableSetPosition promptEntry (-1) -- Register callback case incremental of diff --git a/examples/hbro.hs b/examples/hbro.hs --- a/examples/hbro.hs +++ b/examples/hbro.hs @@ -3,7 +3,7 @@ -- {{{ Imports import Hbro.Config import Hbro.Core -import Hbro.Extra.Bookmarks +import qualified Hbro.Extra.Bookmarks as Bookmarks import Hbro.Extra.Clipboard import Hbro.Extra.History import Hbro.Extra.Misc @@ -17,6 +17,7 @@ import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.Gdk.GC +import Graphics.UI.Gtk.General.General import Graphics.UI.Gtk.WebKit.Download import Graphics.UI.Gtk.WebKit.NetworkRequest import Graphics.UI.Gtk.WebKit.WebNavigationAction @@ -50,6 +51,7 @@ -- {{{ Keys +-- Note that this example is suited for an azerty keyboard. myKeys :: KeysList myKeys = generalKeys ++ bookmarksKeys ++ historyKeys @@ -57,8 +59,8 @@ generalKeys = [ -- ((modifiers, key), callback) -- Browse - (([], "<"), goBack), - (([Shift], ">"), goForward), + (([Control], ""), goBack), + (([Shift], ""), goForward), (([Control], "s"), stopLoading), (([], ""), reload True), (([Shift], ""), reload False), @@ -98,16 +100,19 @@ -- Others (([Control], "i"), showWebInspector), (([Alt], "p"), printPage), - (([Control], "t"), newWindow) + (([Control], "t"), newWindow), + (([Control], "w"), \_ -> mainQuit) ] bookmarksKeys :: KeysList bookmarksKeys = [ - (([Control], "d"), addToBookmarks), - (([Control, Shift], "D"), addAllInstancesToBookmarks), - (([Alt], "d"), deleteTagFromBookmarks), - (([Control], "l"), loadFromBookmarks), - (([Control, Shift], "L"), loadTagFromBookmarks) + (([Control], "d"), Bookmarks.addWithTags), + (([Control, Shift], "D"), Bookmarks.addAllWithTags), + (([Alt], "d"), Bookmarks.deleteWithTag), + (([Control], "l"), Bookmarks.load), + (([Control, Shift], "L"), Bookmarks.loadWithTag), + (([Control], "q"), Bookmarks.appendQueue), + (([Alt], "q"), Bookmarks.popAndLoadQueue) ] historyKeys :: KeysList @@ -160,7 +165,7 @@ --webSettingsResizableTextAreas := True, webSettingsSpellCheckingLang := Just "en_US", --webSettingsTabKeyCyclesThroughElements := True, - webSettingsUserAgent := "Mozilla Firefox" + webSettingsUserAgent := "Mozilla/5.0 (X11; Linux x86_64; rv:2.0.1) Gecko/20100101 Firefox/4.0.1" --webSettingsUserStylesheetUri := Nothing, --webSettingsZoomStep := 0.1 ] @@ -258,7 +263,9 @@ myDownload :: String -> String -> IO () myDownload uri name = do home <- getEnv "HOME" - runExternalCommand $ "wget \"" ++ uri ++ "\" -O \"" ++ home ++ "/" ++ name ++ "\"" + --runExternalCommand $ "wget \"" ++ uri ++ "\" -O \"" ++ home ++ "/" ++ name ++ "\"" + --runExternalCommand $ "axel \"" ++ uri ++ "\" -o \"" ++ home ++ "/" ++ name ++ "\"" + runExternalCommand $ "aria2c \"" ++ uri ++ "\" -d " ++ home ++ "/ -o \"" ++ name ++ "\"" promptGoogle :: Browser -> IO () promptGoogle browser = diff --git a/hbro.cabal b/hbro.cabal --- a/hbro.cabal +++ b/hbro.cabal @@ -1,5 +1,5 @@ Name: hbro -Version: 0.6.5 +Version: 0.6.6 Synopsis: A suckless minimal KISSy browser -- Description: Homepage: http://projects.haskell.org/hbro/ @@ -34,6 +34,7 @@ old-locale, pango, process, + text, time, url, webkit,