hbro 0.6.5 → 0.6.6
raw patch · 6 files changed
+174/−92 lines, 6 filesdep +text
Dependencies added: text
Files
- Hbro/Core.hs +8/−0
- Hbro/Extra/Bookmarks.hs +141/−75
- Hbro/Extra/History.hs +1/−1
- Hbro/Gui.hs +4/−4
- examples/hbro.hs +18/−11
- hbro.cabal +2/−1
Hbro/Core.hs view
@@ -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'
Hbro/Extra/Bookmarks.hs view
@@ -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 -- }}}
Hbro/Extra/History.hs view
@@ -35,7 +35,7 @@ case (code, result) of (ExitSuccess, r) -> let- _:_:uri:_ = words $ r+ uri:_ = words $ r in loadURL uri browser _ -> putStrLn e
Hbro/Gui.hs view
@@ -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
examples/hbro.hs view
@@ -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], "<Left>"), goBack),+ (([Shift], "<Right>"), goForward), (([Control], "s"), stopLoading), (([], "<F5>"), reload True), (([Shift], "<F5>"), 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 =
hbro.cabal view
@@ -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,