leksah 0.4.0.2 → 0.4.0.3
raw patch · 24 files changed
+400/−352 lines, 24 filesdep ~regex-posix
Dependency ranges changed: regex-posix
Files
- data/Default.candy +20/−20
- doc/leksah_manual.pdf binary
- leksah.cabal +16/−15
- src/IDE/Core/State.hs +8/−8
- src/IDE/Core/Types.hs +1/−1
- src/IDE/FileUtils.hs +1/−39
- src/IDE/Find.hs +25/−25
- src/IDE/Leksah.hs +64/−60
- src/IDE/Menu.hs +7/−7
- src/IDE/Metainfo/GHCUtils.hs +66/−0
- src/IDE/Metainfo/InterfaceCollector.hs +10/−17
- src/IDE/Metainfo/Provider.hs +10/−9
- src/IDE/Metainfo/SourceCollector.hs +29/−11
- src/IDE/Package.hs +11/−11
- src/IDE/Pane/Callers.hs +9/−10
- src/IDE/Pane/ClassHierarchy.hs +2/−2
- src/IDE/Pane/Info.hs +24/−24
- src/IDE/Pane/Log.hs +7/−7
- src/IDE/Pane/Modules.hs +24/−28
- src/IDE/Pane/PackageEditor.hs +9/−9
- src/IDE/Pane/PackageFlags.hs +4/−4
- src/IDE/Pane/Preferences.hs +11/−10
- src/IDE/Pane/Search.hs +18/−20
- src/IDE/Pane/SourceBuffer.hs +24/−15
data/Default.candy view
@@ -1,25 +1,25 @@ -- Candy file -"->" 0x2192 Trimming --RIGHTWARDS ARROW-"<-" 0x2190 Trimming --LEFTWARDS ARROW-"=>" 0x21d2 --RIGHTWARDS DOUBLE ARROW-">=" 0x2265 --GREATER-THAN OR EQUAL TO-"<=" 0x2264 --LESS-THAN OR EQUAL TO-"/=" 0x2260 --NOT EQUAL TO-"&&" 0x2227 --LOGICAL AND-"||" 0x2228 --LOGICAL OR-"++" 0x2295 --CIRCLED PLUS---"::" 0x2551 Trimming --BAR---"::" 0x2237 Trimming --PROPORTION-".." 0x2025 --TWO DOT LEADER-"^" 0x2191 --UPWARDS ARROW-"==" 0x2261 --IDENTICAL TO---" . " 0x2218 --RING OPERATOR-"\" 0x03bb --GREEK SMALL LETTER LAMBDA---"=<<" 0x291e ---">>=" 0x21a0-"$" 0x25ca-">>" 0x226b -- MUCH GREATER THEN+"->" 0x2192 Trimming --RIGHTWARDS ARROW -> -+"<-" 0x2190 Trimming --LEFTWARDS ARROW <- -+"=>" 0x21d2 --RIGHTWARDS DOUBLE ARROW => -+">=" 0x2265 --GREATER-THAN OR EQUAL TO >= -+"<=" 0x2264 --LESS-THAN OR EQUAL TO <= -+"/=" 0x2260 --NOT EQUAL TO /= -+"&&" 0x2227 --LOGICAL AND && -+"||" 0x2228 --LOGICAL OR || -+"++" 0x2295 --CIRCLED PLUS ++ -+--"::" 0x2551 Trimming --BAR :: -+--"::" 0x2237 Trimming --PROPORTION :: -+".." 0x2025 --TWO DOT LEADER .. -+"^" 0x2191 --UPWARDS ARROW ^ -+"==" 0x2261 --IDENTICAL TO == -+" . " 0x2218 --RING OPERATOR . -+"\" 0x03bb --GREEK SMALL LETTER LAMBDA \ -+"=<<" 0x291e -- =<< -+">>=" 0x21a0 -- >>= -+"$" 0x25ca -- $ -+">>" 0x226b -- MUCH GREATER THEN >> - "forall" 0x2200 --FOR ALL "exist" 0x2203 --THERE EXISTS
doc/leksah_manual.pdf view
binary file changed (1364761 → 1782132 bytes)
leksah.cabal view
@@ -1,12 +1,12 @@ name: leksah-version: 0.4.0.2+version: 0.4.0.3 cabal-version: >=1.4 build-type: Custom license: GPL license-file: LICENSE copyright: 2007-2009 Jürgen Nicklisch-Franken maintainer: Jutaro <jutaro@leksah.org>-build-depends: regex-posix >=0.72.0.3, utf8-string >=0.3.1.1,+build-depends: regex-posix ==0.72.0.3, utf8-string >=0.3.1.1, bytestring >=0.9.0.1, binary >=0.4.4, ghc >=6.10.1, glib >=0.10, gtk >=0.10, directory >=1.0.0.2, pretty >=1.0.1.0, containers >=0.2.0.0, process >=1.0.1.0, mtl >=1.1.0.2,@@ -53,19 +53,20 @@ install-includes: include-dirs: hs-source-dirs: src-other-modules: MyMissing Default DeepSeq Graphics.UI.Editor.Simple- Graphics.UI.Editor.Parameters Graphics.UI.Editor.Basics- Graphics.UI.Editor.Composite Graphics.UI.Editor.MakeEditor- Graphics.UI.Frame.Panes Graphics.UI.Frame.ViewFrame Control.Event- IDE.Package IDE.Keymap IDE.PrinterParser IDE.Exception- IDE.SpecialEditors IDE.SaveSession IDE.Leksah IDE.DescriptionPP- IDE.Find IDE.Menu IDE.FileUtils IDE.SourceCandy IDE.GUIHistory- IDE.Pane.PackageFlags IDE.Pane.Info IDE.Pane.ClassHierarchy- IDE.Pane.SourceBuffer IDE.Pane.Modules IDE.Pane.Preferences- IDE.Pane.Log IDE.Pane.Callers IDE.Pane.Search- IDE.Pane.PackageEditor IDE.Metainfo.Provider- IDE.Metainfo.SourceCollector IDE.Metainfo.InterfaceCollector- IDE.Core.State IDE.Core.Types+other-modules: IDE.Metainfo.GHCUtils MyMissing DeepSeq Default+ Control.Event Graphics.UI.Editor.Parameters+ Graphics.UI.Editor.Composite Graphics.UI.Editor.Basics+ Graphics.UI.Editor.MakeEditor Graphics.UI.Editor.Simple+ Graphics.UI.Frame.ViewFrame Graphics.UI.Frame.Panes IDE.Leksah+ IDE.PrinterParser IDE.FileUtils IDE.Menu IDE.DescriptionPP IDE.Find+ IDE.SourceCandy IDE.Package IDE.SpecialEditors IDE.GUIHistory+ IDE.SaveSession IDE.Keymap IDE.Exception IDE.Pane.Modules+ IDE.Pane.PackageEditor IDE.Pane.Log IDE.Pane.Search IDE.Pane.Info+ IDE.Pane.SourceBuffer IDE.Pane.Preferences IDE.Pane.Callers+ IDE.Pane.ClassHierarchy IDE.Pane.PackageFlags+ IDE.Metainfo.SourceCollector IDE.Metainfo.Provider+ IDE.Metainfo.InterfaceCollector IDE.Core.Types IDE.Core.State+ ghc-prof-options: -prof -auto-all ghc-shared-options: -prof -auto-all ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns
src/IDE/Core/State.hs view
@@ -214,16 +214,17 @@ -- -- | A reader monad for a mutable reference to the IDE state ---type IDEM = ReaderT IDERef Ghc+type IDEM = ReaderT IDERef IO -reifyIDE :: (IDERef -> Session -> IO a) -> IDEM a-reifyIDE f = ask >>= \ideR -> lift $ reifyGhc (f ideR)+reifyIDE :: (IDERef -> IO a) -> IDEM a+reifyIDE = ReaderT -reflectIDE :: IDEM a -> IDERef -> Session -> IO a-reflectIDE c ideR = reflectGhc (runReaderT c ideR) +reflectIDE :: IDEM a -> IDERef -> IO a+reflectIDE c ideR = runReaderT c ideR+ catchIDE :: Exception e => IDEM a -> (e -> IO a) -> IDEM a-catchIDE block handler = reifyIDE (\ideR session -> catch (reflectIDE block ideR session) handler)+catchIDE block handler = reifyIDE (\ideR -> catch (reflectIDE block ideR) handler) -- -- | A shorthand for a reader monad for a mutable reference to the IDE state@@ -243,8 +244,7 @@ setActivePaneSt v = modifyIDE_ (\ide -> return ide{activePane = v}) setLayoutSt v = modifyIDE_ (\ide -> return ide{layout = v}) - runInIO f = reifyIDE (\ideRef session ->- return (\v -> reflectIDE (f v) ideRef session))+ runInIO f = reifyIDE (\ideRef -> return (\v -> reflectIDE (f v) ideRef))
src/IDE/Core/Types.hs view
@@ -124,7 +124,7 @@ , label :: String , tooltip :: Maybe String , stockID :: Maybe String-, action :: ReaderT alpha Ghc ()+, action :: ReaderT alpha IO () , accelerator :: [KeyString] , isToggle :: Bool }
src/IDE/FileUtils.hs view
@@ -16,8 +16,6 @@ , findSourceFile , autoExtractTarFiles -, getInstalledPackageInfos-, findFittingPackages ) where import System.FilePath@@ -34,21 +32,13 @@ import qualified Data.List as List import qualified Data.Set as Set import Data.Set (Set)-import Data.List (maximumBy,isSuffixOf,isPrefixOf)+import Data.List (isSuffixOf,isPrefixOf) import Distribution.ModuleName(ModuleName,toFilePath) import Distribution.Text(simpleParse) import Debug.Trace import Paths_leksah import IDE.Core.State-import GHC (setSessionDynFlags,getSessionDynFlags,Ghc(..))-import PackageConfig (PackageConfig(..))-import DynFlags (DynFlag(..),flags,pkgDatabase)-import UniqFM (eltsUFM)-import Distribution.Simple (PackageIdentifier(..),Dependency(..))-import qualified Distribution.InstalledPackageInfo as IPI (package)-import Distribution.Version (withinRange)-import Distribution.Package (pkgVersion) import Data.Char (ord) -- | Returns True if the second path is a location which starts with the first path@@ -300,35 +290,7 @@ let libDir2 = if ord (last libDir) == 13 then List.init libDir else libDir- trace ("getSysLibDir " ++ libDir2) $ waitForProcess pid return (normalise libDir2)---- ------------------------------------------------------------------------ The (mothers) little helpers-----getInstalledPackageInfos :: Ghc [PackageConfig]-getInstalledPackageInfos = do- dflags1 <- getSessionDynFlags- setSessionDynFlags dflags1{flags = Opt_ReadUserPackageConf : (flags dflags1)}- pkgInfos <- case pkgDatabase dflags1 of- Nothing -> return []- Just fm -> return (eltsUFM fm)- return pkgInfos--findFittingPackages :: [Dependency] -> Ghc [PackageIdentifier]-findFittingPackages dependencyList = do- knownPackages <- getInstalledPackageInfos- let packages = map IPI.package knownPackages- return (concatMap (fittingKnown packages) dependencyList)- where- fittingKnown packages (Dependency dname versionRange) =- let filtered = filter (\ (PackageIdentifier name version) ->- name == dname && withinRange version versionRange)- packages- in if length filtered > 1- then [maximumBy (\a b -> compare (pkgVersion a) (pkgVersion b)) filtered]- else filtered
src/IDE/Find.hs view
@@ -148,7 +148,7 @@ else showFindbar constructFindReplace :: Toolbar -> IDEM (Toolbar)-constructFindReplace toolbar = reifyIDE $ \ ideR session -> do+constructFindReplace toolbar = reifyIDE $ \ ideR -> do closeButton <- toolButtonNewFromStock "gtk-close" toolbarInsert toolbar closeButton 0 @@ -228,35 +228,35 @@ containerAdd labelTool label toolbarInsert toolbar labelTool 0 - findButton `onToolButtonClicked` (doSearch toolbar Forward ideR session)+ findButton `onToolButtonClicked` (doSearch toolbar Forward ideR ) entry `afterInsertText` (\t i -> do- doSearch toolbar Insert ideR session+ doSearch toolbar Insert ideR return i)- entry `afterDeleteText` (\ _ _ -> doSearch toolbar Delete ideR session)+ entry `afterDeleteText` (\ _ _ -> doSearch toolbar Delete ideR ) entry `afterKeyPress` (\ e -> case e of k@(Key _ _ _ _ _ _ _ _ _ _) | eventKeyName k == "Down" -> do- doSearch toolbar Forward ideR session+ doSearch toolbar Forward ideR return True | eventKeyName k == "Up" -> do- doSearch toolbar Backward ideR session+ doSearch toolbar Backward ideR return True | eventKeyName k == "Escape" -> do- getOut ideR session+ getOut ideR return True | otherwise -> return True _ -> return True)- entry `onEntryActivate` getOut ideR session- replaceButton `onToolButtonClicked` replace toolbar Forward ideR session+ entry `onEntryActivate` getOut ideR+ replaceButton `onToolButtonClicked` replace toolbar Forward ideR - replaceAllButton `onToolButtonClicked` replaceAll toolbar Forward ideR session+ replaceAllButton `onToolButtonClicked` replaceAll toolbar Forward ideR spinL `afterFocusIn` (\ _ -> (reflectIDE (inBufContext True $ \_ gtkbuf currentBuffer _ -> do max <- textBufferGetLineCount gtkbuf spinButtonSetRange spinL 1.0 (fromIntegral max)- return True) ideR session))+ return True) ideR )) spinL `afterEntryActivate` (reflectIDE (inBufContext () $ \_ gtkbuf currentBuffer _ -> do@@ -265,10 +265,10 @@ textIterSetLine iter (line - 1) textBufferPlaceCursor gtkbuf iter textViewScrollToIter (sourceView currentBuffer) iter 0.2 Nothing- return ()) ideR session)+ return ()) ideR ) closeButton `onToolButtonClicked` do- reflectIDE hideFindbar ideR session+ reflectIDE hideFindbar ideR set toolbar [ toolbarChildHomogeneous spinTool := False ] set toolbar [ toolbarChildHomogeneous wrapAroundButton := False ]@@ -291,14 +291,14 @@ return () -doSearch :: Toolbar -> SearchHint -> IDERef -> Session -> IO ()-doSearch fb hint ideR session = do+doSearch :: Toolbar -> SearchHint -> IDERef -> IO ()+doSearch fb hint ideR = do entry <- getFindEntry fb search <- entryGetText (castToEntry entry) entireWord <- getEntireWord fb caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb- res <- reflectIDE (editFind entireWord caseSensitive wrapAround search "" hint) ideR session+ res <- reflectIDE (editFind entireWord caseSensitive wrapAround search "" hint) ideR if res || null search then do widgetModifyBase entry StateNormal white@@ -308,8 +308,8 @@ widgetModifyText entry StateNormal white return () -replace :: Toolbar -> SearchHint -> IDERef -> Session -> IO ()-replace fb hint ideR session = do+replace :: Toolbar -> SearchHint -> IDERef -> IO ()+replace fb hint ideR = do entry <- getFindEntry fb search <- entryGetText (castToEntry entry) rentry <- getReplaceEntry fb@@ -318,12 +318,12 @@ caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb found <- reflectIDE (editReplace entireWord caseSensitive wrapAround search replace hint)- ideR session+ ideR return () -replaceAll :: Toolbar -> SearchHint -> IDERef -> Session -> IO ()-replaceAll fb hint ideR session = do+replaceAll :: Toolbar -> SearchHint -> IDERef -> IO ()+replaceAll fb hint ideR = do entry <- getFindEntry fb search <- entryGetText (castToEntry entry) rentry <- getReplaceEntry fb@@ -332,7 +332,7 @@ caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb found <- reflectIDE (editReplaceAll entireWord caseSensitive wrapAround search replace hint)- ideR session+ ideR return () editFind :: Bool -> Bool -> Bool -> String -> String -> SearchHint -> IDEM Bool@@ -443,12 +443,12 @@ editFindInc hint = do showFindbar fb <- readIDE findbar- reifyIDE $ \ideR session -> do+ reifyIDE $ \ideR -> do entry <- getFindEntry fb widgetGrabFocus entry case hint of- Forward -> doSearch fb Forward ideR session- Backward -> doSearch fb Backward ideR session+ Forward -> doSearch fb Forward ideR+ Backward -> doSearch fb Backward ideR _ -> return () editGotoLine :: IDEAction
src/IDE/Leksah.hs view
@@ -31,7 +31,6 @@ import System.Console.GetOpt import System.Environment import GHC-import HscTypes hiding (liftIO) import Config import Data.Version import Prelude hiding(catch)@@ -63,6 +62,8 @@ import IDE.Find import Graphics.UI.Editor.Composite (maybeEditor) import Graphics.UI.Editor.Simple (fileEditor)+--import Outputable (ppr,showSDoc)+import IDE.Metainfo.GHCUtils (inGhcIO) -- --------------------------------------------------------------------- -- Command line options@@ -121,9 +122,8 @@ buildSourceForPackageDB sysMessage Normal "rebuild SourceForPackageDB") when (elem Rebuild o || elem Collect o || not (null uninstalled)) $ do- libDir <- getSysLibDir- runGhc (Just libDir) $ do- getSessionDynFlags >>= setSessionDynFlags+ inGhcIO $ do+ flags <- getSessionDynFlags let version = cProjectVersion let uninstalled = filter (\x -> case x of UninstalledProject _ -> True@@ -145,7 +145,7 @@ st <- initGUI when rtsSupportsBoundThreads (sysMessage Normal "Linked with -threaded")- timeoutAddFull (yield >> return True) priorityHigh 25+ timeoutAddFull (yield >> return True) priorityHigh 5 mapM_ (sysMessage Normal) st uiManager <- uiManagerNew newIcons@@ -194,65 +194,69 @@ , toolbar = Nothing , findbarVisible = True , toolbarVisible = True-}+ } ideR <- newIORef ide- libDir <- getSysLibDir- runGhc (Just libDir) (do- getSessionDynFlags >>= setSessionDynFlags- reifyGhc (\session -> do- menuDescription' <- menuDescription- (acc,menus) <- reflectIDE (makeMenu uiManager accelActions menuDescription') ideR session- when (length menus /= 2) $ throwIDE ("Failed to build menu" ++ show (length menus))- let toolbar = castToToolbar (menus !! 1)- reflectIDE (do- constructFindReplace findBar- modifyIDE_ (\ide -> return ide{toolbar = Just toolbar})- initInfo :: IDEAction) ideR session- sep0 <- separatorToolItemNew- separatorToolItemSetDraw sep0 False- toolItemSetExpand sep0 True- toolbarInsert toolbar sep0 (-1)- closeButton <- toolButtonNewFromStock "gtk-close"- toolbarInsert toolbar closeButton (-1)- closeButton `onToolButtonClicked` do- reflectIDE hideToolbar ideR session+ menuDescription' <- menuDescription+ (acc,menus) <- reflectIDE (makeMenu uiManager accelActions menuDescription') ideR+ when (length menus /= 2) $ throwIDE ("Failed to build menu" ++ show (length menus))+ let toolbar = castToToolbar (menus !! 1)+ reflectIDE (do+ constructFindReplace findBar+ modifyIDE_ (\ide -> return ide{toolbar = Just toolbar})+ initInfo :: IDEAction) ideR+ sep0 <- separatorToolItemNew+ separatorToolItemSetDraw sep0 False+ toolItemSetExpand sep0 True+ toolbarInsert toolbar sep0 (-1)+ closeButton <- toolButtonNewFromStock "gtk-close"+ toolbarInsert toolbar closeButton (-1)+ closeButton `onToolButtonClicked` do+ reflectIDE hideToolbar ideR - windowAddAccelGroup win acc- nb <- newNotebook- afterSwitchPage nb (\i -> reflectIDE (handleNotebookSwitch nb i) ideR session)- widgetSetName nb $"root"- statusBar <- buildStatusbar ideR- vb <- vBoxNew False 1 -- Top-level vbox- widgetSetName vb "topBox"- toolbarSetStyle (castToToolbar (menus !! 1)) ToolbarIcons- boxPackStart vb (menus !! 0) PackNatural 0- boxPackStart vb (menus !! 1) PackNatural 0- boxPackStart vb nb PackGrow 0- boxPackStart vb findBar PackNatural 0- boxPackEnd vb statusBar PackNatural 0- win `onDelete` (\ _ -> do reflectIDE quit ideR session; return True)- win `onKeyPress` (\ e -> reflectIDE (handleSpecialKeystrokes e) ideR session)- containerAdd win vb- reflectIDE (setCandyState (isJust (sourceCandy prefs))) ideR session- let (x,y) = defaultSize prefs- windowSetDefaultSize win x y- sessionPath <- getConfigFilePathForLoad sessionFilename- (tbv,fbv) <- reflectIDE (do- registerEvents menus- recoverSession sessionPath- ) ideR session- widgetShowAll win- reflectIDE (do- if tbv- then showToolbar- else hideToolbar- if fbv- then showFindbar- else hideFindbar) ideR session- mainGUI))+ windowAddAccelGroup win acc+ nb <- newNotebook+ afterSwitchPage nb (\i -> reflectIDE (handleNotebookSwitch nb i) ideR)+ widgetSetName nb $"root"+ statusBar <- buildStatusbar ideR+ vb <- vBoxNew False 1 -- Top-level vbox+ widgetSetName vb "topBox"+ toolbarSetStyle (castToToolbar (menus !! 1)) ToolbarIcons+ boxPackStart vb (menus !! 0) PackNatural 0+ boxPackStart vb (menus !! 1) PackNatural 0+ boxPackStart vb nb PackGrow 0+ boxPackStart vb findBar PackNatural 0+ boxPackEnd vb statusBar PackNatural 0+ 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+ windowSetDefaultSize win x y+ sessionPath <- getConfigFilePathForLoad sessionFilename+ (tbv,fbv) <- reflectIDE (do+ registerEvents menus+ recoverSession sessionPath+ ) ideR+ reflectIDE (do+ if tbv+ then showToolbar+ else hideToolbar+ if fbv+ then showFindbar+ else hideFindbar) ideR+ widgetShowAll win+-- patch for windows+ 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+ mainGUI ----- | Callback function for onKeyPress of the main window, so preprocess any key+-- | Callback function for onKeyPress of the main window, so 'preprocess' any key -- handleSpecialKeystrokes :: GdkEvents.Event -> IDEM Bool handleSpecialKeystrokes (Key _ _ _ mods _ _ _ keyVal name mbChar) = do
src/IDE/Menu.hs view
@@ -255,9 +255,9 @@ -- | Building the Menu -- makeMenu :: UIManager -> [ActionDescr IDERef] -> String -> IDEM (AccelGroup, [Widget])-makeMenu uiManager actions menuDescription = reifyIDE (\ideR session -> do+makeMenu uiManager actions menuDescription = reifyIDE (\ideR -> do actionGroupGlobal <- actionGroupNew "global"- mapM_ (actm ideR session actionGroupGlobal) actions+ mapM_ (actm ideR actionGroupGlobal) actions uiManagerInsertActionGroup uiManager actionGroupGlobal 1 uiManagerAddUiFromString uiManager menuDescription accGroup <- uiManagerGetAccelGroup uiManager@@ -267,26 +267,26 @@ Nothing -> throwIDE "Menu>>makeMenu: failed to build menu") mbWidgets return (accGroup,widgets)) where- actm ideR session ag (AD name label tooltip stockId ideAction accs isToggle) = do+ actm ideR ag (AD name label tooltip stockId ideAction accs isToggle) = do let (acc,accString) = if null accs then (Just "","=" ++ name) else (Just (head accs),(head accs) ++ "=" ++ name) if isToggle then do act <- toggleActionNew name label tooltip stockId- on act actionToggled (doAction ideAction ideR session accString)+ on act actionToggled (doAction ideAction ideR accString) actionGroupAddActionWithAccel ag act acc else do act <- actionNew name label tooltip stockId- onActionActivate act (doAction ideAction ideR session accString)+ onActionActivate act (doAction ideAction ideR accString) actionGroupAddActionWithAccel ag act acc- doAction ideAction ideR session accStr =+ doAction ideAction ideR accStr = handleTopExceptions (reflectIDE (do ideAction sb <- getSBSpecialKeys liftIO $statusbarPop sb 1 liftIO $statusbarPush sb 1 $accStr- return ()) ideR session)+ return ()) ideR) -- | Quit ide -- ### make reasonable
+ src/IDE/Metainfo/GHCUtils.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+--+-- Module : IDE.Metainfo.GHCUtils+-- Copyright : 2007-2009 Jürgen Nicklisch-Franken+-- License : GPL+--+-- Maintainer : Jutaro <jutaro@leksah.org>+-- Stability : provisional+-- Portability :+--+-- |+--+----------------------------------------------------------------------------- module IDE.Metainfo.GHCUtils (++ inGhc+, inGhcIO+, getInstalledPackageInfos+, findFittingPackages++) where++import GHC (setSessionDynFlags,getSessionDynFlags,runGhc,Ghc(..))+import IDE.Core.State (IDEM(..))+import IDE.FileUtils (getSysLibDir)+import Control.Monad.Trans (liftIO)+import PackageConfig (PackageConfig(..))+import DynFlags (pkgDatabase,DynFlag(..),flags)+import UniqFM (eltsUFM)+import Distribution.Simple (withinRange,PackageIdentifier(..),Dependency(..))+import qualified Distribution.InstalledPackageInfo as IPI (package)+import Data.List (maximumBy)+import Distribution.Package (pkgVersion)++inGhc :: Ghc a -> IDEM a+inGhc = liftIO . inGhcIO++inGhcIO :: Ghc a -> IO a+inGhcIO f = do+ libDir <- getSysLibDir+ runGhc (Just libDir) $ do+ getSessionDynFlags >>= setSessionDynFlags+ f++getInstalledPackageInfos :: Ghc [PackageConfig]+getInstalledPackageInfos = do+ dflags1 <- getSessionDynFlags+ setSessionDynFlags dflags1{flags = Opt_ReadUserPackageConf : (flags dflags1)}+ pkgInfos <- case pkgDatabase dflags1 of+ Nothing -> return []+ Just fm -> return (eltsUFM fm)+ return pkgInfos++findFittingPackages :: [Dependency] -> Ghc [PackageIdentifier]+findFittingPackages dependencyList = do+ knownPackages <- getInstalledPackageInfos+ let packages = map IPI.package knownPackages+ return (concatMap (fittingKnown packages) dependencyList)+ where+ fittingKnown packages (Dependency dname versionRange) =+ let filtered = filter (\ (PackageIdentifier name version) ->+ name == dname && withinRange version versionRange)+ packages+ in if length filtered > 1+ then [maximumBy (\a b -> compare (pkgVersion a) (pkgVersion b)) filtered]+ else filtered+
src/IDE/Metainfo/InterfaceCollector.hs view
@@ -15,11 +15,8 @@ module IDE.Metainfo.InterfaceCollector ( collectInstalled-, collectInstalledI , collectInstalled' , collectUninstalled-, getInstalledPackageInfos-, findFittingPackages , metadataVersion ) where@@ -27,6 +24,7 @@ import GHC hiding(Id,Failed,Succeeded,ModuleName) import Module hiding (PackageId,ModuleName)+import IDE.Metainfo.GHCUtils (findFittingPackages,getInstalledPackageInfos) import qualified Module import TcRnMonad hiding (liftIO,MonadIO) import qualified Maybes as M@@ -80,6 +78,7 @@ import IDE.FileUtils --import IDE.Metainfo.Provider import IDE.Metainfo.SourceCollector+import IDE.Metainfo.GHCUtils(inGhc) metadataVersion :: Integer metadataVersion = 3@@ -96,15 +95,8 @@ getDefault = CollectStatistics getDefault getDefault getDefault getDefault getDefault -collectInstalledI :: Bool -> IDEAction-collectInstalledI b = do- session' <- lift $ getSession- lift $ collectInstalled' False cProjectVersion b---collectInstalled :: HscEnv -> Bool -> Ghc ()-collectInstalled session b = do- collectInstalled' False cProjectVersion b+collectInstalled :: Bool -> IDEAction+collectInstalled b = inGhc $ collectInstalled' False cProjectVersion b collectInstalled' :: Bool -> String -> Bool -> Ghc() collectInstalled' writeAscii version forceRebuild = do@@ -159,13 +151,14 @@ collectUninstalled :: Bool -> String -> FilePath -> Ghc () collectUninstalled writeAscii version cabalPath = do- pd <- liftIO $ readPackageDescription normal cabalPath+ trace ("collect Uninstalled " ++ show cabalPath) return ()+ cCabalPath <- liftIO $ canonicalizePath cabalPath+ pd <- liftIO $ readPackageDescription normal cCabalPath >>= return . flattenPackageDescription let packageName = if hasExes pd then "main" else show $ package pd let modules = nub $ exeModules pd ++ libModules pd- cCabalPath <- liftIO $ canonicalizePath cabalPath let basePath = takeDirectory cCabalPath let buildPath = if hasExes pd then let exeName' = exeName (head (executables pd))@@ -187,11 +180,11 @@ allIfaceInfos <- getIFaceInfos2 ghcmodules packageName deps <- findFittingPackages (buildDepends pd) let extracted = extractInfo (allIfaceInfos, [], package pd, deps)- let sources = Map.fromList [(package pd,[cabalPath])]+ let sources = Map.fromList [(package pd,[cCabalPath])] (extractedWithSources,_) <- collectSources sources extracted collectorPath <- getCollectorPath version writeExtracted collectorPath writeAscii True extractedWithSources- sysMessage Normal $ "\nExtracted infos for " ++ cabalPath +++ sysMessage Normal $ "\nExtracted infos for " ++ cCabalPath ++ " size: " ++ (show . length) (exposedModulesPD extractedWithSources) -------------------------------------------------------------------------@@ -372,7 +365,7 @@ (map extractType (ifConArgTys decl)) extractType :: IfaceType -> TypeInfo-extractType decl = BS.pack $ filterExtras $ showSDocUnqual $ppr decl+extractType = BS.pack . filterExtras . showSDocUnqual . ppr extractFieldNames :: OccName -> Symbol extractFieldNames occName = unpackFS $occNameFS occName
src/IDE/Metainfo/Provider.hs view
@@ -48,7 +48,7 @@ import Control.Monad.Reader(ask) import Distribution.Version import Distribution.ModuleName-import GHC (runGhc,getSession)+import GHC (runGhc) import DeepSeq import IDE.FileUtils@@ -59,6 +59,7 @@ import Text.Regex.Posix import System.IO.Unsafe (unsafePerformIO) import Text.Regex.Posix.String (execute,compile)+import IDE.Metainfo.GHCUtils (findFittingPackages,getInstalledPackageInfos,inGhc) -- -- | Searching of metadata@@ -149,10 +150,9 @@ initInfo :: IDEAction initInfo = do prefs <- readIDE prefs- session' <- lift getSession when (collectAtStart prefs) $ do ideMessage Normal "Now updating metadata ..."- lift $ collectInstalled session' False+ collectInstalled False ideMessage Normal "Now loading metadata ..." loadAccessibleInfo ideMessage Normal "Finished loading ..."@@ -165,7 +165,7 @@ loadAccessibleInfo = let version = cProjectVersion in do collectorPath <- lift $ getCollectorPath version- packageInfos <- lift $ getInstalledPackageInfos+ packageInfos <- inGhc $ getInstalledPackageInfos packageList <- liftIO $ mapM (loadInfosForPackage collectorPath False) (map DP.package packageInfos) let scope = foldr buildScope (Map.empty,Map.empty)@@ -194,7 +194,7 @@ modifyIDE_ (\ide -> return (ide{currentInfo = Nothing})) Just pack -> do let depends' = depends pack- fp <- lift $findFittingPackages depends'+ fp <- inGhc $ findFittingPackages depends' mbActive <- loadOrBuildActiveInfo case mbActive of Nothing -> do@@ -221,7 +221,7 @@ -- If a process handle is given, it waits for this process to finish before building -- mayRebuildInBackground :: Maybe ProcessHandle -> IDEAction-mayRebuildInBackground mbHandle = reifyIDE $ \ ideR session ->+mayRebuildInBackground mbHandle = reifyIDE $ \ ideR -> let myRebuild :: IO Bool myRebuild =@@ -239,12 +239,13 @@ errs <- readIDE errors when (length (filter isError errs) == 0) $ do ideMessage Normal "Update meta info for active package"- setInfo buildActiveInfo) ideR session+ setInfo buildActiveInfo) ideR return False in do timeoutAddFull myRebuild priorityDefaultIdle 500 return () +rebuildActiveInfo :: IDEAction rebuildActiveInfo = setInfo buildActiveInfo --@@ -306,7 +307,7 @@ Just idePackage -> do libDir <- liftIO $ getSysLibDir liftIO $ runGhc (Just libDir)- $ collectUninstalled False cProjectVersion (cabalFile idePackage)+ $ collectUninstalled False cProjectVersion (takeFileName $ cabalFile idePackage) -- ideMessage Normal "uninstalled collected" collectorPath <- lift $ getCollectorPath cProjectVersion packageDescr <- liftIO $ loadInfosForPackage collectorPath True@@ -333,7 +334,7 @@ case wi of Nothing -> loadAccessibleInfo Just (psmap,psst) -> do- packageInfos <- lift getInstalledPackageInfos+ packageInfos <- inGhc getInstalledPackageInfos let packageIds = map DP.package packageInfos let newPackages = filter (\ pi -> Map.member pi psmap) packageIds let trashPackages = filter (\ e -> not (elem e packageIds))(Map.keys psmap)
src/IDE/Metainfo/SourceCollector.hs view
@@ -19,6 +19,8 @@ , sourceForPackage , parseSourceForPackageDB , getSourcesMap++, unloadGhc ) where import qualified Text.PrettyPrint.HughesPJ as PP@@ -66,25 +68,33 @@ -> PackageDescr -> Ghc (PackageDescr,Int) collectSources sourceMap pdescr = do+ unloadGhc sysMessage Normal $ "Now collecting sources for " ++ display (packagePD pdescr) case sourceForPackage (packagePD pdescr) sourceMap of Nothing -> do sysMessage Normal $ "No source for package " ++ display (packagePD pdescr) return (pdescr,0)- Just cabalPath -> gcatch (do- basePath <- liftIO $ canonicalizePath (takeDirectory cabalPath)+ Just cabalPath' -> gcatch (do+ cabalPath <- liftIO $ canonicalizePath cabalPath'+ let basePath = takeDirectory cabalPath pkgDescr <- gcatch (liftIO $ (liftM flattenPackageDescription (readPackageDescription silent cabalPath))) (\(e :: SomeException) -> return emptyPackageDescription)- let bis = allBuildInfo pkgDescr- let buildPaths = map (\p -> basePath </> p)- $ nub $ ("dist" </> "build" </> "autogen") : (".")- : concatMap hsSourceDirs bis- let includes = map (\p -> basePath </> p) $ nub $ concatMap includeDirs bis-+ let bis = allBuildInfo pkgDescr+ let buildPaths = if hasExes pkgDescr+ then let exeName' = exeName (head (executables pkgDescr))+ in -- map (\p -> basePath </> p) $+ ("dist" </> "build" </> exeName' </>+ exeName' ++ "-tmp" </> "") :+ ("dist" </> "build" </> "autogen") : (".")+ : (nub $ concatMap hsSourceDirs bis)+ else -- map (\p -> basePath </> p) $+ ("dist" </> "build" </> "autogen") : (".")+ : (nub $ concatMap hsSourceDirs bis)+ let includes = {-- map (\p -> basePath </> p) $ --} nub $ concatMap includeDirs bis dflags <- getSessionDynFlags let dflags2 = dflags {- topDir = basePath,+ topDir = basePath, hscTarget = HscAsm, ghcMode = CompManager, ghcLink = NoLink}@@ -132,7 +142,9 @@ collectSourcesForPackage pkgDescr sourceFiles interesting = do targets <- mapM (\f -> guessTarget f Nothing) sourceFiles setTargets targets+ trace ("before depanal") $ return () modgraph <- depanal [] False+ trace ("after depanal") $ return () let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph Nothing let interestingMods = filter (\m -> elem (moduleNameString (ms_mod_name m)) interesting) orderedMods let orderedTupels = catMaybes (map (\om -> case filter (\m -> ((moduleNameString . moduleName . ms_mod) om) ==@@ -144,8 +156,8 @@ collectSourcesForModule :: ([ModuleDescr],Int) -> (ModuleDescr, ModSummary) -> Ghc ([ModuleDescr],Int) collectSourcesForModule (moduleDescrs,failureCount) (modD,modsum) = gcatch (do- let filename = msHsFilePath modsum- let dynflags = ms_hspp_opts modsum+ let filename = msHsFilePath modsum+ let dynflags = ms_hspp_opts modsum parsedMod <- parseModule modsum let decls = (hsmodDecls . unLoc . parsedSource) $ parsedMod let map' = convertToMap (idDescriptionsMD modD)@@ -320,6 +332,12 @@ show (DocCommentPrev doc) = "DocCommentPrev " ++ show doc show (DocCommentNamed str doc) = "DocCommentNamed" ++ " " ++ str ++ " " ++ show doc show (DocGroup i doc) = "DocGroup" ++ " " ++ show i ++ " " ++ show doc++unloadGhc :: Ghc ()+unloadGhc = do+ setTargets []+ load LoadAllTargets+ return () -- --------------------------------------------------------------------- -- Function to map packages to file paths
src/IDE/Package.hs view
@@ -123,11 +123,11 @@ ideR <- ask let ppath = dropFileName filePath liftIO $ setCurrentDirectory ppath- mbPackageD <- reifyIDE (\ideR session -> catch (do+ mbPackageD <- reifyIDE (\ideR -> catch (do pd <- readPackageDescription normal filePath return (Just (flattenPackageDescription pd))) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ("Can't activate package " ++(show e))) ideR session+ reflectIDE (ideMessage Normal ("Can't activate package " ++(show e))) ideR return Nothing)) case mbPackageD of Nothing -> return (Nothing)@@ -173,7 +173,7 @@ case mbPackage of Nothing -> return () Just package -> do- mbPackageD <- reifyIDE (\ideR session -> catch (do+ mbPackageD <- reifyIDE (\ideR -> catch (do (inp,out,err,pid) <- runExternal "runhaskell" (["Setup","configure"] ++ (configFlags package)) oid <- forkIO(readOut log out)@@ -181,7 +181,7 @@ pd <- readPackageDescription normal (cabalFile package) return (Just (flattenPackageDescription pd))) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal (show e)) ideR session+ reflectIDE (ideMessage Normal (show e)) ideR return Nothing)) case mbPackageD of Just packageD -> do@@ -205,12 +205,12 @@ liftIO $statusbarPop sb 1 liftIO $statusbarPush sb 1 "Building" unmarkCurrentError- pid' <- reifyIDE (\ideR session -> do+ 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 session)+ eid <- forkIO (reflectIDE (readErrForBuild log err) ideR) return pid) when (collectAfterBuild prefs) $ mayRebuildInBackground (Just pid')) (\(e :: SomeException) -> putStrLn (show e))@@ -576,11 +576,11 @@ return Nothing Just p -> do ideR <- ask- reifyIDE (\ideR session -> catch (do+ reifyIDE (\ideR -> catch (do pd <- readPackageDescription normal (cabalFile p) return (Just (flattenPackageDescription pd,cabalFile p))) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ("Can't load package " ++(show e))) ideR session+ reflectIDE (ideMessage Normal ("Can't load package " ++(show e))) ideR return Nothing)) getModuleTemplate :: PackageDescription -> String -> IO String@@ -601,12 +601,12 @@ return () Just p -> do ideR <- ask- reifyIDE (\ideR session -> catch (do+ reifyIDE (\ideR -> catch (do gpd <- readPackageDescription normal (cabalFile p) if hasConfigs gpd then do reflectIDE (ideMessage High- "Cabal File with configurations can't be automatically updated") ideR session+ "Cabal File with configurations can't be automatically updated") ideR else let pd = flattenPackageDescription gpd npd = if isExposed && isJust (library pd)@@ -621,7 +621,7 @@ (executables npd1)} in writePackageDescription (cabalFile p) npd) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ("Can't upade package " ++ show e)) ideR session+ reflectIDE (ideMessage Normal ("Can't upade package " ++ show e)) ideR return ())) where addModToBuildInfo :: BuildInfo -> ModuleName -> BuildInfo
src/IDE/Pane/Callers.hs view
@@ -151,7 +151,7 @@ paneMap <- readIDE paneMap prefs <- readIDE prefs currentInfo <- readIDE currentInfo- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do listStore <- New.listStoreNew [] treeView <- New.treeViewNew New.treeViewSetModel treeView listStore@@ -204,8 +204,8 @@ notebookInsertOrdered nb box (paneName callers) Nothing widgetShowAll box cid1 <- treeView `afterFocusIn`- (\_ -> do reflectIDE (makeActive callers) ideR session; return True)- treeView `onButtonPress` (treeViewPopup ideR session callers)+ (\_ -> do reflectIDE (makeActive callers) ideR ; return True)+ treeView `onButtonPress` (treeViewPopup ideR callers) return (callers,[ConnectC cid1]) addPaneAdmin buf cids panePath liftIO $widgetGrabFocus (scrolledView buf)@@ -224,11 +224,10 @@ _ -> return Nothing treeViewPopup :: IDERef- -> Session -> IDECallers -> Event -> IO (Bool)-treeViewPopup ideR session callers (Button _ click _ _ _ _ button _ _) = do+treeViewPopup ideR callers (Button _ click _ _ _ _ button _ _) = do if button == RightButton then do theMenu <- menuNew@@ -242,7 +241,7 @@ text <- entryGetText (callersEntry callers) case words text of (hd : tl) -> do- reflectIDE (selectText fp hd) ideR session+ reflectIDE (selectText fp hd) ideR return () _ -> return () otherwise -> return ()@@ -261,12 +260,12 @@ text <- entryGetText (callersEntry callers) case words text of (hd : tl) -> do- reflectIDE (selectText fp hd) ideR session+ reflectIDE (selectText fp hd) ideR return True _ -> return False otherwise -> return False else return False-treeViewPopup _ _ _ _ = throwIDE "treeViewPopup wrong event type"+treeViewPopup _ _ _ = throwIDE "treeViewPopup wrong event type" selectText :: FilePath -> String -> IDEM Bool selectText fp text = do@@ -278,9 +277,9 @@ setFindState fs {entryStr = text} showFindbar focusFindEntry- reifyIDE $ \ideR session -> do+ reifyIDE $ \ideR -> do idleAdd (do- reflectIDE (editFind True True True text "" Forward) ideR session+ reflectIDE (editFind True True True text "" Forward) ideR return False) priorityDefaultIdle return True
src/IDE/Pane/ClassHierarchy.hs view
@@ -262,7 +262,7 @@ paneMap <- readIDE paneMap prefs <- readIDE prefs currentInfo <- readIDE currentInfo- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do -- Class Hierarchy let forest = case currentInfo of@@ -366,7 +366,7 @@ New.treeViewExpandRow treeView treePath False return ()) cid1 <- treeView `afterFocusIn`- (\_ -> do reflectIDE (makeActive classes) ideR session; return True)+ (\_ -> do reflectIDE (makeActive classes) ideR; return True) -- cid2 <- facetView `afterFocusIn` -- (\_ -> do runReaderT (makeActive classes) ideR; return True) -- treeView `onButtonPress` (treeViewPopup ideR treeStore treeView)
src/IDE/Pane/Info.hs view
@@ -101,8 +101,8 @@ Nothing -> return () Just p -> liftIO $ bringPaneToFront p -idDescrDescr :: IDERef -> Session -> FieldDescription Descr-idDescrDescr ideR session = VFD emptyParams [+idDescrDescr :: IDERef -> FieldDescription Descr+idDescrDescr ideR = VFD emptyParams [ HFD emptyParams [ mkField (paraName <<<- ParaName "Identifier"@@ -110,7 +110,7 @@ $ emptyParams) descrName (\ b a -> if isReexported a then a else a{descrName' = b})- (symbolEditor ideR session)+ (symbolEditor ideR ) , mkField emptyParams (stockIdFromType . descrType . details)@@ -142,22 +142,22 @@ mbComment' = case snd b of "" -> Nothing s -> Just (BS.pack s)}))- (typeAndCommentEditor ideR session)]+ (typeAndCommentEditor ideR )] --allIdTypes = [Function, Newtype, Type, AbstractData, OpenData, Foreign -- , Data, Class, Instance, Constructor, Field, Method, OrphanedInstance] -typeEditor :: IDERef -> Session -> Editor String-typeEditor ideR session para noti = do+typeEditor :: IDERef -> Editor String+typeEditor ideR para noti = do ed@(wid,inj,ext) <- multilineStringEditor para noti registerEvent noti ButtonRelease $Left (\e -> do- res <- showInfoHandler wid ideR session+ res <- showInfoHandler wid ideR return e {gtkReturn = res}) return ed -typeAndCommentEditor :: IDERef -> Session -> Editor (String,String)-typeAndCommentEditor ideR session para noti =- splitEditor (typeEditor ideR session,+typeAndCommentEditor :: IDERef -> Editor (String,String)+typeAndCommentEditor ideR para noti =+ splitEditor (typeEditor ideR, paraName <<<- ParaName "Type" $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)@@ -171,9 +171,9 @@ $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) $ para) noti -symbolEditor :: IDERef -> Session -> Editor String-symbolEditor ideR session parameters notifier = do- window <- reflectIDE (readIDE window) ideR session+symbolEditor :: IDERef -> Editor String+symbolEditor ideR parameters notifier = do+ window <- reflectIDE (readIDE window) ideR ed@(w,i,ext) <- stringEditor (\_ -> True) parameters notifier registerEvent notifier AfterKeyRelease (Left (\ event -> do mbText <- ext@@ -181,7 +181,7 @@ Just t -> do reflectIDE (do triggerEvent ideR (SearchMeta t)- return ()) ideR session+ return ()) ideR rw <- liftIO $ getRealWidget w when (isJust rw) $ liftIO $ do widgetGrabFocus (fromJust rw)@@ -191,8 +191,8 @@ return event{gtkReturn=False})) return ed -showInfoHandler :: Widget -> IDERef -> Session -> IO Bool-showInfoHandler wid ideR session = do+showInfoHandler :: Widget -> IDERef -> IO Bool+showInfoHandler wid ideR = do mbFrame <- binGetChild (castToAlignment wid) mbInner <- binGetChild (castToFrame (forceJust mbFrame "InfoPane>>typeEditor: Can't find child")) mbScrolled <- binGetChild (castToAlignment (forceJust mbInner "InfoPane>>typeEditor: Can't find child2")) @@ -200,7 +200,7 @@ buf <- textViewGetBuffer (castToTextView (forceJust mbTV "InfoPane>>typeEditor: Can't find child4")) (l,r) <- textBufferGetSelectionBounds buf symbol <- textBufferGetText buf l r True- reflectIDE (triggerEvent ideR (SelectInfo symbol)) ideR session+ reflectIDE (triggerEvent ideR (SelectInfo symbol)) ideR return False initInfo :: PanePath -> Notebook -> Descr -> IDEAction@@ -208,7 +208,7 @@ panes <- readIDE panes paneMap <- readIDE paneMap prefs <- readIDE prefs- (pane,cids) <- reifyIDE $ \ideR session -> do+ (pane,cids) <- reifyIDE $ \ideR -> do ibox <- vBoxNew False 0 bb <- hButtonBoxNew buttonBoxSetLayout bb ButtonboxSpread@@ -223,7 +223,7 @@ boxPackStartDefaults bb usesB boxPackStartDefaults bb docuB boxPackStartDefaults bb searchB- (widget,injb,ext,notifier) <- buildEditor (idDescrDescr ideR session) idDescr+ (widget,injb,ext,notifier) <- buildEditor (idDescrDescr ideR ) idDescr boxPackStart ibox widget PackGrow 0 boxPackEnd ibox bb PackNatural 0 --openType@@ -233,18 +233,18 @@ currentDescr' <- newIORef idDescr let info = IDEInfo sw currentDescr' injb ext -- mapM_ (\w -> widgetSetExtensionEvents w [ExtensionEventsAll]) widgets--- widget `onFocus` (\_ -> do reflectIDE (makeActive info) ideR session+-- widget `onFocus` (\_ -> do reflectIDE (makeActive info) ideR -- return False)- definitionB `onClicked` (reflectIDE gotoSource ideR session)- moduB `onClicked` (reflectIDE gotoModule' ideR session)- usesB `onClicked` (reflectIDE calledBy' ideR session)+ definitionB `onClicked` (reflectIDE gotoSource ideR )+ moduB `onClicked` (reflectIDE gotoModule' ideR )+ usesB `onClicked` (reflectIDE calledBy' ideR ) searchB `onClicked` (do mbDescr <- ext idDescr case mbDescr of Nothing -> return () Just descr -> reflectIDE (do triggerEvent ideR (SearchMeta (descrName' descr))- showInfo) ideR session)+ showInfo) ideR ) notebookInsertOrdered nb sw (paneName info) Nothing widgetShowAll sw return (info,[])
src/IDE/Pane/Log.hs view
@@ -142,7 +142,7 @@ panes <- readIDE panes paneMap <- readIDE paneMap prefs <- readIDE prefs- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do tv <- textViewNew buf <- textViewGetBuffer tv iter <- textBufferGetEndIter buf@@ -177,9 +177,9 @@ notebookInsertOrdered nb sw (paneName buf) Nothing widgetShowAll (scrolledWindowL buf) cid1 <- tv `afterFocusIn`- (\_ -> do reflectIDE (makeActive buf) ideR session; return True)+ (\_ -> do reflectIDE (makeActive buf) ideR ; return True) cid2 <- tv `onButtonPress`- (\ b -> do reflectIDE (clicked b buf) ideR session; return True)+ (\ b -> do reflectIDE (clicked b buf) ideR ; return True) return (buf,[ConnectC cid1, ConnectC cid2]) addPaneAdmin buf cids panePath liftIO $widgetGrabFocus (textView buf)@@ -206,18 +206,18 @@ otherwise -> return () clicked (Button _ SingleClick _ _ _ _ RightButton x y) ideLog = do errors' <- readIDE errors- line' <- reifyIDE $ \ideR session -> do+ line' <- reifyIDE $ \ideR -> do (x,y) <- widgetGetPointer (textView ideLog) (_,y') <- textViewWindowToBufferCoords (textView ideLog) TextWindowWidget (x,y) (iter,_) <- textViewGetLineAtY (textView ideLog) y' textIterGetLine iter case filter (\(es,_) -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1)) (zip errors' [0..(length errors')]) of- [(thisErr,n)] -> reifyIDE $ \ideR session -> do+ [(thisErr,n)] -> reifyIDE $ \ideR -> do theMenu <- menuNew item0 <- menuItemNewWithLabel "Add all imports" item0 `onActivateLeaf` do- reflectIDE addAllImports' ideR session+ reflectIDE addAllImports' ideR menuShellAppend theMenu item0 case parseNotInScope (errDescription thisErr) of Nothing -> do@@ -225,7 +225,7 @@ Just _ -> do item1 <- menuItemNewWithLabel "Add import" item1 `onActivateLeaf` do- reflectIDE (addImport thisErr >> return()) ideR session+ reflectIDE (addImport thisErr >> return()) ideR menuShellAppend theMenu item1 menuPopup theMenu Nothing widgetShowAll theMenu
src/IDE/Pane/Modules.hs view
@@ -257,7 +257,7 @@ paneMap <- readIDE paneMap prefs <- readIDE prefs currentInfo <- readIDE currentInfo- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do -- Modules List let forest = case currentInfo of Nothing -> []@@ -372,24 +372,24 @@ New.treeViewExpandRow treeView treePath False return ()) cid1 <- treeView `afterFocusIn`- (\_ -> do reflectIDE (makeActive modules) ideR session; return True)+ (\_ -> do reflectIDE (makeActive modules) ideR; return True) cid2 <- descrView `afterFocusIn`- (\_ -> do reflectIDE (makeActive modules) ideR session; return True)- treeView `onButtonPress` (treeViewPopup ideR session treeStore treeView)- descrView `onButtonPress` (descrViewPopup ideR session descrStore descrView)- rb1 `onToggled` (reflectIDE scopeSelection ideR session)- rb2 `onToggled` (reflectIDE scopeSelection ideR session)- rb3 `onToggled` (reflectIDE scopeSelection ideR session)- cb `onToggled` (reflectIDE scopeSelection ideR session)+ (\_ -> do reflectIDE (makeActive modules) ideR; return True)+ treeView `onButtonPress` (treeViewPopup ideR treeStore treeView)+ descrView `onButtonPress` (descrViewPopup ideR descrStore descrView)+ rb1 `onToggled` (reflectIDE scopeSelection ideR)+ rb2 `onToggled` (reflectIDE scopeSelection ideR)+ rb3 `onToggled` (reflectIDE scopeSelection ideR)+ cb `onToggled` (reflectIDE scopeSelection ideR) sel <- New.treeViewGetSelection treeView sel `New.onSelectionChanged` do fillFacets treeView treeStore descrView descrStore- reflectIDE recordSelHistory ideR session+ reflectIDE recordSelHistory ideR return () sel2 <- New.treeViewGetSelection descrView sel2 `New.onSelectionChanged` do- fillInfo descrView descrStore ideR session- reflectIDE recordSelHistory ideR session+ fillInfo descrView descrStore ideR+ reflectIDE recordSelHistory ideR return () return (modules,[ConnectC cid1,ConnectC cid2, ConnectC cid3]) addPaneAdmin buf cids panePath@@ -502,16 +502,15 @@ fillInfo :: New.TreeView -> New.TreeStore Descr -> IDERef- -> Session -> IO ()-fillInfo treeView lst ideR session = do+fillInfo treeView lst ideR = do treeSelection <- New.treeViewGetSelection treeView paths <- New.treeSelectionGetSelectedRows treeSelection case paths of [] -> return () [a] -> do descr <- New.treeStoreGetValue lst a- reflectIDE (setInfo descr) ideR session+ reflectIDE (setInfo descr) ideR return () _ -> return () @@ -720,12 +719,11 @@ sortTree (Node l forest) = Node l (sort (map sortTree forest)) treeViewPopup :: IDERef- -> Session -> New.TreeStore (String, [(ModuleDescr,PackageDescr)]) -> New.TreeView -> Event -> IO (Bool)-treeViewPopup ideR session store treeView (Button _ click _ _ _ _ button _ _) = do+treeViewPopup ideR store treeView (Button _ click _ _ _ _ button _ _) = do if button == RightButton then do theMenu <- menuNew@@ -736,7 +734,7 @@ Just (_,[(m,_)]) -> case mbSourcePathMD m of Nothing -> return () Just fp -> do- reflectIDE (selectSourceBuf fp) ideR session+ reflectIDE (selectSourceBuf fp) ideR return () otherwise -> return () sep1 <- separatorMenuItemNew@@ -750,7 +748,7 @@ item5 `onActivateLeaf` (New.treeViewCollapseAll treeView) sep2 <- separatorMenuItemNew item6 <- menuItemNewWithLabel "Add module"- item6 `onActivateLeaf` (reflectIDE (addModule treeView store) ideR session)+ item6 `onActivateLeaf` (reflectIDE (addModule treeView store) ideR) mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1, castToMenuItem item2, castToMenuItem item3, castToMenuItem item4, castToMenuItem item5, castToMenuItem sep2,@@ -764,20 +762,19 @@ Just (_,[(m,_)]) -> case mbSourcePathMD m of Nothing -> return () Just fp -> do- reflectIDE (selectSourceBuf fp) ideR session+ reflectIDE (selectSourceBuf fp) ideR return () otherwise -> return () return True else return False-treeViewPopup _ _ _ _ _ = throwIDE "treeViewPopup wrong event type"+treeViewPopup _ _ _ _ = throwIDE "treeViewPopup wrong event type" descrViewPopup :: IDERef- -> Session -> New.TreeStore Descr -> New.TreeView -> Event -> IO (Bool)-descrViewPopup ideR session store descrView (Button _ click _ _ _ _ button _ _) = do+descrViewPopup ideR store descrView (Button _ click _ _ _ _ button _ _) = do if button == RightButton then do theMenu <- menuNew@@ -785,8 +782,7 @@ item1 `onActivateLeaf` do sel <- getSelectionDescr descrView store case sel of- Just descr -> reflectIDE- (goToDefinition descr) ideR session+ Just descr -> reflectIDE (goToDefinition descr) ideR otherwise -> sysMessage Normal "Modules>> descrViewPopup: no selection" menuShellAppend theMenu item1 menuPopup theMenu Nothing@@ -795,15 +791,15 @@ else if button == LeftButton && click == DoubleClick then do sel <- getSelectionDescr descrView store case sel of- Just descr -> reflectIDE (goToDefinition descr) ideR session+ Just descr -> reflectIDE (goToDefinition descr) ideR otherwise -> sysMessage Normal "Modules>> descrViewPopup: no selection2" return True else do- mbPane :: Maybe IDEInfo <- reflectIDE getPane ideR session+ mbPane :: Maybe IDEInfo <- reflectIDE getPane ideR when (isJust mbPane) $ bringPaneToFront (fromJust mbPane) return False -descrViewPopup _ _ _ _ _ = throwIDE "descrViewPopup wrong event type"+descrViewPopup _ _ _ _ = throwIDE "descrViewPopup wrong event type" setScope :: (Scope,Bool) -> IDEAction setScope (sc,bl) = do
src/IDE/Pane/PackageEditor.hs view
@@ -43,7 +43,6 @@ import Distribution.ModuleName(ModuleName) import Data.Typeable (Typeable(..)) import Debug.Trace (trace)-import IDE.Metainfo.InterfaceCollector (getInstalledPackageInfos) import qualified Distribution.InstalledPackageInfo as IPI (package) import Graphics.UI.Editor.Composite (maybeEditor,pairEditor,ColumnDescr(..),multisetEditor) import qualified Graphics.UI.Gtk as New (cellText)@@ -52,6 +51,7 @@ import Graphics.UI.Editor.Parameters (Parameter(..),paraPack,Direction(..),paraDirection,paraMinSize,paraShadow,paraSynopsis,(<<<-),emptyParams,paraName,getParameterPrim) import Graphics.UI.Editor.Simple (boolEditor,fileEditor,comboSelectionEditor,multilineStringEditor,stringEditor) import Distribution.License (License(..))+import IDE.Metainfo.GHCUtils (inGhc,getInstalledPackageInfos) -- --------------------------------------------------------------------- -- The exported stuff goes here@@ -257,7 +257,7 @@ layout <- readIDE layout let pp = getStandardPanePath (sourcePanePath prefs) layout nb <- getNotebook pp- packageInfos <- lift $ getInstalledPackageInfos+ packageInfos <- inGhc $ getInstalledPackageInfos let packageEd = toEditor packageD initPackage packagePath packageEd (packageDD@@ -286,8 +286,8 @@ window <- readIDE window paneMap <- readIDE paneMap currentInfo <- readIDE currentInfo- packageInfos <- lift $ getInstalledPackageInfos- (buf,cids) <- reifyIDE $ \ideR session -> do+ packageInfos <- inGhc $ getInstalledPackageInfos+ (buf,cids) <- reifyIDE $ \ideR -> do vb <- vBoxNew False 0 let packagePane = PackagePane vb bb <- hButtonBoxNew@@ -313,7 +313,7 @@ let packagePath = packageDir </> (display . pkgName . package . pd) newPackage' ++ ".cabal" writePackageDescription packagePath newPackage- reflectIDE (afterSaveAction packagePath) ideR session)+ reflectIDE (afterSaveAction packagePath) ideR) closeB `onClicked` (do mbNewPackage' <- extractAndValidate packageD [getExt] fieldNames case mbNewPackage' of@@ -323,7 +323,7 @@ rid <- dialogRun md widgetDestroy md case rid of- ResponseYes -> (reflectIDE (close packagePane) ideR session)+ ResponseYes -> (reflectIDE (close packagePane) ideR) otherwise -> return () Just newPackage -> do let packagePath = packageDir </> (display . pkgName . package . pd) newPackage@@ -363,7 +363,7 @@ ResponseNo -> return False _ -> return False else return False- when (not cancel) (reflectIDE (close packagePane) ideR session))+ when (not cancel) (reflectIDE (close packagePane) ideR)) restore `onClicked` (do package <- readPackageDescription normal initialPackagePath setInj (toEditor (flattenPackageDescription package)))@@ -382,7 +382,7 @@ (length (bis pde) + 1) (concatMap (buildInfoD (Just packageDir) modules) [0..length (bis pde)]))- panePath nb2 modules afterSaveAction) ideR session)+ panePath nb2 modules afterSaveAction) ideR) removeB `onClicked` (do mbNewPackage' <- extractAndValidate packageD [getExt] fieldNames case mbNewPackage' of@@ -398,7 +398,7 @@ (length (bis pde) - 1) (concatMap (buildInfoD (Just packageDir) modules) [0..length (bis pde) - 2]))- panePath nb2 modules afterSaveAction) ideR session)+ panePath nb2 modules afterSaveAction) ideR) boxPackStart vb widget PackGrow 7 boxPackEnd vb bb PackNatural 7 widgetShowAll vb
src/IDE/Pane/PackageFlags.hs view
@@ -229,7 +229,7 @@ initFlags idePackage panePath nb = do let flagsDesc = extractFieldDescription flagsDescription let flatflagsDesc = flattenFieldDescription flagsDesc- (buf,cids) <- reifyIDE $ \ ideR session -> do+ (buf,cids) <- reifyIDE $ \ ideR -> do vb <- vBoxNew False 0 let flagsPane = IDEFlags vb bb <- hButtonBoxNew@@ -249,12 +249,12 @@ Just packWithNewFlags -> do reflectIDE (do modifyIDE_ (\ide -> return (ide{activePack = Just packWithNewFlags}))- close flagsPane) ideR session -- we don't trigger the activePack event here+ close flagsPane) ideR -- we don't trigger the activePack event here writeFlags ((dropFileName (cabalFile packWithNewFlags)) </> "IDE.flags") packWithNewFlags)- closeB `onClicked` (reflectIDE (close flagsPane) ideR session)+ closeB `onClicked` (reflectIDE (close flagsPane) ideR) registerEvent notifier FocusIn (Left (\e -> do- reflectIDE (makeActive flagsPane) ideR session+ reflectIDE (makeActive flagsPane) ideR return (e{gtkReturn=False}))) boxPackStart vb sw PackGrow 7 boxPackEnd vb bb PackNatural 7
src/IDE/Pane/Preferences.hs view
@@ -52,6 +52,7 @@ import IDE.FileUtils import System.IO import Distribution.InstalledPackageInfo (package)+import IDE.Metainfo.GHCUtils (getInstalledPackageInfos,inGhc) -- -- | The Preferences Pane@@ -123,14 +124,14 @@ initPrefs :: PanePath -> Notebook -> IDEAction initPrefs panePath nb2 = do- packageInfos <- lift $ getInstalledPackageInfos+ packageInfos <- inGhc getInstalledPackageInfos let flatPrefsDesc = flattenFieldDescriptionPP (prefsDescription (map package packageInfos)) prefs <- readIDE prefs lastAppliedPrefsRef <- liftIO $ newIORef prefs panes <- readIDE panes paneMap <- readIDE paneMap currentInfo <- readIDE currentInfo- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do vb <- vBoxNew False 0 bb <- hButtonBoxNew apply <- buttonNewFromStock "gtk-apply"@@ -151,11 +152,11 @@ Nothing -> return () Just newPrefs -> do lastAppliedPrefs <- readIORef lastAppliedPrefsRef- mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF newPrefs lastAppliedPrefs) ideR session) flatPrefsDesc+ mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF newPrefs lastAppliedPrefs) ideR ) flatPrefsDesc writeIORef lastAppliedPrefsRef newPrefs) restore `onClicked` (do lastAppliedPrefs <- readIORef lastAppliedPrefsRef- mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF prefs lastAppliedPrefs) ideR session) flatPrefsDesc+ mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF prefs lastAppliedPrefs) ideR ) flatPrefsDesc injb prefs writeIORef lastAppliedPrefsRef prefs) save `onClicked` (do@@ -164,13 +165,13 @@ case mbNewPrefs of Nothing -> return () Just newPrefs -> do- mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF newPrefs lastAppliedPrefs) ideR session) flatPrefsDesc+ mapM_ (\ (FDPP _ _ _ _ applyF) -> reflectIDE (applyF newPrefs lastAppliedPrefs) ideR ) flatPrefsDesc fp <- getConfigFilePathForSave "Default.prefs" writePrefs fp newPrefs- reflectIDE (modifyIDE_ (\ide -> return (ide{prefs = newPrefs}))) ideR session)- closeB `onClicked` (reflectIDE (close prefsPane) ideR session)+ reflectIDE (modifyIDE_ (\ide -> return (ide{prefs = newPrefs}))) ideR )+ closeB `onClicked` (reflectIDE (close prefsPane) ideR ) registerEvent notifier FocusIn (Left (\e -> do- reflectIDE (makeActive prefsPane) ideR session+ reflectIDE (makeActive prefsPane) ideR return (e{gtkReturn=False}))) notebookInsertOrdered nb2 vb (paneName prefsPane) Nothing widgetShowAll vb@@ -196,7 +197,7 @@ boolEditor (\b -> do buffers <- allBuffers- mapM_ (\buf -> liftIO$sourceViewSetShowLineNumbers (sourceView buf) b) buffers)+ mapM_ (\buf -> liftIO $ sourceViewSetShowLineNumbers (sourceView buf) b) buffers) , mkFieldPP (paraName <<<- ParaName "TextView Font" $ emptyParams) (\a -> PP.text (case a of Nothing -> show ""; Just s -> show s))@@ -207,7 +208,7 @@ fontEditor (\mbs -> do buffers <- allBuffers- fdesc <- liftIO $fontDescriptionFromString (case mbs of Just str -> str; Nothing -> "")+ fdesc <- liftIO $ fontDescriptionFromString (case mbs of Just str -> str; Nothing -> "") liftIO $mapM_ (\buf -> widgetModifyFont (castToWidget $sourceView buf) (Just fdesc)) buffers) , mkFieldPP (paraName <<<- ParaName "Right margin"
src/IDE/Pane/Search.hs view
@@ -123,7 +123,7 @@ paneMap <- readIDE paneMap prefs <- readIDE prefs currentInfo <- readIDE currentInfo- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do scopebox <- hBoxNew True 2 rb1 <- radioButtonNewWithLabel "Local"@@ -227,28 +227,28 @@ widgetShowAll box cid1 <- treeView `afterFocusIn`- (\_ -> do reflectIDE (makeActive search) ideR session; return True)- rb1 `onToggled` (reflectIDE (scopeSelection Local) ideR session)- rb2 `onToggled` (reflectIDE (scopeSelection Package) ideR session)- rb3 `onToggled` (reflectIDE (scopeSelection System) ideR session)+ (\_ -> do reflectIDE (makeActive search) ideR ; return True)+ rb1 `onToggled` (reflectIDE (scopeSelection Local) ideR )+ rb2 `onToggled` (reflectIDE (scopeSelection Package) ideR )+ rb3 `onToggled` (reflectIDE (scopeSelection System) ideR ) mb1 `onToggled` do widgetSetSensitivity mb4 False active <- toggleButtonGetActive mb4- (reflectIDE (modeSelection (Exact active)) ideR session)+ (reflectIDE (modeSelection (Exact active)) ideR ) mb2 `onToggled`do widgetSetSensitivity mb4 True active <- toggleButtonGetActive mb4- (reflectIDE (modeSelection (Prefix active)) ideR session)+ (reflectIDE (modeSelection (Prefix active)) ideR ) mb3 `onToggled` do widgetSetSensitivity mb4 True active <- toggleButtonGetActive mb4- (reflectIDE (modeSelection (Regex active)) ideR session)+ (reflectIDE (modeSelection (Regex active)) ideR ) mb4 `onToggled` do active <- toggleButtonGetActive mb4- (reflectIDE (modeSelectionCase active) ideR session)- treeView `onButtonPress` (listViewPopup ideR session listStore treeView)+ (reflectIDE (modeSelectionCase active) ideR )+ treeView `onButtonPress` (listViewPopup ideR listStore treeView) sel `New.onSelectionChanged` do- fillInfo treeView listStore ideR session+ fillInfo treeView listStore ideR trace "search pane selection changes" $ return () return (search,[ConnectC cid1]) addPaneAdmin buf cids panePath@@ -298,12 +298,11 @@ mapM_ (New.listStoreAppend (searchStore search)) descrs listViewPopup :: IDERef- -> Session -> New.ListStore Descr -> New.TreeView -> Event -> IO (Bool)-listViewPopup ideR session store descrView (Button _ click _ _ _ _ button _ _) = do+listViewPopup ideR store descrView (Button _ click _ _ _ _ button _ _) = do if button == RightButton then do theMenu <- menuNew@@ -312,7 +311,7 @@ sel <- getSelectionDescr descrView store case sel of Just descr -> reflectIDE- (goToDefinition descr) ideR session+ (goToDefinition descr) ideR otherwise -> sysMessage Normal "Search >> listViewPopup: no selection" menuShellAppend theMenu item1 menuPopup theMenu Nothing@@ -322,14 +321,14 @@ then do sel <- getSelectionDescr descrView store case sel of Just descr -> reflectIDE (triggerEvent ideR (SelectIdent descr))- ideR session >> return ()+ ideR >> return () otherwise -> sysMessage Normal "Search >> listViewPopup: no selection2" return True else do- mbPane :: Maybe IDEInfo <- reflectIDE getPane ideR session+ mbPane :: Maybe IDEInfo <- reflectIDE getPane ideR when (isJust mbPane) $ bringPaneToFront (fromJust mbPane) return False-listViewPopup _ _ _ _ _ = throwIDE "listViewPopup wrong event type"+listViewPopup _ _ _ _ = throwIDE "listViewPopup wrong event type" getSelectionDescr :: New.TreeView -> New.ListStore Descr@@ -346,12 +345,11 @@ fillInfo :: New.TreeView -> New.ListStore Descr -> IDERef- -> Session -> IO ()-fillInfo treeView listStore ideR session = do+fillInfo treeView listStore ideR = do sel <- getSelectionDescr treeView listStore case sel of- Just descr -> reflectIDE (setInfo descr) ideR session+ Just descr -> reflectIDE (setInfo descr) ideR otherwise -> sysMessage Normal "Search>>fillInfo:no selection" setChoices :: [Descr] -> IDEAction
src/IDE/Pane/SourceBuffer.hs view
@@ -116,12 +116,12 @@ sbIO <- getStatusbarIO infos <- readIDE accessibleInfo let sv = sourceView actbuf- (cids) <- reifyIDE $ \ideR session -> do+ (cids) <- reifyIDE $ \ideR -> do gtkBuf <- textViewGetBuffer sv bringPaneToFront actbuf writeCursorPositionInStatusbar sv sbLC writeOverwriteInStatusbar sv sbIO- id1 <- gtkBuf `afterModifiedChanged` reflectIDE (markLabelAsChanged) ideR session+ id1 <- gtkBuf `afterModifiedChanged` reflectIDE (markLabelAsChanged) ideR id2 <- sv `afterMoveCursor` (\_ _ _ -> writeCursorPositionInStatusbar sv sbLC) id3 <- gtkBuf `afterEndUserAction` writeCursorPositionInStatusbar sv sbLC@@ -129,7 +129,7 @@ id5 <- sv `onButtonRelease` (\ e -> do writeCursorPositionInStatusbar sv sbLC- when (controlIsPressed e) $ showInfo sv ideR session+ when (controlIsPressed e) $ showInfo sv ideR return False) id6 <- sv `afterToggleOverwrite` writeOverwriteInStatusbar sv sbIO return [ConnectC id2,ConnectC id6,ConnectC id1,ConnectC id3]@@ -290,7 +290,7 @@ bs <- getCandyState ct <- readIDE candy let (ind,rbn) = figureOutPaneName panes bn 0- (buf,cids) <- reifyIDE $ \ideR session -> do+ (buf,cids) <- reifyIDE $ \ideR -> do lm <- sourceLanguageManagerNew (mbLanguage, mbSLang) <- sourceLanguageForFilename lm mbfn @@ -326,7 +326,6 @@ -- create a new SourceView Widget sv <- sourceViewNewWithBuffer buffer- set sv [sourceViewHighlightCurrentLine := True] fd <- case textviewFont prefs of Just str -> do fontDescriptionFromString str@@ -335,6 +334,7 @@ fontDescriptionSetFamily f "Monospace" return f widgetModifyFont sv (Just fd)+ set sv [sourceViewHighlightCurrentLine := True] sourceViewSetShowLineNumbers sv (showLineNumbers prefs) case rightMargin prefs of Just n -> do@@ -366,11 +366,19 @@ notebookInsertOrdered nb sw rbn Nothing -- events cid <- sv `afterFocusIn`- (\_ -> do reflectIDE (makeActive buf) ideR session; return False)+ (\_ -> do reflectIDE (makeActive buf) ideR ; return False) return (buf,[cid]) addPaneAdmin buf (map ConnectC cids) panePath- liftIO $widgetShowAll (scrolledWindow buf)- liftIO $widgetGrabFocus (sourceView buf)+ liftIO $do+ widgetShowAll (scrolledWindow buf)+ widgetGrabFocus (sourceView buf)+-- patch for windows+ 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 return buf checkModTime :: IDEBuffer -> IDEAction@@ -468,12 +476,12 @@ return () -showInfo :: SourceView -> IDERef -> Session -> IO ()-showInfo sv ideR session = do+showInfo :: SourceView -> IDERef -> IO ()+showInfo sv ideR = do buf <- textViewGetBuffer sv (l,r) <- textBufferGetSelectionBounds buf symbol <- textBufferGetText buf l r True- reflectIDE (triggerEvent ideR (SelectInfo symbol)) ideR session+ reflectIDE (triggerEvent ideR (SelectInfo symbol)) ideR return () markLabelAsChanged :: IDEAction@@ -540,7 +548,7 @@ liftIO $fileSave' (forceLineEnds prefs) (removeTBlanks prefs) currentBuffer bs candy $fromJust mbfn setModTime currentBuffer return ()- else reifyIDE $ \ideR session -> do+ else reifyIDE $ \ideR -> do dialog <- fileChooserDialogNew (Just $ "Save File") (Just window)@@ -578,7 +586,7 @@ reflectIDE (do close currentBuffer newTextBuffer panePath (takeFileName fn) (Just cfn)- ) ideR session+ ) ideR return () ResponseNo -> return () _ -> return ()@@ -613,7 +621,7 @@ window <- readIDE window bufs <- readIDE panes paneMap <- readIDE paneMap- cancel <- reifyIDE $ \ideR session -> do+ cancel <- reifyIDE $ \ideR -> do modified <- textBufferGetModified gtkbuf if modified then do@@ -630,7 +638,7 @@ widgetDestroy md case resp of ResponseYes -> do- reflectIDE (fileSave False) ideR session+ reflectIDE (fileSave False) ideR return False ResponseCancel -> return True ResponseNo -> return False@@ -640,6 +648,7 @@ then return False else do deactivatePane+ modifyIDE_ (\ide -> return (ide{lastActiveBufferPane = Nothing})) removePaneAdmin currentBuffer liftIO $ do notebookRemovePage nb i