hbro 0.5.1 → 0.5.2
raw patch · 5 files changed
+197/−71 lines, 5 files
Files
- Hbro/Core.hs +15/−2
- Hbro/Socket.hs +46/−55
- examples/Main.hs +41/−11
- examples/scripts/bookmarks.sh +90/−0
- hbro.cabal +5/−3
Hbro/Core.hs view
@@ -30,6 +30,7 @@ import System.Console.CmdArgs import System.Glib.Signals import System.Posix.Process+import qualified System.ZMQ as ZMQ -- }}} -- {{{ Commandline options@@ -73,8 +74,20 @@ let webView = mWebView gui -- Initialize IPC socket- pid <- getProcessID- _ <- forkIO $ createReplySocket ("ipc://" ++ (mSocketDir configuration) ++ "/hbro." ++ show pid) browser+ pid <- getProcessID+ context <- ZMQ.init 1+ repSocket <- ZMQ.socket context ZMQ.Rep + let socketURI = "ipc://" ++ (mSocketDir configuration) ++ "/hbro." ++ show pid++ ZMQ.bind repSocket socketURI+ + _ <- quitAdd 0 $ do+ ZMQ.setOption repSocket (ZMQ.Linger 0)+ ZMQ.close repSocket+ ZMQ.term context+ return False++ _ <- forkIO $ listenToSocket repSocket browser -- Load configuration settings <- mWebSettings configuration
Hbro/Socket.hs view
@@ -10,62 +10,53 @@ import System.ZMQ -- }}} -createReplySocket :: String -> Browser -> IO a-createReplySocket socketName browser = withContext 1 $ \context -> do - withSocket context Rep $ \socket -> do- bind socket socketName-- postGUIAsync $ do- quitAdd 0 $ do- close socket- return False- return ()+listenToSocket :: Socket Rep -> Browser -> IO a+listenToSocket repSocket browser = forever $ do+ command <- receive repSocket [] - forever $ do- command <- receive socket []- case unpack command of- -- Get information- "getUri" -> do- getUri <- postGUISync $ webViewGetUri (mWebView $ mGUI browser)- case getUri of- Just uri -> send socket (pack uri) []- _ -> send socket (pack "ERROR No URL opened") []- "getTitle" -> do- getTitle <- postGUISync $ webViewGetTitle (mWebView $ mGUI browser)- case getTitle of- Just title -> send socket (pack title) []- _ -> send socket (pack "ERROR No title") []- "getFaviconUri" -> do- getUri <- postGUISync $ webViewGetIconUri (mWebView $ mGUI browser)- case getUri of- Just uri -> send socket (pack uri) []- _ -> send socket (pack "ERROR No favicon uri") []- "getLoadProgress" -> do- progress <- postGUISync $ webViewGetProgress (mWebView $ mGUI browser)- send socket (pack (show progress)) []+ case unpack command of+ -- Get information+ "getUri" -> do+ getUri <- postGUISync $ webViewGetUri (mWebView $ mGUI browser)+ case getUri of+ Just uri -> send repSocket (pack uri) []+ _ -> send repSocket (pack "ERROR No URL opened") []+ "getTitle" -> do+ getTitle <- postGUISync $ webViewGetTitle (mWebView $ mGUI browser)+ case getTitle of+ Just title -> send repSocket (pack title) []+ _ -> send repSocket (pack "ERROR No title") []+ "getFaviconUri" -> do+ getUri <- postGUISync $ webViewGetIconUri (mWebView $ mGUI browser)+ case getUri of+ Just uri -> send repSocket (pack uri) []+ _ -> send repSocket (pack "ERROR No favicon uri") []+ "getLoadProgress" -> do+ progress <- postGUISync $ webViewGetProgress (mWebView $ mGUI browser)+ send repSocket (pack (show progress)) [] - -- Trigger actions- ('l':'o':'a':'d':'U':'r':'i':' ':uri) -> do- postGUIAsync $ webViewLoadUri (mWebView $ mGUI browser) uri- send socket (pack "OK") []- "stopLoading" -> do- postGUIAsync $ webViewStopLoading (mWebView $ mGUI browser) - send socket (pack "OK") []- "reload" -> do- postGUIAsync $ webViewReload (mWebView $ mGUI browser)- send socket (pack "OK") []- "goBack" -> do- postGUIAsync $ webViewGoBack (mWebView $ mGUI browser)- send socket (pack "OK") []- "goForward" -> do- postGUIAsync $ webViewGoForward (mWebView $ mGUI browser)- send socket (pack "OK") []- "zoomIn" -> do- postGUIAsync $ webViewZoomIn (mWebView $ mGUI browser)- send socket (pack "OK") []- "zoomOut" -> do- postGUIAsync $ webViewZoomOut (mWebView $ mGUI browser)- send socket (pack "OK") []+ -- Trigger actions+ ('l':'o':'a':'d':'U':'r':'i':' ':uri) -> do+ postGUIAsync $ webViewLoadUri (mWebView $ mGUI browser) uri+ send repSocket (pack "OK") []+ "stopLoading" -> do+ postGUIAsync $ webViewStopLoading (mWebView $ mGUI browser) + send repSocket (pack "OK") []+ "reload" -> do+ postGUIAsync $ webViewReload (mWebView $ mGUI browser)+ send repSocket (pack "OK") []+ "goBack" -> do+ postGUIAsync $ webViewGoBack (mWebView $ mGUI browser)+ send repSocket (pack "OK") []+ "goForward" -> do+ postGUIAsync $ webViewGoForward (mWebView $ mGUI browser)+ send repSocket (pack "OK") []+ "zoomIn" -> do+ postGUIAsync $ webViewZoomIn (mWebView $ mGUI browser)+ send repSocket (pack "OK") []+ "zoomOut" -> do+ postGUIAsync $ webViewZoomOut (mWebView $ mGUI browser)+ send repSocket (pack "OK") [] - _ -> send socket (pack "ERROR Unknown command") []+ _ -> send repSocket (pack "ERROR Unknown command") []
examples/Main.hs view
@@ -6,6 +6,7 @@ import Hbro.Types import Hbro.Util +import Control.Concurrent import Control.Monad.Trans(liftIO) import Graphics.Rendering.Pango.Layout@@ -37,7 +38,11 @@ main :: IO () main = do- uiFile <- getDataFileName "examples/ui.xml" -- Remove this line in your custom hbro.hs+ -- All lines containing "getDataFileName" won't compile+ -- in your custom configuration file, you must remove them+ uiFile <- getDataFileName "examples/ui.xml"+ bookmarksHandlerFile <- getDataFileName "examples/scripts/bookmarks.sh"+ configHome <- getEnv "XDG_CONFIG_HOME" hbro Configuration {@@ -71,6 +76,8 @@ (([], "s"), stopLoading), (([], "<F5>"), reload True), (([Shift], "<F5>"), reload False),+ (([Control], "r"), reload True),+ (([Control, Shift], "R"), reload False), (([], "^"), horizontalHome), (([], "$"), horizontalEnd), (([], "<Home>"), verticalHome),@@ -78,8 +85,8 @@ (([Control], "<Home>"), goHome), -- Display- (([Shift], "+"), zoomIn),- (([], "-"), zoomOut),+ (([Control, Shift], "+"), zoomIn),+ (([Control], "-"), zoomOut), (([], "<F11>"), fullscreen), (([], "<Escape>"), unfullscreen), (([], "t"), toggleStatusBar),@@ -101,12 +108,16 @@ --(([], "p"), pasteUri), -- /!\ UNSTABLE, can't see why... -- Bookmarks- (([Control], "d"), addToBookmarks),- (([Control], "l"), loadFromBookmarks),+ (([Control], "d"), addToBookmarks bookmarksHandlerFile),+ (([Control, Shift], "D"), addAllInstancesToBookmarks bookmarksHandlerFile),+ (([Alt], "d"), deleteTagFromBookmarks bookmarksHandlerFile),+ (([Control], "l"), loadFromBookmarks bookmarksHandlerFile),+ (([Control, Shift], "L"), loadTagFromBookmarks bookmarksHandlerFile), -- Others (([Control], "i"), showWebInspector),- (([Control], "p"), printPage)+ (([Control], "p"), printPage),+ (([Control], "n"), newWindow) ], @@ -339,6 +350,9 @@ found <- webViewSearchText (mWebView $ mGUI browser) keyWord caseSensitive forward wrap return () + newWindow :: Browser -> IO ()+ newWindow browser = runExternalCommand ("hbro")+ -- Copy/paste copyUri, copyTitle, pasteUri :: Browser -> IO() copyUri browser = do@@ -393,16 +407,32 @@ -- Bookmarks- addToBookmarks, loadFromBookmarks :: Browser -> IO()- addToBookmarks browser = do+ addToBookmarks, addAllInstancesToBookmarks, loadFromBookmarks :: FilePath -> Browser -> IO()+ addToBookmarks handlerPath browser = do getUri <- webViewGetUri (mWebView $ mGUI browser) case getUri of Just uri -> prompt "Bookmark with tag:" "" False browser (\b -> do tags <- entryGetText (mPromptEntry $ mGUI b)- runExternalCommand $ scriptsDir ++ "bookmarks.sh add " ++ uri ++ " " ++ tags)+ runExternalCommand $ handlerPath ++ " add " ++ uri ++ " " ++ tags)+ --runExternalCommand $ scriptsDir ++ "bookmarks.sh add " ++ uri ++ " " ++ tags) _ -> return () - loadFromBookmarks browser = do + addAllInstancesToBookmarks handlerPath browser = do+ prompt "Bookmark all instances with tag:" "" False browser (\b -> do + tags <- entryGetText (mPromptEntry $ mGUI b)+ _ <- forkIO $ (runCommand (handlerPath ++ " add-all " ++ socketDir ++ " " ++ tags)) >> return ()+ --_ <- forkIO $ (runCommand (scriptsDir ++ "bookmarks.sh add-all " ++ socketDir ++ " " ++ tags)) >> return ()+ return())++ loadFromBookmarks handlerPath browser = do pid <- getProcessID- runExternalCommand $ scriptsDir ++ "bookmarks.sh load \"" ++ socketDir ++ "/hbro." ++ show pid ++ "\""+ runExternalCommand $ handlerPath ++ " load \"" ++ socketDir ++ "/hbro." ++ show pid ++ "\""+ --runExternalCommand $ scriptsDir ++ "bookmarks.sh load \"" ++ socketDir ++ "/hbro." ++ show pid ++ "\"" + loadTagFromBookmarks handlerPath browser = do+ runExternalCommand $ handlerPath ++ " load-tag"+ --runExternalCommand $ scriptsDir ++ "bookmarks.sh load-tag"++ deleteTagFromBookmarks handlerPath browser = do+ runExternalCommand $ handlerPath ++ " delete-tag"+ --runExternalCommand $ scriptsDir ++ "bookmarks.sh delete-tag"
+ examples/scripts/bookmarks.sh view
@@ -0,0 +1,90 @@+#!/bin/sh++DMENU_OPTIONS="-l 10"+DMENU_COLORS="-nb #000033 -nf #ccccff -sb #0000ff -sf #ffff00"+BOOKMARKS_FILE="$XDG_CONFIG_HOME/hbro/bookmarks"+BROWSER="hbro"+SCRIPT_PATH="$0"+ACTION="$1"+++case $ACTION in+ # Add current page to bookmarks+ "add" )+ # Not enough arguments+ if [ $# -lt 3 ]; then+ echo "Not enough argument."+ exit 1+ fi++ URI="$2"+ TAGS=$(echo $* | cut -d' ' -f3-)++ echo -e "$URI $TAGS" >> $BOOKMARKS_FILE+ ;;++ # Add all currently opened pages to bookmarks+ "add-all" )+ # Not enough arguments+ if [ $# -lt 3 ]; then+ echo "Not enough argument."+ exit 1+ fi++ SOCKET_DIR="$2"+ TAGS=$(echo $* | cut -d' ' -f3-)++ for PID in `pidof hbro`; do+ SOCKET="$SOCKET_DIR/hbro.$PID"+ URI=`zmqat -req "ipc://$SOCKET" "getUri"`+ echo -e "$URI $TAGS" >> $BOOKMARKS_FILE+ done+ ;;++ # Delete all bookmarks with given tag+ "delete-tag" )+ TAG=$(awk '{for (i = 2; i <= NF; i++) print $i; }' "$BOOKMARKS_FILE" | sort -bfu | dmenu $DMENU_OPTIONS $DMENU_COLORS -p "Delete bookmarks tag:")++ if [ -n "$TAG" ]; then+ sed -i".bak" '/ '$TAG'/d' "$BOOKMARKS_FILE"+ fi+ ;;++ # Load a single bookmark+ "load" )+ # Not enough arguments+ if [ $# -lt 2 ]; then+ echo "Not enough argument."+ exit 1+ fi++ SOCKET=$2+ URI=$(sed -e 's/%/%%/g' "$BOOKMARKS_FILE" | awk '{for (i = 2; i <= NF; i++) printf "[%s] ", $i; printf $1 "\n"}' | sort -bf | dmenu $DMENU_OPTIONS $DMENU_COLORS -p "Load bookmark:" | awk '{print $NF}')++ [ -n "$URI" ] && zmqat -req "ipc://$SOCKET" "loadUri $URI"+ ;;++ # Load all bookmarks for a given tag+ "load-tag" )+ TAG=$(awk '{for (i = 2; i <= NF; i++) print $i; }' "$BOOKMARKS_FILE" | sort -bfu | dmenu $DMENU_OPTIONS $DMENU_COLORS -p "Load bookmarks with tag:")+ URIs=$(awk '/'$TAG'/ {print $1}' "$BOOKMARKS_FILE" | sort -bfu)++ [ -n "$TAG" ] && [ -n "$URIs" ] || exit 2++ for URI in $URIs; do+ nohup $BROWSER -u "$URI" &+ done+ ;;++ * )+ echo "Bookmarks manager: bad action"+ echo "Usage: bookmarks.sh [COMMAND]"+ echo ""+ echo "where commands are:"+ echo " add - Add a new single bookmark."+ echo " add-all - Add all currently opened pages as bookmarks."+ echo " delete-tag - Delete all bookmarks with a given tag."+ echo " load - Load a single bookmark in current $BROWSER instance."+ echo " load-tag - Load all bookmarks with a given tag in new $BROWSER instances."+ ;;+esac
hbro.cabal view
@@ -1,8 +1,8 @@ Name: hbro-Version: 0.5.1+Version: 0.5.2 Synopsis: A suckless minimal KISSy browser -- Description: --- Homepage:+Homepage: http://projects.haskell.org/hbro/ Category: Browser,Web Stability: alpha @@ -14,8 +14,10 @@ Cabal-version: >=1.8 Build-type: Simple-Data-files: examples/ui.xml Extra-source-files: examples/Main.hs+Data-files: + examples/ui.xml,+ examples/scripts/bookmarks.sh Source-repository head Type: git