leksah 0.13.3.0 → 0.13.4.0
raw patch · 8 files changed
+232/−152 lines, 8 filesdep ~hlintdep ~leksahdep ~ltk
Dependency ranges changed: hlint, leksah, ltk
Files
- leksah.cabal +10/−7
- src/IDE/Command/VCS/Types.hs +2/−1
- src/IDE/ImportTool.hs +8/−3
- src/IDE/Leksah.hs +13/−13
- src/IDE/Package.hs +1/−1
- src/IDE/Pane/HLint.hs +151/−91
- src/IDE/Pane/PackageEditor.hs +21/−35
- src/IDE/Pane/SourceBuffer.hs +26/−1
leksah.cabal view
@@ -1,5 +1,5 @@ name: leksah-version: 0.13.3.0+version: 0.13.4.0 cabal-version: >=1.10 build-type: Simple license: GPL@@ -166,9 +166,12 @@ x-gettext-po-files: po/*.po x-gettext-domain-name: leksah - extra-tmp-files: +source-repository head+ type: git+ location: https://github.com/leksah/leksah+ flag yi Description: Experimental Yi support Default: False@@ -245,14 +248,14 @@ mtl >=1.1.0.2 && <2.2, old-time >=1.0.0.1 && <1.2, parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2, regex-tdfa >=1.1 && <1.3, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.6,- time >=0.1 && <1.5, ltk >= 0.13.1.0 && <0.14, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4,+ time >=0.1 && <1.5, ltk >= 0.13.2.0 && <0.14, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, hslogger >= 1.0.7 && <1.3, leksah-server >=0.13.1.0 && <0.14, network >= 2.2 && <3.0, ghc >=6.10.1 && <7.9, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.1, text >= 0.11.1.5 && < 1.2, gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.4, executable-path >=0.0.3 && <0.1, vcsgui >=0.0.1 && < 0.1, vcswrapper >=0.0.1 && < 0.1, QuickCheck >=2.4.2 && <2.7, haskell-src-exts >=1.13.5 && <1.15,- hlint >=1.8.39 && <1.9, vado >=0.0.1 && <0.1+ hlint >=1.8.59 && <1.9, vado >=0.0.1 && <0.1 exposed-modules: IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find IDE.Session IDE.Command IDE.Keymap IDE.Utils.GUIUtils IDE.SymbolNavigation@@ -313,7 +316,7 @@ ghc-options: -threaded hs-source-dirs: main- build-depends: leksah == 0.13.3.0, base >= 4.0.0.0 && <=4.8, gtk3 -any+ build-depends: leksah == 0.13.4.0, base >= 4.0.0.0 && <=4.8, gtk3 -any if os(linux) && flag(loc) cpp-options: -DLOCALIZATION build-depends: hgettext, setlocale@@ -332,7 +335,7 @@ if !flag(webkit) buildable: False else- build-depends: leksah ==0.13.3.0, base >=4.0.0.0 && <=4.8,+ build-depends: leksah ==0.13.4.0, base >=4.0.0.0 && <=4.8, jsaddle -any, ghcjs-dom -any if flag(gtk3) build-depends: gtk3 >=0.12.4 && <0.13, gtksourceview3 >=0.10.0 && <0.13,@@ -349,7 +352,7 @@ test-suite tests build-depends: base >=4.0.0.0 && <4.8, Cabal >=1.6.0.1 && <1.19,- QuickCheck >=2.4.2 && <2.7, leksah ==0.13.3.0,+ QuickCheck >=2.4.2 && <2.7, leksah ==0.13.4.0, containers, ltk, leksah-server, hslogger, transformers, glib, monad-loops if flag(gtk3)
src/IDE/Command/VCS/Types.hs view
@@ -20,11 +20,12 @@ ,reflectIDE' ) where import Control.Monad.Reader+import Control.Applicative import IDE.Core.Types import IDE.Core.State newtype VCSAction a = VCSAction (ReaderT (VCSConf,FilePath) IDEM a)- deriving (Monad, MonadIO, MonadReader (VCSConf,FilePath))+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader (VCSConf,FilePath)) askIDERef :: VCSAction IDERef askIDERef = VCSAction $ lift $ ask
src/IDE/ImportTool.hs view
@@ -353,21 +353,26 @@ isSub <- optionMaybe (try (choice [symbol "type constructor or class" , symbol "data constructor"])) ( (do- char '`'+ choice [char '`',char '‘'] mbQual <- optionMaybe (try (do q <- lexeme conid dot return q)) id <- optionMaybe (try identifier) case id of+#if MIN_VERSION_ghc(7,8,0) Just id -> return (NotInScopeParseResult mbQual+ id (isJust isSub) False)+#else+ Just id -> return (NotInScopeParseResult mbQual (take (length id - 1) id) (isJust isSub) False)+#endif Nothing -> do op <- operator char '\'' return (NotInScopeParseResult mbQual op (isJust isSub) True)) <|> (do- char '‛'+ choice [char '`',char '‘'] mbQual <- optionMaybe (try (do q <- lexeme conid dot@@ -375,7 +380,7 @@ id <- optionMaybe (try identifier) result <- case id of Just id -> return (NotInScopeParseResult mbQual- (take (length id) id) (isJust isSub) False)+ id (isJust isSub) False) Nothing -> do op <- operator return (NotInScopeParseResult mbQual op (isJust isSub) True)
src/IDE/Leksah.hs view
@@ -212,20 +212,20 @@ st <- unsafeInitGUIForThreadedRTS when rtsSupportsBoundThreads (sysMessage Normal "Linked with -threaded")+ mapM_ (sysMessage Normal) st+ initGtkRc+ dataDir <- getDataDir+ mbStartupPrefs <- if not isFirstStart+ then return $ Just iprefs+ else do+ firstStartOK <- firstStart iprefs+ if not firstStartOK+ then return Nothing+ else do+ prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir+ prefs <- readPrefs prefsPath+ return $ Just prefs postGUIAsync $ do- mapM_ (sysMessage Normal) st- initGtkRc- dataDir <- getDataDir- mbStartupPrefs <- if not isFirstStart- then return $ Just iprefs- else do- firstStartOK <- firstStart iprefs- if not firstStartOK- then return Nothing- else do- prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir- prefs <- readPrefs prefsPath- return $ Just prefs case mbStartupPrefs of Nothing -> return () Just startupPrefs -> startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs
src/IDE/Package.hs view
@@ -517,7 +517,7 @@ filePath <- getConfigFilePathForLoad (template ++ leksahTemplateFileExtension) Nothing dataDir template <- UTF8.readFile filePath return (foldl' (\ a (from, to) -> replace from to a) template- [ ("@License@" , (show . license) pd)+ [ ("@License@" , (display . license) pd) , ("@Maintainer@" , maintainer pd) , ("@Stability@" , stability pd) , ("@Portability@" , "")
src/IDE/Pane/HLint.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, RecordWildCards #-} ----------------------------------------------------------------------------- --@@ -29,11 +30,11 @@ import qualified Text.ParserCombinators.Parsec.Token as P import Data.Maybe import Data.Typeable-import IDE.Core.State+import IDE.Core.State hiding (SrcSpan(..)) import IDE.BufferMode import IDE.LogRef (logOutput, defaultLineLogger) import IDE.Pane.SourceBuffer- (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..))+ (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..), replaceHLintSource) import IDE.TextEditor (grabFocus) import Control.Applicative ((<$>)) import System.FilePath ((</>), dropFileName)@@ -45,13 +46,22 @@ import Control.Monad.IO.Class (MonadIO(..)) import Language.Haskell.HLint (Suggestion(..), suggestionLocation) import Language.Haskell.Exts (SrcLoc(..))-import qualified Language.Haskell.HLint as H (hlint)-import IDE.Utils.GUIUtils (__)+import Language.Haskell.Exts.SrcLoc (SrcSpan(..)) +import qualified Language.Haskell.HLint2 as H+import IDE.Utils.GUIUtils (__, treeViewContextMenu)+import Data.List (isPrefixOf, findIndex)+import Debug.Trace (trace)+import Control.Exception (SomeException, catch)+import Distribution.ModuleName (ModuleName)+import IDE.Metainfo.Provider (getWorkspaceInfo)+import qualified Data.Map as Map (keys, lookup)+import Distribution.Package (PackageIdentifier(..))+ data HLintRecord = HLintRecord {- file :: FilePath- , line :: Int+ condPackage :: Maybe IDEPackage , context :: String+ , condIdea :: Maybe H.Idea , parDir :: Maybe FilePath } deriving (Eq) @@ -110,36 +120,26 @@ scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic let hlint = IDEHLint {..}- gotoSource :: Bool -> IO Bool- gotoSource focus = do- sel <- getSelectionHLintRecord treeView hlintStore- case sel of- Just record -> reflectIDE (do- case record of- HLintRecord {file=f, line=l, parDir=Just pp} ->- (goToSourceDefinition (pp </> f) $ Just $ Location l 0 l 0)- ?>>= (\(IDEBuffer {sourceView = sv}) -> when focus $ grabFocus sv)- _ -> return ()) ideR- Nothing -> return ()- return True cid1 <- after treeView focusInEvent $ do liftIO $ reflectIDE (makeActive hlint) ideR return True cid2 <- on treeView rowExpanded $ \ iter path -> do record <- treeStoreGetValue hlintStore path case record of- HLintRecord { file = f, parDir = Nothing } -> refreshDir hlintStore iter f+ HLintRecord { condPackage = Just p, parDir = Nothing } ->+ reflectIDE (refreshDir hlintStore iter p) ideR _ -> reflectIDE (ideMessage Normal (__ "Unexpected Expansion in HLint Pane")) ideR cid3 <- on treeView rowActivated $ \ path col -> do record <- treeStoreGetValue hlintStore path mbIter <- treeModelGetIter hlintStore path case (mbIter, record) of- (Just iter, HLintRecord { file = f, parDir = Nothing }) -> refreshDir hlintStore iter f+ (Just iter, HLintRecord { condPackage = Just p, parDir = Nothing }) ->+ reflectIDE (refreshDir hlintStore iter p) ideR _ -> return () cid4 <- on treeView keyPressEvent $ do name <- eventKeyName liftIO $ case name of- "Return" -> gotoSource True+ "Return" -> reflectIDE (gotoSource True treeView hlintStore) ideR "Escape" -> do reflectIDE (do lastActiveBufferPane ?>>= \paneName -> do@@ -150,34 +150,48 @@ return True -- gotoSource True _ -> return False- on sel treeSelectionSelectionChanged (gotoSource False >> return ())+ treeViewContextMenu treeView+ $ hlintContextMenu ideR hlintStore treeView+ on sel treeSelectionSelectionChanged (reflectIDE (gotoSource False treeView hlintStore+ >> return ()) ideR) - return (Just hlint,map ConnectC [cid1, cid2, cid3, cid4])+ return (Just hlint,map ConnectC [cid1]) getHLint :: Maybe PanePath -> IDEM IDEHLint getHLint Nothing = forceGetPane (Right "*HLint") getHLint (Just pp) = forceGetPane (Left pp) -hlintLineParser :: CharParser () HLintRecord-hlintLineParser = try (do- file <- many (noneOf ":")- char ':'- line <- int- char ':'- context <- many anyChar- let parDir = Nothing- return $ HLintRecord {..}- <?> "hlintLineParser")+data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound -lexer = P.makeTokenParser emptyDef-lexeme = P.lexeme lexer-whiteSpace = P.whiteSpace lexer-hexadecimal = P.hexadecimal lexer-symbol = P.symbol lexer-identifier = P.identifier lexer-colon = P.colon lexer-int = fmap fromInteger $ P.integer lexer+find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult+find _ _ Nothing = return NotFound+find a store (Just iter) = do+ row <- treeModelGetRow store iter+ if row == a+ then return $ WhereExpected iter+ else treeModelIterNext store iter >>= find'+ where+ find' :: Maybe TreeIter -> IO FindResult+ find' Nothing = return NotFound+ find' (Just iter) = do+ row <- treeModelGetRow store iter+ if row == a+ then return $ Found iter+ else treeModelIterNext store iter >>= find' +removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()+removeUntil a store path = do+ row <- treeStoreGetValue store path+ when (row /= a) $ do+ found <- treeStoreRemove store path+ when found $ removeUntil a store path++removeRemaining :: TreeStore a -> TreePath -> IO ()+removeRemaining store path = do+ found <- treeStoreRemove store path+ when found $ removeRemaining store path++ getSelectionHLintRecord :: TreeView -> TreeStore HLintRecord -> IO (Maybe HLintRecord)@@ -195,40 +209,83 @@ let packages = case maybeActive of Just active -> active : (filter (/= active) $ wsPackages ws) Nothing -> wsPackages ws- lift $ hlintDirectories $- concatMap (\p -> map (dropFileName (ipdCabalFile p) </>) $ ipdSrcDirs p) $ packages+ lift $ hlintDirectories2 packages -hlintDirectories :: [FilePath] -> IDEAction-hlintDirectories dirs = do++--gotoSource :: Bool -> IDEM Bool+gotoSource focus treeView hlintStore = do+ sel <- liftIO $ getSelectionHLintRecord treeView hlintStore+ case sel of+ Just record -> do+ case record of+ HLintRecord {condIdea = Just idea} ->+ (goToSourceDefinition (srcSpanFilename (H.ideaSpan idea))+ (Just $ Location (srcSpanStartLine (H.ideaSpan idea))+ (srcSpanStartColumn (H.ideaSpan idea))+ (srcSpanEndLine (H.ideaSpan idea))+ (srcSpanEndColumn (H.ideaSpan idea))))+ ?>>= (\(IDEBuffer {sourceView = sv}) -> when focus $ grabFocus sv)+ _ -> return ()+ Nothing -> return ()+ return True+++hlintDirectories2 :: [IDEPackage] -> IDEAction+hlintDirectories2 packages = do hlint <- getHLint Nothing let store = hlintStore hlint liftIO $ do treeStoreClear store- forM_ dirs $ \ dir -> do+ forM_ packages $ \ p -> do nDir <- treeModelIterNChildren store Nothing- treeStoreInsert store [] nDir $ HLintRecord dir 0 dir Nothing- treeStoreInsert store [nDir] 0 $ HLintRecord dir 0 dir Nothing+ treeStoreInsert store [] nDir $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing+ treeStoreInsert store [nDir] 0 $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing -refreshDir :: TreeStore HLintRecord -> TreeIter -> FilePath -> IO ()-refreshDir store iter dir = do- mbHlintDir <- leksahSubDir "hlint"+refreshDir :: TreeStore HLintRecord -> TreeIter -> IDEPackage -> IDEM ()+refreshDir store iter package = do+ mbHlintDir <- liftIO $ leksahSubDir "hlint" let datadirOpt = case mbHlintDir of Just d -> "--datadir":[d] Nothing -> []- suggestions <- take 1000 <$> H.hlint ("--quiet":dir:datadirOpt)- setHLintResults store iter dir suggestions+ (flags, classify, hint) <- liftIO $ H.autoSettings+ let modules = Map.keys (ipdModules package)+ pathes <- getSourcePathes (ipdPackageId package) modules+ resL <- liftIO $ mapM (\dir -> H.parseModuleEx flags dir Nothing) pathes+ let resOk = mapMaybe (\ pr -> case pr of+ Left e -> trace ("can't parse: " ++ H.parseErrorContents e +++ " location " ++ show H.parseErrorLocation) Nothing+ Right r -> Just r) resL+ let ideas = H.applyHints classify hint resOk+ liftIO $ setHLint2Results store iter (packageIdentifierToString (ipdPackageId package)) ideas return () -hlintRecord dir suggestion = HLintRecord {- file = srcFilename loc,- line = srcLine loc,- context = show suggestion,- parDir = Just dir}- where- loc = suggestionLocation suggestion -setHLintResults :: TreeStore HLintRecord -> TreeIter -> FilePath -> [Suggestion] -> IO Int-setHLintResults store parent dir suggestions = do+getSourcePathes :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath]+getSourcePathes packId names = do+ mbWorkspaceInfo <- getWorkspaceInfo+ case mbWorkspaceInfo of+ Nothing -> return []+ Just (sc, _) -> return (mapMaybe (sourcePathFromScope sc) names)+ where+ sourcePathFromScope :: GenScope -> ModuleName -> Maybe FilePath+ sourcePathFromScope (GenScopeC (PackScope l _)) mn =+ case packId `Map.lookup` l of+ Just pack ->+ case filter (\md -> modu (mdModuleId md) == mn)+ (pdModules pack) of+ (mod : tl) -> mdMbSourcePath mod+ [] -> Nothing+ Nothing -> Nothing+++hlint2Record dir idea = HLintRecord {+ condPackage = Nothing,+ context = show idea,+ condIdea = Just idea,+ parDir = Just dir}++setHLint2Results :: TreeStore HLintRecord -> TreeIter -> FilePath -> [H.Idea] -> IO Int+setHLint2Results store parent dir ideas = do parentPath <- treeModelGetPath store parent forM_ (zip [0..] records) $ \(n, record) -> do mbChild <- treeModelIterNthChild store (Just parent) n@@ -243,35 +300,38 @@ removeRemaining store (parentPath++[nRecords]) return nRecords where- records = map (hlintRecord dir) suggestions+ records = map (hlint2Record dir) ideas nRecords = length records -data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound--find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult-find _ _ Nothing = return NotFound-find a store (Just iter) = do- row <- treeModelGetRow store iter- if row == a- then return $ WhereExpected iter- else treeModelIterNext store iter >>= find'+hlintContextMenu :: IDERef+ -> TreeStore HLintRecord+ -> TreeView+ -> Menu+ -> IO ()+hlintContextMenu ideR store treeView theMenu = do+ mbSel <- getSelectionHLintRecord treeView store+ item0 <- menuItemNewWithLabel (__ "Replace")+ item0 `on` menuItemActivate $ do+ reflectIDE (replaceHlint store treeView mbSel) ideR+ menuShellAppend theMenu item0 where- find' :: Maybe TreeIter -> IO FindResult- find' Nothing = return NotFound- find' (Just iter) = do- row <- treeModelGetRow store iter- if row == a- then return $ Found iter- else treeModelIterNext store iter >>= find'--removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()-removeUntil a store path = do- row <- treeStoreGetValue store path- when (row /= a) $ do- found <- treeStoreRemove store path- when found $ removeUntil a store path+ replaceableSelection Nothing = False+ replaceableSelection (Just s) | isNothing (parDir s) = True+ | otherwise = False -removeRemaining :: TreeStore a -> TreePath -> IO ()-removeRemaining store path = do- found <- treeStoreRemove store path- when found $ removeRemaining store path+replaceHlint store treeView (Just sel) =+ case condIdea sel of+ Just idea | isJust (H.ideaTo idea) ->+ let lined = lines (fromJust (H.ideaTo idea))+ startColumn = srcSpanStartColumn (H.ideaSpan idea)+ source = init $ unlines (head lined :+ map (\ s -> replicate startColumn ' ' ++ s) (tail lined))+ in do+ replaceHLintSource (srcSpanFilename (H.ideaSpan idea))+ (srcSpanStartLine (H.ideaSpan idea))+ startColumn+ (srcSpanEndLine (H.ideaSpan idea))+ (srcSpanEndColumn (H.ideaSpan idea))+ source+ otherwise -> return ()+replaceHlint _ _ Nothing = return ()
src/IDE/Pane/PackageEditor.hs view
@@ -35,8 +35,6 @@ import System.FilePath import Data.Maybe import System.Directory-import System.IO (withFile, IOMode(..))-import System.IO.Strict (hGetContents) import IDE.Core.State import IDE.Utils.FileUtils@@ -76,13 +74,9 @@ paraName, getParameterPrim) import Graphics.UI.Editor.Simple- (staticListMultiEditor,- intEditor,- boolEditor,- fileEditor,- comboSelectionEditor,- multilineStringEditor,- stringEditor)+ (comboEntryEditor, staticListMultiEditor, intEditor, boolEditor,+ fileEditor, comboSelectionEditor, multilineStringEditor,+ stringEditor) import Graphics.UI.Editor.Basics (Notifier, Editor(..), GUIEventSelector(..), GUIEvent(..)) import Distribution.Compiler@@ -122,6 +116,7 @@ import qualified Data.Conduit.List as CL (fold) import qualified Data.Conduit as C (Sink) import IDE.Utils.ExternalTool (runExternalTool')+import qualified System.IO.Strict as S (readFile) import Data.Char (toLower) -- | Get the last item@@ -263,8 +258,10 @@ $ emptyParams) templatePackage (\ a b -> b{templatePackage = a})- (stringEditor (const True) True)]+ (comboEntryEditor examplePackages)] +examplePackages = ["hello", "gtk2hs-hello"]+ newPackageDialog :: Window -> FilePath -> IO (Maybe NewPackage) newPackageDialog parent workspaceDir = do dia <- dialogNew@@ -278,17 +275,11 @@ lower <- dialogGetActionArea dia (widget,inj,ext,_) <- buildEditor (packageFields workspaceDir) (NewPackage "" workspaceDir "hello")- bb <- hButtonBoxNew- closeB <- buttonNewFromStock "gtk-cancel"- save <- buttonNewFromStock "gtk-ok"- boxPackEnd bb closeB PackNatural 0- boxPackEnd bb save PackNatural 0- on save buttonActivated (dialogResponse dia ResponseOk)- on closeB buttonActivated (dialogResponse dia ResponseCancel)+ okButton <- dialogAddButton dia "Ok" ResponseOk+ dialogAddButton dia "Cancel" ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7- boxPackStart (castToBox lower) bb PackNatural 7- set save [widgetCanDefault := True]- widgetGrabDefault save+ set okButton [widgetCanDefault := True]+ widgetGrabDefault okButton widgetShowAll dia resp <- dialogRun dia value <- ext (NewPackage "" workspaceDir "hello")@@ -378,14 +369,14 @@ packageToClone :: String, cloneParentDir :: FilePath} -cloneFields :: FilePath -> FieldDescription ClonePackageSourceRepo-cloneFields workspaceDir = VFD emptyParams [+cloneFields :: [PackageId] -> FilePath -> FieldDescription ClonePackageSourceRepo+cloneFields packages workspaceDir = VFD emptyParams [ mkField (paraName <<<- ParaName ((__ "Existing package to clone source repository")) $ emptyParams) packageToClone (\ a b -> b{packageToClone = a})- (stringEditor (const True) True),+ (comboEntryEditor ((sort . nub) (map (display . pkgName) packages))), mkField (paraName <<<- ParaName ((__ "Parent directory")) $ paraMinSize <<<- ParaMinSize (-1, 120)@@ -396,6 +387,7 @@ clonePackageSourceDialog :: Window -> FilePath -> IO (Maybe ClonePackageSourceRepo) clonePackageSourceDialog parent workspaceDir = do+ packages <- getInstalledPackageIds dia <- dialogNew set dia [ windowTransientFor := parent , windowTitle := (__ "Clone Package") ]@@ -405,19 +397,13 @@ upper <- dialogGetUpper dia #endif lower <- dialogGetActionArea dia- (widget,inj,ext,_) <- buildEditor (cloneFields workspaceDir)+ (widget,inj,ext,_) <- buildEditor (cloneFields packages workspaceDir) (ClonePackageSourceRepo "" workspaceDir)- bb <- hButtonBoxNew- closeB <- buttonNewFromStock "gtk-cancel"- save <- buttonNewFromStock "gtk-ok"- boxPackEnd bb closeB PackNatural 0- boxPackEnd bb save PackNatural 0- on save buttonActivated (dialogResponse dia ResponseOk)- on closeB buttonActivated (dialogResponse dia ResponseCancel)+ okButton <- dialogAddButton dia "Ok" ResponseOk+ dialogAddButton dia "Cancel" ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7- boxPackStart (castToBox lower) bb PackNatural 7- set save [widgetCanDefault := True]- widgetGrabDefault save+ set okButton [widgetCanDefault := True]+ widgetGrabDefault okButton widgetShowAll dia resp <- dialogRun dia value <- ext (ClonePackageSourceRepo "" workspaceDir)@@ -466,7 +452,7 @@ (Just cfn, Just newName) -> do let newCfn = takeDirectory cfn </> newName ++ ".cabal" when (cfn /= newCfn) . liftIO $ do- s <- withFile cfn ReadMode $ hGetContents+ s <- S.readFile cfn writeFile newCfn $ renameCabalFile (takeBaseName cfn) newName s removeFile cfn activateAction newCfn
src/IDE/Pane/SourceBuffer.hs view
@@ -25,6 +25,7 @@ , goToSourceDefinition , goToDefinition , insertInBuffer+, replaceHLintSource , fileNew , fileOpenThis@@ -292,6 +293,30 @@ return () return mbBuf +replaceHLintSource :: FilePath -> Int -> Int -> Int -> Int -> String -> IDEAction+replaceHLintSource file lineS columnS lineE columnE to = do+ mbBuf <- selectSourceBuf file+ case mbBuf of+ Just buf -> inActiveBufContext () $ \_ sv ebuf _ _ -> do+ useCandy <- useCandyFor buf+ candy' <- readIDE candy+ realString <- if useCandy then stringToCandy candy' to else return to+ (lineS', columnS', lineE', columnE') <- if useCandy+ then do+ (_,e1) <- positionToCandy candy' ebuf (lineS,columnS - 1)+ (_,e2) <- positionToCandy candy' ebuf (lineE,columnE - 1)+ return (lineS-1,e1,lineE-1,e2)+ else return (lineS-1, columnS-1, lineE-1, columnE-1)+ i1 <- getIterAtLine ebuf (lineS')+ i1' <- forwardCharsC i1 (columnS')+ i2 <- getIterAtLine ebuf (lineE')+ i2' <- forwardCharsC i2 (columnE')+ delete ebuf i1' i2'+ editInsertCode ebuf i1' realString+ fileSave False+ setModified ebuf True+ _ -> return ()+ insertInBuffer :: Descr -> IDEAction insertInBuffer idDescr = do mbPaneName <- lastActiveBufferPane@@ -740,7 +765,7 @@ (do nmt <- getModificationTime fn writeIORef (modTime buf) (Just nmt))- (\(e::SomeException) -> do+ (\(e:: SomeException) -> do sysMessage Normal (show e) return ())