diff --git a/hpage.cabal b/hpage.cabal --- a/hpage.cabal +++ b/hpage.cabal @@ -1,5 +1,5 @@ name: hpage -version: 0.7.6 +version: 0.8.0 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -21,6 +21,7 @@ res/images/icon/hpage.icns res/images/icon/hpage.tif res/help/helpPage.hs + res/help/about.html res/test/*.hs data-dir: "" extra-source-files: Setup.hs diff --git a/res/help/about.html b/res/help/about.html new file mode 100644 --- /dev/null +++ b/res/help/about.html @@ -0,0 +1,44 @@ + + + + + + + + diff --git a/src/HPage/Control.hs b/src/HPage/Control.hs --- a/src/HPage/Control.hs +++ b/src/HPage/Control.hs @@ -467,7 +467,11 @@ do ctx <- get iores <- liftIO $ HPIO.runIn (ioServer ctx) ioAction - return $ Right iores + case iores of + Left err -> + return . Left . Hint.UnknownError $ show err + Right r -> + return . Right $ r Left err -> return $ Left err _ -> diff --git a/src/HPage/GUI/Dialogs.hs b/src/HPage/GUI/Dialogs.hs --- a/src/HPage/GUI/Dialogs.hs +++ b/src/HPage/GUI/Dialogs.hs @@ -6,25 +6,32 @@ import Graphics.UI.WXCore import HPage.GUI.IDs import qualified HPage.Control as HP +import HPage.Utils.Log data Preferences = Prefs {languageExtensions :: [HP.Extension], sourceDirs :: [FilePath], ghcOptions :: String} deriving (Eq, Show) +aboutDialog :: Window a -> FilePath -> IO () +aboutDialog win aboutFile = + htmlDialog win "About \955Page" (sz 400 500) $ "file://" ++ aboutFile + hayooDialog :: Window a -> String -> IO () hayooDialog win query = - htmlDialog win "Hayoo!" $ "http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=" ++ query + htmlDialog win "Hayoo!" (sz 640 480) $ "http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=" ++ query -htmlDialog :: Window a -> String -> String -> IO () -htmlDialog win caption url = +htmlDialog :: Window a -> String -> Size -> String -> IO () +htmlDialog win caption size url = do dlg <- dialog win [text := caption] - htmlw <- htmlWindowCreate dlg idAny (rect (point 0 0) (sz 640 480)) 0 "" + htmlw <- htmlWindowCreate dlg idAny (rect (point 0 0) size) 0 "" + debugIO ("url:", url) htmlWindowLoadPage htmlw url set dlg [layout := fill $ widget htmlw, visible := True, - clientSize := sz 640 480] + clientSize := size] + windowCenter dlg wxCENTRE_ON_SCREEN return () preferencesDialog :: Window a -> String -> Preferences -> IO (Maybe Preferences) diff --git a/src/HPage/GUI/FreeTextWindow.hs b/src/HPage/GUI/FreeTextWindow.hs --- a/src/HPage/GUI/FreeTextWindow.hs +++ b/src/HPage/GUI/FreeTextWindow.hs @@ -56,6 +56,16 @@ return $ dropFileName progPath "Resources" "helpPage.hs" _ -> getDataFileName "res/help/helpPage.hs" + +aboutFile :: IO FilePath +aboutFile = + do + progPath <- getProgPath + case takeBaseName progPath of + "MacOS" -> + return $ dropFileName progPath "Resources" "about.html" + _ -> + getDataFileName "res/help/about.html" data GUIBottom = GUIBtm { bottomDesc :: String, bottomSource :: String } @@ -228,7 +238,8 @@ mnuHelp <- menuHelp [] menuAppend mnuHelp wxId_HELP "&Help page\tCtrl-h" "Open the Help Page" False - menuAbout mnuHelp [on command := infoDialog win "About \955Page" "Author: Fernando Brujo Benavides\nWebsite: http://haskell.hpage.com"] + about <- aboutFile + menuAbout mnuHelp [on command := aboutDialog win about] set win [menuBar := [mnuPage, mnuEdit, mnuHask, mnuHelp]] evtHandlerOnMenuCommand win wxId_NEW $ onCmd "runHP' addPage" $ runHP' HP.addPage diff --git a/src/HPage/IOServer.hs b/src/HPage/IOServer.hs --- a/src/HPage/IOServer.hs +++ b/src/HPage/IOServer.hs @@ -3,6 +3,7 @@ start, stop, runIn, ServerHandle ) where +import Control.Exception (try, SomeException) import Control.Monad import Control.Monad.Trans import Control.Concurrent.Process @@ -13,10 +14,10 @@ start = spawn ioRunner >>= return . SH where ioRunner = forever $ recv >>= liftIO -runIn :: ServerHandle -> IO a -> IO a +runIn :: ServerHandle -> IO a -> IO (Either SomeException a) runIn server action = runHere $ do me <- self - sendTo (handle server) $ action >>= sendTo me + sendTo (handle server) $ try action >>= sendTo me recv stop :: ServerHandle -> IO ()