himerge-0.17.9: src/Web.hs

{-
    Implementation of the Mozilla Embedded Browser.
    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}

module Web where

import Util
import Graphics.UI.Gtk
import Graphics.UI.Gtk.MozEmbed
import System.Process
import System.Exit
import System.Glib.Signals
import Control.Concurrent
import Control.Parallel

webapp :: String
webapp = "firefox"

webBrowser :: IO (Frame, MozEmbed)
{- | Package information widget. (Mozilla) -}
webBrowser = 
    do
    mozEmbedSetCompPath mozEmbedDefaultCompPath
    mozbrowser <- mozEmbedNew
    webframe <- frameNew
    containerAdd webframe mozbrowser
    -- Open the web browser links with the mozilla/firefox programs.
    mozbrowser `onMouseDoubleClick` 
		   (\ _ -> do
		    forkIO $ mozEmbedStopLoad mozbrowser
		    stopMoz mozbrowser
		    loadUrl mozbrowser >> return 0)
    -- Omit one click.
    mozbrowser `onMouseClick`
		   (\ _ -> do
		    forkIO $ mozEmbedStopLoad mozbrowser
		    (mozEmbedStopLoad mozbrowser)
		           `seq` (stopMoz mozbrowser)
		    return 0)
    return (webframe, mozbrowser)

stopMoz :: MozEmbed -> IO ThreadId
stopMoz moz =
    moz `onOpenURI`
	    (\ _ -> mozEmbedStopLoad moz >>
	     return True) >>=
    forkIO . signalDisconnect

loadUrl :: MozEmbed -> IO ThreadId
loadUrl mb  = forkIO (mozEmbedGetLinkMessage mb >>=
		      runMozilla)

runMozilla :: String -> IO ()
runMozilla ('f':'i':'l':'e':':':'/':'/':url) =
    do
    ph <- runProcess envbin [webapp, url] Nothing Nothing 
	             Nothing Nothing Nothing
    ph `onExit` f
	where
	f ExitSuccess = return ()
	f e = popErrorWindow $ show e
runMozilla _ = return ()