leksah 0.8.0.3 → 0.8.0.4
raw patch · 6 files changed
+150/−65 lines, 6 files
Files
- leksah.cabal +2/−2
- src/IDE/Leksah.hs +66/−50
- src/IDE/Metainfo/Provider.hs +1/−2
- src/IDE/OSX.hs +64/−0
- src/IDE/Package.hs +1/−0
- src/IDE/Workspaces.hs +16/−11
leksah.cabal view
@@ -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
src/IDE/Leksah.hs view
@@ -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++
src/IDE/Metainfo/Provider.hs view
@@ -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
+ src/IDE/OSX.hs view
@@ -0,0 +1,64 @@+{-# INCLUDE <igemacintegration/ige-mac-menu.h> #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+--+-- Module : IDE.OSX+-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie+-- License : GNU-GPL+--+-- Maintainer : <maintainer at leksah.org>+-- 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 ()+
src/IDE/Package.hs view
@@ -18,6 +18,7 @@ module IDE.Package ( packageConfig+, packageConfig' , buildPackage , packageDoc
src/IDE/Workspaces.hs view
@@ -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)