diff --git a/Hbro/Core.hs b/Hbro/Core.hs --- a/Hbro/Core.hs +++ b/Hbro/Core.hs @@ -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 diff --git a/Hbro/Socket.hs b/Hbro/Socket.hs --- a/Hbro/Socket.hs +++ b/Hbro/Socket.hs @@ -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") [] diff --git a/examples/Main.hs b/examples/Main.hs --- a/examples/Main.hs +++ b/examples/Main.hs @@ -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), (([], ""), reload True), (([Shift], ""), reload False), + (([Control], "r"), reload True), + (([Control, Shift], "R"), reload False), (([], "^"), horizontalHome), (([], "$"), horizontalEnd), (([], ""), verticalHome), @@ -78,8 +85,8 @@ (([Control], ""), goHome), -- Display - (([Shift], "+"), zoomIn), - (([], "-"), zoomOut), + (([Control, Shift], "+"), zoomIn), + (([Control], "-"), zoomOut), (([], ""), fullscreen), (([], ""), 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" diff --git a/examples/scripts/bookmarks.sh b/examples/scripts/bookmarks.sh new file mode 100644 --- /dev/null +++ b/examples/scripts/bookmarks.sh @@ -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 diff --git a/hbro.cabal b/hbro.cabal --- a/hbro.cabal +++ b/hbro.cabal @@ -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