diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,5 +1,5 @@ name: leksah -version: 0.8.0.3 +version: 0.8.0.4 cabal-version: >=1.6 build-type: Simple license: GPL @@ -110,7 +110,7 @@ IDE.Pane.Breakpoints IDE.Pane.Trace IDE.Pane.Variables IDE.Pane.Errors IDE.TextEditor IDE.Workspaces IDE.Statusbar IDE.Pane.Workspace IDE.PaneGroups - IDE.Utils.ServerConnection + IDE.Utils.ServerConnection IDE.OSX ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all -prof ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans diff --git a/src/IDE/Leksah.hs b/src/IDE/Leksah.hs --- a/src/IDE/Leksah.hs +++ b/src/IDE/Leksah.hs @@ -53,7 +53,7 @@ import IDE.Pane.SourceBuffer import IDE.Find import Graphics.UI.Editor.Composite (filesEditor, maybeEditor) -import Graphics.UI.Editor.Simple (fileEditor, intEditor, stringEditor) +import Graphics.UI.Editor.Simple (fileEditor, intEditor, stringEditor, boolEditor) import IDE.Metainfo.Provider (initInfo) import IDE.Workspaces (backgroundMake) import IDE.Utils.GUIUtils @@ -70,6 +70,7 @@ #endif import System.Log import System.Log.Logger(updateGlobalLogger,rootLoggerName,setLevel) +import Data.List (stripPrefix) -- -------------------------------------------------------------------- -- Command line options @@ -88,7 +89,7 @@ , Option ['e'] ["verbosity"] (ReqArg Verbosity "Verbosity") "One of DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY"] -header = "Usage: ide [OPTION...] files..." +header = "Usage: leksah [OPTION...] files..." ideOpts :: [String] -> IO ([Flag], [String]) ideOpts argv = @@ -287,15 +288,20 @@ (maybeEditor ((fileEditor (Just (configPath "packageSources")) FileChooserActionSelectFolder "Select folder for unpacking cabal packages"), emptyParams) True "Yes") , mkField + (paraName <<<- ParaName "Maybe an URL to load prebuild metadata " $ emptyParams) + retreiveURL + (\b a -> a{retreiveURL = b}) + (maybeEditor ((stringEditor (\ _ -> True)), emptyParams) True "Yes") + , mkField (paraName <<<- ParaName "Port number for server connection" $ emptyParams) serverPort (\b a -> a{serverPort = b}) (intEditor (1.0, 65535.0, 1.0)) , mkField - (paraName <<<- ParaName "Server IP address " $ emptyParams) - serverIP - (\b a -> a{serverIP = b}) - (stringEditor (\ s -> not $ null s))] + (paraName <<<- ParaName "End the server with last connection" $ emptyParams) + endWithLastConn + (\b a -> a{endWithLastConn = b}) + boolEditor] -- -- | Called when leksah ist first called (the .leksah-xx directory does not exist) @@ -306,60 +312,70 @@ prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir prefs <- readPrefs prefsPath configDir <- getConfigDir - dialog <- windowNew - vb <- vBoxNew False 0 - bb <- hButtonBoxNew - ok <- buttonNewFromStock "gtk-ok" - cancel <- buttonNewFromStock "gtk-cancel" - boxPackStart bb ok PackNatural 0 - boxPackStart bb cancel PackNatural 0 + dialog <- dialogNew + dialogAddButton dialog "gtk-ok" ResponseOk + dialogAddButton dialog "gtk-cancel" ResponseCancel + vb <- dialogGetUpper dialog label <- labelNew (Just ("Welcome to Leksah, the Haskell IDE.\n" ++ "At the first start, Leksah will collect metadata about your installed haskell packages.\n" ++ "You can add folders under which you have sources for Haskell packages not available from Hackage.\n" ++ "If you are not shure what to do, just keep the defaults \n" ++ "This process may take a long time, but it only needs to run one time.")) - (widget, setInj, getExt,notifier) - <- buildEditor (fDescription configDir) prefs - ok `onClicked` (do - mbNewPrefs <- extract prefs [getExt] - case mbNewPrefs of - Nothing -> do - sysMessage Normal "No dialog results" - return () - Just newPrefs -> do - fp <- getConfigFilePathForSave standardPreferencesFilename - writePrefs fp newPrefs - fp2 <- getConfigFilePathForSave strippedPreferencesFilename - SP.writeStrippedPrefs fp2 - (SP.Prefs {SP.sourceDirectories = sourceDirectories newPrefs, - SP.unpackDirectory = unpackDirectory newPrefs, - SP.retreiveURL = retreiveURL newPrefs, - SP.serverPort = serverPort newPrefs, - SP.endWithLastConn = endWithLastConn newPrefs}) - widgetDestroy dialog - mainQuit - firstBuild newPrefs - ) - cancel `onClicked` (do - widgetDestroy dialog - mainQuit) - dialog `onDelete` (\_ -> do - widgetDestroy dialog - mainQuit - return True) + (widget, setInj, getExt,notifier) <- buildEditor (fDescription configDir) prefs boxPackStart vb label PackGrow 7 boxPackStart vb widget PackGrow 7 - boxPackEnd vb bb PackNatural 7 - containerAdd dialog vb - widgetSetSizeRequest dialog 1024 800 + widgetSetSizeRequest dialog 800 640 widgetShowAll dialog - mainGUI - return () + response <- dialogRun dialog + widgetHide dialog + widgetDestroy dialog + case response of + ResponseOk -> do + mbNewPrefs <- extract prefs [getExt] + case mbNewPrefs of + Nothing -> do + sysMessage Normal "No dialog results" + return () + Just newPrefs -> do + fp <- getConfigFilePathForSave standardPreferencesFilename + writePrefs fp newPrefs + fp2 <- getConfigFilePathForSave strippedPreferencesFilename + SP.writeStrippedPrefs fp2 + (SP.Prefs {SP.sourceDirectories = sourceDirectories newPrefs, + SP.unpackDirectory = unpackDirectory newPrefs, + SP.retreiveURL = retreiveURL newPrefs, + SP.serverPort = serverPort newPrefs, + SP.endWithLastConn = endWithLastConn newPrefs}) + firstBuild newPrefs + _ -> return () firstBuild newPrefs = do - (output, pid) <- runTool "leksah-server" ["-sbo"] Nothing - mapM_ (putStrLn . toolline) output - waitForProcess pid + dialog <- dialogNew + vb <- dialogGetUpper dialog + progressBar <- progressBarNew + progressBarSetText progressBar "Please wait while Leksah collects information about Haskell package on your system" + progressBarSetFraction progressBar 0.0 + boxPackStart vb progressBar PackGrow 7 + forkIO $ do + (output, pid) <- runTool "leksah-server" ["-sbo"] Nothing + mapM_ (update progressBar) output + waitForProcess pid + postGUIAsync (dialogResponse dialog ResponseOk) + widgetShowAll dialog + dialogRun dialog + widgetHide dialog + widgetDestroy dialog return () + where + update pb to = do + putStrLn str + when (isJust prog) $ postGUIAsync (progressBarSetFraction pb (fromJust prog)) + where + str = toolline to + prog = case stripPrefix "update_toolbar " str of + Just rest -> Just (read rest) + Nothing -> Nothing + + diff --git a/src/IDE/Metainfo/Provider.hs b/src/IDE/Metainfo/Provider.hs --- a/src/IDE/Metainfo/Provider.hs +++ b/src/IDE/Metainfo/Provider.hs @@ -394,8 +394,7 @@ sourcePath <- if exists' then liftM Just (readFile filePath2) else return Nothing - let packageInfo' = trace ("source path= " ++ show sourcePath) $ - injectSourceInPack sourcePath packageInfo + let packageInfo' = injectSourceInPack sourcePath packageInfo return (Just packageInfo')) (\ (e :: SomeException) -> do sysMessage Normal diff --git a/src/IDE/OSX.hs b/src/IDE/OSX.hs new file mode 100644 --- /dev/null +++ b/src/IDE/OSX.hs @@ -0,0 +1,64 @@ +{-# INCLUDE #-} +{-# LANGUAGE ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- +-- Module : IDE.OSX +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie +-- License : GNU-GPL +-- +-- Maintainer : +-- Stability : provisional +-- Portability : portable +-- +-- +-- Support for OSX +-- +--------------------------------------------------------------------------------- + +module IDE.OSX ( + updateMenu +) where + +import Graphics.UI.Gtk +import Foreign (nullPtr, withForeignPtr, Ptr(..)) +import System.Glib (GObject(..)) +import System.Glib.Types (toGObject) + +foreign import ccall unsafe "ige_mac_menu_set_menu_bar" ige_mac_menu_set_menu_bar :: Ptr GObject -> IO () +foreign import ccall unsafe "ige_mac_menu_set_quit_menu_item" ige_mac_menu_set_quit_menu_item :: Ptr GObject -> IO () +foreign import ccall unsafe "ige_mac_menu_add_app_menu_group" ige_mac_menu_add_app_menu_group :: IO (Ptr GObject) +foreign import ccall unsafe "ige_mac_menu_add_app_menu_item" ige_mac_menu_add_app_menu_item :: Ptr GObject -> Ptr GObject -> Ptr GObject -> IO () + +updateMenu :: UIManager -> IO () +updateMenu uiManager = do + mbMenu <- uiManagerGetWidget uiManager "/ui/menubar" + case mbMenu of + Just menu -> do + widgetHide menu + let (GObject p) = toGObject menu + withForeignPtr p ige_mac_menu_set_menu_bar + Nothing -> return () + + mbQuit <- uiManagerGetWidget uiManager "/ui/menubar/_File/_Quit" + case mbQuit of + Just quit -> do + let (GObject p) = toGObject quit + withForeignPtr p ige_mac_menu_set_quit_menu_item + Nothing -> return () + + mbAbout <- uiManagerGetWidget uiManager "/ui/menubar/_Help/_About" + case mbAbout of + Just about -> do + let (GObject p) = toGObject about + group <- ige_mac_menu_add_app_menu_group + withForeignPtr p (\ptr -> ige_mac_menu_add_app_menu_item group ptr nullPtr) + Nothing -> return () + + mbPrefs <- uiManagerGetWidget uiManager "/ui/menubar/_Configuration/Edit general Preferences" + case mbPrefs of + Just prefs -> do + let (GObject p) = toGObject prefs + group <- ige_mac_menu_add_app_menu_group + withForeignPtr p (\ptr -> ige_mac_menu_add_app_menu_item group ptr nullPtr) + Nothing -> return () + diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -18,6 +18,7 @@ module IDE.Package ( packageConfig +, packageConfig' , buildPackage , packageDoc diff --git a/src/IDE/Workspaces.hs b/src/IDE/Workspaces.hs --- a/src/IDE/Workspaces.hs +++ b/src/IDE/Workspaces.hs @@ -56,9 +56,9 @@ import IDE.Pane.PackageEditor (packageNew', choosePackageFile) import Data.List ((\\), foldl', nub, delete) import IDE.Package - (getModuleTemplate, getPackageDescriptionAndPath, buildPackage, - packageInstall', packageClean, activatePackage, deactivatePackage, - idePackageFromPath) + (packageConfig', getModuleTemplate, getPackageDescriptionAndPath, + buildPackage, packageInstall', packageClean, activatePackage, + deactivatePackage, idePackageFromPath) import System.Directory (createDirectoryIfMissing, doesFileExist, canonicalizePath) import System.Time (getClockTime) @@ -441,16 +441,21 @@ Nothing -> [] Just list -> list ++ concatMap allDeps list -makePackages :: Bool -> [IDEPackage] -> IDEAction -makePackages _ [] = return () -makePackages isBackgroundBuild packages = do +makePackages :: Bool -> Bool -> [IDEPackage] -> IDEAction +makePackages _ _ [] = return () +makePackages isBackgroundBuild needConfigure packages = do mbWs <- readIDE workspace prefs' <- readIDE prefs case mbWs of Nothing -> return () Just ws -> do let package = selectFirstReasonableTarget packages (wsReverseDeps ws) - buildPackage isBackgroundBuild package (cont prefs' package ws) + if needConfigure + then packageConfig' package (\b -> + if b + then buildPackage isBackgroundBuild package (cont prefs' package ws) + else return ()) + else buildPackage isBackgroundBuild package (cont prefs' package ws) where cont prefs' package ws res = if res @@ -469,7 +474,7 @@ cont2 deps package res = do when res $ do let nextTargets = delete package $ nub $ packages ++ deps - makePackages isBackgroundBuild nextTargets + makePackages isBackgroundBuild True nextTargets backgroundMake :: IDEAction @@ -485,7 +490,7 @@ else return [] let isModified = not (null modifiedPacks) when isModified $ do - makePackages True modifiedPacks + makePackages True False modifiedPacks ) (\(e :: SomeException) -> sysMessage Normal (show e)) @@ -494,7 +499,7 @@ activePack' <- readIDE activePack case activePack' of Nothing -> return () - Just p -> makePackages False [p] + Just p -> makePackages False False [p] workspaceClean = do mbWs <- readIDE workspace @@ -506,5 +511,5 @@ mbWs <- readIDE workspace case mbWs of Nothing -> return () - Just ws -> makePackages False (wsPackages ws) + Just ws -> makePackages False True (wsPackages ws)