leksah 0.15.0.3 → 0.15.0.4

raw patch · 17 files changed

+269/−123 lines, 17 filesdep ~leksahdep ~leksah-serverPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: leksah, leksah-server

API changes (from Hackage documentation)

Files

• Readme.md +3/−1
• data/styles/leksah-dark.xml +4/−4
• data/styles/leksah.xml +8/−4
• leksah.cabal +5/−5
• src/IDE/Core/Types.hs +1/−0
• src/IDE/Leksah.hs +15/−7
• src/IDE/LogRef.hs +14/−10
• src/IDE/Pane/Files.hs +77/−20
• src/IDE/Pane/Modules.hs +32/−12
• src/IDE/Pane/Preferences.hs +48/−27
• src/IDE/Pane/SourceBuffer.hs +9/−3
• src/IDE/SourceCandy.hs +18/−4
• src/IDE/TextEditor/Class.hs +4/−2
• src/IDE/TextEditor/CodeMirror.hs +4/−10
• src/IDE/TextEditor/GtkSourceView.hs +23/−10
• src/IDE/TextEditor/Yi.hs +2/−2
• src/IDE/Utils/ServerConnection.hs +2/−2

@@ -106,12 +106,14 @@  Get the leksah source: -    git clone https://github.org/leksah/leksah+    git clone https://github.com/leksah/leksah     cd leksah     git submodule update --init  Build it using the Dockerfile: +    wget http://dl.fedoraproject.org/pub/fedora/linux/releases/test/22_Beta/Docker/x86_64/Fedora-Docker-Base-22_Beta-20150415.x86_64.tar.xz+    docker load -i Fedora-Docker-Base-22_Beta-20150415.x86_64.tar.xz     sudo docker build -t leksah/build .  Copy the resulting msi file out of the container (version number in the file name will match the one in the leksah.cabal file):

@@ -32,10 +32,10 @@   <color name="violet"     value="#6A5ACD"/>   <color name="cyan"       value="#448A8C"/>   <color name="gray"       value="#444444"/>-  <color name="green"      value="#4EAB57"/>+  <color name="green"      value="#80AB80"/>   <color name="statement"  value="#CC7733"/>   <color name="red"        value="#FF0000"/>-  <color name="yellow"     value="#FFFF88"/>+  <color name="yellow"     value="#FFFFC0"/>   <color name="preproc"    value="#B54A6A"/>    <!-- Global Settings -->@@ -65,10 +65,10 @@   <style name="def:identifier"              foreground="cyan"/>    <!-- Statements -->-  <style name="def:statement"               foreground="statement" bold="true"/>+  <style name="def:statement"               foreground="statement"/>    <!-- Types -->-  <style name="def:type"                    foreground="green" bold="true"/>+  <style name="def:type"                    foreground="green"/>    <!-- Others -->   <style name="def:preprocessor"            foreground="preproc"/>

@@ -32,7 +32,7 @@   <color name="violet"     value="#7A00CD"/>   <color name="cyan"       value="#008A8C"/>   <color name="gray"       value="#DDDDDD"/>-  <color name="green"      value="#1E9B27"/>+  <color name="green"      value="#409B48"/>   <color name="statement"  value="#CC6700"/>   <color name="red"        value="#EF0000"/>   <color name="yellow"     value="#EFEF00"/>@@ -41,6 +41,10 @@   <!-- Global Settings -->   <style name="current-line"                background="#EEEEEE"/>   <style name="draw-spaces"                 foreground="#aaada6"/>+  <style name="line-numbers"                background="#E8E8E8"/>+  <style name="text"                        background="#FFFFFF"/>+  <style name="selection"                   background="#FFFFC0" foreground="#000000"/>+  <style name="selection-unfocused"         background="#FFFFD0" foreground="#000000"/>    <!-- Bracket Matching -->   <style name="bracket-match"               foreground="white" background="gray" bold="true"/>@@ -54,7 +58,7 @@    <!-- Comments -->   <style name="def:comment"                 foreground="comment"/>-  <style name="def:shebang"                 foreground="comment" bold="true"/>+  <style name="def:shebang"                 foreground="comment"/>   <style name="def:doc-comment-element"     italic="true"/>    <!-- Constants -->@@ -65,10 +69,10 @@   <style name="def:identifier"              foreground="cyan"/>    <!-- Statements -->-  <style name="def:statement"               foreground="statement" bold="true"/>+  <style name="def:statement"               foreground="statement"/>    <!-- Types -->-  <style name="def:type"                    foreground="green" bold="true"/>+  <style name="def:type"                    foreground="green"/>    <!-- Others -->   <style name="def:preprocessor"            foreground="preproc"/>

@@ -1,5 +1,5 @@ name: leksah-version: 0.15.0.3+version: 0.15.0.4 cabal-version: >=1.18 build-type: Simple license: GPL@@ -246,7 +246,7 @@                        parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2,                        regex-tdfa >=1.1 && <1.3, regex-tdfa-text, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <1.1, array >=0.2.0.0 && <0.6,                        time >=0.1 && <1.6, ltk >= 0.15.0.1 && <0.16, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.5,-                       hslogger >= 1.0.7 && <1.3, leksah-server >=0.15.0.2 && <0.16,+                       hslogger >= 1.0.7 && <1.3, leksah-server >=0.15.0.3 && <0.16,                        ghc >=6.10.1 && <7.11, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.3, text >= 0.11.1.5 && < 1.3,                        gio >=0.13.0.0 && <0.14, transformers >=0.2.2.0 && <0.5,                        executable-path >=0.0.3 && <0.1,@@ -296,7 +296,7 @@         ghc-options: -threaded      hs-source-dirs: main-    build-depends: leksah == 0.15.0.3,+    build-depends: leksah == 0.15.0.4,                    base >= 4.0.0.0 && <=4.9,                    gtk3 >=0.13.2 && <0.14     if os(linux) && flag(loc)@@ -312,7 +312,7 @@     ghc-options: -rtsopts -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans  executable bewleksah-    build-depends: leksah ==0.15.0.3,+    build-depends: leksah ==0.15.0.4,                    base >=4.0.0.0 && <=4.9,                    jsaddle -any,                    ghcjs-dom -any,@@ -331,7 +331,7 @@     build-depends: base >=4.0.0.0 && <4.9,                    Cabal >=1.10.2.0 && <1.23,                    QuickCheck >=2.4.2 && <2.9,-                   leksah ==0.15.0.3,+                   leksah ==0.15.0.4,                    containers,                    ltk,                    leksah-server,

@@ -482,6 +482,7 @@     ,   breakOnError        ::   Bool     ,   printBindResult     ::   Bool     ,   serverIP            ::   Text+    ,   showHiddenFiles     ::   Bool             -- As well used by server     ,   serverPort          ::   Int     ,   sourceDirectories   ::   [FilePath]

@@ -78,7 +78,7 @@ import Control.Monad (when, unless, liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Applicative ((<$>))-import qualified Data.Text as T (pack, unpack, stripPrefix)+import qualified Data.Text as T (pack, unpack, stripPrefix, unlines) import Data.Text (Text) import Data.Monoid ((<>)) import Graphics.UI.Gtk.General.CssProvider@@ -222,12 +222,19 @@     mbScreen <- screenGetDefault     case mbScreen of         Just screen -> do-            provider <- cssProviderNew
-            cssProviderLoadFromString provider (
-                ".window-frame,\n" <>
-                ".window-frame:backdrop {\n" <>
-                "  box-shadow: none;\n" <>
-                "  margin: 0;}\n" :: Text)
+            provider <- cssProviderNew+            cssProviderLoadFromString provider $+                T.unlines [ ".window-frame,"+                          , ".window-frame:backdrop {"+                          , "  box-shadow: none;"+                          , "  margin: 0;}"+                          , "#errorLabel {"+                          , "  padding: 10px;"+                          , "  background: #F2DEDE;"+                          , "  color: #A94442;"+                          , "  border: 1px solid #EBCCD1;"+                          , "  border-radius: 5px;}"+                          ]             styleContextAddProviderForScreen screen provider 600         Nothing -> debugM "leksah" "Unable to add style provider for screen"     mapM_ (sysMessage Normal . T.pack) st@@ -446,6 +453,7 @@             welcomeCabal = welcomePath</>"leksah-welcome.cabal"             welcomeMain  = welcomePath</>"src"</>"Main.hs"         createDirectoryIfMissing True $ welcomePath</>"src"+        createDirectoryIfMissing True $ welcomePath</>"test"         copyFile (welcomeSource</>"Setup.lhs")            (welcomePath</>"Setup.lhs")         copyFile (welcomeSource</>"leksah-welcome.cabal") (welcomeCabal)         copyFile (welcomeSource</>"LICENSE")              (welcomePath</>"LICENSE")

@@ -650,17 +650,23 @@         addLogRefs [last refs]         lastContext +contextParser :: CharParser () SrcSpan+contextParser = try (do+        whiteSpace+        (symbol "Logged breakpoint at" <|> symbol "Stopped at")+        whiteSpace+        srcSpanParser)+    <?> "historicContextParser"+ logOutputForLiveContext :: IDEPackage                         -> LogLaunch           -- ^ loglaunch                         -> C.Sink ToolOutput IDEM () logOutputForLiveContext package logLaunch = logOutputForContext package logLaunch (getContexts . T.unpack)     where         getContexts [] = []-        getContexts line@(x:xs) = case stripPrefix "Stopped at " line of-            Just rest -> case parse srcSpanParser "" rest of-                Right desc -> desc : getContexts xs-                _          -> getContexts xs-            _ -> getContexts xs+        getContexts line@(x:xs) = case parse contextParser "" line of+                                    Right desc -> desc : getContexts xs+                                    _          -> getContexts xs  logOutputForLiveContextDefault :: IDEPackage                                -> C.Sink ToolOutput IDEM ()@@ -674,11 +680,9 @@                             -> C.Sink ToolOutput IDEM () logOutputForHistoricContext package logLaunch = logOutputForContext package logLaunch getContexts     where-        getContexts line = case T.stripPrefix "Logged breakpoint at " line of-            Just rest -> case parse srcSpanParser "" $ T.unpack rest of-                Right desc -> [desc]-                _          -> []-            _ -> []+        getContexts line = case parse contextParser "" $ T.unpack line of+                                Right desc -> [desc]+                                _          -> []  logOutputForHistoricContextDefault :: IDEPackage                                    -> C.Sink ToolOutput IDEM ()

@@ -41,7 +41,7 @@         treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,         cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,         treeViewNew, treeStoreNew, castToWidget, TreeStore, TreeView,-        ScrolledWindow)+        ScrolledWindow, treeViewRowExpanded, treeStoreGetTree) import Data.Maybe (isJust) import Control.Monad (forM, void, forM_, when) import Data.Typeable (Typeable)@@ -74,6 +74,8 @@ import Data.List (sortBy, sort) import Data.Ord (comparing) import Data.Char (toLower)+import IDE.Core.Types (IDE(..), Prefs (..))+import Data.Tree (Tree(..))  data FileRecord =     FileRecord FilePath@@ -155,16 +157,16 @@             record <- treeStoreGetValue fileStore path             reflectIDE (                 case record of-                    DirRecord f     -> liftIO $ refreshDir fileStore path f-                    PackageRecord p -> liftIO $ refreshPackage fileStore path p+                    DirRecord f     -> refreshDir fileStore path f+                    PackageRecord p -> refreshPackage fileStore path p                     _               -> ideMessage Normal (__ "Unexpected Expansion in Files Pane")) ideR         on treeView rowActivated $ \ path col -> do             record <- treeStoreGetValue fileStore path             reflectIDE (                 case record of                     FileRecord f    -> void (goToSourceDefinition' f (Location "" 1 0 1 0))-                    DirRecord f     -> liftIO $ refreshDir fileStore path f-                    PackageRecord p -> liftIO $ refreshPackage fileStore path p+                    DirRecord f     -> refreshDir fileStore path f+                    PackageRecord p -> refreshPackage fileStore path p                     _               -> ideMessage Normal (__ "Unexpected Activation in Files Pane")) ideR         on sel treeSelectionSelectionChanged $ do             paths <- treeSelectionGetSelectedRows sel@@ -173,8 +175,8 @@                 reflectIDE (                     case record of                         FileRecord _    -> return ()-                        DirRecord f     -> liftIO $ refreshDir fileStore path f-                        PackageRecord p -> liftIO $ refreshPackage fileStore path p+                        DirRecord f     -> refreshDir fileStore path f+                        PackageRecord p -> refreshPackage fileStore path p                         _               -> ideMessage Normal (__ "Unexpected Selection in Files Pane")) ideR          return (Just files,[ConnectC cid1])@@ -183,6 +185,7 @@ getFiles Nothing    = forceGetPane (Right "*Files") getFiles (Just pp)  = forceGetPane (Left pp) +-- | Tries to get the 'FileRecord' of the selected node in the 'TreeView' getSelectionFileRecord ::  TreeView     ->  TreeStore FileRecord     -> IO (Maybe FileRecord)@@ -193,40 +196,81 @@         p:_ ->  Just <$> treeStoreGetValue fileStore p         _   ->  return Nothing ++-- | Refreshes the Files pane, lists all package directories and synchronizes the expanded+-- folders with the file system refreshFiles :: IDEAction refreshFiles = do     files <- getFiles Nothing     let store = fileStore files+    let view  = treeView files     mbWS <- readIDE workspace-    liftIO $ setDirectories store Nothing $ map PackageRecord $ maybe [] wsPackages mbWS+    let packages = maybe [] wsPackages mbWS+    setDirectories store Nothing $ map PackageRecord packages -dirContents :: FilePath -> IO [FileRecord]+    forM_ (zip [0..] packages) $ \(n, package) -> do+         refreshRecursively store [n] view++-- | Returns the 'FileRecord's at the given 'FilePath'.+dirContents :: FilePath -> IDEM [FileRecord] dirContents dir = do-   contents <- filter ((/= '.') . head) <$> getDirectoryContents dir-                   `catch` \ (e :: IOError) -> return []-   records <- forM contents $ \f -> do+   prefs <- readIDE prefs+   contents <- liftIO $ getDirectoryContents dir+                            `catch` \ (e :: IOError) -> return []+   let filtered = if showHiddenFiles prefs+                      then filter (`notElem` [".", ".."]) contents+                      else filter ((/= '.') . head) contents+   records <- forM filtered $ \f -> do                   let full = dir </> f-                  isDir <- doesDirectoryExist full+                  isDir <- liftIO $ doesDirectoryExist full                   return $ if isDir then DirRecord full else FileRecord full    return (sort records) -refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IO ()++-- | Recursively refreshes the file tree with the given TreePath as root. Only refreshes contents+-- of expanded folders.+refreshRecursively :: TreeStore FileRecord -> TreePath -> TreeView -> IDEAction+refreshRecursively store path view = do+    isExpanded <- liftIO $ treeViewRowExpanded view path+    record     <- liftIO $ treeStoreGetValue store path++    when isExpanded $ do+        case record of+            DirRecord dir -> do+                refreshDir store path dir+                nChildren  <- length . subForest <$> liftIO (treeStoreGetTree store path)+                forM_ [0..nChildren-1] (\n -> refreshRecursively store (path ++ [n]) view)++            PackageRecord package -> do+                refreshPackage store path package+                nChildren  <- length . subForest <$> liftIO (treeStoreGetTree store path)+                forM_ [0..nChildren-1] (\n -> refreshRecursively store (path ++ [n]) view)++            _ -> return ()++-- | Refreshes the child nodes of the package node at the given 'TreePath'. Also adds sandbox+-- add-source dependencies as a 'PackageRecord'.+refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IDEAction refreshPackage store path p = do     let dir = ipdBuildDir p-    mbIter <- treeModelGetIter store path+    mbIter <- liftIO $ treeModelGetIter store path     when (isJust mbIter) $ do         contents <- dirContents dir         setDirectories store mbIter $ map PackageRecord (ipdSandboxSources p) ++ contents -refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IO ()-refreshDir store path dir = do-    mbIter <- treeModelGetIter store path++-- | Refreshes the child nodes of the node at the given 'TreePath'.+refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IDEAction+refreshDir store path dir =  do+    mbIter <- liftIO $ treeModelGetIter store path     when (isJust mbIter) $ do         contents <- dirContents dir         setDirectories store mbIter contents -setDirectories :: TreeStore FileRecord -> Maybe TreeIter -> [FileRecord] -> IO ()-setDirectories store parent records = do+-- | Sets the child nodes of the given 'TreeIter' to the provided list of 'FileRecord's. If a record+-- is already present, it is kept in the same (expanded) state.+setDirectories :: TreeStore FileRecord -> Maybe TreeIter -> [FileRecord] -> IDEAction+setDirectories store parent records = liftIO $ do     parentPath <- case parent of                 Just i -> treeModelGetPath store i                 _      -> return []@@ -240,6 +284,9 @@                 removeUntil record store path             _ -> do                 treeStoreInsert store parentPath n record++                -- Insert placeholder children for dirs and packages so they can+                -- be expanded on clicking, and have the contents loaded "lazily".                 case record of                     DirRecord _     -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder                     PackageRecord _ -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder@@ -248,6 +295,11 @@  data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound +-- | Tries to find the given value in the 'TreeStore'. Only looks at the given 'TreeIter' and its+-- sibling nodes to the right.+-- Returns @WhereExpected iter@ if the records is found at the provided 'TreeIter'+-- Returns @Found iter@ if the record is found at a sibling iter+-- Returns @NotFound@ otherwise find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult find _ _ Nothing = return NotFound find a store (Just iter) = do@@ -264,6 +316,9 @@             then return $ Found iter             else treeModelIterNext store iter >>= find' ++-- | Starting at the node at the given 'TreePath', removes all sibling nodes to the right+--   until the given value is found. removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO () removeUntil a store path = do     row <- treeStoreGetValue store path@@ -271,6 +326,8 @@         found <- treeStoreRemove store path         when found $ removeUntil a store path ++-- | Starting at the node at the given 'TreePath', removes all sibling nodes to the right removeRemaining :: TreeStore a -> TreePath -> IO () removeRemaining store path = do     found <- treeStoreRemove store path

@@ -1186,27 +1186,47 @@     dia                        <-   dialogNew     set dia [ windowTransientFor := parent             , windowTitle := (__ "Construct new module") ]+    windowSetDefaultSize dia 400 100 #ifdef MIN_VERSION_gtk3     upper                      <-   dialogGetContentArea dia #else     upper                      <-   dialogGetUpper dia #endif     lower                      <-   dialogGetActionArea dia-    (widget,inj,ext,_)         <-   buildEditor (moduleFields sourceRoots hasLib exesTests)+    (widget,inj,ext,_)  <-   buildEditor (moduleFields sourceRoots hasLib exesTests)                                         (AddModule modString (head sourceRoots) (Just False) Set.empty)     bb      <-  hButtonBoxNew     boxSetSpacing bb 6     buttonBoxSetLayout bb ButtonboxSpread-    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)+    cancel  <-  buttonNewFromStock "gtk-cancel"+    ok      <-  buttonNewFromStock "gtk-ok"+    boxPackEnd bb cancel PackNatural 0+    boxPackEnd bb ok PackNatural 0++    errorLabel <-  labelNew (Nothing :: Maybe String)+    labelSetLineWrap errorLabel True+    widgetSetName errorLabel ("errorLabel" :: String)++    on ok buttonActivated $ do+        mbAddModule <- ext (AddModule modString (head sourceRoots) (Just False) Set.empty)+        case mbAddModule of+            Nothing -> return ()+            Just am -> do+                let mbModName = simpleParse $ T.unpack (moduleName am) :: Maybe ModuleName+                case mbModName of+                    Just _  -> dialogResponse dia ResponseOk+                    Nothing -> do+                        boxPackStart (castToBox upper) errorLabel PackNatural 0+                        boxReorderChild (castToBox upper) errorLabel 0+                        labelSetText errorLabel ("Invalid module name, use uppercase identifiers seperated by dots. For example Some.New.Module" :: String)+                        widgetShow errorLabel+++    on cancel buttonActivated (dialogResponse dia ResponseCancel)     boxPackStart (castToBox upper) widget PackGrow 0-    boxPackStart (castToBox lower) bb PackNatural 5-    set save [widgetCanDefault := True]-    widgetGrabDefault save+    boxPackEnd (castToBox lower) bb PackNatural 5+    set ok [widgetCanDefault := True]+    widgetGrabDefault ok     widgetShowAll dia     resp  <- dialogRun dia     value <- ext (AddModule modString (head sourceRoots) (Just False) Set.empty)@@ -1235,11 +1255,11 @@         ++ (if hasLibs                 then [                     mkField-                        (paraName <<<- ParaName ((__ "Is this an exposed library module"))+                        (paraName <<<- ParaName ((__ "Library should"))                                 $ emptyParams)                         libExposed                         (\ a b -> b{libExposed = a})-                        (maybeEditor (boolEditor, emptyParams) True (__ "Expose module"))]+                        (maybeEditor (boolEditor, paraName <<<- ParaName ((__ "Expose module")) $ emptyParams) True (__ "Include module"))]                 else [])         ++ map (\ name ->             mkField

@@ -85,12 +85,13 @@ import Data.Monoid ((<>)) import Control.Applicative ((<$>)) import Distribution.Text (display, simpleParse)+import IDE.Pane.Files (refreshFiles)  -- --------------------------------------------------------------------- -- This needs to be incremented, when the preferences format changes -- prefsVersion :: Int-prefsVersion = 2+prefsVersion = 3  -- -- | The Preferences Pane@@ -114,9 +115,9 @@     saveState p     =   return Nothing     recoverState pp st  =  return Nothing     builder pp nb windows = do-        prefs <- readIDE prefs+        initialPrefs <- readIDE prefs         configDir <- liftIO getConfigDir-        lastAppliedPrefsRef <- liftIO $ newIORef prefs+        lastAppliedPrefsRef <- liftIO $ newIORef initialPrefs         packageInfos <- liftIO getInstalledPackageIds         let flatPrefsDesc = flattenFieldDescriptionPP (prefsDescription configDir packageInfos)         reifyIDE $  \ ideR -> do@@ -124,45 +125,52 @@             bb      <-  hButtonBoxNew             boxSetSpacing bb 6             buttonBoxSetLayout bb ButtonboxSpread-            apply   <-  buttonNewFromStock "gtk-apply"+            preview   <-  buttonNewFromStock "Preview"             restore <-  buttonNewFromStock "Restore"             closeB  <-  buttonNewFromStock "gtk-cancel"             save    <-  buttonNewFromStock "gtk-save"             widgetSetSensitive save False-            boxPackStart bb apply PackNatural 0+            boxPackStart bb preview PackNatural 0             boxPackStart bb restore PackNatural 0             boxPackEnd bb closeB PackNatural 0             boxPackEnd bb save PackNatural 0             (widget,injb,ext,notifier) <-  buildEditor-                                (extractFieldDescription $ prefsDescription configDir packageInfos) prefs+                                (extractFieldDescription $ prefsDescription configDir packageInfos) initialPrefs             boxPackStart vb widget PackGrow 0             label   <-  labelNew (Nothing :: Maybe Text)             boxPackStart vb label PackNatural 0             boxPackEnd vb bb PackNatural 5             let prefsPane = IDEPrefs vb-            on apply buttonActivated $ do-                mbNewPrefs <- extract prefs [ext]++            let applyPrefs newPrefs = do+                lastAppliedPrefs    <- readIORef lastAppliedPrefsRef+                reflectIDE (modifyIDE_ (\ide -> ide{prefs = newPrefs})) ideR+                mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR) flatPrefsDesc+                writeIORef lastAppliedPrefsRef newPrefs++            on preview buttonActivated $ do+                mbNewPrefs <- extract initialPrefs [ext]                 case mbNewPrefs of                     Nothing -> return ()-                    Just newPrefs -> do-                        lastAppliedPrefs    <- readIORef lastAppliedPrefsRef-                        mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR) flatPrefsDesc-                        writeIORef lastAppliedPrefsRef newPrefs-            on restore buttonActivated (do-                lastAppliedPrefs <- readIORef lastAppliedPrefsRef-                mapM_ (\f -> reflectIDE (applicator f prefs lastAppliedPrefs) ideR) flatPrefsDesc-                injb prefs-                writeIORef lastAppliedPrefsRef prefs+                    Just newPrefs -> applyPrefs newPrefs++            on restore buttonActivated $ do+                applyPrefs initialPrefs++                -- update the UI+                injb initialPrefs                 markLabel nb (getTopWidget prefsPane) False                 widgetSetSensitive save False-                )++             on save buttonActivated $ do-                lastAppliedPrefs <- readIORef lastAppliedPrefsRef-                mbNewPrefs <- extract prefs [ext]+                mbNewPrefs <- extract initialPrefs [ext]                 case mbNewPrefs of                     Nothing -> return ()                     Just newPrefs -> do-                        mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR ) flatPrefsDesc+                        applyPrefs newPrefs++                        -- save preferences to disk                         fp   <- getConfigFilePathForSave standardPreferencesFilename                         writePrefs fp newPrefs                         fp2  <-  getConfigFilePathForSave strippedPreferencesFilename@@ -173,14 +181,16 @@                                        SP.retrieveStrategy  = retrieveStrategy newPrefs,                                        SP.serverPort        = serverPort newPrefs,                                        SP.endWithLastConn   = endWithLastConn newPrefs}-                        reflectIDE (modifyIDE_ (\ide -> ide{prefs = newPrefs})) ideR++                        -- close the UI                         reflectIDE (void (closePane prefsPane)) ideR+             on closeB buttonActivated $ do-                mbP <- extract prefs [ext]+                mbP <- extract initialPrefs [ext]                 let hasChanged = case mbP of                                         Nothing -> False                                         Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /=-                                                  prefs{prefsFormat = 0, prefsSaveTime = ""}+                                                  initialPrefs{prefsFormat = 0, prefsSaveTime = ""}                 if not hasChanged                     then reflectIDE (void (closePane prefsPane)) ideR                     else do@@ -192,17 +202,19 @@                         resp <- dialogRun md                         widgetDestroy md                         case resp of-                            ResponseYes ->   reflectIDE (void (closePane prefsPane)) ideR+                            ResponseYes -> do+                                applyPrefs initialPrefs+                                reflectIDE (void (closePane prefsPane)) ideR                             _  ->   return ()             registerEvent notifier FocusIn (\e -> do                 reflectIDE (makeActive prefsPane) ideR                 return (e{gtkReturn=False}))             registerEvent notifier MayHaveChanged (\ e -> do-                mbP <- extract prefs [ext]+                mbP <- extract initialPrefs [ext]                 let hasChanged = case mbP of                                         Nothing -> False                                         Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /=-                                                  prefs{prefsFormat = 0, prefsSaveTime = ""}+                                                  initialPrefs{prefsFormat = 0, prefsSaveTime = ""}                 when (isJust mbP) $ labelSetMarkup label ("" :: Text)                 markLabel nb (getTopWidget prefsPane) hasChanged                 widgetSetSensitive save hasChanged@@ -459,6 +471,14 @@                             paraName <<<- ParaName "Y" $ emptyParams))             (\a -> return ())     ,   mkFieldPP+            (paraName <<<- ParaName (__ "Show hidden files in file tree") $ emptyParams)+            (PP.text . show)+            boolParser+            showHiddenFiles+            (\b a -> a {showHiddenFiles = b})+            boolEditor+            (\b -> refreshFiles)+    ,   mkFieldPP             (paraName <<<- ParaName (__ "Use ctrl Tab for Notebook flipper") $ emptyParams)             (PP.text . show)             boolParser@@ -838,6 +858,7 @@     ,   serverPort          =   11111     ,   serverIP            =   "127.0.0.1"     ,   endWithLastConn     =   True+    ,   showHiddenFiles     =   False     }  -- ------------------------------------------------------------

@@ -416,6 +416,13 @@                                 _ -> False         unless isOldContext $ do             liftIO $ debugM "lekash" "markRefInSourceBuf calling applyTagByName"+            lineStart <- backwardToLineStartC iter+            createMark sv tagName lineStart (+                case logRefType logRef of+                    ErrorRef      -> "dialog-error"+                    WarningRef    -> "dialog-warning"+                    BreakpointRef -> "media-playback-pause"+                    ContextRef    -> "media-playback-start") $ refDescription logRef             applyTagByName ebuf tagName iter iter2         when scrollTo $ do             ideR    <- ask@@ -1381,10 +1388,9 @@         when hasSelection $ do             realString <-  if useCandy then stringToCandy candy' str else return str             (_,i)      <- getSelectionBounds ebuf-            mark       <- createMark ebuf i True             insert ebuf i realString-            i1         <- getIterAtMark ebuf mark-            i2         <- forwardCharsC i1 (T.length str)+            (_,i1)     <- getSelectionBounds ebuf+            i2         <- forwardCharsC i1 (T.length realString)             selectRange ebuf i1 i2  -- | Returns the package, to which this buffer belongs, if possible

@@ -44,6 +44,10 @@        (pack, singleton, replicate, head, takeWhile, isSuffixOf, length,         index) import Data.Monoid ((<>))+import Control.Monad.IO.Class (MonadIO(..))+import Graphics.UI.Gtk.SourceView (sourceBufferNew)+import Graphics.UI.Gtk.Multiline.TextBuffer+       (textBufferGetIterAtMark, textBufferCreateMark, textBufferSetText)  --------------------------------------------------------------------------------- -- * Implementation@@ -163,6 +167,12 @@     endUserAction ebuf     setModified ebuf modified +simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView)+simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do+    buffer <- sourceBufferNew Nothing+    textBufferSetText buffer contents+    return buffer+ getCandylessText :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM Text getCandylessText (CT(_,transformTableBack)) ebuf = do     i1          <-  getStartIter ebuf@@ -194,6 +204,10 @@     text2       <-  getText workBuffer i1 i2 True     return text2 +-- We only need a TextMark here not a SourceMark+createTextMark (GtkBuffer sb) (GtkIter i) leftGravity = liftIO $  textBufferCreateMark sb Nothing i leftGravity+getIterAtTextMark (GtkBuffer sb) m = liftIO $ GtkIter <$> textBufferGetIterAtMark sb m+ positionFromCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> (Int,Int) -> IDEM (Int,Int) positionFromCandy candyTable ebuf (line,column) = do     i1          <- getIterAtLine ebuf (max 0 (line - 1))@@ -201,9 +215,9 @@     text        <-  getText ebuf i1 i2 True     workBuffer  <-  simpleGtkBuffer text     i3          <- getIterAtOffset workBuffer column-    mark        <- createMark workBuffer i3 True+    mark        <- createTextMark workBuffer i3 True     transformFromCandy candyTable workBuffer-    i4          <- getIterAtMark workBuffer mark+    i4          <- getIterAtTextMark workBuffer mark     columnNew   <- getLineOffset i4     return (line,columnNew) @@ -215,9 +229,9 @@     workBuffer  <-  simpleGtkBuffer text     transformFromCandy candyTable workBuffer     i3          <- getIterAtOffset workBuffer column-    mark        <- createMark workBuffer i3 True+    mark        <- createTextMark workBuffer i3 True     transformToCandy candyTable workBuffer (\ _ -> False)-    i4          <- getIterAtMark workBuffer mark+    i4          <- getIterAtTextMark workBuffer mark     columnNew   <- getLineOffset i4     return (line,columnNew) 

@@ -49,9 +49,11 @@     canRedo :: EditorBuffer editor -> IDEM Bool     canUndo :: EditorBuffer editor -> IDEM Bool     copyClipboard :: EditorBuffer editor -> Clipboard -> IDEM ()-    createMark :: EditorBuffer editor+    createMark :: EditorView editor+                  -> Text                   -> EditorIter editor-                  -> Bool+                  -> Text+                  -> Text                   -> IDEM (EditorMark editor)     cutClipboard :: EditorBuffer editor -> Clipboard -> Bool -> IDEM ()     delete :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM ()

@@ -155,9 +155,7 @@ lastLine          = js0 "lastLine" getRange          = js2 "getRange" setValue          = js1 "setValue"-setBookmark       = js1 "setBookmark" setBookmark'      = js2 "setBookmark"-insertLeft        = js  "insertLeft" find              = js0 "find" from              = js  "from" getCursor :: (MakeValueRef a0, MakeObjectRef o) => a0 -> IndexPreservingGetter o (JSM JSValueRef)@@ -263,15 +261,11 @@         m <- codeMirror         lift $ (m ^. historySize ^. undo') >>= valToBool     copyClipboard (CMBuffer cm) _ = return () -- TODO-    createMark (CMBuffer cm) (CMIter _ i) leftGravity = runCM cm $ do+    createMark (CMView cm) _name (CMIter _ i) _icon _tooltip = runCM cm $ do         m <- codeMirror-        lift $ do-            CMMark <$> if leftGravity-                            then m ^. setBookmark i-                            else do-                                o <- obj-                                o ^. insertLeft <# True-                                m ^. setBookmark' i o+        lift $ CMMark <$> do+                o <- obj+                m ^. setBookmark' i o     cutClipboard (CMBuffer cm) _ _ = return () -- TODO     delete (CMBuffer cm) (CMIter _ first) (CMIter _ last) = runCM cm $ do         m <- codeMirror

@@ -27,7 +27,6 @@    , GtkSourceView(..)   , newGtkBuffer-  , simpleGtkBuffer  ) where @@ -82,7 +81,9 @@ import Data.Typeable (Typeable) import Control.Applicative ((<$>)) import Graphics.UI.Gtk.SourceView-       (sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,+       (sourceBufferCreateSourceMark, SourceMark,+        sourceViewSetShowLineMarks,+        sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,         sourceViewSetShowLineNumbers, sourceViewSetRightMarginPosition,         sourceViewSetShowRightMargin, sourceViewSetIndentWidth,         castToSourceBuffer, sourceViewSetDrawSpaces, sourceBufferUndo,@@ -121,6 +122,14 @@ import Data.Text (Text) import qualified Data.Text as T (all, length, pack) import Data.Monoid ((<>))+import Graphics.UI.Gtk.Multiline.TextBuffer+       (textBufferDeleteMark, textBufferGetMark)+import Graphics.UI.Gtk.SourceView.SourceMarkAttributes+       (queryTooltipText, sourceMarkAttributesSetIconName,+        sourceMarkAttributesNew)+import Graphics.UI.Gtk.SourceView.SourceView+       (sourceViewSetMarkAttributes)+import Graphics.UI.Gtk.Multiline.TextMark (toTextMark)  transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView) transformGtkIter (GtkIter i) f = do@@ -180,7 +189,13 @@     canRedo (GtkBuffer sb) = liftIO $ sourceBufferGetCanRedo sb     canUndo (GtkBuffer sb) = liftIO $ sourceBufferGetCanUndo sb     copyClipboard (GtkBuffer sb) clipboard = liftIO $ textBufferCopyClipboard sb clipboard-    createMark (GtkBuffer sb) (GtkIter i) leftGravity = liftIO $ GtkMark <$> textBufferCreateMark sb Nothing i leftGravity+    createMark (GtkView sv) name (GtkIter i) icon tooltip = liftIO $ do+        attributes <- sourceMarkAttributesNew+        sourceMarkAttributesSetIconName attributes (Just icon)+        on attributes queryTooltipText $ \ mark -> return tooltip+        sourceViewSetMarkAttributes sv name (Just attributes) 1+        sb <- castToSourceBuffer <$> get sv textViewBuffer+        GtkMark . toTextMark <$> sourceBufferCreateSourceMark sb (Just name) name i     cutClipboard (GtkBuffer sb) clipboard defaultEditable = liftIO $ textBufferCutClipboard sb clipboard defaultEditable     delete (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $         textBufferDelete sb first last@@ -219,6 +234,7 @@             sourceViewSetIndentOnTab sv True             sourceViewSetAutoIndent sv True             sourceViewSetSmartHomeEnd sv SourceSmartHomeEndBefore+            sourceViewSetShowLineMarks sv True             if wrapLines prefs                 then textViewSetWrapMode sv WrapWord                 else textViewSetWrapMode sv WrapNone@@ -234,6 +250,10 @@         first <- textBufferGetStartIter sb         last <- textBufferGetEndIter sb         textBufferRemoveTagByName sb name first last+        mbMark <- textBufferGetMark sb name+        case mbMark of+            Just mark -> textBufferDeleteMark sb mark+            Nothing   -> return ()     selectRange (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $         textBufferSelectRange sb first last     setModified (GtkBuffer sb) modified = liftIO $ textBufferSetModified sb modified >> return ()@@ -447,11 +467,4 @@     -- Tag     background (GtkTag t) color = liftIO $ set t [textTagBackground := T.pack $ colorHexString color]     underline (GtkTag t) value = liftIO $ set t [textTagUnderline := value]--simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView)-simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do-    buffer <- sourceBufferNew Nothing-    textBufferSetText buffer contents-    return buffer- 

@@ -155,8 +155,8 @@     canRedo (YiBuffer fb) = return True -- TODO     canUndo (YiBuffer fb) = return True -- TODO     copyClipboard (YiBuffer fb) _ = liftYi $ withEditor $ copy-    createMark (YiBuffer b) (YiIter (Iter _ p)) leftGravity = withYiBuffer b $-        YiMark <$> newMarkB (MarkValue p (if leftGravity then Backward else Forward))+    createMark (YiView b) _name (YiIter (Iter _ p)) _icon _description = withYiBuffer b $+        YiMark <$> newMarkB (MarkValue p Backward)     cutClipboard (YiBuffer fb) clipboard defaultEditable = liftYi $ withEditor $ cut     delete (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) =         withYiBuffer b $ deleteRegionB $ mkRegion first last

@@ -69,7 +69,7 @@         Nothing -> do             prefs' <- readIDE prefs             handle <- reifyIDE $ \ideR ->-                catch (connectTo (T.unpack $ serverIP prefs') (PortNumber(PortNum (fromIntegral $ serverPort prefs'))))+                catch (connectTo (T.unpack $ serverIP prefs') (PortNumber (fromIntegral $ serverPort prefs')))                     (\(exc :: SomeException) -> do                         catch (startServer (serverPort prefs'))                             (\(exc :: SomeException) -> throwIDE ("Can't start leksah-server" <> T.pack (show exc)))@@ -111,7 +111,7 @@ waitForServer prefs s = do     threadDelay 100000 -- 0.1 second     catch (do-        handle <- liftIO $ connectTo (T.unpack $ serverIP prefs) (PortNumber(PortNum (fromIntegral $ serverPort prefs)))+        handle <- liftIO $ connectTo (T.unpack $ serverIP prefs) (PortNumber (fromIntegral $ serverPort prefs))         return (Just handle))         (\(exc :: SomeException) -> waitForServer prefs (s-1))