diff --git a/Readme b/Readme --- a/Readme +++ b/Readme @@ -5,18 +5,18 @@ Leksah uses GTK+ as GUI Toolkit with the gtk2hs binding. It is plattform independend and should run on any plattform where GTK+, gtk2hs and ghc can be installed. -It is currently been tested on Windows and Linux. It uses the Cabal package management +It is currently been tested on Linux, Mac and Windows. It uses the Cabal package management and build system for Package Management. It currently only supports the Glasgow Haskell Compiler (ghc). -Documentation can be found in the doc/ subdirectory. +Documentation can be found on leksah.org. System Requirements =================== Leksah currently requires: GHC version 6.10.x - gtk2hs 0.9.14 + gtk2hs 0.10.x other dependencies see cabal file Leksah works better if you install GHC and additional packages with sources diff --git a/data/Default.keymap b/data/Default.keymap --- a/data/Default.keymap +++ b/data/Default.keymap @@ -72,6 +72,7 @@ -> HelpAbout b -> BuildPackage +r -> AddAllImports r -> RunPackage diff --git a/data/Default.menu b/data/Default.menu --- a/data/Default.menu +++ b/data/Default.menu @@ -58,6 +58,7 @@ + @@ -124,16 +125,18 @@ + - + + diff --git a/data/ide_build.png b/data/ide_build.png new file mode 100644 Binary files /dev/null and b/data/ide_build.png differ diff --git a/data/ide_clean.png b/data/ide_clean.png new file mode 100644 Binary files /dev/null and b/data/ide_clean.png differ diff --git a/data/ide_link.png b/data/ide_link.png new file mode 100644 Binary files /dev/null and b/data/ide_link.png differ diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,17 +1,11 @@ name: leksah -version: 0.4.3 +version: 0.4.4 cabal-version: >=1.4 build-type: Simple license: GPL license-file: LICENSE -copyright: 2007-2009 Jürgen Nicklisch-Franken +copyright: 2007-2009 Juergen Nicklisch-Franken, Hamish Mackenzie maintainer: maintainer@leksah.org -build-depends: Cabal ==1.6.0.1, base >=4.0.0.0, binary >=0.4.4, - bytestring >=0.9.0.1, containers >=0.2.0.0, directory >=1.0.0.2, - filepath >=1.1.0.1, ghc >=6.10.1, glib >=0.10, gtk >=0.10, - gtksourceview2 >=0.10.0, mtl >=1.1.0.2, old-time >=1.0.0.1, - parsec >=2.1.0.1, pretty >=1.0.1.0, process >=1.0.1.0, - regex-posix ==0.72.0.3, utf8-string >=0.3.1.1 stability: provisional homepage: http://www.leksah.org package-url: http://code.haskell.org/leksah @@ -19,7 +13,7 @@ synopsis: Haskell IDE written in Haskell description: An Integrated Development Environment for Haskell written in Haskell. category: Development, IDE, Editor -author: Jutaro +author: Juergen Nicklisch-Franken, Hamish Mackenzie tested-with: GHC ==6.10.1 data-files: LICENSE Readme data/Current.session data/Default.candy data/Default.keymap data/Default.menu data/Default.prefs @@ -31,45 +25,57 @@ data/ide_newtype.png data/ide_other.png data/ide_reexported.png data/ide_rule.png data/ide_run.png data/ide_slot.png data/ide_source.png data/ide_type.png data/leksah.png - data/welcome.txt + data/welcome.txt data/ide_clean.png data/ide_build.png data/ide_link.png data-dir: "" extra-source-files: Setup.lhs extra-tmp-files: - -executable: leksah -main-is: Main.hs -buildable: True -build-tools: -cpp-options: -cc-options: -ld-options: -pkgconfig-depends: -frameworks: -c-sources: -extensions: CPP -extra-libraries: -extra-lib-dirs: -includes: -install-includes: -include-dirs: -hs-source-dirs: src -other-modules: Default DeepSeq MyMissing Data.Binary.Shared - Control.Event Graphics.UI.Frame.ViewFrame Graphics.UI.Frame.Panes - Graphics.UI.Editor.Composite Graphics.UI.Editor.Simple - Graphics.UI.Editor.Basics Graphics.UI.Editor.Parameters - Graphics.UI.Editor.MakeEditor IDE.Completion IDE.ImportTool - IDE.Find IDE.SaveSession IDE.Menu IDE.Keymap IDE.FileUtils - IDE.DescriptionPP IDE.PrinterParser IDE.Package IDE.Exception - IDE.Leksah IDE.GUIHistory IDE.SourceCandy IDE.NotebookFlipper - IDE.Core.Types IDE.Core.State IDE.Metainfo.GHCUtils - IDE.Metainfo.Provider IDE.Metainfo.SourceCollector - IDE.Metainfo.Serializable IDE.Metainfo.InterfaceCollector - IDE.Pane.Preferences IDE.Pane.ClassHierarchy IDE.Pane.PackageEditor - IDE.Pane.Info IDE.Pane.Log IDE.Pane.SourceBuffer IDE.Pane.Modules - IDE.Pane.Search IDE.Pane.References IDE.Pane.PackageFlags -ghc-prof-options: -auto-all -prof -ghc-shared-options: -auto-all -prof -ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns -hugs-options: -nhc98-options: -jhc-options: +Executable leksah + if os(windows) + build-depends: Win32 >=2.2.0.0 + else + build-depends: unix >=2.3.1.0 + build-depends: Cabal ==1.6.0.1, base >=4.0.0.0, binary >=0.4.4, + bytestring >=0.9.0.1, containers >=0.2.0.0, directory >=1.0.0.2, + filepath >=1.1.0.1, ghc >=6.10.1, glib >=0.10, gtk >=0.10, + gtksourceview2 >=0.10.0, mtl >=1.1.0.2, old-time >=1.0.0.1, + parsec >=2.1.0.1, pretty >=1.0.1.0, process >=1.0.1.0, + regex-posix ==0.72.0.3, utf8-string >=0.3.1.1 + main-is: Main.hs + buildable: True + build-tools: + cpp-options: + cc-options: + ld-options: + pkgconfig-depends: + frameworks: + c-sources: + extensions: CPP + extra-libraries: + extra-lib-dirs: + includes: + install-includes: + include-dirs: + hs-source-dirs: src + other-modules: Default DeepSeq MyMissing Data.Binary.Shared + Control.Event Graphics.UI.Frame.ViewFrame Graphics.UI.Frame.Panes + Graphics.UI.Editor.Composite Graphics.UI.Editor.Simple + Graphics.UI.Editor.Basics Graphics.UI.Editor.Parameters + Graphics.UI.Editor.MakeEditor IDE.Completion IDE.ImportTool + IDE.Find IDE.SaveSession IDE.Menu IDE.Keymap IDE.FileUtils + IDE.DescriptionPP IDE.PrinterParser IDE.Package IDE.Exception + IDE.Leksah IDE.GUIHistory IDE.SourceCandy IDE.NotebookFlipper + IDE.Core.Types IDE.Core.State IDE.Metainfo.GHCUtils + IDE.Metainfo.Provider IDE.Metainfo.SourceCollector + IDE.Metainfo.Serializable IDE.Metainfo.InterfaceCollector + IDE.Pane.Preferences IDE.Pane.ClassHierarchy IDE.Pane.PackageEditor + IDE.Pane.Info IDE.Pane.Log IDE.Pane.SourceBuffer IDE.Pane.Modules + IDE.Pane.Search IDE.Pane.References IDE.Pane.PackageFlags + ghc-prof-options: -auto-all -prof + ghc-shared-options: -auto-all -prof + ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns + hugs-options: + nhc98-options: + jhc-options: + + + diff --git a/src/Control/Event.hs b/src/Control/Event.hs --- a/src/Control/Event.hs +++ b/src/Control/Event.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : Control.Event --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | A simple event mechanism diff --git a/src/Default.hs b/src/Default.hs --- a/src/Default.hs +++ b/src/Default.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : Default --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Stability : provisional -- Portability : portable -- -- | Module for default values of a data type diff --git a/src/Graphics/UI/Editor/Basics.hs b/src/Graphics/UI/Editor/Basics.hs --- a/src/Graphics/UI/Editor/Basics.hs +++ b/src/Graphics/UI/Editor/Basics.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.Basics --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Module for the basiscs of composing GUIs from editors diff --git a/src/Graphics/UI/Editor/Composite.hs b/src/Graphics/UI/Editor/Composite.hs --- a/src/Graphics/UI/Editor/Composite.hs +++ b/src/Graphics/UI/Editor/Composite.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.Composite --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Module for making composite editors diff --git a/src/Graphics/UI/Editor/MakeEditor.hs b/src/Graphics/UI/Editor/MakeEditor.hs --- a/src/Graphics/UI/Editor/MakeEditor.hs +++ b/src/Graphics/UI/Editor/MakeEditor.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.MakeEditor --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Module for making editors out of descriptions diff --git a/src/Graphics/UI/Editor/Parameters.hs b/src/Graphics/UI/Editor/Parameters.hs --- a/src/Graphics/UI/Editor/Parameters.hs +++ b/src/Graphics/UI/Editor/Parameters.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.Parameters --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Module for parameters for editors diff --git a/src/Graphics/UI/Editor/Simple.hs b/src/Graphics/UI/Editor/Simple.hs --- a/src/Graphics/UI/Editor/Simple.hs +++ b/src/Graphics/UI/Editor/Simple.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.Simple --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Module for making simple editors @@ -23,7 +23,7 @@ , fontEditor , comboSelectionEditor , staticListEditor -, staticListEditor2 +, staticListMultiEditor , multiselectionEditor , fileEditor , otherEditor @@ -391,8 +391,8 @@ -- | Editor for the selection of some elements from a static list of elements in the -- | form of a list box with toggle elements -staticListEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta] -staticListEditor list showF parameters notifier = do +staticListMultiEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta] +staticListMultiEditor list showF parameters notifier = do coreRef <- newIORef Nothing mkEditor (\widget objs -> do @@ -405,10 +405,7 @@ mapM_ (activateEvent (castToWidget listView) notifier Nothing) [FocusOut,FocusIn] sel <- treeViewGetSelection listView - treeSelectionSetMode sel - (case getParameter paraMultiSel parameters of - True -> SelectionMultiple - False -> SelectionSingle) + treeSelectionSetMode sel SelectionSingle rendererToggle <- cellRendererToggleNew set rendererToggle [cellToggleActivatable := True] rendererText <- cellRendererTextNew @@ -465,11 +462,11 @@ -- | Editor for the selection of some elements from a static list of elements in the -- | form of a list box -staticListEditor2 :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta] -staticListEditor2 list showF parameters notifier = do +staticListEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor beta +staticListEditor list showF parameters notifier = do coreRef <- newIORef Nothing mkEditor - (\widget objs -> do + (\widget obj -> do core <- readIORef coreRef case core of Nothing -> do @@ -499,21 +496,27 @@ scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic containerAdd widget sw treeSelectionUnselectAll sel - let inds = catMaybes $map (\obj -> elemIndex obj list) objs - mapM_ (\i -> treeSelectionSelectPath sel [i]) inds + let mbInd = elemIndex obj list + case mbInd of + Nothing -> return () + Just ind -> treeSelectionSelectPath sel [ind] writeIORef coreRef (Just listView) Just listView -> do sel <- treeViewGetSelection listView treeSelectionUnselectAll sel - let inds = catMaybes $map (\obj -> elemIndex obj list) objs - mapM_ (\i -> treeSelectionSelectPath sel [i]) inds) + let mbInd = elemIndex obj list + case mbInd of + Nothing -> return () + Just ind -> treeSelectionSelectPath sel [ind]) (do core <- readIORef coreRef case core of Nothing -> return Nothing Just listView -> do sel <- treeViewGetSelection listView - treePath <- treeSelectionGetSelectedRows sel - return (Just (map (\[i] -> list !! i) treePath))) + treePaths <- treeSelectionGetSelectedRows sel + case treePaths of + [[i]] -> return (Just (list !! i)) + _ -> return Nothing) parameters notifier diff --git a/src/Graphics/UI/Frame/Panes.hs b/src/Graphics/UI/Frame/Panes.hs --- a/src/Graphics/UI/Frame/Panes.hs +++ b/src/Graphics/UI/Frame/Panes.hs @@ -5,11 +5,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Core.Panes --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The basic definitions for all panes diff --git a/src/Graphics/UI/Frame/ViewFrame.hs b/src/Graphics/UI/Frame/ViewFrame.hs --- a/src/Graphics/UI/Frame/ViewFrame.hs +++ b/src/Graphics/UI/Frame/ViewFrame.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Core.ViewFrame --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- diff --git a/src/IDE/Core/State.hs b/src/IDE/Core/State.hs --- a/src/IDE/Core/State.hs +++ b/src/IDE/Core/State.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Core.State --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The core state of ide. This module is imported from every other module, @@ -60,6 +60,11 @@ , getStatusbarIO , getStatusbarLC +, getBackgroundBuildToggled +, setBackgroundBuildToggled +, getBackgroundLinkToggled +, setBackgroundLinkToggled + , getRecentFiles , getRecentPackages , controlIsPressed @@ -94,6 +99,7 @@ import IDE.Exception import Control.Event import System.IO +import System.Process (ProcessHandle(..)) -- this should not be repeated here, why is it necessary? instance MonadIO Ghc where @@ -158,6 +164,7 @@ , toolbar :: (Bool,Maybe Toolbar) , recentFiles :: [FilePath] , recentPackages :: [FilePath] +, buildProcess :: Maybe ProcessHandle } --deriving Show data IDEState = @@ -402,7 +409,7 @@ removePaneAdmin pane modifyIDE_ (\ide -> return ide{recentPanes = filter (/= paneName pane) (recentPanes ide)}) --- get widget elements (menu) +-- get widget elements (menu & toolbar) getCandyState :: PaneMonad alpha => alpha (Bool) getCandyState = do @@ -426,6 +433,26 @@ case mbWidget of Nothing -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " ++ path) Just widget -> return (castToMenuItem widget) + +getBackgroundBuildToggled :: PaneMonad alpha => alpha (Bool) +getBackgroundBuildToggled = do + ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction + liftIO $ toggleActionGetActive ui + +setBackgroundBuildToggled :: PaneMonad alpha => Bool -> alpha () +setBackgroundBuildToggled b = do + ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction + liftIO $ toggleActionSetActive ui b + +getBackgroundLinkToggled :: PaneMonad alpha => alpha (Bool) +getBackgroundLinkToggled = do + ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundLink" castToToggleAction + liftIO $ toggleActionGetActive ui + +setBackgroundLinkToggled :: PaneMonad alpha => Bool -> alpha () +setBackgroundLinkToggled b = do + ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundLink" castToToggleAction + liftIO $ toggleActionSetActive ui b getRecentFiles , getRecentPackages :: IDEM MenuItem getRecentFiles = getMenuItem "ui/menubar/_File/_Recent Files" diff --git a/src/IDE/Core/Types.hs b/src/IDE/Core/Types.hs --- a/src/IDE/Core/Types.hs +++ b/src/IDE/Core/Types.hs @@ -7,11 +7,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Core.Data --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The core state of ide. This module is imported from every other module, @@ -165,6 +165,8 @@ , docuSearchURL :: String , completeRestricted :: Bool , saveAllBeforeBuild :: Bool + , backgroundBuild :: Bool + , backgroundLink :: Bool } deriving(Eq,Show) data SearchHint = Forward | Backward | Insert | Delete | Initial diff --git a/src/IDE/DescriptionPP.hs b/src/IDE/DescriptionPP.hs --- a/src/IDE/DescriptionPP.hs +++ b/src/IDE/DescriptionPP.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.DescriptionPP --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | Description of a editor with additional fileds for printing and parsing diff --git a/src/IDE/Exception.hs b/src/IDE/Exception.hs --- a/src/IDE/Exception.hs +++ b/src/IDE/Exception.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Exception --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | A Type for IDE exceptions diff --git a/src/IDE/FileUtils.hs b/src/IDE/FileUtils.hs --- a/src/IDE/FileUtils.hs +++ b/src/IDE/FileUtils.hs @@ -304,13 +304,14 @@ return filePath getSysLibDir :: IO FilePath -getSysLibDir = do +getSysLibDir = catch (do (_, out, _, pid) <- runInteractiveProcess "ghc" ["--print-libdir"] Nothing Nothing libDir <- hGetLine out let libDir2 = if ord (last libDir) == 13 then List.init libDir else libDir return (normalise libDir2) + ) $ \ _ -> error ("FileUtils>>getSysLibDir failed") diff --git a/src/IDE/Find.hs b/src/IDE/Find.hs --- a/src/IDE/Find.hs +++ b/src/IDE/Find.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Find --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portablea -- -- | The toolbar for searching and replacing in a text buffer @@ -59,7 +59,7 @@ getFindState :: IDEM FindState getFindState = do - (fb,ls) <- needFindbar + (fb,ls) <- needFindbar liftIO $ do lineNr <- getLineEntry fb >>= (\e -> spinButtonGetValueAsInt (castToSpinButton e)) replaceStr <- getReplaceEntry fb >>= (\e -> entryGetText (castToEntry e)) @@ -93,7 +93,6 @@ setWrapAround fb (wrapAround fs) setCaseSensitive fb (caseSensitive fs) setBackward fb (backward fs) - hideToolbar :: IDEAction hideToolbar = do diff --git a/src/IDE/GUIHistory.hs b/src/IDE/GUIHistory.hs --- a/src/IDE/GUIHistory.hs +++ b/src/IDE/GUIHistory.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.GUIHistory --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- diff --git a/src/IDE/ImportTool.hs b/src/IDE/ImportTool.hs --- a/src/IDE/ImportTool.hs +++ b/src/IDE/ImportTool.hs @@ -27,7 +27,7 @@ import Text.PrettyPrint (render) import Distribution.Text (disp) import IDE.Pane.SourceBuffer - (fileSaveBuffer, inActiveBufContext', selectSourceBuf) + (inActiveBufContext', selectSourceBuf) import Graphics.UI.Gtk import IDE.SourceCandy (getCandylessText) import Text.ParserCombinators.Parsec.Language (haskellStyle) @@ -41,7 +41,6 @@ paraName) import Graphics.UI.Editor.Basics (eventPaneName,GUIEventSelector(..)) import IDE.Metainfo.GHCUtils(parseHeader) -import Outputable (showSDoc,Outputable(..)) import Data.Maybe (fromJust) import RdrName (mkRdrUnqual) import OccName (mkDataOcc,mkVarOcc) @@ -53,18 +52,28 @@ (operator, dot, identifier, symbol, whiteSpace, lexeme,makeTokenParser) import Graphics.UI.Editor.Simple (okCancelFields, staticListEditor) import Control.Event (registerEvent) -import Control.Monad (foldM_) import Control.Monad.Trans (liftIO) +import Control.Monad (foldM_, when) +import Outputable (ppr,showSDoc) + + -- | Add all imports which gave error messages ... addAllImports :: IDEAction addAllImports = do + prefs' <- readIDE prefs + let buildInBackground = backgroundBuild prefs' + when buildInBackground ( + modifyIDE_ (\ide -> return (ide{prefs = prefs'{backgroundBuild = False}}))) errors <- readIDE errors foldM_ addThis (True,[]) [ y | (x,y) <- nubBy (\ (p1,_) (p2,_) -> p1 == p2) $ [(x,y) | (x,y) <- [((parseNotInScope . errDescription) e, e) | e <- errors]], isJust x] + when buildInBackground $ + modifyIDE_ (\ide -> return (ide{prefs = prefs'{backgroundBuild = True}})) + where addThis :: (Bool,[Descr]) -> ErrorSpec -> IDEM (Bool,[Descr]) addThis c@(False,_) _ = return c @@ -150,7 +159,6 @@ liftIO $ do i1 <- textBufferGetIterAtLine gtkbuf lineSel textBufferInsert gtkbuf i1 newLine - fileSaveBuffer False nb gtkbuf idebuf n return (True,descr : descrList) l@(impDecl:_) -> let newImpDecl = addToDecl (unLoc impDecl) @@ -171,7 +179,6 @@ i2 <- textBufferGetIterAtLine gtkbuf (lineEnd) textBufferDelete gtkbuf i1 i2 textBufferInsert gtkbuf i1 newLine - fileSaveBuffer False nb gtkbuf idebuf n return (True, descr : descrList) where isHiding (Just (_,False)) = True @@ -340,8 +347,8 @@ $ paraMultiSel <<<- ParaMultiSel False $ paraMinSize <<<- ParaMinSize (300,400) $ emptyParams) - (\ a -> [a]) - (\ [a] b -> a) + (\ a -> a) + (\ a b -> a) (staticListEditor ((nub . sort) list) id) selectModuleDialog :: [Descr] -> String -> Maybe Descr -> IO (Maybe Descr) diff --git a/src/IDE/Leksah.hs b/src/IDE/Leksah.hs --- a/src/IDE/Leksah.hs +++ b/src/IDE/Leksah.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Leksah --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- @@ -64,6 +64,7 @@ --import Outputable (ppr,showSDoc) import IDE.Metainfo.GHCUtils (inGhcIO) import IDE.NotebookFlipper (flipUp,flipDown) +import IDE.Package (packageBuild) -- --------------------------------------------------------------------- -- Command line options @@ -174,19 +175,19 @@ uiManager <- uiManagerNew newIcons hasConfigDir' <- hasConfigDir - (prefs,isFirstStart) <- if hasConfigDir' + (startupPrefs,isFirstStart) <- if hasConfigDir' then return (iprefs,False) else do firstStart iprefs prefsPath <- getConfigFilePathForLoad "Default.prefs" prefs <- readPrefs prefsPath return (prefs,True) - keysPath <- getConfigFilePathForLoad $ keymapName prefs ++ ".keymap" + keysPath <- getConfigFilePathForLoad $ keymapName startupPrefs ++ ".keymap" keyMap <- parseKeymap keysPath let accelActions = setKeymap (keyMap :: KeymapI) actions specialKeys <- buildSpecialKeys keyMap accelActions candyPath <- getConfigFilePathForLoad - (case sourceCandy prefs of + (case sourceCandy startupPrefs of Nothing -> "Default.candy" Just name -> name ++ ".candy") candySt <- parseCandy candyPath @@ -207,7 +208,7 @@ , specialKeys = specialKeys , specialKey = Nothing , candy = candySt - , prefs = prefs + , prefs = startupPrefs , activePack = Nothing , errors = [] , currentErr = Nothing @@ -220,6 +221,7 @@ , toolbar = (True,Nothing) , recentFiles = [] , recentPackages = [] + , buildProcess = Nothing } ideR <- newIORef ide menuDescription' <- menuDescription @@ -255,8 +257,11 @@ win `onDelete` (\ _ -> do reflectIDE quit ideR; return True) win `onKeyPress` (\ e -> reflectIDE (handleSpecialKeystrokes e) ideR) containerAdd win vb - reflectIDE (setCandyState (isJust (sourceCandy prefs))) ideR - let (x,y) = defaultSize prefs + reflectIDE (do + setCandyState (isJust (sourceCandy startupPrefs)) + setBackgroundBuildToggled (backgroundBuild startupPrefs) + setBackgroundLinkToggled (backgroundLink startupPrefs)) ideR + let (x,y) = defaultSize startupPrefs windowSetDefaultSize win x y sessionPath <- getConfigFilePathForLoad sessionFilename (tbv,fbv) <- reflectIDE (do @@ -273,18 +278,17 @@ then showFindbar else hideFindbar) ideR --- TODO: patch for windows, maybe we can remove it again --- buffers <- reflectIDE allBuffers ideR --- fdesc <- fontDescriptionFromString (case textviewFont prefs of Just str -> str; Nothing -> "") --- fds <- fontDescriptionGetSize fdesc --- when (isJust fds) $ do --- fontDescriptionSetSize fdesc (fromJust fds + 0.01) --- mapM_ (\buf -> widgetModifyFont (castToWidget $sourceView buf) (Just fdesc)) buffers --- end patch when isFirstStart $ do welcomePath <- getConfigFilePathForLoad $ "welcome.txt" reflectIDE (fileOpenThis welcomePath) ideR reflectIDE (modifyIDE_ (\ide -> return ide{currentState = IsRunning})) ideR + + timeoutAddFull (do + reflectIDE (do + currentPrefs <- readIDE prefs + when (backgroundBuild currentPrefs) $ packageBuild True) ideR + return True) priorityDefaultIdle 100 + mainGUI -- diff --git a/src/IDE/Menu.hs b/src/IDE/Menu.hs --- a/src/IDE/Menu.hs +++ b/src/IDE/Menu.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Menu --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- @@ -56,6 +56,7 @@ import IDE.Metainfo.Provider (rebuildLibInfo,rebuildActiveInfo) import IDE.Pane.Info (showInfo) import IDE.NotebookFlipper +import IDE.ImportTool (addAllImports) -- -- | The Actions known to the system (they can be activated by keystrokes or menus) @@ -71,11 +72,11 @@ ,AD "FileRevert" "_Revert" Nothing Nothing fileRevert [] False ,AD "FileSave" "_Save" Nothing (Just "gtk-save") - (fileSave False) [] False + (do fileSave False; return ()) [] False ,AD "FileSaveAs" "Save _As" Nothing (Just "gtk-save-as") - (fileSave True) [] False + (do fileSave True; return ()) [] False ,AD "FileSaveAll" "Save A_ll" Nothing Nothing - fileSaveAll [] False + (do fileSaveAll; return ()) [] False ,AD "FileClose" "_Close" Nothing (Just "gtk-close") (do fileClose; return ()) [] False ,AD "FileCloseAll" "Close All" Nothing Nothing @@ -147,10 +148,10 @@ ,AD "ConfigPackage" "_Configure Package" (Just "Configures the package") (Just "ide_configure") packageConfig [] False ,AD "BuildPackage" "_Build Package" (Just "Builds the package") (Just "ide_make") - packageBuild [] False + (packageBuild False) [] False ,AD "DocPackage" "_Build Documentation" (Just "Builds the documentation") Nothing packageDoc [] False - ,AD "CleanPackage" "Cl_ean Package" (Just "Cleans the package") Nothing + ,AD "CleanPackage" "Cl_ean Package" (Just "Cleans the package") (Just "ide_clean") packageClean [] False ,AD "CopyPackage" "_Copy Package" (Just "Copies the package") Nothing packageCopy [] False @@ -160,6 +161,8 @@ nextError [] False ,AD "PreviousError" "_Previous Error" (Just "Go to the previous error") (Just "ide_error_prev") previousError [] False + ,AD "AddAllImports" "_Add All Imports" (Just "Resolve 'Not in scope' errors by adding the necessary imports") Nothing + addAllImports [] False ,AD "InstallPackage" "_Install Package" Nothing Nothing packageInstall [] False @@ -253,8 +256,13 @@ pack <- readIDE activePack ideMessage Normal (show pack)) [] False -- ,AD "HelpDebug2" "Debug2" (Just "d") Nothing dbgInstalledPackageInfo [] False - ,AD "HelpAbout" "About" Nothing (Just "gtk-about") aboutDialog [] False] + ,AD "HelpAbout" "About" Nothing (Just "gtk-about") aboutDialog [] False + ,AD "BackgroundBuildToggled" "_BackgroundBuild" (Just "Build in the background and report errors") (Just "ide_build") + backgroundBuildToggled [] True + ,AD "BackgroundLinkToggled" "_BackgroundLink" (Just "Link in the background") (Just "ide_link") + backgroundLinkToggled [] True] + -- -- | The menu description in XML Syntax as defined by GTK -- @@ -422,7 +430,7 @@ mapM_ (loadIcon dataDir iconFactory) ["ide_class","ide_configure","ide_data","ide_error_next", "ide_error_prev","ide_field","ide_function","ide_instance", "ide_konstructor","ide_make", "ide_method","ide_newtype","ide_other","ide_rule","ide_run","ide_slot", - "ide_source","ide_type","leksah", "ide_reexported" + "ide_source","ide_type","leksah", "ide_reexported", "ide_clean", "ide_link", "ide_build" ] iconFactoryAddDefault iconFactory) (\(e :: SomeException) -> getDataDir >>= \dataDir -> throwIDE ("Can't load icons from " ++ dataDir)) diff --git a/src/IDE/Metainfo/InterfaceCollector.hs b/src/IDE/Metainfo/InterfaceCollector.hs --- a/src/IDE/Metainfo/InterfaceCollector.hs +++ b/src/IDE/Metainfo/InterfaceCollector.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Metainfo.InterfaceCollector --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | This modulle extracts information from .hi files for installed packages 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 @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Metainfo.Provider --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | This module provides the infos collected by the extractor before diff --git a/src/IDE/Metainfo/SourceCollector.hs b/src/IDE/Metainfo/SourceCollector.hs --- a/src/IDE/Metainfo/SourceCollector.hs +++ b/src/IDE/Metainfo/SourceCollector.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Metainfo.SourceCollector --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | This module collects information for packages with source available diff --git a/src/IDE/NotebookFlipper.hs b/src/IDE/NotebookFlipper.hs --- a/src/IDE/NotebookFlipper.hs +++ b/src/IDE/NotebookFlipper.hs @@ -132,7 +132,7 @@ Just column <- treeViewGetColumn tree 0 treeViewRowActivated tree treePath column reflectIDE (modifyIDE_ (\ide -> return (ide{currentState = IsRunning}))) ideR - return True + return False _ -> return False (_,_,_) -> return False handleKeyRelease tree ideR _ = return False diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -1,12 +1,13 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} {-# OPTIONS_GHC -XScopedTypeVariables #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Package --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- @@ -41,6 +42,9 @@ , getPackageDescriptionAndPath , getModuleTemplate , addModuleToPackageDescr + +, backgroundBuildToggled +, backgroundLinkToggled ) where import Graphics.UI.Gtk @@ -53,13 +57,14 @@ import System.FilePath import Control.Concurrent import System.Directory -import System.IO + (doesFileExist, setCurrentDirectory, canonicalizePath) +import System.IO (Handle(..), hClose, hGetLine, hSetBuffering) import Prelude hiding (catch) import Text.ParserCombinators.Parsec.Language import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec hiding(Parser) -import Data.Maybe(isJust,fromJust) -import Control.Exception hiding (try) +import Data.Maybe (isJust, fromJust) +import Control.Exception (SomeException(..), catch) import IDE.Pane.Log import Control.Event @@ -72,9 +77,42 @@ import IDE.FileUtils (getConfigFilePathForLoad) import MyMissing (replace) import Distribution.ModuleName (ModuleName(..)) -import Data.List (foldl') +import Data.List (isPrefixOf, foldl') import qualified System.IO.UTF8 as UTF8 (readFile) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import System.Process (getProcessExitCode, ProcessHandle(..)) +import Data.Maybe (isNothing) +import GHC.ConsoleHandler (Handler(..), installHandler) +import System.Win32 + (th32SnapEnumProcesses, + DWORD(..), + cTRL_BREAK_EVENT, + generateConsoleCtrlEvent, + tH32CS_SNAPPROCESS, + withTh32Snap) +import System.Process.Internals + (withProcessHandle, ProcessHandle__(..)) +#else +import System.Posix + (getGroupProcessStatus, + sigINT, + installHandler, + signalProcessGroup, + getProcessGroupID) +import System.Posix.Signals (Handler(..)) +import Foreign.C (Errno(..), getErrno) +#endif +import GHC.IOBase (BufferMode(..)) + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +foreign import stdcall unsafe "winbase.h GetCurrentProcessId" + c_GetCurrentProcessId :: IO DWORD + +foreign import stdcall unsafe "winbase.h GetProcessId" + c_GetProcessId :: DWORD -> IO DWORD +#endif + packageNew :: IDEAction packageNew = packageNew' (\fp -> activatePackage fp >> return ()) @@ -200,32 +238,8 @@ Nothing -> return ()) (\(e :: SomeException) -> putStrLn (show e)) -packageCompile :: IDEAction -packageCompile = catchIDE (do - mbPackage <- getActivePackage - log <- getLog - ideR <- ask - prefs <- readIDE prefs - case mbPackage of - Nothing -> return () - Just package -> do - when (saveAllBeforeBuild prefs) $ fileSaveAll - sb <- getSBErrors - liftIO $statusbarPop sb 1 - liftIO $statusbarPush sb 1 "Compiling" - unmarkCurrentError - pid' <- reifyIDE (\ideR -> do - (inp,out,err,pid) <- runExternal "runhaskell" (["Setup","build","--build-to=Compile"] - ++ buildFlags package) - oid <- forkIO (readOut log out) - hSetBuffering err NoBuffering - eid <- forkIO (reflectIDE (readErrForBuild log err) ideR) - return pid) - when (collectAfterBuild prefs) $ mayRebuildInBackground (Just pid')) - (\(e :: SomeException) -> putStrLn (show e)) - -packageBuild :: IDEAction -packageBuild = catchIDE (do +packageBuild :: Bool -> IDEAction +packageBuild backgroundBuild = catchIDE (do mbPackage <- getActivePackage log <- getLog ideR <- ask @@ -233,19 +247,36 @@ case mbPackage of Nothing -> return () Just package -> do - when (saveAllBeforeBuild prefs) $ fileSaveAll - sb <- getSBErrors - liftIO $statusbarPop sb 1 - liftIO $statusbarPush sb 1 "Building" - unmarkCurrentError - pid' <- reifyIDE (\ideR -> do - (inp,out,err,pid) <- runExternal "runhaskell" (["Setup","build"] - ++ buildFlags package) - oid <- forkIO (readOut log out) - hSetBuffering err NoBuffering - eid <- forkIO (reflectIDE (readErrForBuild log err) ideR) - return pid) - when (collectAfterBuild prefs) $ mayRebuildInBackground (Just pid')) + modified <- if (saveAllBeforeBuild prefs) then fileCheckAll else return False + when ((not backgroundBuild) || modified) $ do + alreadyRunning <- isRunning + if alreadyRunning + then do + interruptBuild + when (not backgroundBuild) $ liftIO $ do + timeoutAddFull (do + reflectIDE (do packageBuild False; return False) ideR + return False) priorityDefaultIdle 100 + return () + else do + when (saveAllBeforeBuild prefs) (do fileSaveAll; return ()) + sb <- getSBErrors + liftIO $statusbarPop sb 1 + liftIO $statusbarPush sb 1 "Building" + reifyIDE (\ideR -> forkIO $ do + let args = (["Setup","build"] ++ + if ((not backgroundBuild) || (backgroundLink prefs)) + then [] + else ["--ghc-options=-c", "--with-ar=true", "--with-ld=true"] + ++ buildFlags package) + (inp,out,err,pid) <- runExternal "runhaskell" args + oid <- forkIO (readOut log out) + hSetBuffering err NoBuffering + eid <- forkIO (reflectIDE (readErrForBuild backgroundBuild log err) ideR) + reflectIDE (modifyIDE_ (\ide -> return ide{buildProcess = Just pid})) ideR + when ((not backgroundBuild) && (collectAfterBuild prefs)) $ reflectIDE (mayRebuildInBackground (Just pid)) ideR + return ()) + return ()) (\(e :: SomeException) -> putStrLn (show e)) packageDoc :: IDEAction @@ -434,50 +465,129 @@ -- --------------------------------------------------------------------- -- | Handling of Compiler errors -- +isRunning :: IDEM Bool +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +isRunning = do + maybeProcess <- readIDE buildProcess + liftIO $ do + case maybeProcess of + Just process -> do + maybeExitCode <- getProcessExitCode process + return $ isNothing maybeExitCode + Nothing -> return False +-- Once we can interupt the build on windows, then something like this might be needed +-- alreadyRunning <- liftIO $ do +-- withTh32Snap tH32CS_SNAPPROCESS Nothing (\h -> do +-- all <- th32SnapEnumProcesses h +-- currentId <- c_GetCurrentProcessId +-- return $ not $ null $ filter (\(_, _, parentId, _, _) -> parentId == currentId) all) +#else +isRunning = do + ideR <- ask + liftIO $ (do + group <- getProcessGroupID + status <- getGroupProcessStatus False False group + putStrLn $ "Status " ++ show status + case status of + Just _ -> reflectIDE isRunning ideR + Nothing -> return True) + `catch` (\(e :: IOError) -> do + Errno errno <- liftIO $ getErrno + putStrLn $ "Error " ++ show errno + return $ errno /= 10) +#endif -readErrForBuild :: IDELog -> Handle -> IDEAction -readErrForBuild log hndl = do +interruptBuild :: IDEAction +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +interruptBuild = do + -- I can't get this to work + --maybeProcess <- readIDE buildProcess + --liftIO $ do + -- processGroupId <- case maybeProcess of + -- Just h -> do + -- withProcessHandle h (\h2 -> do + -- case h2 of + -- OpenHandle oh -> do + -- pid <- c_GetProcessId oh + -- return (h2, pid) + -- _ -> return (h2, 0)) + -- _ -> return 0 + -- old <- installHandler Ignore + -- putStrLn $ show processGroupId + -- generateConsoleCtrlEvent cTRL_BREAK_EVENT processGroupId + -- installHandler old + return () +#else +interruptBuild = liftIO $ do + group <- getProcessGroupID + old_int <- installHandler sigINT Ignore Nothing + signalProcessGroup sigINT group + installHandler sigINT old_int Nothing + return () +#endif + +readErrForBuild :: Bool -> IDELog -> Handle -> IDEAction +readErrForBuild backgroundBuild log hndl = do ideRef <- ask - errs <- liftIO $readAndShow False [] + errs <- liftIO $readAndShow ideRef False [] + unmarkErrors modifyIDE_ (\ide -> return (ide{errors = reverse errs, currentErr = Nothing})) + markErrors triggerEvent ideRef (Sensitivity [(SensitivityError,not (null errs))]) sb <- getSBErrors let errorNum = length (filter isError errs) let warnNum = length errs - errorNum liftIO $statusbarPop sb 1 liftIO $statusbarPush sb 1 $show errorNum ++ " Errors, " ++ show warnNum ++ " Warnings" - when (not (null errs)) nextError + when ((not backgroundBuild) && (not (null errs))) nextError where - readAndShow :: Bool -> [ErrorSpec] -> IO [ErrorSpec] - readAndShow inError errs = catch (do + readAndShow :: IDERef -> Bool -> [ErrorSpec] -> IO [ErrorSpec] + readAndShow ideR inError errs = catch (do line <- hGetLine hndl + tag <- case line of + '[' : _ -> return LogTag + _ | "Linking " `isPrefixOf` line || "ar:" `isPrefixOf` line || "ld:" `isPrefixOf` line -> do + -- when backgroundBuild $ reflectIDE interruptProcess ideR + postGUISync $ reflectIDE (do + unmarkErrors + modifyIDE_ (\ide -> return (ide{errors = reverse errs, currentErr = Nothing})) + markErrors + ) ideR + return LogTag + _ -> return ErrorTag let parsed = parse buildLineParser "" line - lineNr <- appendLog log (line ++ "\n") ErrorTag + lineNr <- appendLog log (line ++ "\n") tag case (parsed, errs) of (Left e,_) -> do sysMessage Normal (show e) - readAndShow False errs + readAndShow ideR False errs (Right ne@(ErrorLine fp l c str),_) -> - readAndShow True ((ErrorSpec fp l c str (lineNr,lineNr) True):errs) + readAndShow ideR True ((ErrorSpec fp l c str (lineNr,lineNr) True):errs) (Right (OtherLine str1),(ErrorSpec fp i1 i2 str (l1,l2) isError):tl) -> if inError - then readAndShow True ((ErrorSpec fp i1 i2 + then readAndShow ideR True ((ErrorSpec fp i1 i2 (if null str then line else str ++ "\n" ++ line) (l1,lineNr) isError) : tl) - else readAndShow False errs + else readAndShow ideR False errs (Right (WarningLine str1),(ErrorSpec fp i1 i2 str (l1,l2) isError):tl) -> if inError - then readAndShow True ((ErrorSpec fp i1 i2 + then readAndShow ideR True ((ErrorSpec fp i1 i2 (if null str then line else str ++ "\n" ++ line) (l1,lineNr) False) : tl) - else readAndShow False errs - otherwise -> readAndShow False errs) + else readAndShow ideR False errs + otherwise -> readAndShow ideR False errs) (\ (_ :: SomeException) -> do hClose hndl + let errorNum = length (filter isError errs) + let warnNum = length errs - errorNum + case errs of + [] -> appendLog log "Finished.\n" LogTag + _ -> appendLog log ("Finished. " ++ show errorNum ++ " errors - " + ++ show warnNum ++ " warnings.") LogTag return errs) selectErr :: Int -> IDEAction @@ -487,32 +597,39 @@ then return () else do let thisErr = errors !! index - succ <- selectSourceBuf (filePath thisErr) - if isJust succ - then markErrorInSourceBuf (line thisErr) (column thisErr) - (errDescription thisErr) - else return () + mbBuf <- selectSourceBuf (filePath thisErr) + case mbBuf of + Just buf -> markErrorInSourceBuf index buf (line thisErr) (column thisErr) + (errDescription thisErr) True + Nothing -> return () log :: IDELog <- getLog liftIO $ markErrorInLog log (logLines thisErr) -unmarkCurrentError :: IDEAction -unmarkCurrentError = do - currentErr' <- readIDE currentErr - errors' <- readIDE errors - when (isJust currentErr') $ do - let theError = errors' !! fromJust currentErr' - allBufs <- allBuffers - fpc <- liftIO $ canonicalizePath $ filePath theError - let theBufs = filter (\ buf -> isJust (fileName buf) && - equalFilePath fpc (fromJust (fileName buf))) - allBufs - mapM_ removeMark theBufs - where - removeMark buf = liftIO $ do +forOpenErrors :: (Int -> ErrorSpec -> IDEBuffer -> IDEAction) -> IDEAction +forOpenErrors f = do + errors <- readIDE errors + allBufs <- allBuffers + forM_ [0 .. ((length errors)-1)] (\index -> do + let error = errors !! index + fpc <- liftIO $ canonicalizePath $ filePath error + forM_ (filter (\buf -> case (fileName buf) of + Just fn -> equalFilePath fpc fn + Nothing -> False) allBufs) (f index error)) + +markErrors :: IDEAction +markErrors = do + forOpenErrors (\index error buf -> do + markErrorInSourceBuf index buf (line error) (column error) + (errDescription error) False + return()) + +unmarkErrors :: IDEAction +unmarkErrors = do + forOpenErrors (\index error buf -> liftIO $ do gtkbuf <- textViewGetBuffer (sourceView buf) i1 <- textBufferGetStartIter gtkbuf i2 <- textBufferGetEndIter gtkbuf - textBufferRemoveTagByName gtkbuf "activeErr" i1 i2 + textBufferRemoveTagByName gtkbuf ("Err" ++ show index) i1 i2) nextError :: IDEAction nextError = do @@ -680,3 +797,13 @@ modifyIDE_ (\ide -> return ide{recentPackages = filter (\e -> e /= fp) recentPackages'}) ask >>= \ideR -> triggerEvent ideR UpdateRecent return () + +backgroundBuildToggled :: IDEAction +backgroundBuildToggled = do + toggled <- getBackgroundBuildToggled + modifyIDE_ (\ide -> return (ide{prefs = (prefs ide){backgroundBuild= toggled}})) + +backgroundLinkToggled :: IDEAction +backgroundLinkToggled = do + toggled <- getBackgroundLinkToggled + modifyIDE_ (\ide -> return (ide{prefs = (prefs ide){backgroundLink= toggled}})) diff --git a/src/IDE/Pane/ClassHierarchy.hs b/src/IDE/Pane/ClassHierarchy.hs --- a/src/IDE/Pane/ClassHierarchy.hs +++ b/src/IDE/Pane/ClassHierarchy.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.ClassHierarchy --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The pane of ide where modules are presented in tree form with their diff --git a/src/IDE/Pane/Info.hs b/src/IDE/Pane/Info.hs --- a/src/IDE/Pane/Info.hs +++ b/src/IDE/Pane/Info.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Info --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The GUI stuff for infos diff --git a/src/IDE/Pane/Log.hs b/src/IDE/Pane/Log.hs --- a/src/IDE/Pane/Log.hs +++ b/src/IDE/Pane/Log.hs @@ -2,11 +2,11 @@ -XTypeSynonymInstances -XParallelListComp #-} -- -- Module : IDE.Pane.Log --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Stability : provisional -- Portability : portable -- -- | Log pane @@ -32,12 +32,13 @@ import Graphics.UI.Gtk.Gdk.Events import Control.Monad.Trans (liftIO) import IDE.Pane.SourceBuffer (markErrorInSourceBuf,selectSourceBuf) -import Data.Maybe (isJust) -import System.Process import System.IO import Prelude hiding (catch) import Control.Exception hiding (try) import IDE.ImportTool (addAllImports,addImport,parseNotInScope) +import System.Process + (runInteractiveProcess, ProcessHandle(..)) + ------------------------------------------------------------------------------- -- -- * Interface @@ -150,11 +151,11 @@ case filter (\(es,_) -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1)) (zip errors' [0..(length errors')]) of [(thisErr,n)] -> do - succ <- selectSourceBuf (filePath thisErr) - if isJust succ - then markErrorInSourceBuf (line thisErr) (column thisErr) - (errDescription thisErr) - else return () + mbBuf <- selectSourceBuf (filePath thisErr) + case mbBuf of + Just buf -> markErrorInSourceBuf n buf (line thisErr) (column thisErr) + (errDescription thisErr) True + Nothing -> return () log :: IDELog <- getLog liftIO $ markErrorInLog log (logLines thisErr) modifyIDE_ (\ide -> return (ide{currentErr = Just n})) diff --git a/src/IDE/Pane/Modules.hs b/src/IDE/Pane/Modules.hs --- a/src/IDE/Pane/Modules.hs +++ b/src/IDE/Pane/Modules.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Modules --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Stability : provisional -- Portability : portable -- -- | The pane of ide where modules are presented in tree form with their @@ -55,7 +55,6 @@ import Graphics.UI.Editor.Parameters (paraMultiSel,Parameter(..),emptyParams,(<<<-),paraName) import Graphics.UI.Editor.Simple (boolEditor,okCancelFields,staticListEditor,stringEditor) import Graphics.UI.Editor.Basics (eventPaneName,GUIEventSelector(..)) -import MyMissing (forceHead) import IDE.Metainfo.Provider (rebuildActiveInfo) import qualified System.IO.UTF8 as UTF8 (writeFile) @@ -1026,8 +1025,8 @@ (paraName <<<- ParaName ("Root of the source path") $ paraMultiSel <<<- ParaMultiSel False $ emptyParams) - (\a -> [sourceRoot a]) - (\ a b -> b{sourceRoot = forceHead a "Modules>>moduleFields"}) + (\a -> sourceRoot a) + (\ a b -> b{sourceRoot = a}) (staticListEditor list id), mkField (paraName <<<- ParaName ("Is this an exposed library module") diff --git a/src/IDE/Pane/PackageEditor.hs b/src/IDE/Pane/PackageEditor.hs --- a/src/IDE/Pane/PackageEditor.hs +++ b/src/IDE/Pane/PackageEditor.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.PackageEditor --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Stability : provisional -- Portability : portable -- -- | Module for editing of cabal packages and build infos @@ -58,8 +58,7 @@ import Distribution.Text (simpleParse, display) import MyMissing import Graphics.UI.Editor.Parameters - (paraMultiSel, - paraInnerPadding, + (paraInnerPadding, paraInnerAlignment, paraOuterPadding, paraOuterAlignment, @@ -75,8 +74,8 @@ paraName, getParameterPrim) import Graphics.UI.Editor.Simple - (intEditor, - staticListEditor, + (staticListMultiEditor, + intEditor, boolEditor, fileEditor, comboSelectionEditor, @@ -935,7 +934,7 @@ flavors = [Simple, Configure, Make, Custom] extensionsEditor :: Editor [Extension] -extensionsEditor p = staticListEditor extensionsL show (paraMultiSel <<<- ParaMultiSel True $ p) +extensionsEditor = staticListMultiEditor extensionsL show extensionsL :: [Extension] @@ -1088,7 +1087,7 @@ --moduleEditor modules = comboSelectionEditor (map display modules) modulesEditor :: [ModuleName] -> Editor [String] -modulesEditor modules = staticListEditor (map display modules) id +modulesEditor modules = staticListMultiEditor (map display modules) id executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] executablesEditor fp modules countBuildInfo p = diff --git a/src/IDE/Pane/PackageFlags.hs b/src/IDE/Pane/PackageFlags.hs --- a/src/IDE/Pane/PackageFlags.hs +++ b/src/IDE/Pane/PackageFlags.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.PackageFlags --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- diff --git a/src/IDE/Pane/Preferences.hs b/src/IDE/Pane/Preferences.hs --- a/src/IDE/Pane/Preferences.hs +++ b/src/IDE/Pane/Preferences.hs @@ -1,13 +1,14 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -XScopedTypeVariables -XDeriveDataTypeable -XMultiParamTypeClasses -XTypeSynonymInstances #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Preferences --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- @@ -421,6 +422,22 @@ (\b a -> a{saveAllBeforeBuild = b}) boolEditor (\i -> return ()) + , mkFieldPP + (paraName <<<- ParaName "Background build" $ emptyParams) + (PP.text . show) + boolParser + backgroundBuild + (\b a -> a{backgroundBuild = b}) + boolEditor + (\i -> return ()) + , mkFieldPP + (paraName <<<- ParaName "Include linking in background builds" $ emptyParams) + (PP.text . show) + boolParser + backgroundLink + (\b a -> a{backgroundLink = b}) + boolEditor + (\i -> return ()) ]), ("Help", VFDPP emptyParams [ mkFieldPP @@ -487,6 +504,13 @@ , docuSearchURL = "http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=" , completeRestricted = False , saveAllBeforeBuild = True + , backgroundBuild = True + , backgroundLink = +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + False +#else + True +#endif } -- ------------------------------------------------------------ diff --git a/src/IDE/Pane/References.hs b/src/IDE/Pane/References.hs --- a/src/IDE/Pane/References.hs +++ b/src/IDE/Pane/References.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.References --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The pane of the ide where references to an identifier are presented diff --git a/src/IDE/Pane/Search.hs b/src/IDE/Pane/Search.hs --- a/src/IDE/Pane/Search.hs +++ b/src/IDE/Pane/Search.hs @@ -3,11 +3,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Search --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The pane of ide where metadata searches can be done diff --git a/src/IDE/Pane/SourceBuffer.hs b/src/IDE/Pane/SourceBuffer.hs --- a/src/IDE/Pane/SourceBuffer.hs +++ b/src/IDE/Pane/SourceBuffer.hs @@ -1,12 +1,13 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -XDeriveDataTypeable -XMultiParamTypeClasses -XTypeSynonymInstances -XScopedTypeVariables #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.SourceBuffer --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- | The source editor part of Leksah @@ -37,6 +38,7 @@ , fileSave , fileSaveAll , fileSaveBuffer +, fileCheckAll , editUndo , editRedo , editCut @@ -130,7 +132,7 @@ bringPaneToFront actbuf writeCursorPositionInStatusbar sv sbLC writeOverwriteInStatusbar sv sbIO - id1 <- gtkBuf `afterModifiedChanged` reflectIDE (markLabelAsChanged) ideR + id1 <- gtkBuf `afterModifiedChanged` reflectIDE (markActiveLabelAsChanged) ideR id2 <- sv `afterMoveCursor` (\_ _ _ -> writeCursorPositionInStatusbar sv sbLC) id3 <- gtkBuf `afterEndUserAction` writeCursorPositionInStatusbar sv sbLC @@ -262,12 +264,20 @@ return () -markErrorInSourceBuf :: Int -> Int -> String -> IDEAction -markErrorInSourceBuf line column string = - inActiveBufContext () $ \_ gtkbuf buf _ -> do - i1 <- textBufferGetStartIter gtkbuf - i2 <- textBufferGetEndIter gtkbuf - textBufferRemoveTagByName gtkbuf "activeErr" i1 i2 +markErrorInSourceBuf :: Int -> IDEBuffer -> Int -> Int -> String -> Bool -> IDEAction +markErrorInSourceBuf index buf line column string scrollTo = + inBufContext () buf $ \_ gtkbuf buf _ -> do + tagTable <- textBufferGetTagTable gtkbuf + mbTag <- textTagTableLookup tagTable ("Err" ++ show index) + case mbTag of + Just tag -> do + i1 <- textBufferGetStartIter gtkbuf + i2 <- textBufferGetEndIter gtkbuf + textBufferRemoveTagByName gtkbuf ("Err" ++ show index) i1 i2 + Nothing -> do + errtag <- textTagNew (Just $ "Err" ++ show index) + set errtag[textTagUnderline := UnderlineError] + textTagTableAdd tagTable errtag lines <- textBufferGetLineCount gtkbuf iter <- textBufferGetIterAtLine gtkbuf (max 0 (min (lines-1) (line-1))) @@ -275,13 +285,14 @@ textIterSetLineOffset iter (max 0 (min (chars-1) column)) iter2 <- textIterCopy iter textIterForwardWordEnd iter2 - textBufferApplyTagByName gtkbuf "activeErr" iter iter2 - textBufferPlaceCursor gtkbuf iter + textBufferApplyTagByName gtkbuf ("Err" ++ show index) iter iter2 + when scrollTo $ textBufferPlaceCursor gtkbuf iter mark <- textBufferGetInsert gtkbuf - idleAdd (do - textViewScrollToMark (sourceView buf) mark 0.3 Nothing - return False) priorityDefaultIdle - return () + when scrollTo $ do + idleAdd (do + textViewScrollToMark (sourceView buf) mark 0.3 Nothing + return False) priorityDefaultIdle + return () allBuffers :: IDEM [IDEBuffer] allBuffers = getPanes @@ -326,9 +337,6 @@ foundTag <- textTagNew (Just "found") set foundTag [textTagBackground := "yellow"] textTagTableAdd tagTable foundTag - activeErrtag <- textTagNew (Just "activeErr") - set activeErrtag[textTagUnderline := UnderlineError] - textTagTableAdd tagTable activeErrtag -- load up and display a file (fileContents,modTime) <- case mbfn of @@ -430,13 +438,6 @@ liftIO $do widgetShowAll (scrolledWindow buf) widgetGrabFocus (sourceView buf) --- TODO: patch for windows, maybe we can remove it again --- fdesc <- fontDescriptionFromString (case textviewFont prefs of Just str -> str; Nothing -> "") --- fds <- fontDescriptionGetSize fdesc --- when (isJust fds) $ do --- fontDescriptionSetSize fdesc (fromJust fds + 0.01) --- widgetModifyFont (castToWidget $ sourceView buf) (Just fdesc) --- end patch when (isJust mbfn) $ removeRecentlyUsedFile (fromJust mbfn) return buf @@ -458,6 +459,10 @@ case modTime' of Nothing -> throwIDE $"checkModTime: time not set " ++ show (fileName buf) Just mt -> do +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + -- For some reason evaluating nmt /= mt causes corrupt fonts ?!? + return False +#else --message $"checkModTime " ++ name ++ " " ++ show mt ++ " " ++ show nmt if nmt /= mt then do @@ -478,6 +483,7 @@ return True _ -> do return False else return False +#endif else return False Nothing -> return False @@ -545,8 +551,8 @@ reflectIDE (triggerEvent ideR (SelectInfo symbol)) ideR return () -markLabelAsChanged :: IDEAction -markLabelAsChanged = do +markActiveLabelAsChanged :: IDEAction +markActiveLabelAsChanged = do mbPath <- getActivePanePath case mbPath of Nothing -> return () @@ -555,7 +561,10 @@ mbBS <- maybeActiveBuf case mbBS of Nothing -> return () - Just buf -> liftIO $ do + Just buf -> liftIO $ markLabelAsChanged nb buf + +markLabelAsChanged :: Notebook -> IDEBuffer -> IO () +markLabelAsChanged nb buf = do gtkbuf <- textViewGetBuffer (sourceView buf) modified <- textBufferGetModified gtkbuf mbText <- notebookGetTabLabelText nb (scrolledWindow buf) @@ -596,12 +605,7 @@ inActiveBufContext :: alpha -> (Notebook -> TextBuffer -> IDEBuffer -> Int -> IO alpha) -> IDEM alpha inActiveBufContext def f = inActiveBufContext' def (\ a b c d -> liftIO $ f a b c d) -forAllBuffers_ :: (Notebook -> TextBuffer -> IDEBuffer -> Int -> IDEAction) -> IDEAction -forAllBuffers_ f = do - bufs <- allBuffers - forM_ bufs (\buf -> inBufContext' () buf f) - -fileSaveBuffer :: Bool -> Notebook -> TextBuffer -> IDEBuffer -> Int -> IDEAction +fileSaveBuffer :: Bool -> Notebook -> TextBuffer -> IDEBuffer -> Int -> IDEM Bool fileSaveBuffer query nb gtkbuf ideBuf i = do ideR <- ask window <- readIDE window @@ -619,10 +623,12 @@ if isJust mbfn && query == False then do modifiedOnDisk <- checkModTime ideBuf -- The user is given option to reload modifiedInBuffer <- liftIO $ textBufferGetModified gtkbuf - when (modifiedOnDisk || modifiedInBuffer) $ do - liftIO $fileSave' (forceLineEnds prefs) (removeTBlanks prefs) ideBuf bs candy $fromJust mbfn - setModTime ideBuf - return () + if (modifiedOnDisk || modifiedInBuffer) + then do + liftIO $fileSave' (forceLineEnds prefs) (removeTBlanks prefs) nb ideBuf bs candy $fromJust mbfn + setModTime ideBuf + return True + else return False else reifyIDE $ \ideR -> do dialog <- fileChooserDialogNew (Just $ "Save File") @@ -641,7 +647,7 @@ _ -> return Nothing widgetDestroy dialog case mbFileName of - Nothing -> return () + Nothing -> return False Just fn -> do dfe <- doesFileExist fn resp <- if dfe @@ -656,18 +662,18 @@ case resp of ResponseYes -> do cfn <- canonicalizePath fn - fileSave' (forceLineEnds prefs) (removeTBlanks prefs) ideBuf bs candy cfn + fileSave' (forceLineEnds prefs) (removeTBlanks prefs) nb ideBuf bs candy cfn reflectIDE (do close ideBuf newTextBuffer panePath (takeFileName fn) (Just cfn) ) ideR - return () - ResponseNo -> return () - _ -> return () + return True + ResponseNo -> return False + _ -> return False where - fileSave' :: Bool -> Bool -> IDEBuffer -> Bool -> CandyTable -> FilePath -> IO() - fileSave' forceLineEnds removeTBlanks ideBuf bs ct fn = do + fileSave' :: Bool -> Bool -> Notebook -> IDEBuffer -> Bool -> CandyTable -> FilePath -> IO() + fileSave' forceLineEnds removeTBlanks nb ideBuf bs ct fn = do buf <- textViewGetBuffer $ sourceView ideBuf text <- getCandylessText ct buf let text' = if removeTBlanks @@ -678,14 +684,45 @@ sysMessage Normal (show e) return False) textBufferSetModified buf (not succ) + markLabelAsChanged nb ideBuf removeTrailingBlanks :: String -> String removeTrailingBlanks = reverse . dropWhile (\c -> c == ' ') . reverse -fileSave :: Bool -> IDEAction -fileSave query = inActiveBufContext' () $ fileSaveBuffer query +fileSave :: Bool -> IDEM Bool +fileSave query = inActiveBufContext' False $ fileSaveBuffer query -fileSaveAll :: IDEAction -fileSaveAll = forAllBuffers_ $ fileSaveBuffer False +fileSaveAll :: IDEM Bool +fileSaveAll = do + bufs <- allBuffers + results <- forM bufs (\buf -> inBufContext' False buf (fileSaveBuffer False)) + return $ True `elem` results + +fileCheckBuffer :: Bool -> Notebook -> TextBuffer -> IDEBuffer -> Int -> IDEM Bool +fileCheckBuffer query nb gtkbuf ideBuf i = do + ideR <- ask + window <- readIDE window + bufs <- readIDE panes + prefs <- readIDE prefs + paneMap <- readIDE paneMap + bs <- getCandyState + candy <- readIDE candy + (panePath,connects) <- guiPropertiesFromName (paneName ideBuf) + let mbfn = fileName ideBuf + mbpage <- liftIO $ notebookGetNthPage nb i + case mbpage of + Nothing -> throwIDE "fileCheck: Page not found" + Just page -> + if isJust mbfn && query == False + then do modifiedOnDisk <- checkModTime ideBuf -- The user is given option to reload + modifiedInBuffer <- liftIO $ textBufferGetModified gtkbuf + return (modifiedOnDisk || modifiedInBuffer) + else return False + +fileCheckAll :: IDEM Bool +fileCheckAll = do + bufs <- allBuffers + results <- forM bufs (\buf -> inBufContext' False buf (fileCheckBuffer False)) + return $ True `elem` results fileNew :: IDEAction fileNew = do diff --git a/src/IDE/SaveSession.hs b/src/IDE/SaveSession.hs --- a/src/IDE/SaveSession.hs +++ b/src/IDE/SaveSession.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.SaveSession --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- diff --git a/src/IDE/SourceCandy.hs b/src/IDE/SourceCandy.hs --- a/src/IDE/SourceCandy.hs +++ b/src/IDE/SourceCandy.hs @@ -1,11 +1,11 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.SourceCandy --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- --- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Maintainer : +-- Stability : provisional -- Portability : portable -- -- diff --git a/src/MyMissing.hs b/src/MyMissing.hs --- a/src/MyMissing.hs +++ b/src/MyMissing.hs @@ -2,11 +2,11 @@ ----------------------------------------------------------------------------- -- -- Module : MyMissing --- Copyright : (c) Juergen Nicklisch-Franken (aka Jutaro) +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : Juergen Nicklisch-Franken --- Stability : experimental +-- Stability : provisional -- Portability : portable -- -- | Module for missing base functions