leksah 0.15.2.0 → 0.16.2.2
raw patch · 112 files changed
+8334/−16207 lines, 112 filesdep +HTTPdep +fsnotifydep +gi-cairodep −ghcjs-domdep −giodep −glibdep ~Cabaldep ~QuickCheckdep ~basebinary-added
Dependencies added: HTTP, fsnotify, gi-cairo, gi-gdk, gi-gdkpixbuf, gi-gio, gi-glib, gi-gobject, gi-gtk, gi-gtk-hs, gi-gtkosxapplication, gi-gtksource, gi-pango, gi-webkit, gi-webkit2, haskell-gi-base, haskell-gi-overloading, split
Dependencies removed: ghcjs-dom, gio, glib, gtk3, gtk3-mac-integration, gtksourceview3, monad-loops, webkitgtk3, webkitgtk3-javascriptcore
Dependency ranges changed: Cabal, QuickCheck, base, binary, containers, cpphs, directory, ghc, haskell-src-exts, hlint, hslogger, jsaddle, leksah, leksah-server, ltk, text, time, transformers, vcsgui, yi, yi-language, yi-rope
Files
- Readme.md +98/−101
- bew/Main.hs +0/−14
- data/current.lkshs +7/−8
- data/empty.lkshs +7/−8
- data/keymap.lkshk +8/−7
- data/leksah-welcome/cabal.project +2/−0
- data/leksah-welcome/src/Main.hs +1/−1
- data/leksah.menu +19/−22
- data/prefs.lkshp +8/−6
- data/prefscoll.lkshp +2/−2
- data/styles/leksah-dark.xml +5/−1
- doc/Keybindings.svg +0/−3894
- doc/leksah_manual.lyx +0/−5814
- doc/screenshots2/screenshot_buffer_menu.png binary
- doc/screenshots2/screenshot_completion.png binary
- doc/screenshots2/screenshot_config_menu.png binary
- doc/screenshots2/screenshot_construct_module.png binary
- doc/screenshots2/screenshot_debug_menu.png binary
- doc/screenshots2/screenshot_debug_pane.png binary
- doc/screenshots2/screenshot_edit_menu.png binary
- doc/screenshots2/screenshot_error_pane.png binary
- doc/screenshots2/screenshot_file_menu.png binary
- doc/screenshots2/screenshot_findbar.png binary
- doc/screenshots2/screenshot_first_start.png binary
- doc/screenshots2/screenshot_grep.png binary
- doc/screenshots2/screenshot_help_menu.png binary
- doc/screenshots2/screenshot_metadata_prefs.png binary
- doc/screenshots2/screenshot_module_browser.png binary
- doc/screenshots2/screenshot_package_editor_1.png binary
- doc/screenshots2/screenshot_package_flags.png binary
- doc/screenshots2/screenshot_package_menu.png binary
- doc/screenshots2/screenshot_panes_menu.png binary
- doc/screenshots2/screenshot_prefs_editor.png binary
- doc/screenshots2/screenshot_serach_pane.png binary
- doc/screenshots2/screenshot_source_candy.png binary
- doc/screenshots2/screenshot_view_menu.png binary
- doc/screenshots2/screenshot_welcome.png binary
- doc/screenshots2/screenshot_workspace_menu.png binary
- language-specs/haskell.lang +3/−2
- leksah.cabal +140/−108
- main/Main.hs +1/−1
- osx/Info.plist +3/−3
- osx/launcher.sh +5/−1
- osx/leksah.bundle +44/−10
- osx/makedmg.sh +13/−12
- osx/makedmgs.sh +5/−5
- pics/ide_bench_build.png binary
- pics/ide_doc_build.png binary
- pics/ide_git.png binary
- pics/ide_test_build.png binary
- scripts/stage.sh +8/−10
- src/IDE/BufferMode.hs +21/−18
- src/IDE/Build.hs +89/−76
- src/IDE/Command.hs +195/−176
- src/IDE/Command/VCS/Common.hs +51/−44
- src/IDE/Command/VCS/Common/Workspaces.hs +6/−6
- src/IDE/Command/VCS/SVN.hs +0/−2
- src/IDE/Completion.hs +298/−189
- src/IDE/Core/State.hs +68/−47
- src/IDE/Core/Types.hs +202/−98
- src/IDE/Find.hs +238/−213
- src/IDE/HLint.hs +19/−16
- src/IDE/ImportTool.hs +92/−51
- src/IDE/Keymap.hs +13/−13
- src/IDE/LPaste.hs +78/−0
- src/IDE/Leksah.hs +223/−240
- src/IDE/LogRef.hs +146/−41
- src/IDE/Metainfo/Provider.hs +71/−60
- src/IDE/NotebookFlipper.hs +101/−79
- src/IDE/OSX.hs +46/−31
- src/IDE/Package.hs +564/−353
- src/IDE/Pane/Breakpoints.hs +87/−52
- src/IDE/Pane/Errors.hs +215/−130
- src/IDE/Pane/Files.hs +11/−23
- src/IDE/Pane/Grep.hs +400/−357
- src/IDE/Pane/HLint.hs +5/−4
- src/IDE/Pane/Info.hs +19/−17
- src/IDE/Pane/Log.hs +198/−159
- src/IDE/Pane/Modules.hs +509/−388
- src/IDE/Pane/PackageEditor.hs +516/−290
- src/IDE/Pane/PackageFlags.hs +44/−24
- src/IDE/Pane/Search.hs +185/−155
- src/IDE/Pane/SourceBuffer.hs +292/−218
- src/IDE/Pane/Trace.hs +82/−46
- src/IDE/Pane/Variables.hs +109/−73
- src/IDE/Pane/WebKit/Documentation.hs +55/−73
- src/IDE/Pane/WebKit/Inspect.hs +36/−68
- src/IDE/Pane/WebKit/Output.hs +133/−123
- src/IDE/Pane/Workspace.hs +474/−307
- src/IDE/PaneGroups.hs +25/−28
- src/IDE/Preferences.hs +155/−95
- src/IDE/Sandbox.hs +0/−142
- src/IDE/Session.hs +89/−104
- src/IDE/SourceCandy.hs +13/−12
- src/IDE/Statusbar.hs +59/−70
- src/IDE/SymbolNavigation.hs +117/−65
- src/IDE/TextEditor/Class.hs +32/−18
- src/IDE/TextEditor/CodeMirror.hs +66/−65
- src/IDE/TextEditor/GtkSourceView.hs +410/−331
- src/IDE/TextEditor/Yi.hs +62/−50
- src/IDE/TextEditor/Yi/Config.hs +127/−0
- src/IDE/Utils/CabalUtils.hs +31/−0
- src/IDE/Utils/ExternalTool.hs +10/−8
- src/IDE/Utils/GUIUtils.hs +263/−169
- src/IDE/Utils/GtkBindings.hs +0/−32
- src/IDE/Utils/ServerConnection.hs +0/−1
- src/IDE/Workspaces.hs +409/−301
- src/IDE/Workspaces/Writer.hs +183/−46
- src/IDE/YiConfig.hs +0/−127
- tests/IDE/TextEditor/Tests.hs +0/−179
- tests/Tests.hs +0/−66
- win32/makeinstaller.sh +13/−8
Readme.md view
@@ -1,6 +1,6 @@ # Leksah, an Integrated Development Environment for Haskell -[](http://travis-ci.org/leksah/leksah)+[](http://travis-ci.org/leksah/leksah) [Leksah](http://leksah.org/) aims to integrate various Haskell development tools to provide a practical and pleasant development environment.@@ -8,121 +8,118 @@ Documentation can be found on [leksah.org](http://leksah.org/). -## Installation--Requirements: ghc >= 7.8.3 cabal >= 1.18--You can get Leksah up and running quickly on Windows and OS X using the-[official binaries](https://github.com/leksah/leksah/wiki/download).--Some Linux distributions include Leksah packages, but building from source-on Linux is normally relatively easy.--## Building From Source--### Building on Linux--Install the GtkSourceView and WebKitGtk development packages for your distribution:-- sudo apt-get install libgtksourceview-3.0-dev libwebkitgtk-3.0-dev--Make sure `$HOME/.cabal/bin` is in your `PATH` then:- - cabal update- cabal install Cabal cabal-install- cabal install regex-tdfa-text --ghc-options=-XFlexibleContexts- cabal install alex happy- cabal install gtk2hs-buildtools- cabal install leksah- leksah--### Building on OS X--[Install MacPorts](https://www.macports.org/install.php).--Make sure `/opt/local/bin` and `$HOME/Libraries/Haskell/bin` are in your `PATH`.--To avoid a dependency on X11 add the following to `/opt/local/etc/macports/variants.conf`:-- -x11 +no_x11 +quartz +gtk3--Use MacPorts to install `python27` and `rsync` (sometimes it stops to ask for these to be-activated so if you do them first it might help):-- sudo port install python27 rsync--Use MacPorts to install GHC and the C libraries needed by Leksah (this will take a long time):- - sudo port install ghc gtk3 webkit-gtk3 gtksourceview3 gtk-osx-application-gtk3 adwaita-icon-theme--Update Cabal and cabal-install-- cabal update- cabal install Cabal cabal-install--Make sure the right `cabal` made it into your `PATH`.-- cabal --version--Check that the versions match the ones you just installed (if not check the symbolic links in-`$HOME/Libraries/Haskell/bin`).+## Getting Leksah+### Installation+Leksah requires `ghc --version` >=7.10.3 and `cabal --version` >=1.24. To get them go to **[haskell.og/download](https://www.haskell.org/downloads)** and choose the **Minimal GHC** or **Haskell Platform**. -Install `gtk2hs-buildtools` and `leksah`:+* **Windows** [latest github version built with AppVeyor](https://ci.appveyor.com/project/hamishmack/leksah/build/artifacts)+* **OS X**: [official binaries](https://github.com/leksah/leksah/wiki/download)+* **Linux**: [build from source](https://github.com/leksah/leksah#building-from-source) - cabal install regex-tdfa-text --ghc-options=-XFlexibleContexts- cabal install alex happy- cabal install gtk2hs-buildtools- cabal install leksah- leksah+### Building from source+We have completed a port of Leksah from Gtk2Hs to haskell-gi. Not all of the code is in Hackage yet so to build it you can either use [Xobl](xobl/Readme.md) or follow the instructions below. -### Building on Windows+#### Step 1: Install C libraries -Install [GHC](https://www.haskell.org/downloads/windows).+##### Fedora+```shell+sudo dnf install gobject-introspection-devel webkitgtk4-devel gtksourceview3-devel+``` -Update MinGW if necessary. The GHC installers currently come with old versions of-MinGW and you will probably need to replace it with one that comes with gcc 4.8.1.-The current 64bit GHC installer seems to be happy to work with newer MinGW.-It may not be possible to use the current 32bit GHC installers at all.-Make sure you replace MinGW so that GHC will find the new one (just adding-it to the `PATH` will not work). The MinGW used by GHC is typically in a location-like `C:\Program Files\MinGHC-7.10.1\ghc-7.10.1\mingw`. Move it out of the way-and put a newer one in its place.+##### Ubuntu/Debian+```shell+sudo apt-get install libgirepository1.0-dev libwebkit2gtk-4.0-dev libgtksourceview-3.0-dev+``` -[MinGW version used to build the Leksah binaries](http://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win64/Personal%20Builds/mingw-builds/4.9.2/threads-posix/seh/x86_64-4.9.2-release-posix-seh-rt_v4-rev2.7z)+##### Arch Linux+```shell+sudo pacman -S gobject-introspection gobject-introspection-runtime gtksourceview3 webkit2gtk+``` -Install the C libraries needed by Leksah. The easiest way to do this is to install-Leksah using the MSI files. They include pkg-config and all the C libraries needed.+##### OS X MacPorts+```shell+sudo port install gobject-introspection webkit2-gtk gtksourceview3 gtk-osx-application-gtk3 adwaita-icon-theme`+```+You will also need to build a MacPorts compatible of GHC. First install GHC some other way then unpack the source for the GHC version you want to use and run:+```shell+sudo port install libxslt gmp ncurses libiconv llvm-3.5 libffi+./configure --prefix=$HOME/ghc-8.0.1 --with-iconv-includes=/opt/local/include --with-iconv-libraries=/opt/local/lib --with-gmp-includes=/opt/local/include --with-gmp-libraries=/opt/local/lib --with-system-libffi --with-ffi-includes=/opt/local/lib/libffi-3.2.1/include --with-ffi-libraries=/opt/local/lib --with-nm=/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/nm-classic+make+make install+echo 'PATH: '"$PATH"+``` -Make sure `C:\Leksah\bin` and `%APPDATA%\cabal\bin` are in your `PATH` and build:+Make sure the `$HOME/ghc-8.0.1/bin` is present in PATH. - cabal update- cabal install Cabal- cabal install alex happy- cabal install gtk2hs-buildtools- cabal install leksah- leksah- -### Building Leksah for Windows using Docker+##### OS X Homebrew+It might be possible to build Leksah using Homebrew now we have switched to WebKit 2. If you can figure it out please send us the details or better yet a pull request to update this file. Raise an issue if you try and it does not work. -It may seem crazy, but this is currently the best way to bootstrap Leksah for-Windows from source. This is mostly because Fedora and SUSE have a much-more complete set of MinGW packages than any thing else (including Windows).+##### Windows MSYS2+Install:+* [MSYS2](https://msys2.github.io/)+* [Chocolatey](https://chocolatey.org/) -Get the leksah source:+Then in Bash shell with administrator privileges execute:+```shell+choco install ghc+pacman -S mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-gobject-introspection mingw64/mingw-w64-x86_64-gtksourceview3 mingw64/mingw-w64-x86_64-webkitgtk3+``` - git clone https://github.com/leksah/leksah- cd leksah- git submodule update --init+Set the following environment variables:+```shell+SET PATH=%APPDATA%\cabal\bin;C:\msys64\mingw64\bin;C:\msys64\usr\bin;C:\ProgramData\chocolatey\lib\ghc\tools\ghc-8.0.2\bin;C:\ProgramData\chocolatey\lib\cabal\tools;%PATH%+SET PKG_CONFIG_PATH=C:\msys64\mingw64\lib\pkgconfig+SET XDG_DATA_DIRS=C:\msys64\mingw64\share+```+(change `C:\ProgramData\chocolatey\lib\ghc\tools\ghc-8.0.2\bin` if a newer version is installed) -Get the Fedora 22 docker image and load it:+##### FreeBSD+```shell+pkg install devel/gobject-introspection x11-toolkits/gtksourceview3 www/webkit2-gtk3+``` - wget http://dl.fedoraproject.org/pub/fedora/linux/releases/22/Docker/x86_64/Fedora-Docker-Base-22-20150521.x86_64.tar.xz- sudo docker load -i Fedora-Docker-Base-22-20150521.x86_64.tar.xz+#### Step 2: Clone repository and its submodules+```shell+git clone --recursive https://github.com/leksah/leksah.git+cd leksah+``` -Build Leksah using the Dockerfile:+#### (Cabal variant) Step 3.a: Build+##### Step 3.a.1: Install extra tools+```shell+cabal update+cabal install alex happy+cabal install haskell-gi+```+Make sure `~/.cabal/bin` is present in the PATH (*Windows:* Make sure `%APPDATA%\cabal\bin` is present in the PATH). - sudo docker build -t leksah/build .+##### Step 3.a.2: Build and run Leksah+###### OS X using MacPorts+```shell+XDG_DATA_DIRS=/opt/local/share ./leksah.sh+```+###### All other OS'es+```shell+./leksah.sh+``` -Copy the resulting msi file out of the container (version number in the file name will match the one in the leksah.cabal file):+#### (Stack variant) Step 3.b: Build+##### Step 3.b.1: Install extra tools+```shell+stack setup --upgrade-cabal+stack install alex happy+stack install haskell-gi+stack install gtk2hs-buildtools+```+##### Step 3.b.2: Build and run Leksah+###### For Mac OS+```shell+stack install --stack-yaml stack.osx.yaml+stack exec leksah+``` - sudo docker run --rm --volume $HOME/output:/output leksah/build cp /leksah/win32/leksah-0.15.0.1-ghc-7.10.1.msi /output+###### All other OS'es+```shell+stack install+stack exec leksah+```
− bew/Main.hs
@@ -1,14 +0,0 @@-module Main (- main-) where--import Graphics.UI.Gtk (postGUIAsync)-import GHCJS.DOM (runWebGUI, webViewGetDomDocument)--main =- runWebGUI $ \ webView -> postGUIAsync $ do- Just doc <- webViewGetDomDocument webView- putStrLn "Bewleksah is a version of Leksah that can run in a web browser."- putStrLn "Nothing working yet."--
data/current.lkshs view
@@ -1,19 +1,18 @@ Version of session file format:- 1+ 2 Time of storage:- "Sun Oct 27 02:21:33 NZDT 2013"-Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) 167)], paneTabs = Just TopP, currentPage = 2, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 456) 693-Population: [(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 200 (SystemScope,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP])]-Window size: (1076,728)+ "Sun Sep 4 20:03:20 CEST 2016"+Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 578) 336+Population: [(Just (ErrorsSt (ErrorsState {showErrors = True, showWarnings = True, showSuggestions = True, showTestFails = True})),[SplitP RightP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (WorkspaceSt WorkspaceState),[SplitP LeftP])]+Window size: (1366,768) Full screen: False-Dark: False Completion size: (750,400) Workspace: Nothing-Active pane: Just "Modules"+Active pane: Nothing Toolbar visible: True-FindbarState: (True,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})+FindbarState: (False,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, regex = False, lineNr = 1}) Recently opened files: [] Recently opened workspaces:
data/empty.lkshs view
@@ -1,19 +1,18 @@ Version of session file format:- 1+ 2 Time of storage:- "Fri Feb 26 17:11:46 CET 2010"-Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}), ("Debug",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 206)], paneTabs = Just TopP, currentPage = 2, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 1, detachedId = Nothing, detachedSize = Nothing}) 547) 733-Population: [(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 286 (SystemScope,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser"]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP])]-Window size: (1076,728)-Full screen: True-Dark: True+ "Sun Sep 4 20:03:20 CEST 2016"+Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 578) 336+Population: [(Just (ErrorsSt (ErrorsState {showErrors = True, showWarnings = True, showSuggestions = True, showTestFails = True})),[SplitP RightP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (WorkspaceSt WorkspaceState),[SplitP LeftP])]+Window size: (1366,768)+Full screen: False Completion size: (750,400) Workspace: Nothing Active pane: Nothing Toolbar visible: True-FindbarState: (True,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})+FindbarState: (False,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, regex = False, lineNr = 1}) Recently opened files: [] Recently opened workspaces:
data/keymap.lkshk view
@@ -1,5 +1,5 @@ --Default Keymap file for Leksah---Allowed Modifiers are <shift> <alt> <ctrl> <control> <compose>+--Allowed Modifiers are <shift> <alt> <ctrl> <control> <compose> -- --There are two versions of control so we can map them differently on OS X --<ctrl> is the Apple key on OS X@@ -13,16 +13,17 @@ --File-<ctrl>n -> FileNew "Creates a new haskell module"-<ctrl>o -> FileOpen "Opens an existing file"+<ctrl>n -> FileNewTextFile "Create a new text file"+<ctrl><shift>n -> FileNewModule "Creates a new Haskell module"+<ctrl>o -> FileOpenFile "Opens an existing file" --<ctrl>x/<ctrl>f -> FileOpen "Opens an existing file" <ctrl>s -> FileSave "Saves the current buffer" --<ctrl>x/<ctrl>s -> FileSave "Saves the current buffer" ---<ctrl>x/<ctrl>w -> FileSaveAs "Saves the current buffer as a new file"+<ctrl><shift>s -> FileSaveAs "Saves the current buffer as a new file" -<ctrl><shift>s -> FileSaveAll "Saves all modified buffers"+--<ctrl><shift>s -> FileSaveAll "Saves all modified buffers" <ctrl>w -> FileClose "Closes the current buffer" --<ctrl>x/k -> FileClose "Closes the current buffer"@@ -48,7 +49,7 @@ <shift>F3 -> EditFindPrevious "Find the previous occurence of the text string" -<ctrl>l -> EditGotoLine "Go to line with a known index"+<ctrl>g -> EditGotoLine "Go to line with a known index" <ctrl>d -> EditComment "Add a line style comment to the selected lies" <ctrl><shift>d -> EditUncomment "Remove a line style comment"@@ -72,7 +73,7 @@ -> ViewTabsUp "Shows the tabs of the current notebook on the top" -> ViewTabsDown "Shows the tabs of the current notebook on the bottom" -> ViewSwitchTabs "Switches if tabs for the current notebook are visible"-<ctrl><shift>f -> ViewFullScreen "Toggle fullscreen mode"+F11 -> ViewFullScreen "Toggle fullscreen mode" <ctrl>t -> ToggleToolbar -> HelpDebug -> HelpAbout
+ data/leksah-welcome/cabal.project view
@@ -0,0 +1,2 @@+packages:+ .
data/leksah-welcome/src/Main.hs view
@@ -13,7 +13,7 @@ -- * Package -> Build -- When you are ready to create your own workspace and package.--- * Package -> New+-- * File -> New -> Package -- Next we are importing some things from other modules. -- Leksah can normally add these imports for you, just
@@ -7,12 +7,16 @@ <menuitem name="_Text File..." action="FileNewTextFile" /> <separator /> <menuitem name="_Workspace..." action="FileNewWorkspace" />+ <menuitem name="Pro_ject..." action="FileNewProject" /> </menu> <menu name="_Open" action="FileOpen"> <menuitem name="_Workspace..." action="FileOpenWorkspace" />+ <menuitem name="Pro_ject..." action="FileOpenProject" /> <menuitem name="_Package..." action="FileOpenPackage" /> <menuitem name="_File..." action="FileOpenFile" /> </menu>+ <menu name="Recent Files" action="FileRecentFiles" />+ <menu name="Recent Workspaces" action="FileRecentWorkspaces" /> <separator /> <menuitem name="_Save" action="FileSave" /> <menuitem name="Save _As..." action="FileSaveAs" />@@ -20,11 +24,6 @@ <menuitem name="_Close" action="FileClose" /> <menuitem name="_Print File" action="FilePrint" /> <separator/>- <menu name="Recent Files" action="FileRecentFiles">- </menu>- <menu name="Recent Workspaces" action="FileRecentWorkspaces">- </menu>- <separator/> <menuitem name="Close Workspace" action="FileCloseWorkspace" /> <menuitem name="Close All" action="FileCloseAll" /> <menuitem name="Close All but Package" action="FileCloseAllButPackage" />@@ -69,18 +68,9 @@ <menuitem name="Resol_ve Errors" action="ResolveErrors" /> </menu> <menu name="_Package" action="Package">- <menu name="_Edit" action="PackageEdit">- <menuitem name="With _Package Editor" action="EditPackage" />- <menuitem name="With _Text Editor" action="EditPackageText" />- <menuitem name="Package _Flags" action="PackageFlags" />- </menu>- <menu name="_Sandbox" action="PackageSandbox">- <menuitem name="_Init" action="SandboxInit" />- <menuitem name="Init _Shared" action="SandboxInitShared" />- <menuitem name="_Delete" action="SandboxDelete" />- <menuitem name="_Add Source..." action="SandboxAddSource" />- <menuitem name="Add Source S_napshot..." action="SandboxAddSourceSnapshot" />- </menu>+ <menuitem name="Edit _Package" action="EditPackage" />+ <menuitem name="Edit Package as _Text" action="EditPackageText" />+ <menuitem name="Command _Flags" action="PackageFlags" /> <separator/> <menuitem name="Clea_n" action="CleanPackage" /> <menuitem name="_Configure" action="ConfigPackage" />@@ -88,11 +78,11 @@ <menuitem name="_Run" action="RunPackage" /> <menuitem name="Run _JavaScript" action="RunJavaScript" /> <separator/>- <menuitem name="_Install Dependencies" action="InstallDependenciesPackage" /> <menuitem name="C_opy" action="CopyPackage" />- <menuitem name="Re_gister" action="RegisterPackage" />+ <menuitem name="Install" action="InstallPackage" /> <menuitem name="_HLint" action="HLintPackage" /> <menuitem name="Test" action="TestPackage" />+ <menuitem name="Benchmark" action="BenchPackage" /> <menuitem name="SDist" action="SdistPackage" /> <menuitem name="_Build Documentation" action="DocPackage" /> <separator/>@@ -134,9 +124,9 @@ <menuitem name="_Workspace" action="ShowWorkspace" /> </menu> <menu name="_View" action="View">- <menuitem name="Split H_orizontal" action="ViewSplitHorizontal" />- <menuitem name="Split V_ertical" action="ViewSplitVertical" />- <menuitem name="_Collapse" action="ViewCollapse" />+ <menuitem name="Split Top/Bottom" action="ViewSplitHorizontal" />+ <menuitem name="Split Left/Right" action="ViewSplitVertical" />+ <menuitem name="_Collapse Split" action="ViewCollapse" /> <menuitem name="Close Pane" action="ViewClosePane" /> <separator/> <menuitem name="_Group" action="ViewNest" />@@ -159,6 +149,11 @@ <menuitem name="Toggle Toolbar" action="ToggleToolbar" /> </menu> <menu name="_Tools" action="Tools">+ <menuitem name="BackgroundBuild" action="BackgroundBuildToggled"/>+ <menuitem name="BuildDocs" action="MakeDocsToggled"/>+ <menuitem name="RunUnitTests" action="RunUnitTestsToggled"/>+ <menuitem name="RunBenchmarks" action="RunBenchmarksToggled"/>+ <separator/> <menuitem name="Update Workspace Data" action="UpdateMetadataCurrent" /> <menuitem name="Rebuild Workspace Data" action="RebuildMetadataCurrent" /> <menuitem name="Update System Data" action="UpdateMetadataLib" />@@ -208,7 +203,9 @@ <toolitem name="Forward" action="ViewHistoryForth"/> <separator/> <toolitem name="BackgroundBuild" action="BackgroundBuildToggled"/>+ <toolitem name="MakeDocs" action="MakeDocsToggled"/> <toolitem name="RunUnitTests" action="RunUnitTestsToggled"/>+ <toolitem name="RunBenchmarks" action="RunBenchmarksToggled"/> <toolitem name="MakeMode" action="MakeModeToggled"/> <separator/> <toolitem name="Update Project" action="UpdateMetadataCurrent" />
data/prefs.lkshp view
@@ -38,7 +38,9 @@ Lint Text Dark Background: Color 0 15000 0 Text Editor: "GtkSourceView"-LogView Font: "Sans 12"+LogView Font: "Monospace 10"+Workspace Font:+ "Sans 10" Window default size: (1024,800) --Default size of the main ide window specified as pair (int,int)@@ -50,17 +52,17 @@ keymap --The name of a keymap file in a config dir Categories for panes:- [("*Breakpoints","LogCategory"),("*Browser","ToolCategory"),("*Debug","ToolCategory"),("*Errors","ToolCategory"),("*Files","ToolCategory"),("*Flags","ToolCategory"),("*Grep","ToolCategory"),("*HLint","ToolCategory"),("*Doc","ToolCategory"),("*Info","LogCategory"),("*Log","LogCategory"),("*Inspect","LogCategory"),("*Modules","ToolCategory"),("*Out","ToolCategory"),("*Package","EditorCategory"),("*Prefs","EditorCategory"),("*Search","ToolCategory"),("*Trace","LogCategory"),("*Variables","LogCategory"),("*Workspace","LogCategory")]+ [("*Breakpoints","LogCategory"),("*Browser","ToolCategory"),("*Debug","ToolCategory"),("*Errors","LogCategory"),("*Files","ToolCategory"),("*Flags","ToolCategory"),("*Grep","LogCategory"),("*HLint","ToolCategory"),("*Doc","ToolCategory"),("*Info","LogCategory"),("*Log","LogCategory"),("*Inspect","LogCategory"),("*Modules","ToolCategory"),("*Out","ToolCategory"),("*Package","EditorCategory"),("*Prefs","EditorCategory"),("*Search","ToolCategory"),("*Trace","LogCategory"),("*Variables","LogCategory"),("*Workspace","ExplorerCategory")] Pane path for category:- [("EditorCategory",[SplitP LeftP]),("ToolCategory",[SplitP RightP,SplitP TopP]),("LogCategory",[SplitP RightP,SplitP BottomP])]+ [("ExplorerCategory",[SplitP LeftP]),("EditorCategory",[SplitP RightP]),("ToolCategory",[SplitP RightP,SplitP TopP]),("LogCategory",[SplitP RightP,SplitP BottomP])] Default pane path:- [SplitP LeftP]+ [SplitP RightP] Paths under which haskell sources for packages may be found: [] Unpack source for cabal packages to:- Just "~/.leksah-0.15/packageSources"+ Just "~/.leksah-0.16/packageSources" URL from which to download prebuilt metadata:- "http://www.leksah.org"+ "http://leksah.github.io" Strategy for downloading prebuilt metadata: RetrieveThenBuild Update metadata at startup:
data/prefscoll.lkshp view
@@ -1,9 +1,9 @@ Paths under which haskell sources for packages may be found: [] Unpack source for cabal packages to:- Just "~/.leksah-0.15/packageSources"+ Just "~/.leksah-0.16/packageSources" URL from which to download prebuilt metadata:- "http://www.leksah.org"+ "http://leksah.github.io" Strategy for downloading prebuilt metadata: RetrieveThenBuild Port number for leksah to comunicate with leksah-server:
data/styles/leksah-dark.xml view
@@ -36,6 +36,7 @@ <color name="statement" value="#CC7733"/> <color name="red" value="#FF0000"/> <color name="yellow" value="#FFFFC0"/>+ <color name="brown" value="#666600"/> <color name="preproc" value="#B54A6A"/> <!-- Global Settings -->@@ -44,6 +45,7 @@ <style name="text" background="#202020"/> <style name="selection" background="#3B73AE" foreground="#FFFFFF"/> <style name="selection-unfocused" background="#3B73AE" foreground="#FFFFFF"/>+ <style name="selection-match" background="green" foreground="#FFFFFF"/> <!-- Bracket Matching --> <style name="bracket-match" foreground="white" background="gray" bold="true"/>@@ -53,7 +55,7 @@ <style name="right-margin" foreground="gray"/> <!-- Search Matching -->- <style name="search-match" background="yellow"/>+ <style name="search-match" background="brown"/> <!-- Comments --> <style name="def:comment" foreground="comment"/>@@ -79,6 +81,8 @@ <style name="def:warning" background="yellow"/> <style name="def:note" foreground="comment" background="yellow" bold="true"/> <style name="def:underlined" italic="true" underline="false"/>+ <style name="BreakpointRef" background="#594011"/>+ <style name="ContextRef" background="#0f2c6f"/> <!-- Language specific styles --> <style name="diff:added-line" foreground="#008B8B"/>
− doc/Keybindings.svg
@@ -1,3894 +0,0 @@-<?xml version="1.0" encoding="UTF-8" standalone="no"?>-<!-- Created with Inkscape (http://www.inkscape.org/) -->--<svg- xmlns:dc="http://purl.org/dc/elements/1.1/"- xmlns:cc="http://creativecommons.org/ns#"- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"- xmlns:svg="http://www.w3.org/2000/svg"- xmlns="http://www.w3.org/2000/svg"- xmlns:xlink="http://www.w3.org/1999/xlink"- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"- width="1024"- height="640"- id="svg2"- sodipodi:version="0.32"- inkscape:version="0.47 r22583"- version="1.0"- sodipodi:docname="Keybindings.svg"- inkscape:output_extension="org.inkscape.output.svg.inkscape"- inkscape:export-filename="/home/vav/images/xmonad/xmbindings_lg.png"- inkscape:export-xdpi="112.5"- inkscape:export-ydpi="112.5">- <defs- id="defs4">- <pattern- inkscape:collect="always"- xlink:href="#Strips1_1"- id="pattern5757"- patternTransform="matrix(10,0,0,10,1,68)" />- <pattern- inkscape:stockid="Stripes 1:1"- id="Strips1_1"- patternTransform="translate(0,0) scale(10,10)"- height="1"- width="2"- patternUnits="userSpaceOnUse"- inkscape:collect="always">- <rect- id="rect4867"- height="2"- width="1"- y="-0.5"- x="0"- style="fill:black;stroke:none" />- </pattern>- <inkscape:perspective- sodipodi:type="inkscape:persp3d"- inkscape:vp_x="0 : 320 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_z="1024 : 320 : 1"- inkscape:persp3d-origin="512 : 213.33333 : 1"- id="perspective554" />- <inkscape:perspective- id="perspective5602"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective5664"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective5695"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective5734"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective5767"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6056"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6095"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6128"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6156"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6156-3"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6218"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6246"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6278"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6339"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6370"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6417"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6456"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6541"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6572"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6597"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6634"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6668"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6705"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6741"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6778"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6841"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6888"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6940"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective6975"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7006"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7034"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7080"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7111"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7142"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7173"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7210"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7210-2"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7255"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7288"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7325"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7366"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7401"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7426"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7457"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7492"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7525"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7559"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7590"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- <inkscape:perspective- id="perspective7590-1"- inkscape:persp3d-origin="0.5 : 0.33333333 : 1"- inkscape:vp_z="1 : 0.5 : 1"- inkscape:vp_y="0 : 1000 : 0"- inkscape:vp_x="0 : 0.5 : 1"- sodipodi:type="inkscape:persp3d" />- </defs>- <sodipodi:namedview- id="base"- pagecolor="#ffffff"- bordercolor="#666666"- borderopacity="1.0"- gridtolerance="10000"- guidetolerance="10"- objecttolerance="10"- inkscape:pageopacity="0.0"- inkscape:pageshadow="2"- inkscape:zoom="1"- inkscape:cx="455.37417"- inkscape:cy="322.32716"- inkscape:document-units="px"- inkscape:current-layer="layer1"- width="1024px"- height="640px"- showgrid="false"- inkscape:window-width="1918"- inkscape:window-height="1152"- inkscape:window-x="1920"- inkscape:window-y="14"- showguides="true"- inkscape:guide-bbox="true"- inkscape:snap-grids="true"- inkscape:window-maximized="0">- <inkscape:grid- id="GridFromPre046Settings"- type="xygrid"- originx="0px"- originy="0px"- spacingx="2px"- spacingy="2px"- color="#0000ff"- empcolor="#0000ff"- opacity="0.2"- empopacity="0.4"- empspacing="5" />- </sodipodi:namedview>- <metadata- id="metadata7">- <rdf:RDF>- <cc:Work- rdf:about="">- <dc:format>image/svg+xml</dc:format>- <dc:type- rdf:resource="http://purl.org/dc/dcmitype/StillImage" />- <dc:title></dc:title>- </cc:Work>- </rdf:RDF>- </metadata>- <g- inkscape:label="Layer 1"- inkscape:groupmode="layer"- id="layer1">- <g- id="g7271-0"- transform="translate(-67.951295,149.5)"- style="fill:#eeeeec;fill-opacity:1">- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3378-4"- width="59.494934"- height="60"- x="370.45383"- y="138"- ry="4.480969" />- <rect- ry="2.2778258"- y="138"- x="370.45383"- height="30.5"- width="59.494934"- id="rect7269-6"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:#eeeeec;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 370.54685,168.5 c 19.9363,0 39.87259,0 59.80889,0"- id="path3484-1" />- </g>- <text- sodipodi:linespacing="89.999998%"- id="text10763"- y="227.65041"- x="185.58366"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- xml:space="preserve"><tspan- id="tspan10765"- y="227.65041"- x="185.58366"- sodipodi:role="line">Move window</tspan><tspan- y="233.95041"- x="185.58366"- sodipodi:role="line"- id="tspan10767">to second</tspan><tspan- y="240.25041"- x="185.58366"- sodipodi:role="line"- id="tspan10769">workspace</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3878"- width="59.494934"- height="60"- x="151.45648"- y="217.55692"- ry="4.480969" />- <text- sodipodi:linespacing="89.999998%"- id="text10699"- y="256.94482"- x="116.8933"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- xml:space="preserve"><tspan- id="tspan10701"- y="256.94482"- x="116.8933"- sodipodi:role="line">Switch to</tspan><tspan- y="263.24481"- x="116.8933"- sodipodi:role="line"- id="tspan10703">first</tspan><tspan- y="269.54483"- x="116.8933"- sodipodi:role="line"- id="tspan10705">workspace</tspan></text>- <text- xml:space="preserve"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="116.8933"- y="226.64024"- id="text10771"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="116.8933"- y="226.64024"- id="tspan10773">Move window</tspan><tspan- id="tspan10775"- sodipodi:role="line"- x="116.8933"- y="232.94025">to first</tspan><tspan- id="tspan10777"- sodipodi:role="line"- x="116.8933"- y="239.24025">workspace</tspan></text>- <rect- ry="4.480969"- y="287.55692"- x="11"- height="60"- width="70"- id="rect3328"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3330"- width="60"- height="60"- x="91"- y="287.55692"- ry="4.480969" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3382"- width="59.494934"- height="60"- x="511.4538"- y="287.55692"- ry="4.480969" />- <rect- ry="4.480969"- y="287.55692"- x="581.45642"- height="60"- width="59.494934"- id="rect3384"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- ry="4.480969"- y="287.55692"- x="441.45361"- height="60"- width="59.494934"- id="rect3386"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- ry="4.480969"- y="287.55692"- x="721.4538"- height="60"- width="59.494934"- id="rect3388"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3392"- width="59.494934"- height="60"- x="651.45642"- y="287.55692"- ry="4.480969" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="94.516792"- y="309.5993"- id="text3444"><tspan- sodipodi:role="line"- id="tspan3446"- x="94.516792"- y="309.5993">Q</tspan></text>- <text- id="text3448"- y="309.87833"- x="303.95746"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="309.87833"- x="303.95746"- id="tspan3450"- sodipodi:role="line">R</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7301"- width="59.494934"- height="60"- x="161.45648"- y="287.55692"- ry="4.480969" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 161.5446,318.55692 c 19.7729,0 39.54579,0 59.31869,0"- id="path7305" />- <text- id="text3464"- y="310.17899"- x="165.66309"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:Monospace"- xml:space="preserve"><tspan- y="310.17899"- x="165.66309"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono"- id="tspan3498">W</tspan></text>- <text- id="text3468"- y="336.77765"- x="94.295898"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="336.77765"- x="94.295898"- id="tspan3470"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">q</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="163.72855"- y="340.66086"- id="text3472"><tspan- sodipodi:role="line"- id="tspan3474"- x="163.72855"- y="340.66086"- style="font-size:18px;font-family:DejaVu Sans Mono">w</tspan></text>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 91.598089,317.55692 c 19.936301,0 39.872591,0 59.808891,0"- id="path3476" />- <g- id="g7271"- transform="translate(1,150.05692)"- style="fill:#eeeeec;fill-opacity:1">- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3378"- width="59.494934"- height="60"- x="370.45383"- y="138"- ry="4.480969" />- <rect- ry="2.2778258"- y="138"- x="370.45383"- height="30.5"- width="59.494934"- id="rect7269"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:#eeeeec;fill-rule:evenodd;stroke:#000000;stroke-width:1.09369910000000004px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"- d="m 370.54685,168.5 c 19.9363,0 39.87259,0 59.80889,0"- id="path3484" />- </g>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08917749px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 441.54459,318.55692 c 19.77181,0 39.54358,0 59.31538,0"- id="path3486" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 511.54685,318.55692 c 19.9363,0 39.87259,0 59.80889,0"- id="path3488" />- <path- id="path3490"- d="m 581.5446,318.05692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- id="path3492"- d="m 651.5446,318.55692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- id="path3494"- d="m 721.54685,318.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <rect- ry="4.480969"- y="286"- x="231.04858"- height="60"- width="59.494934"- id="rect2735"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path2737"- d="m 231.13671,316.99999 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="234.23283"- y="309.87833"- id="text3502"><tspan- sodipodi:role="line"- id="tspan3504"- x="234.23283"- y="309.87833">E</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="234.10065"- y="340.40598"- id="text3506"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3508"- x="234.10065"- y="340.40598">e</tspan></text>- <text- id="text3510"- y="340.138"- x="302.84863"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="340.138"- x="302.84863"- id="tspan3512"- sodipodi:role="line">r</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="371.84863"- y="340.55695"- id="text3532"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3534"- x="371.84863"- y="340.55695">t</tspan></text>- <text- id="text3536"- y="338.31281"- x="445.58594"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="338.31281"- x="445.58594"- id="tspan3538"- sodipodi:role="line">y</tspan></text>- <text- id="text3540"- y="340.15921"- x="514.22791"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="340.15921"- x="514.22791"- id="tspan3542"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">u</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="584.43555"- y="340.55695"- id="text3544"><tspan- sodipodi:role="line"- id="tspan3546"- x="584.43555"- y="340.55695"- style="font-size:18px;font-family:DejaVu Sans Mono">i</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="655.86719"- y="340.138"- id="text3548"><tspan- sodipodi:role="line"- id="tspan3550"- x="655.86719"- y="340.138"- style="font-size:18px;font-family:DejaVu Sans Mono">o</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="724.76172"- y="340.138"- id="text3552"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3554"- x="724.76172"- y="340.138">p</tspan></text>- <text- id="text3556"- y="188.60269"- x="798.63989"- style="font-size:22px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-family:DejaVu Sans Mono"- y="188.60269"- x="798.63989"- id="tspan3558"- sodipodi:role="line" /></text>- <rect- ry="4.480969"- y="357.55695"- x="100.59211"- height="60"- width="60"- id="rect3616"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3618"- width="59.494934"- height="60"- x="171.04858"- y="357.55695"- ry="4.480969" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3620"- width="60.505096"- height="60"- x="240.5921"- y="357.55695"- ry="4.480969" />- <rect- ry="4.480969"- y="357.55695"- x="311.04858"- height="60"- width="59.494934"- id="rect3622"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3624"- width="59.494934"- height="60"- x="381.04593"- y="357.55695"- ry="4.480969" />- <rect- ry="4.480969"- y="357.55695"- x="521.0459"- height="60"- width="59.494934"- id="rect3626"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3628"- width="59.494934"- height="60"- x="591.04852"- y="357.55695"- ry="4.480969" />- <rect- ry="4.480969"- y="357.55695"- x="731.45642"- height="60"- width="59.951477"- id="rect3634"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <text- id="text3638"- y="379.6998"- x="104.64462"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="379.6998"- x="104.64462"- id="tspan3640"- sodipodi:role="line">A</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="318.95215"- y="381"- id="text3642"><tspan- sodipodi:role="line"- id="tspan3644"- x="318.95215"- y="381">F</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:Monospace"- x="174.7986"- y="379.44492"- id="text3646"><tspan- id="tspan3648"- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- x="174.7986"- y="379.44492">S</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="104.19238"- y="410.638"- id="text3650"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3652"- x="104.19238"- y="410.638">a</tspan></text>- <text- id="text3654"- y="410.638"- x="174.94727"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="410.638"- x="174.94727"- id="tspan3656"- sodipodi:role="line">s</tspan></text>- <path- id="path3658"- d="m 101.1902,387.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 171.13671,388.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3660" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:0.57072788px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 241.66724,387.20486 c 19.00094,0 38.00186,0 57.0028,0"- id="path3662" />- <path- id="path3664"- d="m 311.13671,388.55692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 381.13896,388.05692 c 19.9363,0 39.87259,0 59.80889,0"- id="path3666" />- <g- id="g10542"- transform="translate(1,27.999989)"- style="fill:#eeeeec;fill-opacity:1">- <rect- ry="4.480969"- y="329.55695"- x="450.04572"- height="60"- width="59.494934"- id="rect3630"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect8437"- width="59.494934"- height="30.943054"- x="450.04572"- y="329.55695"- ry="2.3109145" />- <path- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08917748999999997px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"- d="m 450.1367,360.55693 c 19.77181,0 39.54358,0 59.31538,0"- id="path3668" />- </g>- <path- id="path3670"- d="m 521.13896,388.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 591.13671,388.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3672" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 661.13671,388.55692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3674" />- <path- id="path3678"- d="m 731.5446,388.05692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- id="text3680"- y="379.6998"- x="244.62431"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="379.6998"- x="244.62431"- id="tspan3682"- sodipodi:role="line">D</tspan></text>- <text- id="text3684"- y="411.23273"- x="245.3418"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="411.23273"- x="245.3418"- id="tspan3686"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">d</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="317.80347"- y="409.5882"- id="text3688"><tspan- sodipodi:role="line"- id="tspan3690"- x="317.80347"- y="409.5882"- style="font-size:18px;font-family:DejaVu Sans Mono">f</tspan></text>- <text- id="text3692"- y="408.94226"- x="389.0748"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="408.94226"- x="389.0748"- id="tspan3694"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">g</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="458.34314"- y="408.17078"- id="text3696"><tspan- sodipodi:role="line"- id="tspan3698"- x="458.34314"- y="408.17078"- style="font-size:18px;font-family:DejaVu Sans Mono">h</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="528.9986"- y="409.12097"- id="text3700"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3702"- x="528.9986"- y="409.12097">j</tspan></text>- <text- id="text3704"- y="413.64285"- x="591.64008"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="413.64285"- x="591.64008"- id="tspan3706"- sodipodi:role="line">k</tspan></text>- <g- id="g10537"- transform="translate(1,27.999989)"- style="fill:#eeeeec;fill-opacity:1">- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect8447"- width="59.494934"- height="60"- x="660"- y="329"- ry="4.480969" />- <rect- ry="2.2404845"- y="359"- x="660"- height="30"- width="59.494934"- id="rect8449"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path8451"- d="m 660.3186,359.97316 c 19.77181,0 39.54358,0 59.31538,0"- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08917748999999997px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1" />- </g>- <text- id="text3708"- y="412.85968"- x="665.90234"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="412.85968"- x="665.90234"- id="tspan3710"- sodipodi:role="line">l</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="733.63672"- y="407.93781"- id="text3716"><tspan- sodipodi:role="line"- id="tspan3718"- x="733.63672"- y="407.93781"- style="font-size:18px;font-family:DejaVu Sans Mono">;</tspan></text>- <rect- ry="4.480969"- y="357.55695"- x="801.86169"- height="60"- width="59.494934"- id="rect3720"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3724"- d="m 801.95474,388.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3722"- width="129.00507"- height="60"- x="871.99487"- y="357.55692"- ry="4.480969" />- <rect- ry="2.2404845"- y="387.55692"- x="871.99487"- height="30"- width="129.00507"- id="rect7133"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.49844062px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 887.74259,388.05692 c 37.4221,0 74.84417,0 112.26621,0"- id="path3726" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="805.84375"- y="411.7171"- id="text3728"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3730"- x="805.84375"- y="411.7171">'</tspan></text>- <text- id="text3740"- y="396.10226"- x="872.17328"- style="font-size:20px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;text-align:start;line-height:125%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:Bitstream Vera Sans"- xml:space="preserve"- sodipodi:linespacing="125%"><tspan- y="396.10226"- x="872.17328"- id="tspan3742"- sodipodi:role="line">↲</tspan></text>- <path- id="path3758"- d="m 41.400804,317.01007 c 13.350921,0 26.701835,0 40.052755,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:0.89501685px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3764"- width="60"- height="60"- x="110.59211"- y="427.55695"- ry="4.480969" />- <rect- ry="4.480969"- y="427.55695"- x="181.04858"- height="60"- width="59.494934"- id="rect3766"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3770"- width="59.494934"- height="60"- x="321.04858"- y="427.55695"- ry="4.480969" />- <rect- ry="4.480969"- y="427.55695"- x="391.04593"- height="60"- width="59.494934"- id="rect3772"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- ry="4.480969"- y="427.55695"- x="461.04572"- height="60"- width="59.494934"- id="rect3778"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3780"- width="59.951477"- height="60"- x="741.45642"- y="427.55695"- ry="4.480969" />- <text- id="text3796"- y="479.65656"- x="119.84034"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="479.65656"- x="119.84034"- id="tspan3798"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">z</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="187.63174"- y="478.17078"- id="text3800"><tspan- sodipodi:role="line"- id="tspan3802"- x="187.63174"- y="478.17078"- style="font-size:18px;font-family:DejaVu Sans Mono">x</tspan></text>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 111.1902,457.55692 c 19.9363,0 39.87259,0 59.80889,0"- id="path3804" />- <path- id="path3806"- d="m 181.13671,458.05692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <rect- ry="4.480969"- y="427.55692"- x="250.5921"- height="60"- width="60.505096"- id="rect3768"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7145"- width="60.505096"- height="30"- x="250.5921"- y="427.55692"- ry="2.2404845" />- <path- id="path3808"- d="m 251.66724,457.20486 c 19.00094,0 38.00186,0 57.0028,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 321.13671,458.55692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3810" />- <path- id="path3812"- d="m 391.13896,458.05692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <rect- style="font-size:18px;fill:none;stroke:none"- id="rect10608"- width="59.494934"- height="28.556946"- x="461.04572"- y="459"- ry="2.1327131" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08917749px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 461.1367,458.55692 c 19.77181,0 39.54358,0 59.31538,0"- id="path3814" />- <g- id="g7140"- transform="translate(1,149.55692)"- style="fill:#eeeeec;fill-opacity:1">- <rect- ry="4.480969"- y="278"- x="530.0459"- height="60"- width="59.494934"- id="rect3774"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7131"- width="59.494934"- height="30"- x="530.0459"- y="308"- ry="2.2404845" />- <path- id="path3816"- d="m 530.13896,309 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.09369910000000004px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1" />- </g>- <g- id="g7162"- transform="translate(1,149.55692)"- style="fill:#eeeeec;fill-opacity:1">- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3776"- width="59.494934"- height="60"- x="600.04852"- y="278"- ry="4.480969" />- <rect- ry="2.2404845"- y="308"- x="600.04852"- height="30"- width="59.494934"- id="rect7160"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08920788999999996px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"- d="m 600.13671,308.5 c 19.7729,0 39.54579,0 59.31869,0"- id="path3818" />- </g>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 741.5446,458.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3822" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="255.6748"- y="479.58105"- id="text3828"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3830"- x="255.6748"- y="479.58105">c</tspan></text>- <text- id="text3832"- y="479.5882"- x="327.80347"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="479.5882"- x="327.80347"- id="tspan3834"- sodipodi:role="line">v</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="399.0748"- y="478.94226"- id="text3836"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3838"- x="399.0748"- y="478.94226">b</tspan></text>- <text- id="text3840"- y="479.05466"- x="464.4288"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="479.05466"- x="464.4288"- id="tspan3842"- sodipodi:role="line">n</tspan></text>- <text- id="text3844"- y="479.12097"- x="538.9986"- style="font-size:18px;font-style:normal;font-weight:normal;fill:url(#pattern5757);fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="479.12097"- x="538.9986"- id="tspan3846"- sodipodi:role="line"- style="font-size:18px;fill:url(#pattern5757);fill-opacity:1;font-family:DejaVu Sans Mono">m</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="604.58911"- y="478.8739"- id="text3848"><tspan- sodipodi:role="line"- id="tspan3850"- x="604.58911"- y="478.8739"- style="font-size:18px;font-family:DejaVu Sans Mono">,</tspan></text>- <g- id="g7167"- transform="translate(70.999996,149.55692)"- style="fill:#eeeeec;fill-opacity:1">- <rect- ry="4.480969"- y="278"- x="600.04852"- height="60"- width="59.494934"- id="rect7169"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7171"- width="59.494934"- height="30"- x="600.04852"- y="308"- ry="2.2404845" />- <path- id="path7173"- d="m 600.13671,308.5 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08920788999999996px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1" />- </g>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="674.70215"- y="478.5"- id="text3852"><tspan- sodipodi:role="line"- id="tspan3854"- x="674.70215"- y="478.5"- style="font-size:18px;font-family:DejaVu Sans Mono">.</tspan></text>- <text- id="text3856"- y="478.15964"- x="749.63989"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="478.15964"- x="749.63989"- id="tspan3858"- sodipodi:role="line">/</tspan></text>- <rect- ry="4.480969"- y="217.55692"- x="80.999992"- height="60"- width="60"- id="rect3876"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect10511"- width="59.494934"- height="60"- x="221.45648"- y="217.55692"- ry="4.480969" />- <rect- ry="4.480969"- y="217.55692"- x="291.45648"- height="60"- width="59.494934"- id="rect3882"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3884"- width="59.494934"- height="60"- x="361.45383"- y="217.55692"- ry="4.480969" />- <rect- ry="4.480969"- y="217.55692"- x="501.4538"- height="60"- width="59.494934"- id="rect3886"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3888"- width="59.494934"- height="60"- x="571.45642"- y="217.55692"- ry="4.480969" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3890"- width="59.494934"- height="60"- x="431.45361"- y="217.55692"- ry="4.480969" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3892"- width="59.494934"- height="60"- x="711"- y="217.55692"- ry="4.480969" />- <rect- ry="4.480969"- y="217.55692"- x="781.45642"- height="60"- width="59.494934"- id="rect3894"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- ry="4.480969"- y="217.55692"- x="641.45642"- height="60"- width="59.494934"- id="rect3896"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="84.176796"- y="270.28568"- id="text3910"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3912"- x="84.176796"- y="270.28568">1</tspan></text>- <text- id="text3914"- y="269.85934"- x="153.69238"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="269.85934"- x="153.69238"- id="tspan3916"- sodipodi:role="line">2</tspan></text>- <path- id="path3918"- d="m 81.598085,247.55692 c 19.936305,0 39.872595,0 59.808895,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 151.5446,248.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3920" />- <path- id="path3924"- d="m 291.5446,248.55692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 361.54685,248.05692 c 19.9363,0 39.87259,0 59.80889,0"- id="path3926" />- <path- id="path3928"- d="m 431.54459,248.55692 c 19.77181,0 39.54358,0 59.31538,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08917749px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- id="path3930"- d="m 501.54685,248.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 571.5446,248.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3932" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 641.5446,248.55692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3934" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 711.54685,248.55692 c 19.9363,0 39.87259,0 59.80889,0"- id="path3936" />- <path- id="path3938"- d="m 781.5446,248.05692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 221.5446,248.55692 c 19.7729,0 39.54579,0 59.31869,0"- id="path10513" />- <text- id="text3944"- y="269.85934"- x="225.5166"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="269.85934"- x="225.5166"- id="tspan3946"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">3</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="293.74707"- y="270.28568"- id="text3948"><tspan- sodipodi:role="line"- id="tspan3950"- x="293.74707"- y="270.28568"- style="font-size:18px;font-family:DejaVu Sans Mono">4</tspan></text>- <text- id="text3952"- y="269.74509"- x="363.74316"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="269.74509"- x="363.74316"- id="tspan3954"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">5</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="433.33203"- y="269.85934"- id="text3956"><tspan- sodipodi:role="line"- id="tspan3958"- x="433.33203"- y="269.85934"- style="font-size:18px;font-family:DejaVu Sans Mono">6</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="503.77832"- y="269.99997"- id="text3960"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3962"- x="503.77832"- y="269.99997">7</tspan></text>- <text- id="text3964"- y="269.74509"- x="573.84863"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="269.74509"- x="573.84863"- id="tspan3966"- sodipodi:role="line">8</tspan></text>- <text- id="text3968"- y="269.77789"- x="644.64673"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="269.77789"- x="644.64673"- id="tspan3970"- sodipodi:role="line">9</tspan></text>- <text- id="text3972"- y="269.53793"- x="713.83203"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="269.53793"- x="713.83203"- id="tspan3974"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">0</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3976"- width="59.494934"- height="60"- x="851.04852"- y="217.55692"- ry="4.480969" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 851.13671,248.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path3978" />- <rect- ry="4.480969"- y="217.55692"- x="11.456417"- height="60"- width="59.494934"- id="rect3980"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3982"- d="m 11.544604,248.05692 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="788.75385"- y="268.88504"- id="text3988"><tspan- sodipodi:role="line"- id="tspan3990"- x="788.75385"- y="268.88504"- style="font-size:18px;font-family:DejaVu Sans Mono">-</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="859.40649"- y="269.83527"- id="text3992"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3994"- x="859.40649"- y="269.83527">=</tspan></text>- <rect- ry="4.480969"- y="217.55692"- x="921.32385"- height="60"- width="89.135681"- id="rect3996"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3998"- d="m 921.6635,248.05692 c 29.34839,0 58.69676,0 88.0451,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.32699001px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- id="text4004"- y="266.37692"- x="931.37891"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="266.37692"- x="931.37891"- id="tspan4006"- sodipodi:role="line"- style="font-size:13px;font-family:DejaVu Sans Mono">Backspace</tspan></text>- <text- id="text4977"- y="244.12206"- x="84.680664"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="244.12206"- x="84.680664"- id="tspan4979"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">!</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="153.03964"- y="243.17078"- id="text4981"><tspan- sodipodi:role="line"- id="tspan4983"- x="153.03964"- y="243.17078"- style="font-size:18px;font-family:DejaVu Sans Mono">@</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="224.98242"- y="244.49998"- id="text4985"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan4987"- x="224.98242"- y="244.49998">#</tspan></text>- <text- id="text4989"- y="244.58817"- x="293.21136"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="244.58817"- x="293.21136"- id="tspan4991"- sodipodi:role="line">$</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="364.4827"- y="243.94225"- id="text4993"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan4995"- x="364.4827"- y="243.94225">%</tspan></text>- <text- id="text4997"- y="243.17078"- x="433.75104"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="243.17078"- x="433.75104"- id="tspan4999"- sodipodi:role="line">^</tspan></text>- <text- id="text5001"- y="244.12096"- x="504.40649"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="244.12096"- x="504.40649"- id="tspan5003"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">&</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="572.49701"- y="243.87389"- id="text5005"><tspan- sodipodi:role="line"- id="tspan5007"- x="572.49701"- y="243.87389"- style="font-size:18px;font-family:DejaVu Sans Mono">*</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="643.21814"- y="243.17076"- id="text5009"><tspan- sodipodi:role="line"- id="tspan5011"- x="643.21814"- y="243.17076"- style="font-size:18px;font-family:DejaVu Sans Mono">(</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="715.29938"- y="242.87096"- id="text5013"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan5015"- x="715.29938"- y="242.87096">)</tspan></text>- <rect- ry="4.3646927"- y="497.55695"- x="239.30771"- height="58.443066"- width="361.69229"- id="rect5017"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <text- xml:space="preserve"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="246.32532"- y="529.78864"- id="text5021"><tspan- sodipodi:role="line"- id="tspan5023"- x="246.32532"- y="529.78864">Space</tspan></text>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:0.86598694;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"- d="m 289.69581,526.77845 c 103.63515,0 207.27032,0 310.90547,0"- id="path5031" />- <text- id="text6971"- y="451.98907"- x="118.53249"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="451.98907"- x="118.53249"- id="tspan6973"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">Z</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="186.32391"- y="450.50333"- id="text6975"><tspan- sodipodi:role="line"- id="tspan6977"- x="186.32391"- y="450.50333"- style="font-size:18px;font-family:DejaVu Sans Mono">X</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="255.77832"- y="452.74512"- id="text6979"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan6981"- x="255.77832"- y="452.74512">C</tspan></text>- <text- id="text6983"- y="451.92072"- x="326.49564"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="451.92072"- x="326.49564"- id="tspan6985"- sodipodi:role="line">V</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="397.76697"- y="451.27481"- id="text6987"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan6989"- x="397.76697"- y="451.27481">B</tspan></text>- <text- id="text6991"- y="451.13467"- x="464.25739"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="451.13467"- x="464.25739"- id="tspan6993"- sodipodi:role="line">N</tspan></text>- <text- id="text6995"- y="451.45352"- x="537.6908"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="451.45352"- x="537.6908"- id="tspan6997"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">M</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="605.78131"- y="451.20645"- id="text6999"><tspan- sodipodi:role="line"- id="tspan7001"- x="605.78131"- y="451.20645"- style="font-size:18px;font-family:DejaVu Sans Mono"><</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="679.18103"- y="449.78903"- id="text7003"><tspan- sodipodi:role="line"- id="tspan7005"- x="679.18103"- y="449.78903"- style="font-size:18px;font-family:DejaVu Sans Mono">></tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="749.83368"- y="450.73923"- id="text7007"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7009"- x="749.83368"- y="450.73923">?</tspan></text>- <text- id="text7027"- y="381.57428"- x="385.14008"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="381.57428"- x="385.14008"- id="tspan7029"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">G</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="454.40842"- y="380.8028"- id="text7031"><tspan- sodipodi:role="line"- id="tspan7033"- x="454.40842"- y="380.8028"- style="font-size:18px;font-family:DejaVu Sans Mono">H</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="525.0639"- y="381.75299"- id="text7035"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7037"- x="525.0639"- y="381.75299">J</tspan></text>- <text- id="text7039"- y="380.69351"- x="592.94769"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="380.69351"- x="592.94769"- id="tspan7041"- sodipodi:role="line">K</tspan></text>- <text- id="text7043"- y="382.4007"- x="665.31641"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="382.4007"- x="665.31641"- id="tspan7045"- sodipodi:role="line">L</tspan></text>- <text- id="text7047"- y="380.88547"- x="733.49005"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="380.88547"- x="733.49005"- id="tspan7049"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">:</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="376.07617"- y="310.17899"- id="text7051"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7053"- x="376.07617"- y="310.17899">T</tspan></text>- <text- id="text7055"- y="309.87833"- x="445.88342"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="309.87833"- x="445.88342"- id="tspan7057"- sodipodi:role="line">Y</tspan></text>- <text- id="text7059"- y="309.62344"- x="514.93176"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="309.62344"- x="514.93176"- id="tspan7061"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">U</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="583.9151"- y="309.87833"- id="text7063"><tspan- sodipodi:role="line"- id="tspan7065"- x="583.9151"- y="309.87833"- style="font-size:18px;font-family:DejaVu Sans Mono">I</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="656.24341"- y="309.62344"- id="text7067"><tspan- sodipodi:role="line"- id="tspan7069"- x="656.24341"- y="309.62344"- style="font-size:18px;font-family:DejaVu Sans Mono">O</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="724.47168"- y="310.17899"- id="text7071"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7073"- x="724.47168"- y="310.17899">P</tspan></text>- <rect- ry="4.480969"- y="287.55692"- x="791.0459"- height="60"- width="59.494934"- id="rect7075"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7077"- width="59.494934"- height="60"- x="861.04852"- y="287.55692"- ry="4.480969" />- <rect- ry="4.480969"- y="287.55692"- x="931.04852"- height="60"- width="79.951477"- id="rect7079"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path7081"- d="m 791.13896,318.55692 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 861.13671,318.05692 c 19.7729,0 39.54579,0 59.31869,0"- id="path7083" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.25664687px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 931.31702,318.55692 c 26.31936,0 52.63871,0 78.95808,0"- id="path7085" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="793.43066"- y="339.6839"- id="text7087"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7089"- x="793.43066"- y="339.6839">[</tspan></text>- <text- id="text7091"- y="339.6839"- x="863.45898"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="339.6839"- x="863.45898"- id="tspan7093"- sodipodi:role="line">]</tspan></text>- <text- id="text7095"- y="340.17902"- x="932.0166"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="340.17902"- x="932.0166"- id="tspan7097"- sodipodi:role="line">\</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="793.10547"- y="309.2327"- id="text7099"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7101"- x="793.10547"- y="309.2327">{</tspan></text>- <text- id="text7103"- y="309.2327"- x="862.10547"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="309.2327"- x="862.10547"- id="tspan7105"- sodipodi:role="line">}</tspan></text>- <text- id="text7107"- y="307.8118"- x="932.3418"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="307.8118"- x="932.3418"- id="tspan7109"- sodipodi:role="line">|</tspan></text>- <flowRoot- xml:space="preserve"- id="flowRoot7111"- style="font-size:20px;font-family:DejaVu Sans Mono"><flowRegion- id="flowRegion7113"><rect- id="rect7115"- width="12.121831"- height="16.162441"- x="806.10175"- y="215.85266"- style="font-size:20px;font-family:DejaVu Sans Mono" /></flowRegion><flowPara- id="flowPara7117">'"l</flowPara></flowRoot> <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="804.70117"- y="382.27374"- id="text7119"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7121"- x="804.70117"- y="382.27374">"</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="19.835238"- y="270.55493"- id="text7123"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7125"- x="19.835238"- y="270.55493">`</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="18.527391"- y="242.88747"- id="text7127"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7129"- x="18.527391"- y="242.88747">~</tspan></text>- <flowRoot- xml:space="preserve"- id="flowRoot7342"- style="font-size:13px;font-family:DejaVu Sans Mono"><flowRegion- id="flowRegion7344"><rect- id="rect7346"- width="16.362942"- height="34.170197"- x="13.637059"- y="163.8298"- style="font-size:13px;font-family:DejaVu Sans Mono" /></flowRegion><flowPara- id="flowPara7348">TabTa</flowPara></flowRoot> <text- id="text7358"- y="320.61826"- x="11.98186"- style="font-size:12px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="320.61826"- x="11.98186"- id="tspan7360"- sodipodi:role="line"- style="font-size:12px;font-family:DejaVu Sans Mono">Tab</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none;stroke-width:1;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:1, 3;stroke-dashoffset:0;stroke-opacity:1"- id="rect10890"- width="317.01669"- height="39.126007"- x="12.98332"- y="35.686996"- ry="2.9220402" />- <text- id="text7404"- y="62.497929"- x="17.641596"- style="font-size:22px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:start;line-height:100%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- xml:space="preserve"- sodipodi:linespacing="100%"><tspan- y="62.497929"- x="17.641596"- id="tspan7406"- sodipodi:role="line">leksah-0.8 default bindings</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none;stroke-width:0.94688416;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:0.94688416, 2.84065247;stroke-dashoffset:0;stroke-opacity:1"- id="rect11866"- width="558.63818"- height="39.017399"- x="450.47345"- y="36.009155"- ry="2.9139295" />- <rect- ry="2.2404845"- y="40.60714"- x="522.39178"- height="30"- width="60.505096"- id="rect8456"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:#000000;stroke-width:0.50000000000000000;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />- <text- id="text8458"- y="58.433311"- x="551.8833"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- xml:space="preserve"- sodipodi:linespacing="125%"><tspan- y="58.433311"- x="551.8833"- id="tspan8460"- sodipodi:role="line"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans">Ctrl</tspan></text>- <rect- style="font-size:18px;fill:#fcaf3e;fill-opacity:1;stroke:#000000;stroke-width:0.5;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"- id="rect8462"- width="60.505096"- height="30"- x="592.39178"- y="40.60714"- ry="2.2404845" />- <text- sodipodi:linespacing="125%"- xml:space="preserve"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- x="622.5976"- y="58.433311"- id="text8464"><tspan- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans"- sodipodi:role="line"- id="tspan8466"- x="622.5976"- y="58.433311">Alt</tspan><tspan- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans"- sodipodi:role="line"- x="622.5976"- y="58.433311"- id="tspan7352" /></text>- <rect- style="font-size:18px;fill:#ad7fa8;fill-opacity:1;stroke:#000000;stroke-width:0.5;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"- id="rect8468"- width="60.505096"- height="30"- x="661.88666"- y="40.60714"- ry="2.2404845" />- <text- sodipodi:linespacing="125%"- xml:space="preserve"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- x="692.09253"- y="58.433311"- id="text8470"><tspan- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans"- sodipodi:role="line"- id="tspan8472"- x="692.09253"- y="58.433311">Windows</tspan></text>- <rect- ry="2.2404845"- y="40.60714"- x="732.39172"- height="30"- width="60.505096"- id="rect8480"- style="font-size:18px;fill:#8ae234;fill-opacity:1;stroke:#000000;stroke-width:0.5;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />- <text- id="text8482"- y="58.433311"- x="762.5976"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- xml:space="preserve"- sodipodi:linespacing="125%"><tspan- y="58.433311"- x="762.5976"- id="tspan8484"- sodipodi:role="line"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans">AltGr</tspan></text>- <rect- ry="2.2404845"- y="40.60714"- x="801.39172"- height="30"- width="60.505096"- id="rect8486"- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:#000000;stroke-width:0.5;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none" />- <text- id="text8488"- y="58.433311"- x="832.0976"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- xml:space="preserve"- sodipodi:linespacing="125%"><tspan- y="58.433311"- x="832.0976"- sodipodi:role="line"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans"- id="tspan8508">unmodified</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="481.83459"- y="470.37329"- id="text10610"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="481.83459"- y="470.37329"- id="tspan5592">New</tspan><tspan- sodipodi:role="line"- x="481.83459"- y="478.4733"- id="tspan5588">file</tspan><tspan- sodipodi:role="line"- x="481.83459"- y="486.5733"- id="tspan5590" /></text>- <text- sodipodi:linespacing="125%"- xml:space="preserve"- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans"- x="481.35913"- y="58.356812"- id="text11868"><tspan- style="font-size:10px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:condensed;text-align:center;line-height:125%;writing-mode:lr-tb;text-anchor:middle;font-family:DejaVu Sans"- sodipodi:role="line"- id="tspan11870"- x="481.35913"- y="58.356812">Modifiers</tspan></text>- <g- id="g14824"- transform="translate(-202,130)">- <path- id="rect14799"- d="m 885.46874,378.36166 c -14.1057,0 -25.46874,9.09042 -25.46874,20.375 l 0,19.625 100,0 0,-19.625 c 0,-11.28456 -11.36302,-20.375 -25.46876,-20.375 l -49.0625,0 z"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:0.88851714px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 925.55574,417.9174 c 0,-13.15772 0,-26.31543 0,-39.47314"- id="path14801" />- <path- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- d="M 885.46874,488.36166 C 871.36304,488.36166 860,472.45343 860,452.70541 l 0,-34.34375 100,0 0,34.34375 c 0,19.74798 -11.36302,35.65625 -25.46876,35.65625 l -49.0625,0 z"- id="path14810" />- <path- id="path14822"- d="m 894.44426,417.55574 c 0,-13.15772 0,-26.31543 0,-39.47314"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:0.88851714px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- </g>- <text- id="text14803"- y="565.6424"- x="689.66016"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="565.6424"- x="689.66016"- id="tspan14805"- sodipodi:role="line">mouse</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="675.77704"- y="330.5145"- id="text10610-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="675.77704"- y="330.5145"- id="tspan5588-9">Open</tspan><tspan- sodipodi:role="line"- x="675.77704"- y="338.6145"- id="tspan5634">file</tspan><tspan- sodipodi:role="line"- x="675.77704"- y="346.71451"- id="tspan5590-2" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="195.96628"- y="401.0015"- id="text10610-0"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="195.96628"- y="401.0015"- id="tspan5592-5">Save</tspan><tspan- sodipodi:role="line"- x="195.96628"- y="409.1015"- id="tspan5588-5">file</tspan><tspan- sodipodi:role="line"- x="195.96628"- y="417.20151"- id="tspan5590-0" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="194.87178"- y="367.56451"- id="text10610-0-8"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="194.87178"- y="367.56451"- id="tspan5592-5-2">Save</tspan><tspan- sodipodi:role="line"- x="194.87178"- y="375.66452"- id="tspan5724">all</tspan><tspan- sodipodi:role="line"- x="194.87178"- y="383.76453"- id="tspan5588-5-0">files</tspan><tspan- sodipodi:role="line"- x="194.87178"- y="391.8645"- id="tspan5590-0-5" /></text>- <text- xml:space="preserve"- style="font-size:40px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:Bitstream Vera Sans"- x="257.5"- y="316.5"- id="text5718"><tspan- sodipodi:role="line"- id="tspan5720"- x="257.5"- y="316.5"></tspan><tspan- sodipodi:role="line"- id="tspan5722" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="185.87177"- y="330.56451"- id="text10610-0-4"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="185.87177"- y="330.56451"- id="tspan5592-5-4">Close</tspan><tspan- sodipodi:role="line"- x="185.87177"- y="338.66452"- id="tspan5588-5-2">file</tspan><tspan- sodipodi:role="line"- x="185.87177"- y="346.76453"- id="tspan5590-0-9" /></text>- <text- sodipodi:linespacing="89.999998%"- id="text10763-4"- y="160.09349"- x="186.8539"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- xml:space="preserve"><tspan- id="tspan10765-4"- y="160.09349"- x="186.8539"- sodipodi:role="line">Move window</tspan><tspan- y="166.39349"- x="186.8539"- sodipodi:role="line"- id="tspan10767-3">to second</tspan><tspan- y="172.6935"- x="186.8539"- sodipodi:role="line"- id="tspan10769-8">workspace</tspan></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3878-1"- width="59.494934"- height="60"- x="152.72672"- y="150"- ry="4.480969" />- <text- sodipodi:linespacing="89.999998%"- id="text10699-9"- y="189.38791"- x="118.16354"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- xml:space="preserve"><tspan- id="tspan10701-8"- y="189.38791"- x="118.16354"- sodipodi:role="line">Switch to</tspan><tspan- y="195.68791"- x="118.16354"- sodipodi:role="line"- id="tspan10703-1">first</tspan><tspan- y="201.98792"- x="118.16354"- sodipodi:role="line"- id="tspan10705-5">workspace</tspan></text>- <text- xml:space="preserve"- style="font-size:7px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:center;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:middle;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="118.16354"- y="159.08333"- id="text10771-6"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="118.16354"- y="159.08333"- id="tspan10773-6">Move window</tspan><tspan- id="tspan10775-4"- sodipodi:role="line"- x="118.16354"- y="165.38333">to first</tspan><tspan- id="tspan10777-0"- sodipodi:role="line"- x="118.16354"- y="171.68332">workspace</tspan></text>- <rect- ry="4.480969"- y="150"- x="82.270233"- height="60"- width="60"- id="rect3876-4"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:none"- id="rect10511-4"- width="59.494934"- height="60"- x="222.72672"- y="150"- ry="4.480969" />- <rect- ry="4.480969"- y="150"- x="292.72672"- height="60"- width="59.494934"- id="rect3882-0"- style="font-size:18px;fill:#fcaf3e;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3884-3"- width="59.494934"- height="60"- x="362.72406"- y="150"- ry="4.480969" />- <rect- ry="4.480969"- y="150"- x="502.72403"- height="60"- width="59.494934"- id="rect3886-5"- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:none"- id="rect3888-9"- width="59.494934"- height="60"- x="572.72662"- y="150"- ry="4.480969" />- <rect- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:none"- id="rect3890-6"- width="59.494934"- height="60"- x="432.72385"- y="150"- ry="4.480969" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3892-7"- width="59.494934"- height="60"- x="712.2702"- y="150"- ry="4.480969" />- <rect- ry="4.480969"- y="150"- x="782.72662"- height="60"- width="59.494934"- id="rect3894-3"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- ry="4.480969"- y="150"- x="642.72662"- height="60"- width="59.494934"- id="rect3896-3"- style="font-size:18px;fill:#babdb6;fill-opacity:1;stroke:none" />- <path- id="path3918-6"- d="m 82.86832,180.00001 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 152.81483,180.50001 c 19.7729,0 39.54579,0 59.31869,0"- id="path3920-7" />- <path- id="path3924-6"- d="m 292.81483,181.00001 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 362.81708,180.50001 c 19.9363,0 39.87259,0 59.80889,0"- id="path3926-1" />- <path- id="path3928-3"- d="m 432.81482,181.00001 c 19.77181,0 39.54358,0 59.31538,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08917749px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- id="path3930-0"- d="m 502.81708,181.00001 c 19.9363,0 39.87259,0 59.80889,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 572.81483,180.50001 c 19.7729,0 39.54579,0 59.31869,0"- id="path3932-4" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 642.81483,181.00001 c 19.7729,0 39.54579,0 59.31869,0"- id="path3934-1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.0936991px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 712.81708,181.00001 c 19.9363,0 39.87259,0 59.80889,0"- id="path3936-3" />- <path- id="path3938-5"- d="m 782.81483,180.50001 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 222.81483,181.00001 c 19.7729,0 39.54579,0 59.31869,0"- id="path10513-9" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3976-0"- width="59.494934"- height="60"- x="852.31873"- y="150"- ry="4.480969" />- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 852.40694,180.50001 c 19.7729,0 39.54579,0 59.31869,0"- id="path3978-0" />- <rect- ry="4.480969"- y="150"- x="12.726654"- height="60"- width="59.494934"- id="rect3980-4"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3982-1"- d="m 12.81484,180.50001 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="790.02405"- y="201.32812"- id="text3988-6"><tspan- sodipodi:role="line"- id="tspan3990-3"- x="790.02405"- y="201.32812"- style="font-size:18px;font-family:DejaVu Sans Mono" /></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="860.6767"- y="202.27835"- id="text3992-9"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan3994-0"- x="860.6767"- y="202.27835" /></text>- <rect- ry="4.480969"- y="84"- x="921.59406"- height="60"- width="89.135681"- id="rect3996-6"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3998-1"- d="m 921.93373,114.50001 c 29.34839,0 58.69676,0 88.04507,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.32699001px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- id="text4004-6"- y="198.82001"- x="932.64911"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="198.82001"- x="932.64911"- id="tspan4006-8"- sodipodi:role="line"- style="font-size:13px;font-family:DejaVu Sans Mono" /></text>- <text- id="text4977-6"- y="176.56514"- x="85.950897"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="176.56514"- x="85.950897"- id="tspan4979-4"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">F1</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="154.30988"- y="175.61386"- id="text4981-9"><tspan- sodipodi:role="line"- id="tspan4983-4"- x="154.30988"- y="175.61386"- style="font-size:18px;font-family:DejaVu Sans Mono">F2</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="226.25266"- y="176.94307"- id="text4985-7"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan4987-7"- x="226.25266"- y="176.94307">F3</tspan></text>- <text- id="text4989-9"- y="177.03125"- x="294.4816"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="177.03125"- x="294.4816"- id="tspan4991-4"- sodipodi:role="line">F4</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="365.75293"- y="176.38533"- id="text4993-6"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan4995-3"- x="365.75293"- y="176.38533">F5</tspan></text>- <text- id="text4997-7"- y="175.61386"- x="435.02127"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- y="175.61386"- x="435.02127"- id="tspan4999-6"- sodipodi:role="line">F6</tspan></text>- <text- id="text5001-9"- y="176.56404"- x="505.67673"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="176.56404"- x="505.67673"- id="tspan5003-8"- sodipodi:role="line"- style="font-size:18px;font-family:DejaVu Sans Mono">F7</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="573.76721"- y="176.31697"- id="text5005-8"><tspan- sodipodi:role="line"- id="tspan5007-2"- x="573.76721"- y="176.31697"- style="font-size:18px;font-family:DejaVu Sans Mono">F8</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="644.48834"- y="175.61385"- id="text5009-6"><tspan- sodipodi:role="line"- id="tspan5011-4"- x="644.48834"- y="175.61385"- style="font-size:18px;font-family:DejaVu Sans Mono">F9</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="716.56958"- y="175.31404"- id="text5013-8"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan5015-7"- x="716.56958"- y="175.31404">F10</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="21.105469"- y="202.99802"- id="text7123-4"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7125-4"- x="21.105469"- y="202.99802" /></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="19.797638"- y="175.33055"- id="text7127-0"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7129-3"- x="19.797638"- y="175.33055">Esc</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="316.58353"- y="194.186"- id="text10610-0-4-0"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="316.58353"- y="194.186"- id="tspan5588-5-2-5">Quit</tspan><tspan- sodipodi:role="line"- x="316.58353"- y="202.28601"- id="tspan6083">Leksah</tspan><tspan- sodipodi:role="line"- x="316.58353"- y="210.386"- id="tspan5590-0-9-9" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="138.15128"- y="476.56451"- id="text10610-0-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="138.15128"- y="476.56451"- id="tspan5588-5-04">Undo</tspan><tspan- sodipodi:role="line"- x="138.15128"- y="484.66452"- id="tspan5590-0-4" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="204.84927"- y="475.73599"- id="text10610-0-7-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="204.84927"- y="475.73599"- id="tspan5588-5-04-6">Cut</tspan><tspan- sodipodi:role="line"- x="204.84927"- y="483.836"- id="tspan5590-0-4-5" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="275.07452"- y="476.6145"- id="text10610-0-7-7-8"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="275.07452"- y="476.6145"- id="tspan5588-5-04-6-7">Copy</tspan><tspan- sodipodi:role="line"- x="275.07452"- y="484.71451"- id="tspan5590-0-4-5-1" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="347.57452"- y="476.6145"- id="text10610-0-7-7-2"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="347.57452"- y="476.6145"- id="tspan5588-5-04-6-8">Paste</tspan><tspan- sodipodi:role="line"- x="347.57452"- y="484.71451"- id="tspan5590-0-4-5-0" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="466.34927"- y="307.23599"- id="text10610-0-7-8"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="466.34927"- y="307.23599"- id="tspan5588-5-04-0">Redo</tspan><tspan- sodipodi:role="line"- x="466.34927"- y="315.336"- id="tspan5590-0-4-3" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="123.84927"- y="397.23602"- id="text10610-0-7-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="123.84927"- y="397.23602"- id="tspan5588-5-04-2">Select</tspan><tspan- sodipodi:role="line"- x="123.84927"- y="405.33603"- id="tspan6266">all</tspan><tspan- sodipodi:role="line"- x="123.84927"- y="413.43604"- id="tspan6268">text</tspan><tspan- sodipodi:role="line"- x="123.84927"- y="421.53601"- id="tspan5590-0-4-6" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="683.34924"- y="401.73599"- id="text10610-0-7-9"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="683.34924"- y="401.73599"- id="tspan6298">Goto</tspan><tspan- sodipodi:role="line"- x="683.34924"- y="409.836"- id="tspan6444">line</tspan><tspan- sodipodi:role="line"- x="683.34924"- y="417.936"- id="tspan5590-0-4-1" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="247.20529"- y="160.53751"- id="text10610-0-7-9-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="247.20529"- y="160.53751"- id="tspan5588-5-04-9-7">Text</tspan><tspan- sodipodi:role="line"- x="247.20529"- y="168.63751"- id="tspan6298-2">search</tspan><tspan- sodipodi:role="line"- x="247.20529"- y="176.7375"- id="tspan5590-0-4-1-5">prev.</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="245.79079"- y="189.4875"- id="text10610-0-7-9-3-6"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="245.79079"- y="189.4875"- id="tspan5588-5-04-9-7-2">Text</tspan><tspan- sodipodi:role="line"- x="245.79079"- y="197.58751"- id="tspan6298-2-6">search</tspan><tspan- sodipodi:role="line"- x="245.79079"- y="205.6875"- id="tspan5590-0-4-1-5-5">next</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="334.20529"- y="401.53751"- id="text10610-0-7-9-2"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="334.20529"- y="401.53751"- id="tspan5588-5-04-9-3">Text</tspan><tspan- sodipodi:role="line"- x="334.20529"- y="409.63751"- id="tspan6298-8">search</tspan><tspan- sodipodi:role="line"- x="334.20529"- y="417.73752"- id="tspan5590-0-4-1-4" /></text>- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3780-8"- width="59.951477"- height="60"- x="949.45642"- y="500"- ry="4.480969" />- <g- id="g7162-6"- transform="matrix(1,0,0,1.0083333,208.99999,219.68332)"- style="fill:#eeeeec;fill-opacity:1">- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect3776-4"- width="59.494934"- height="60"- x="600.04852"- y="278"- ry="4.480969" />- <rect- ry="2.2404845"- y="308"- x="600.04852"- height="30"- width="59.494934"- id="rect7160-1"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 600.13671,308.5 c 19.7729,0 39.54579,0 59.31869,0"- id="path3818-3" />- </g>- <path- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.08920789px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"- d="m 949.54459,530.49999 c 19.7729,0 39.54579,0 59.31871,0"- id="path3822-5" />- <g- id="g7167-0"- transform="translate(278.99999,221.99999)"- style="fill:#eeeeec;fill-opacity:1">- <rect- ry="4.480969"- y="278"- x="600.04852"- height="60"- width="59.494934"- id="rect7169-4"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7171-6"- width="59.494934"- height="30"- x="600.04852"- y="308"- ry="2.2404845" />- <path- id="path7173-0"- d="m 600.13671,308.5 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08920788999999996px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1" />- </g>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="813.78131"- y="523.64954"- id="text6999-3"><tspan- sodipodi:role="line"- id="tspan7001-5"- x="813.78131"- y="523.64954"- style="font-size:18px;font-family:DejaVu Sans Mono">←</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="887.18103"- y="522.23212"- id="text7003-7"><tspan- sodipodi:role="line"- id="tspan7005-4"- x="887.18103"- y="522.23212"- style="font-size:18px;font-family:DejaVu Sans Mono">↓</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="957.83368"- y="523.18231"- id="text7007-9"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan7009-7"- x="957.83368"- y="523.18231">→</tspan></text>- <g- id="g7167-0-9"- transform="translate(278.20394,153)"- style="fill:#eeeeec;fill-opacity:1">- <rect- ry="4.480969"- y="278"- x="600.04852"- height="60"- width="59.494934"- id="rect7169-4-4"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <rect- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none"- id="rect7171-6-2"- width="59.494934"- height="30"- x="600.04852"- y="308"- ry="2.2404845" />- <path- id="path7173-0-3"- d="m 600.13671,308.5 c 19.7729,0 39.54579,0 59.31869,0"- style="font-size:18px;fill:#eeeeec;stroke:#000000;stroke-width:1.08920788999999996px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1" />- </g>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="887.58594"- y="451.25488"- id="text7003-7-5"><tspan- sodipodi:role="line"- id="tspan7005-4-6"- x="887.58594"- y="451.25488"- style="font-size:18px;font-family:DejaVu Sans Mono">↑</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="966.78882"- y="541.7605"- id="text10610-0-7-9-35"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="966.78882"- y="541.7605"- id="tspan6444-3">Comment</tspan><tspan- sodipodi:role="line"- x="966.78882"- y="549.86047"- id="tspan6624">line</tspan><tspan- sodipodi:role="line"- x="966.78882"- y="557.96051"- id="tspan6622" /><tspan- sodipodi:role="line"- x="966.78882"- y="566.06049"- id="tspan5590-0-4-1-55" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="816.78156"- y="543.06451"- id="text10610-0-7-9-35-4"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="816.78156"- y="543.06451"- id="tspan6444-3-8">Uncomment</tspan><tspan- sodipodi:role="line"- x="816.78156"- y="551.16449"- id="tspan6624-4">line</tspan><tspan- sodipodi:role="line"- x="816.78156"- y="559.26453"- id="tspan6622-7" /><tspan- sodipodi:role="line"- x="816.78156"- y="567.3645"- id="tspan5590-0-4-1-55-9" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="96.651283"- y="261.56451"- id="text10610-0-0"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="96.651283"- y="261.56451"- id="tspan5588-5-1">Collapse</tspan><tspan- sodipodi:role="line"- x="96.651283"- y="269.66452"- id="tspan6693">panes</tspan><tspan- sodipodi:role="line"- x="96.651283"- y="277.76453"- id="tspan6695" /><tspan- sodipodi:role="line"- x="96.651283"- y="285.8645"- id="tspan5590-0-41" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="171.17331"- y="258.33551"- id="text10610-0-0-4"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="171.17331"- y="258.33551"- id="tspan5588-5-1-8">Split</tspan><tspan- sodipodi:role="line"- x="171.17331"- y="266.43552"- id="tspan6693-2">panes</tspan><tspan- sodipodi:role="line"- x="171.17331"- y="274.53552"- id="tspan6731">horiz.</tspan><tspan- sodipodi:role="line"- x="171.17331"- y="282.6355"- id="tspan6695-8" /><tspan- sodipodi:role="line"- x="171.17331"- y="290.7355"- id="tspan5590-0-41-7" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="237.85728"- y="257.13599"- id="text10610-0-0-4-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="237.85728"- y="257.13599"- id="tspan5588-5-1-8-2">Split</tspan><tspan- sodipodi:role="line"- x="237.85728"- y="265.23599"- id="tspan6693-2-3">panes</tspan><tspan- sodipodi:role="line"- x="237.85728"- y="273.336"- id="tspan6731-8">vertical</tspan><tspan- sodipodi:role="line"- x="237.85728"- y="281.43597"- id="tspan6695-8-5" /><tspan- sodipodi:role="line"- x="237.85728"- y="289.53598"- id="tspan5590-0-41-7-2" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="390.70529"- y="331.53751"- id="text10610-0-7-9-2-1"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="390.70529"- y="331.53751"- id="tspan6298-8-6">Toggle</tspan><tspan- sodipodi:role="line"- x="390.70529"- y="339.63751"- id="tspan6803">toolbar</tspan><tspan- sodipodi:role="line"- x="390.70529"- y="347.73752"- id="tspan5590-0-4-1-4-0" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="410.67352"- y="470.58749"- id="text10610-0-7-7-2-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="410.67352"- y="470.58749"- id="tspan5590-0-4-5-0-5">Build</tspan><tspan- sodipodi:role="line"- x="410.67352"- y="478.6875"- id="tspan6863">package</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="318.87155"- y="331.33551"- id="text10610-0-7-7-2-7-8"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="318.87155"- y="331.33551"- id="tspan6863-6">Add</tspan><tspan- sodipodi:role="line"- x="318.87155"- y="339.43552"- id="tspan6912">imports</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="536.96625"- y="373.5015"- id="text10610-08"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="536.96625"- y="373.5015"- id="tspan5588-0">Previous</tspan><tspan- sodipodi:role="line"- x="536.96625"- y="381.6015"- id="tspan6965">error</tspan><tspan- sodipodi:role="line"- x="536.96625"- y="389.70151"- id="tspan5590-00" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="544.17352"- y="401.53751"- id="text10610-08-4"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="544.17352"- y="401.53751"- id="tspan5588-0-2">Next</tspan><tspan- sodipodi:role="line"- x="544.17352"- y="409.63751"- id="tspan6965-8">error</tspan><tspan- sodipodi:role="line"- x="544.17352"- y="417.73752"- id="tspan5590-00-9" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="300.67352"- y="540.08752"- id="text10610-0-7-7-2-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="300.67352"- y="540.08752"- id="tspan5588-5-04-6-8-0">Start completion</tspan><tspan- sodipodi:role="line"- x="300.67352"- y="548.1875"- id="tspan5590-0-4-5-0-1" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="254.15128"- y="304.76401"- id="text10610-0-7-7-8-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="254.15128"- y="304.76401"- id="tspan5588-5-04-6-7-0">Align</tspan><tspan- sodipodi:role="line"- x="254.15128"- y="312.86401"- id="tspan7054">=</tspan><tspan- sodipodi:role="line"- x="254.15128"- y="320.96402"- id="tspan5590-0-4-5-1-8" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="323.23206"- y="300.879"- id="text10610-0-7-7-8-3-5"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="323.23206"- y="300.879"- id="tspan5588-5-04-6-7-0-4">Align</tspan><tspan- sodipodi:role="line"- x="323.23206"- y="308.979"- id="tspan7054-2">-></tspan><tspan- sodipodi:role="line"- x="323.23206"- y="317.07901"- id="tspan5590-0-4-5-1-8-7" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="681.73206"- y="368.50101"- id="text10610-0-7-7-8-3-5-0"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="681.73206"- y="368.50101"- id="tspan5588-5-04-6-7-0-4-3">Align</tspan><tspan- sodipodi:role="line"- x="681.73206"- y="376.60101"- id="tspan7054-2-9"><-</tspan><tspan- sodipodi:role="line"- x="681.73206"- y="384.70099"- id="tspan5590-0-4-5-1-8-7-5" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="394.73206"- y="301.99649"- id="text10610-0-7-7-8-3-5-2"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="394.73206"- y="301.99649"- id="tspan5588-5-04-6-7-0-4-6">Align</tspan><tspan- sodipodi:role="line"- x="394.73206"- y="310.0965"- id="tspan7054-2-7">::</tspan><tspan- sodipodi:role="line"- x="394.73206"- y="318.1965"- id="tspan5590-0-4-5-1-8-7-0" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="447.7908"- y="191.9875"- id="text10610-0-7-9-3-6-2"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="447.7908"- y="191.9875"- id="tspan5590-0-4-1-5-5-6">Debug</tspan><tspan- sodipodi:role="line"- x="447.7908"- y="200.08751"- id="tspan7200">step</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="518.9845"- y="190.33549"- id="text10610-0-7-9-3-6-2-4"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="518.9845"- y="190.33549"- id="tspan5590-0-4-1-5-5-6-2">Debug</tspan><tspan- sodipodi:role="line"- x="518.9845"- y="198.4355"- id="tspan7200-2">step</tspan><tspan- sodipodi:role="line"- x="518.9845"- y="206.53549"- id="tspan7230">local</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="587.98456"- y="190.33549"- id="text10610-0-7-9-3-6-2-2"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="587.98456"- y="190.33549"- id="tspan5590-0-4-1-5-5-6-0">Debug</tspan><tspan- sodipodi:role="line"- x="587.98456"- y="198.4355"- id="tspan7200-9">step</tspan><tspan- sodipodi:role="line"- x="587.98456"- y="206.53549"- id="tspan7245">module</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="653.61926"- y="190.636"- id="text10610-0-7-9-3-6-2-2-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="653.61926"- y="190.636"- id="tspan5590-0-4-1-5-5-6-0-7">Debug</tspan><tspan- sodipodi:role="line"- x="653.61926"- y="198.73601"- id="tspan7245-0">continue</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="554.96631"- y="468.0015"- id="text10610-5"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="554.96631"- y="468.0015"- id="tspan5588-90">Update</tspan><tspan- sodipodi:role="line"- x="554.96631"- y="476.1015"- id="tspan7313">meta-</tspan><tspan- sodipodi:role="line"- x="554.96631"- y="484.20151"- id="tspan7315">dat</tspan><tspan- sodipodi:role="line"- x="554.96631"- y="492.30148"- id="tspan5590-6" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="910.24579"- y="398.56451"- id="text10610-0-7-9-6"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="910.24579"- y="398.56451"- id="tspan6444-8">Execute</tspan><tspan- sodipodi:role="line"- x="910.24579"- y="406.66452"- id="tspan7350">selection</tspan><tspan- sodipodi:role="line"- x="910.24579"- y="414.76453"- id="tspan5590-0-4-1-2" /></text>- <text- xml:space="preserve"- style="font-size:40px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:Bitstream Vera Sans"- x="341"- y="170"- id="text7354"><tspan- sodipodi:role="line"- id="tspan7356"></tspan></text>- <text- xml:space="preserve"- style="font-size:40px;font-style:normal;font-weight:normal;line-height:125%;fill:#000000;fill-opacity:1;stroke:none;font-family:Bitstream Vera Sans"- x="865"- y="628"- id="text7389"- sodipodi:linespacing="125%"><tspan- sodipodi:role="line"- id="tspan7391"- x="865"- y="628"- style="font-size:18px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;text-align:start;line-height:125%;writing-mode:lr-tb;text-anchor:start;font-family:Andale Mono;-inkscape-font-specification:Andale Mono">www.leksah.org</tspan></text>- <text- id="text4004-1"- y="105.58643"- x="926.6626"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="105.58643"- x="926.6626"- id="tspan4006-7"- sodipodi:role="line"- style="font-size:13px;font-family:DejaVu Sans Mono">PageUp</tspan></text>- <rect- ry="4.480969"- y="151"- x="920.59406"- height="60"- width="89.135681"- id="rect3996-6-8"- style="font-size:18px;fill:#eeeeec;fill-opacity:1;stroke:none" />- <path- id="path3998-1-4"- d="m 920.93374,181.50001 c 29.34839,0 58.69676,0 88.04506,0"- style="font-size:18px;fill:none;stroke:#000000;stroke-width:1.32699001px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" />- <text- id="text4004-1-1"- y="172.58643"- x="925.6626"- style="font-size:13px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- xml:space="preserve"><tspan- y="172.58643"- x="925.6626"- id="tspan4006-7-7"- sodipodi:role="line"- style="font-size:13px;font-family:DejaVu Sans Mono">PageDown</tspan></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="41.583527"- y="326.686"- id="text10610-0-4-7"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="41.583527"- y="326.686"- id="tspan5588-5-2-0">Flip</tspan><tspan- sodipodi:role="line"- x="41.583527"- y="334.78601"- id="tspan7482">buffer</tspan><tspan- sodipodi:role="line"- x="41.583527"- y="342.88602"- id="tspan5590-0-9-1" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="39.975288"- y="297.186"- id="text10610-0-4-7-3"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="39.975288"- y="297.186"- id="tspan5588-5-2-0-4">Flip</tspan><tspan- sodipodi:role="line"- x="39.975288"- y="305.28601"- id="tspan7482-6">buffer</tspan><tspan- sodipodi:role="line"- x="39.975288"- y="313.38602"- id="tspan7515">reverse</tspan><tspan- sodipodi:role="line"- x="39.975288"- y="321.48599"- id="tspan5590-0-9-1-6" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="942.37152"- y="191.136"- id="text10610-0-4-7-3-5"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="942.37152"- y="191.136"- id="tspan5588-5-2-0-4-3">Flip</tspan><tspan- sodipodi:role="line"- x="942.37152"- y="199.23601"- id="tspan7482-6-9">buffer</tspan><tspan- sodipodi:role="line"- x="942.37152"- y="207.336"- id="tspan7515-7">reverse</tspan><tspan- sodipodi:role="line"- x="942.37152"- y="215.436"- id="tspan5590-0-9-1-6-5" /></text>- <text- xml:space="preserve"- style="font-size:9px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:89.99999762%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;font-family:TlwgTypewriter"- x="941.97534"- y="128.686"- id="text10610-0-4-7-33"- sodipodi:linespacing="89.999998%"><tspan- sodipodi:role="line"- x="941.97534"- y="128.686"- id="tspan5588-5-2-0-0">Flip</tspan><tspan- sodipodi:role="line"- x="941.97534"- y="136.78601"- id="tspan7482-1">buffer</tspan><tspan- sodipodi:role="line"- x="941.97534"- y="144.886"- id="tspan5590-0-9-1-9" /></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="790.31396"- y="174.55225"- id="text5013-8-8"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan5015-7-8"- x="790.31396"- y="174.55225">F11</tspan></text>- <text- xml:space="preserve"- style="font-size:18px;font-style:normal;font-weight:normal;fill:#000000;fill-opacity:1;stroke:none;font-family:DejaVu Sans Mono"- x="861.31396"- y="173.55225"- id="text5013-8-5"><tspan- style="font-size:18px;font-family:DejaVu Sans Mono"- sodipodi:role="line"- id="tspan5015-7-0"- x="861.31396"- y="173.55225">F12</tspan></text>- </g>-</svg>
− doc/leksah_manual.lyx
@@ -1,5814 +0,0 @@-#LyX 1.6.5 created this file. For more info see http://www.lyx.org/-\lyxformat 345-\begin_document-\begin_header-\textclass scrartcl-\use_default_options false-\language english-\inputencoding auto-\font_roman default-\font_sans default-\font_typewriter default-\font_default_family default-\font_sc false-\font_osf false-\font_sf_scale 100-\font_tt_scale 100--\graphics default-\paperfontsize default-\spacing single-\use_hyperref false-\papersize a4paper-\use_geometry false-\use_amsmath 1-\use_esint 0-\cite_engine basic-\use_bibtopic false-\paperorientation portrait-\secnumdepth 3-\tocdepth 2-\paragraph_separation indent-\defskip medskip-\quotes_language english-\papercolumns 1-\papersides 1-\paperpagestyle default-\tracking_changes false-\output_changes false-\author "" -\author "" -\end_header--\begin_body--\begin_layout Title-Leksah: An Integrated Development Environment for Haskell-\begin_inset Newline newline-\end_inset--Version 0.8-\end_layout--\begin_layout Author-Jürgen Nicklisch-Franken-\begin_inset Newline newline-\end_inset--Hamish Mackenzie-\begin_inset Newline newline-\end_inset--edited for v.- 0.8: Andrew U.- Frank and Christian Gruber-\end_layout--\begin_layout Standard-\begin_inset CommandInset toc-LatexCommand tableofcontents--\end_inset---\end_layout--\begin_layout Standard-\begin_inset FloatList figure--\end_inset---\end_layout--\begin_layout Section*-License-\end_layout--\begin_layout Standard-Leksah has been put under the GNU GENERAL PUBLIC LICENSE Version 2.- The full license text can be found in the file data/LICENSE in the distribution.-\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-Introduction-\end_layout--\begin_layout Standard-Leksah is an IDE (Integrated Development Environment) for the programming- language Haskell.- It is written in Haskell and integrates various tools available for writing- programs in Haskell: the GHC compiler and interpreter, the CABAL package- management system (the Common Architecture for Building Applications and- Libraries), Haddock for producing documentation, etc.- in one, single, comprehensive and easy to use environment.- It allows the developer to concentrate on writing the program and Leksah- gives him easy access to all information she needs and helps with the necessary- housekeeping for compiling, linking and package management.- -\end_layout--\begin_layout Standard-A unified focus for translating source code to executable programs: Leksah- introduces the notion of a workspace that can include several packages- transparently: to the programmer it appears as if there were a single program- with a simple -\begin_inset Quotes eld-\end_inset--make-\begin_inset Quotes erd-\end_inset-- command.- Leksah manages rebuilding and installing packages as far as desired automatical-ly.- -\end_layout--\begin_layout Standard-Support for writing source code: Leksah supports debugging with GHCi, evaluation- of expressions, gathering type information, setting breakpoints, displays- values at breakpoints, etc.- is all possible from within Leksah.-\end_layout--\begin_layout Standard-Last, but not least, Leksah collects information about installed packages,- helps to find function names and their type and offers an auto-completion- feature while you type new code.-\end_layout--\begin_layout Standard-The features of Leksah often reflect directly features of the Haskell tools- used; therefore, to understand behavior in special cases needs sometimes- reading the specific documentation of GHC, Cabal or Haddock, (and this- manual, to a degree repeats what is found, with more detail and authority,- in the respective tool documentation).-\end_layout--\begin_layout Standard-Leksah is written in Haskell, which means the Leksah developers use Leksah- to develop Leksah and users of Leksah can read the code and contribute- improvements.- Leksah uses GTK+ as GUI Toolkit with the gtk2hs binding.- It is platform independent and runs on any platform where GTK+, gtk2hs- and GHC can be installed.- It is used on Linux, Windows and Mac.- -\end_layout--\begin_layout Standard-This document is a reference to the functionality of Leksah, it is not intended- to be a tutorial.- Since Leksah is still under development the information may be incomplete- or superseded.-\end_layout--\begin_layout Standard-The current version is 0.8.-\end_layout--\begin_layout Subsection-Further Information-\end_layout--\begin_layout Standard-The home page for Leksah is -\begin_inset CommandInset href-LatexCommand href-name "leksah.org"-target "http://leksah.org"--\end_inset--.- Stable version of Leksah can be installed from Hackage -\begin_inset CommandInset href-LatexCommand href-name "hackage.haskell.org/package/leksah"-target "http://hackage.haskell.org/package/leksah"--\end_inset--using Cabal install.- The source code for Leksah is hosted under -\begin_inset CommandInset href-LatexCommand href-name "code.haskell.org/leksah"-target "http://code.haskell.org/leksah"--\end_inset-- and -\begin_inset CommandInset href-LatexCommand href-name "code.haskell.org/leksah-head"-target "http://code.haskell.org/leksah-head"--\end_inset--.- The Leksah user Wiki is -\begin_inset CommandInset href-LatexCommand href-name "haskell.org/haskellwiki/Leksah"-target "http://haskell.org/haskellwiki/Leksah"--\end_inset--.- The Leksah forum can be accessed at -\begin_inset CommandInset href-LatexCommand href-name "groups.google.com/group/leksah/topics"-target "http://groups.google.com/group/leksah/topics"--\end_inset--.- The current version of this manual can be found at -\begin_inset CommandInset href-LatexCommand href-name "leksah.org/leksah_manual.pdf"-target "http://leksah.org/leksah_manual.pdf"--\end_inset--.- An issue tracker to collect bug reports and suggestions for improvements- is at -\begin_inset CommandInset href-LatexCommand href-name "code.google.com/p/leksah/issues/list"-target "http://code.google.com/p/leksah/issues/list"--\end_inset--.- You can contact the developers at -\begin_inset CommandInset href-LatexCommand href-name "info (at) leksah.org"-target "info@leksah.org"-type "mailto:"--\end_inset--.- -\end_layout--\begin_layout Standard-For information about the Programming language Haskell go to -\begin_inset CommandInset href-LatexCommand href-name "www.haskell.org"-target "http://www.haskell.org"--\end_inset--.- The GHC computer is found at -\begin_inset CommandInset href-LatexCommand href-name "www.haskell.org/ghc"-target "http://www.haskell.org/ghc"--\end_inset--.- For information about gtk2hs -\begin_inset CommandInset href-LatexCommand href-name "www.haskell.org/gtk2hs/"-target "http://www.haskell.org/gtk2hs/"--\end_inset--.- For information about GTK+ go to -\begin_inset CommandInset href-LatexCommand href-name "www.gtk.org"-target "http://www.gtk.org"--\end_inset--.- -\end_layout--\begin_layout Subsection-Release Notes-\end_layout--\begin_layout Subsubsection-Version 0.8 Release March 2010-\end_layout--\begin_layout Standard-The 0.8 release adds the notion of workspaces to allow develop comfortably- projects, where part of the code is in separate packages.- This changes the handling of packages to a degree, which has been improved- with introducing suitable defaults: a simple, single-shot program can be- started with very few clicks and entering not much more than the name of- the program; Leksah becomes usable even for just quickly testing an idea.- Other changes include:-\end_layout--\begin_layout Itemize-Better metadata with non exported definitions for workspace packages-\end_layout--\begin_layout Itemize-Support for prebuild metadata packages-\end_layout--\begin_layout Itemize-Better completion (keywords, language extensions, module name, non exported- definitions)-\end_layout--\begin_layout Itemize-Splittet in a client and server part (Client part doesn't import ghc-api)-\end_layout--\begin_layout Itemize-Added support for Ghc 6.12-\end_layout--\begin_layout Itemize-Prepared for Yi (Abstract TextEditor interface, not ready for use)-\end_layout--\begin_layout Itemize-Various other changes improve usability and stability of the platform.- -\end_layout--\begin_layout Standard-A large number of bugs has been fixed, but there remain, probably a large- number of, bugs - some old and not yet fixed and some new ones.- We expect also to improve and streamline the user interface in the next- minor release to achieve more consistency and make Leksah easier to learn.- You may see comments to this effect in this document, suggesting possible- changes in the interface.- Your opinion on these and other possible improvements you see will be highly- appreciated! -\end_layout--\begin_layout Standard-Version 0.8 works with GHC 6.10 and 6.12.- The installation is described in -\begin_inset CommandInset ref-LatexCommand prettyref-reference "sec:Installing-Leksah"--\end_inset-- for the standard case, more up to date information on installation may- be found on the Wiki -\begin_inset CommandInset href-LatexCommand href-name "haskell.org/haskellwiki/Leksah"-target "http://haskell.org/haskellwiki/Leksah"--\end_inset--.- If you have any trouble installing, please check the Wiki, the forum or- contact the developers to find a solution.- A smooth implementation is a priority for us and we like to hear about- difficulties you encounter to fix them; please report them on the bug and- issues tracker -\begin_inset CommandInset href-LatexCommand href-name "code.google.com/p/leksah/issues/list"-target "http://code.google.com/p/leksah/issues/list"--\end_inset--.-\end_layout--\begin_layout Subsubsection-Version 0.6 Beta Release Juli 2009-\end_layout--\begin_layout Standard-The 0.6 version introduces an interpreter/debugger mode.- This mode can be switched on and off from the toolbar.- In interpreter/debugger mode expressions can be evaluated and the type- of expressions can be dynamically shown.- The GHCi debugger is integrated, so that breakpoints can be set, it is- possible to step through the code, observe the values of variables and- trace the execution history.- -\end_layout--\begin_layout Standard-The other features of Leksah like building in the background and reporting- errors on the fly work in debugger mode as in compiler mode (but not configurin-g, installing, etc.- of packages).-\end_layout--\begin_layout Standard-Another new feature is integration of grep and text search with regular- expression.- This can be accessed from the findbar.-\end_layout--\begin_layout Standard-The GUI framework has been enhanced, so that layouts can be nested in so- called group panes.- This feature is used for the debugger pane.- Furthermore notebooks can be detached, so that Leksah can be used on multiple- screens.-\end_layout--\begin_layout Standard-A lot of little enhancements has been made and numerous bugs has been fixed.-\end_layout--\begin_layout Standard-Known bugs and problems:-\end_layout--\begin_layout Itemize-The package editor works only for cabal files without configurations.-\end_layout--\begin_layout Itemize-MS Windows: The check for external modifications of source files does not- work.-\end_layout--\begin_layout Itemize-MS Windows: Interruption of a background build does not work.-\end_layout--\begin_layout Itemize-GUI History still not working.-\end_layout--\begin_layout Itemize-Traces pane of the Debugger does not work appropriately.-\end_layout--\begin_layout Subsubsection-Version 0.4 Beta Release February/March 2009-\end_layout--\begin_layout Standard-The 0.4 Release is the first beta release of Leksah.- It should be usable for practical work for the ones that wants to engage- with it.-\end_layout--\begin_layout Standard-It depends on GHC -\begin_inset Formula $\geq$-\end_inset--6.10.1 and gtk2hs -\begin_inset Formula $\geq$-\end_inset-- 0.10.0.-\end_layout--\begin_layout Standard-The class pane and the history feature are not quite ready, so we propose- not to use it yet.- -\end_layout--\begin_layout Subsubsection-Version 0.1 Alpha Release February 2008 -\end_layout--\begin_layout Standard-This is a pre-release of Leksah.- The editor for Cabal Files is not ready, so we propose not to use it yet.- w-\end_layout--\begin_layout Standard-\begin_inset Newpage pagebreak-\end_inset---\end_layout--\begin_layout Section-Installing Leksah-\begin_inset CommandInset label-LatexCommand label-name "sec:Installing-Leksah"--\end_inset---\end_layout--\begin_layout Subsection-How to Install: Brief Instructions -\end_layout--\begin_layout Standard-You can install from -\end_layout--\begin_layout Itemize-a binary installer for your operating system, which is typically Windows- or Macintosh.- -\end_layout--\begin_layout Itemize-a package for your platform, which is currently Arch Linux and Fedora Linux,- and Debian(Ubuntu) is in preparation.-\end_layout--\begin_layout Itemize-install from sources from Hackage via -\family typewriter-\emph on-cabal install leksah-\end_layout--\begin_layout Itemize-leksah or leksah-head development repositories.- (If you want the very last or want to help with Leksah development).- -\end_layout--\begin_layout Standard-You can consult the Download page for up-to date information and try the- user Wiki for further help.-\end_layout--\begin_layout Subsection-Microsoft Windows-\end_layout--\begin_layout Enumerate-Install Haskell Platform with an installer for Windows (alternatively install- Ghc directly)-\end_layout--\begin_layout Enumerate-Make sure wget and grep are on the path of your Windows shell-\end_layout--\begin_layout Enumerate-Install Leksah from the most recent binary installer for Windows.-\end_layout--\begin_layout Enumerate-Go to the post installation section.-\end_layout--\begin_layout Subsection-Mac OS X-\end_layout--\begin_layout Enumerate-Install Haskell Platform with an installer for Mac OS X (alternatively install- Ghc directly)-\end_layout--\begin_layout Enumerate-Make sure wget and grep are on the path.-\end_layout--\begin_layout Enumerate-Install Leksah from the most recent binary installer for Mac-\end_layout--\begin_layout Enumerate-Go to the post installation section.-\end_layout--\begin_layout Subsection-Linux from Distro Packages-\end_layout--\begin_layout Enumerate-Install Leksah with the package management system of your Linux platform,- which should pull all prerequisites automatically.-\end_layout--\begin_layout Enumerate-Go to the post installation section.-\end_layout--\begin_layout Subsection-Install from Hackage-\end_layout--\begin_layout Enumerate-Install Haskell Platform (alternatively install Ghc directly, install Cabal- and cabal-install)-\end_layout--\begin_layout Enumerate-Install gtk2hs in a version compatible with the installed Ghc compiler (Currentl-y gtk2hs can't be installed via Hackage, but this should be possible in- the near future, so that you don't have to care about this step any more).- Make sure the gtk2hs gtksourceview2 package gets built and installed.-\end_layout--\begin_layout Enumerate-open a Console and do:-\end_layout--\begin_deeper-\begin_layout LyX-Code-cabal update-\begin_inset Newline newline-\end_inset--cabal install leksah-\end_layout--\end_deeper-\begin_layout Enumerate-Go to the post installation section.-\end_layout--\begin_layout Subsection-Post Installation steps-\end_layout--\begin_layout Enumerate-Until the next release of gtk2hs, for a pleasant visual appearance, you- have to copy or append the .gtkrc-2.0 file from the Leksah data folder or- from the data folder in Leksah sources to your home folder.- If you miss the step, the cross [x] buttons on tabs are almost invisible- (or don't fit in tabs).- This step may become obsolete during the 0.8 release cycle.-\end_layout--\begin_deeper-\begin_layout LyX-Code-cd ~ -\begin_inset Newline newline-\end_inset--wget http://code.haskell.org/leksah/leksah/data/.gtkrc-2.0 -O -\begin_inset Newline newline-\end_inset-- .gtkrc-2.0-leksah-\begin_inset Newline newline-\end_inset--echo -e '-\backslash-ninclude ".gtkrc-2.0-leksah"' >> .gtkrc-2.0 -\end_layout--\end_deeper-\begin_layout Enumerate-Before you start Leksah for the first time, do a:-\end_layout--\begin_deeper-\begin_layout LyX-Code-ghc-pkg recache-\end_layout--\begin_layout Standard-It has been observed, that a package recache is often necessary after installati-on.- The symptom is an empty Module Browser, if you select the System scope.-\end_layout--\end_deeper-\begin_layout Subsection-First start of Leksah-\end_layout--\begin_layout Standard-The first time you start Leksah it will take you through the follow steps:-\end_layout--\begin_layout Enumerate-You are asked to fill in a form telling Leksah where your Haskell sources- are (if you are not sure or just want to test, you can accept the defaults- and correct them later in the -\begin_inset Quotes eld-\end_inset--metadata-\begin_inset Quotes erd-\end_inset-- preferences)-\end_layout--\begin_layout Enumerate-Leksah collects -\begin_inset Quotes eld-\end_inset--metadata-\begin_inset Quotes erd-\end_inset--, i.e.- exported symbols and their type, comments explaining them etc.- for all installed packages on your machine.- This step may take a while and may give no feedback or a lot of strange- errors and warnings, don't worry but be patient.-\end_layout--\begin_layout Enumerate-The Leksah IDE starts and you can start working.-\end_layout--\begin_layout Standard-Later starts will read in the previously collected metadata and check only- for changes.- After starting up, Leksah will open its Main window in a standard configuration.-\end_layout--\begin_layout Standard-Progress on your first contact with Leksah:-\end_layout--\begin_layout Enumerate-Start with the, infamous, -\begin_inset Quotes eld-\end_inset--Hello World-\begin_inset Quotes erd-\end_inset-- example.- The next section gives you a step by step description.-\end_layout--\begin_layout Enumerate-Then it might be the best to construct a workspace and add an existing project- and explore Leksah while you work on it.- -\end_layout--\begin_layout Subsection-First start dialog-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_first_start.png- lyxscale 50- width 90text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:FirstStart-dialog"--\end_inset--First-Start dialog-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-When you start Leksah for the first time it must collect the information- about the packages you have on your computer and may use in your projects.- The first start dialog let you enter settings about this process.- Leksah then collects information about exported symbols, their type and- possible comments (collectively called metadata) to support your work,- e.g.- by suggesting auto-completion and type information about functions you- may use while you edit your source.-\end_layout--\begin_layout Standard-Later you can change this settings in the preferences pane in Leksah and- you can rebuild the metadata at any time.- -\family typewriter-leksah-server -sbo +RTS -N2-\family default- from the console.- Details about metadata collection can be found here: -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Metadata-collection"--\end_inset--.-\end_layout--\begin_layout Standard-If you want to start from scratch again delete or rename the .leksah-*.* folder- in your home folder.- Then you will see the first start dialog again.-\end_layout--\begin_layout Standard-In the first start dialog you are asked for:-\end_layout--\begin_layout Enumerate-The location of folders, where Haskell source code for installed packages- can be found.- This is important for packages which can't be found on Hackage.- -\end_layout--\begin_layout Enumerate-Maybe a directory, where Leksah will unpack source files for packages.- If you give no directory here, Leksah will not try to unpack the sources.-\end_layout--\begin_layout Enumerate-Some packages are difficult to process with Haddock.- So we provide some prebuild metadata.- If you allow this, Leksah will look for prebuild metadata, if sources are- available, but Haddock fails to process.- -\end_layout--\begin_layout Enumerate-The port number used for the local connection to the Leksah server.- -\end_layout--\begin_layout Enumerate-By default the Leksah server terminates with the last connection.- You can change this setting here.-\end_layout--\begin_layout Standard-Leksah collects information about all installed packages on your system- that will take some time (minutes to half an hour) the first time.- Errors occuring in this metadata collection step indicate only that Leksah- has not succeeded to extract the source locations and comments from a module- or package; they are not consequential, except that some metainformation- may be missing.- The metadata is cached and future starts only scan newly installed packages,- starts only information for new packages will be installed.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_welcome.png- lyxscale 50- width 100text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Leksah after first start-\end_layout--\end_inset---\end_layout--\begin_layout Plain Layout--\end_layout--\end_inset---\end_layout--\begin_layout Standard-\begin_inset Newpage pagebreak-\end_inset---\end_layout--\begin_layout Section-Hello World example-\end_layout--\begin_layout Itemize-Workspace -> New.- Constructs a new workspace in a selected folder and give it a name (e.g.- -\begin_inset Quotes eld-\end_inset--Hello-\begin_inset Quotes erd-\end_inset--).- This produces a file Hello.lkshw.-\end_layout--\begin_layout Itemize-Package -> New and use the "Create Folder" button to make a new folder for- the package.- Make sure to be in this folder when you click -\begin_inset Quotes eld-\end_inset--Open-\begin_inset Quotes erd-\end_inset--.- An editor opens up, which let you edit cabal files.- The name proposed for your package is the name of the folder you just construct-ed.- That is the convention with Cabal packages.- The defaults are set for creating a simple executable.- The base package is specified as build dependencies, and an executable- with the name of the package will be constructed.- The main module resides in a file -\begin_inset Quotes eld-\end_inset--Main.hs-\begin_inset Quotes erd-\end_inset--.- The sources are in a -\begin_inset Quotes eld-\end_inset--src-\begin_inset Quotes erd-\end_inset-- subdirectory of the packages.-\end_layout--\begin_layout Itemize-Click Save to write the .cabal file.-\end_layout--\begin_layout Itemize-The main module gets automatically constructed and opens.-\end_layout--\begin_layout Itemize-Now add your code to the module -\end_layout--\begin_deeper-\begin_layout LyX-Code--\emph on-main = putStrLn "Hello World" .- -\end_layout--\end_deeper-\begin_layout Itemize-By default, auto build is on and you can see that the file will be compiled- in the Log pane.-\end_layout--\begin_layout Itemize-Choose Package -> Run or ctrl-alt-r, and you will see Hello World in the- Log pane.-\end_layout--\begin_layout Itemize-Or: Choose Package -> Install, open a Shell and try out your newly created- executable -\end_layout--\begin_layout Standard-Congratulations ! you have now entered, compiled, linked and run your first- Haskell program with Leksah.- It is as easy as: Create workspace / New package / enter your code/ Run.- Remember: -\end_layout--\begin_layout Itemize-the project folder is the folder in which your .cabal file for the project- is stored.- -\end_layout--\begin_layout Itemize-A workspace is just a file, which contain information about included packages.- -\end_layout--\begin_layout Itemize-You see what Leksah is doing by observing the output from the Log window.- -\end_layout--\begin_layout Standard-Furthermore:-\end_layout--\begin_layout Itemize-You can add Packages with the context menu in the workspace pane.- You can construct new packages with Package -> New, from the menubar.- -\end_layout--\begin_layout Itemize-You can add other modules by selecting -\begin_inset Quotes eld-\end_inset--Add module-\begin_inset Quotes erd-\end_inset-- from the context menu of the modules pane of the browser group.-\end_layout--\begin_layout Itemize-You can open panes you need by selecting Panes -> Browser | Log | ...- from the menubar.-\end_layout--\begin_layout Itemize-You can editing modules by selecting them in the Browser.- You can search in the modules pane of the browser by typing text.- -\end_layout--\begin_layout Standard-You may as easily debug it-\end_layout--\begin_layout Itemize-\begin_inset Graphics- filename ../pics/ide_debug.png- width 0.5cm--\end_inset--Switch debugger Mode on.-\end_layout--\begin_layout Itemize-Pane -> Debugger -\end_layout--\begin_layout Itemize-Select the word “main” in your code -\end_layout--\begin_layout Itemize-Right click and choose “Eval” from the pop-up menu or press ctrl-enter.-\end_layout--\begin_layout Itemize-Switch of debugger Mode if you want to compile an executable.-\end_layout--\begin_layout Standard-\begin_inset Box Boxed-position "t"-hor_pos "c"-has_inner_box 1-inner_pos "t"-use_parbox 0-width "100col%"-special "none"-height "1in"-height_special "totalheight"-status open--\begin_layout Plain Layout-It is probably counter productive for new users to use Candy mode (converts- some common ASCII based operators to Unicode alternatives) because all- the tutorials use ASCII.- Switch it off when you get irritated.- Deselect Configuration -> To Candy from the menubar.-\end_layout--\end_inset---\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-The Editor-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement O-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_file_menu.png- lyxscale 50- width 30text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:File-menu"--\end_inset--File menu-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-Most of the time programming is editing source code.- To edit Haskell source files Leksah uses the GtkSourceView2 widget.- It provides editing, undo/redo, syntax highlighting and similar features.- In the file menu (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:File-menu"--\end_inset--) you find the customary functionality to open, save, close and revert files.- To avoid confusion, it is useful to be able to close all files, or all- files which are not stored in or below the top folder of the current project- (this is the folder where the .cabal file resides) at once - this helps- you focus on your project.- This way it is as well possible to close all files, which don't belong- to a workspace.-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement o-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_edit_menu.png- lyxscale 50- scale 40--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Edit-menu"--\end_inset--Edit menu-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-Leksah does not store backup files.- Leksah detects if a file which is currently edited has changed on disk- and queries the user if a reload is desired.- (Attention: This don't currently work for Windows, so take care).- When you open a file which is already open, a dialog pops up to inquire- if you want to make the currently open file active, instead of opening- it a second time (Leksah does not support multiple views on a file, but- if you open a file a second time, it's like editing the file two times,- which makes little sense).- The list of files is shown as notebook tabs (on top or left of the files- - as you prefer (Menu -> View -> Tabs Left).-\end_layout--\begin_layout Standard-When a file has changed compared to the stored version, the file name is- shown in red in the notebook tab, reminding you that it needs to be saved- before compilation.- -\end_layout--\begin_layout Standard-If you want to change to a different file editor buffer you can open a list- of all open files by pressing the right mouse button, while the mouse is- over a notebook tab.- You can then select an entry in this list to select this file.- (See -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Using-the-Flipper"--\end_inset-- for a better way to switch between source files).-\end_layout--\begin_layout Standard-On the right side in the status bar at the bottom you can see the line and- column, in which the cursor currently is; and if overwrite mode is switched- on.- In the second compartment from the left you can see the currently active- pane, which is helpful if you want to be sure that you have selected the- right pane for some operation.-\end_layout--\begin_layout Standard-In the edit menu (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Edit-menu"--\end_inset--) you find the usual operations: undo, redo, cut, copy, paste and select- all.- In addition you can comment and un-comment selected lines in a per line- style (--); however, the comment symbol must start in the first column- (beware of illegal sequences like --# which may be automatically produced- by inserting a comment in front of some symbol).- -\end_layout--\begin_layout Standard-Selected blocks of code can be shifted left or right using the tab or Tab/Shift--Tab keys.- Furthermore, you can align some special characters (=,<-,->,::,|) in selected- lines.- The characters are never moved to the left, but the operation is very simple- and takes the rightmost position of the special character in all lines,- and inserts spaces before the first occurrence of this special characters- in the other lines for alignment.-\end_layout--\begin_layout Subsection-Find and Replace in the current folder-\end_layout--\begin_layout Standard-Leksah supports searching in text files.- When you select Edit/Find from the menu the find bar will open (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Find-bar"--\end_inset--) and you can type in a text string.- Alternatively you can hit Ctrl-F or select a text and hit Ctrl-F (a standard- keystrokes binding, which can be configured, see -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Shortcuts"--\end_inset--).- Pressing the up and down arrow will bring you to the next/previous occurrence- of the search string.- Hitting Enter has a similar effect as the down arrow.- Hitting Escape will closes the find bar and sets the cursor to the current- find position.- You have options for case sensitive search (labeled -\begin_inset Quotes eld-\end_inset--c.S.-\begin_inset Quotes erd-\end_inset--), for searching only whole worlds (toggle Words) and for wrapping around- (button Wrap), which means that the search will start at the beginning/end- of the file, when the end/beginning is reached.- If there is no occurrence of the search string in the currently open file- the entry turns red.- -\end_layout--\begin_layout Standard-You can search for regular expressions by switching on the Regex option.- Leksah supports regular expressions in the Posix style (by using the regex-posi-x package).- When the syntax of regular expressions is not legal, the background of- the find pane turns orange.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_findbar.png- lyxscale 40- width 100text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Find-bar"--\end_inset--Find bar-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-To replace a text enter the new text in the replace entry and select replace- or replace all.-\end_layout--\begin_layout Standard-The last field on the line gives you a mean to jump to a certain line number- in the current text buffer.-\end_layout--\begin_layout Subsubsection-Search in the package: Grep-\end_layout--\begin_layout Standard-Searching for text in all files in a package is often useful For this feature- the grep program must be on your path.- You can then enter a search string in the find bar and search for all occurrenc-es for the string in the folder and sub-folder of the current package with- pressing the Grep button.- A pane will open (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Grep-pane"--\end_inset--), and in every line show where the expression was found (with context).- By clicking on the line, the file is opened in an editor and the focus- is set to the selected line.- You can navigate between lines with the up and down keys.- -\end_layout--\begin_layout Standard-Greps supports the search for regular expressions.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_grep.png- width 70text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Grep-pane"--\end_inset--Grep pane-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Subsection-Source Candy-\end_layout--\begin_layout Standard-\begin_inset Float figure-placement h-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_source_candy.png- width 80text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Source candy example-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-When using Source Candy, Leksah reads and writes pure ASCII Code files,- but can nevertheless show you nice symbols like -\begin_inset Formula $\lambda.$-\end_inset--This is done by replacing certain character combinations by a Unicode character- when loading a file or when typing, and replace it back when the file is- saved.-\end_layout--\begin_layout Standard-The use of the candy feature can be switched on and off in the menu and- the preferences dialog.-\end_layout--\begin_layout Standard-This feature can be configured by editing a .candy file in the .leksah folder- or in the data folder.- The name of the candy file to be used can be specified in the Preferences- dialog.-\end_layout--\begin_layout Standard-Lines in the *.candy file looks like:-\end_layout--\begin_layout Standard-\begin_inset Box Frameless-position "t"-hor_pos "c"-has_inner_box 1-inner_pos "t"-use_parbox 1-width "100col%"-special "none"-height "1in"-height_special "totalheight"-status open--\begin_layout Plain Layout--\family typewriter-"-\backslash-" 0x03bb --GREEK SMALL LETTER LAMBDA-\end_layout--\begin_layout Plain Layout--\family typewriter-"->" 0x2192 Trimming --RIGHTWARDS ARROW-\end_layout--\end_inset---\end_layout--\begin_layout Standard-The first entry in a line are the characters to replace.- The second entry is the hexadecimal representation of the Unicode character- to replace with.- The third entry is an optional argument, which specifies, that the replacement- should add and remove blanks to keep the number of characters.- This is important because of the layout feature of Haskell.- The last entry in the line is an optional comment, which is by convention- the name of the Unicode character.-\end_layout--\begin_layout Standard-Using the source candy feature can give you problems with layout, because- the alignment of characters with and without source candy may differ!-\end_layout--\begin_layout Standard-\begin_inset Box Framed-position "t"-hor_pos "c"-has_inner_box 0-inner_pos "t"-use_parbox 1-width "100col%"-special "none"-height "1in"-height_special "totalheight"-status open--\begin_layout Plain Layout-Leksah reads and writes files encoded in UTF-8.- So you can edit Unicode Haskell source files.- When you want to do this, switch of source candy, because otherwise Unicode- characters may be converted to ASCII when saving the file.-\end_layout--\end_inset---\end_layout--\begin_layout Subsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Completion"--\end_inset--Completion-\end_layout--\begin_layout Standard-Leksah has the ability to auto complete identifiers in text you type.- Additionally the Package, Module and Type of the id gets displayed if selected.- The completion mode can either be always on, or only be activated on pressing- Ctrl+Space (or a user defined keystroke).- You can choose between these two possibilities in the Preferences.-\end_layout--\begin_layout Standard-\begin_inset Float figure-placement h-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_completion.png- width 70text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Completion-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-Autocompletion has currently limitations: -\end_layout--\begin_layout Itemize-locally defined names are not included-\end_layout--\begin_layout Itemize-Qualified imports are not handled-\end_layout--\begin_layout Itemize-All names from all packages imported are provided; this may be more than- you want-\end_layout--\begin_layout Subsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Using-the-Flipper"--\end_inset--Using the Flipper to Switch Between Editors-\end_layout--\begin_layout Standard-You can change the active pane using a keyboard shortcut to bring up the- flipper.- It lists the most recently used panes first so they are easier to get to.- The default shortcuts for the flipper are Ctrl+Tab and Ctrl+Shift+Tab or- Ctrl+Page Down and Ctrl+Page Up.- -\end_layout--\begin_layout Standard-The approach in Leksah is comparable to the Alt+Tab and Alt+Shift+Tab used- to switch between programs in the OS (Ubuntu, Windows).-\end_layout--\begin_layout Subsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Editor-Preferences"--\end_inset--Change Your Preferences for the Editor-\end_layout--\begin_layout Standard-\begin_inset Float figure-placement h-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_prefs_editor.png- width 80text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Editor Preferences-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-When selecting Configuration / Edit Prefs the preferences pane opens, which- has a selection called Editor (Figure 8), were you can edit preferences- for the editor.- Some of the options you find here refer to visual elements, like the display- of line numbers, the font used, the display of a right margin and the use- of a style file for colors and syntax highlighting.- -\end_layout--\begin_layout Standard-You can set here the Tab size you want.- Leksah always stores tabs as spaces.- Using hard tabs is not recommended for Haskell and the Haskell compilers- allow only tab size of 8.-\end_layout--\begin_layout Standard-Leksah offers as well to remove trailing blanks in lines, which you may- choose as default, because blanks at the end of lines make no sense in- source code.-\end_layout--\begin_layout Verse-\begin_inset Box Boxed-position "t"-hor_pos "c"-has_inner_box 1-inner_pos "t"-use_parbox 0-width "100col%"-special "none"-height "1in"-height_special "totalheight"-status open--\begin_layout Plain Layout-Leksah dialogs offer mostly a -\noun on-Apply, save-\noun default- and a -\noun on-close-\noun default- button.- Be aware that the close button does not save your changes; press apply,- save and then close! We will change this for the next version.-\end_layout--\begin_layout Plain Layout-In dialogs, where you select something, there is typically an -\noun on-add-\noun default- button, selecting does not add, neither! Therefore: adding an item means- select item, add, save, close.-\end_layout--\end_inset---\end_layout--\begin_layout Subsection-Further info-\end_layout--\begin_layout Standard-The work with the editor is influenced by other features-\end_layout--\begin_layout Itemize-For background building, which may save your files automatically after every- change refer to -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Background-Build"--\end_inset--.-\end_layout--\begin_layout Itemize-For information about editor preferences go to -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Editor-Preferences"--\end_inset--.-\end_layout--\begin_layout Standard-\begin_inset Newpage pagebreak-\end_inset---\end_layout--\begin_layout Section-Working with Projects: Workspaces and Packages-\end_layout--\begin_layout Standard-Haskell organizes software projects in packages, which are managed independently.- A package is compiled and linked as a unit to produce one or more executables- or/and a library.- It is installed with the package manager Cabal.- A package can be uploaded to Hackage.- And provided packages are downloaded from Hackage and installed.- Packages have version numbers and specify version ranges for dependencies.- Cabal assures that, if a packages is compiled, correct versions of other- packages are selected.-\end_layout--\begin_layout Standard-The difficulties, when working with a project where source code under developmen-t is spread over several packages, are overcome in Leksah with the concept- of a workspace.- It combines several packages and allows smooth working with files from- all packages.- -\end_layout--\begin_layout Standard-Leksah always works in a workspace and always needs at least one package,- to do anything useful.- This seems overkill for very simple projects, where the workspace contains- just one package and this package just one source module producing one- executable, but Leksah provides defaults that reduce the effort to a minimum.- The principle to always to work in a workspace and in a package is beneficial- in the long run, because it gives a smooth transition from a one-shot idea- to a complex projects and integrates the widely used cabal system fully.-\end_layout--\begin_layout Standard-Leksah, in addition, saves the state of your work environment with a workspace:- so you can switch between workspaces and get exactly back to where you- stopped working when leaving the workspace: the same files open in editors- and the cursor in the same file and position.- When you open a workspace, and a session is attached to it, Leksah prompts- you, if you want to switch to the session associated with the workspace.- Leksah silently always saves the session for the workspace you are closing.-\end_layout--\begin_layout Standard-If you have auto-build on and you change a file, Leksah detects if this- file belongs to any project in your Workspace.- If this is the case, it builds the package.- So the source file you are working on, doesn't need to belong to the active- package.- Leksah will detect and compile the package for you.- The active project is important for the menu items of the package menu,- because they always work on the active package.-\end_layout--\begin_layout Itemize-Background build can be permanently set in Prefs -> Build -> Background- build.- You can temporarily enable and disable it from the toolbar with this button:- -\begin_inset Graphics- filename ../pics/ide_build.png- width 0.5cm--\end_inset--.-\end_layout--\begin_layout Itemize-You can set, if Leksah automatically save all files before building, by- the setting Prefs -> Build -> Automatically save all files before building.-\end_layout--\begin_layout Itemize-Linking can take a long time, and on Windows we can't interrupt the build- process in the moment, so it may be an advantage to switch of linking.- This can be done by: Prefs -> Build -> Include linking in background builds.- You can temporarily enable and disable it from the toolbar with this button:- -\begin_inset Graphics- filename ../pics/ide_link.png- width 0.5cm--\end_inset--.-\end_layout--\begin_layout Itemize-The same option (disable linking) can be used to disable cross package build- temporarily.-\end_layout--\begin_layout Subsection-Cross package build-\end_layout--\begin_layout Standard-The following is valid in compiler mode: Depending on your settings the- following may happen.- After a library has been successfully build, it will be installed if:-\end_layout--\begin_layout Itemize-\begin_inset Quotes eld-\end_inset--Include linking in background builds-\begin_inset Quotes erd-\end_inset-- is on and either-\end_layout--\begin_deeper-\begin_layout Itemize-\begin_inset Quotes eld-\end_inset--Install always after a successful build-\begin_inset Quotes erd-\end_inset-- is selected or-\end_layout--\begin_layout Itemize-\begin_inset Quotes eld-\end_inset--Install if it's a library with depended packages in the workspace-\begin_inset Quotes erd-\end_inset-- is selected, and it has dependent packages-\end_layout--\end_deeper-\begin_layout Standard-After this, dependend packages will be build.- If you want a background build, but only for the one package you're working- on, you can temporarily disable this mechanism, by deselecting -\begin_inset Graphics- filename ../pics/ide_link.png- width 0.5cm--\end_inset--.-\end_layout--\begin_layout Subsection-File Organization with Workspaces-\end_layout--\begin_layout Standard-A workspace is represented by a file (-\emph on-workspace_name.lkshws-\emph default-) in a directory.- You may choose a hierarchical folder structure with a workspace file at- the top and the projects in sub-folders for complex projects, but you can- as well put all -\emph on-workspaces-\emph default- in one directory and put all packages flat.- You have to use care when you create a new workspace file.- -\end_layout--\begin_layout Standard-Each package directory contains at least a cabal file (-\emph on-packagename.cabal-\emph default-) and typically folders for the source files, following the usual Haskell- ghc convention of hierarchical module names.-\end_layout--\begin_layout Standard-Cabal controls the compilation and linking of packages with GHC and puts- the results in a dist folder in the package; this folder is reconstructed- often and may be deleted without loss.- In the folder package_name/dist/build/executable_name you find the executable,- but it is also installed in the folder ~ /.cabal/bin (for a build with the- --user flag.- You may wish to add this folder to your search path).- -\end_layout--\begin_layout Subsection-Workspace Operations-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement O-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\begin_inset Graphics- filename screenshots2/screenshot_workspace_menu.png- width 25text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Workspace-Menu"--\end_inset--Workspace Menu-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Subsubsection-New workspace-\end_layout--\begin_layout Standard-Under the menu workspace you find commands to create a new workspace with- a specific name and select the folder in which it should reside.- The windows title and the 3.- compartment of the status bar informs you always about the currently open- workspace.-\end_layout--\begin_layout Subsubsection-Add packages to the workspace-\end_layout--\begin_layout Standard-Open the workspace pane (from menu (Panes → Workspace) and do a right-click- to get the pop-up menu to add a package by selecting the corresponding- cabal file.- -\end_layout--\begin_layout Subsubsection-Open workspace-\end_layout--\begin_layout Standard-When starting, Leksah opens the last workspace used.- You can change to another workspace by opening the corresponding workspace- file, or by choosing from the list of recently used workspaces.- When opening a Workspace you can choose to -\end_layout--\begin_layout Subsubsection-Clean and make workspace-\end_layout--\begin_layout Standard-A workspace can be cleaned, meaning all packages gets cleaned and must be- recompiled from scratch.- Make builds all the packages in a meaningful order, and installs libraries- if needed.- It only stops if an error occurs.-\end_layout--\begin_layout Subsubsection-Jump between errors-\end_layout--\begin_layout Standard-There are menu items to move to the next or the previous error the compiler- found.- You can as well use keyboard shortcuts for this: -\noun on-ctr-j-\noun default- and -\noun on-shift-ctrl-j-\noun default-.- It is as well possible to move by pointing to the error messages in the- log pane or error pane.-\end_layout--\begin_layout Subsubsection-Add all imports-\end_layout--\begin_layout Standard-If you miss imports (given error messages (-\begin_inset Quotes eld-\end_inset--xx is not in scope-\begin_inset Quotes erd-\end_inset--) -\noun on-ctrl-r-\noun default- is adding them automatically to your import list.- Limitation: it does so only, if the modules they export are in a workspace- package or are in a package listed in the build dependencies of the package.-\end_layout--\begin_layout Subsection-Packages-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement O-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\begin_inset Graphics- filename screenshots2/screenshot_package_menu.png- width 25text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Package-Menu"--\end_inset--Package Menu-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-The concept of a package is used to handle a unit of work for the development- of some library or executable.- It is, in the first place, the unit Cabal deals with and is a standard- in the Haskell community.-\end_layout--\begin_layout Standard-Leksah stores data for packages in the standard cabal files.- The same files can be used outside of leksah: for example, you can issue- the command cabal install in the folder that contains the cabal file and- cabal will (as it would inside leksah) configures, compiles and links and- install or register the library or executable produced.- -\end_layout--\begin_layout Subsubsection-Opening and activating a package-\end_layout--\begin_layout Standard-Leksah uses Cabal for package management, and opening a package is done- by opening the corresponding .-\emph on-cabal-\emph default- file.- To open a package select -\emph on-Add Package-\emph default- from the context menu of the workspace, select the *.cabal file of the desired- package.- You must not have more than one *.cabal file in a folder!-\end_layout--\begin_layout Standard-For workspaces with more then one package, you can activate a package in- the workspace pane, by double clicking on it or by selecting -\emph on-Activate Package-\emph default- from the context menu.- The active package is the one that the commands in the Package menu refers- to.- (e.g.- configure, build, install).- -\end_layout--\begin_layout Standard-Leksah shows the currently active package in the third compartment in the- status bar and in the window title.- The package file contains appropriate defaults and for a small program,- you may just save and close it.- -\end_layout--\begin_layout Subsubsection-New package-\end_layout--\begin_layout Standard-To start with a new package select Package / NewPackage from the menu.- Then you have to select a folder for the project, this is by GHC convention- the same name you will give to your package in the package editor (see- -\begin_inset CommandInset ref-LatexCommand prettyref-reference "sub:Package-editor"--\end_inset--).- Then the package editor will open to collect the package details.- -\end_layout--\begin_layout Standard-This currently does not work, if an editor for a different package is open.-\end_layout--\begin_layout Subsubsection-Package editor-\begin_inset CommandInset label-LatexCommand label-name "sub:Package-editor"--\end_inset---\end_layout--\begin_layout Standard-The package editor (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:PackageEditor-1"--\end_inset--) is an editor for cabal files and but you can edit the cabal files in your- regular text editor as well.- Leksah works (usually) with the cabal files you and others have already- written, for example those you get when you install a package from Hackage.- Since cabal files offer complex options the editor offers many separate- sub-panes in a list on the right.- For a complete description of all options see the -\begin_inset CommandInset href-LatexCommand href-name "Cabal User's Guide"-target "http://www.haskell.org/ghc/docs/latest/html/Cabal/index.html"--\end_inset--.- -\end_layout--\begin_layout Standard-The package editor does currently not support the cabal configurations feature.- If you need cabal configurations, you need to edit the cabal files as a- text file separately.- Leksah uses standard cabal files with no modifications this is no problem- just the package editor will not work for you.- -\end_layout--\begin_layout Standard-\begin_inset Float figure-placement h-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_package_editor_1.png- scale 33--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:PackageEditor-1"--\end_inset--PackageEditor 1-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Subsubsection-The most important parts of cabal files-\end_layout--\begin_layout Standard-A package has, as a minimal requirement, a -\bar under-name-\bar default- and a -\bar under-version-\bar default- (default is 0.0.1 -- meaning something like -\begin_inset Quotes eld-\end_inset--first idea-\begin_inset Quotes erd-\end_inset---\begin_inset Quotes erd-\end_inset--).- If your code uses other packages then they must be listed in -\bar under-dependencies-\bar default-.- This will be at least the -\emph on-base-\emph default- package (which is entered by default).- This is independent whether you downloaded them, e.g., from Hackage produced- them yourself.- Version numbers are used to document (and enforce) that older versions- of a program use the corresponding older versions of other packages with- which it was developed originally.- -\end_layout--\begin_layout Standard-The result of the packages can be an executable and you enter the name of- the Haskell file that contains the main function in the executable pane- and the name of the executable.- The result of the package can be a library; in the corresponding pane you- tick off the modules which should be exposed (i.e., their exports can be- used in other packages).- Cabal gives the possibility to build more then one executable from one- package and to build a library and executables from one package.- -\end_layout--\begin_layout Standard-You have to specify a build info.- With build information you give additional -\begin_inset space \space{}-\end_inset--information, e.g: -\end_layout--\begin_layout Itemize-where the sources can be found (relative to the root folder of the project,- which is the one with the cabal file).- -\end_layout--\begin_layout Itemize-what additional non-exposed or non main modules your project includes-\end_layout--\begin_layout Itemize-compiler flags-\end_layout--\begin_layout Itemize-used language extensions in addition to Haskell 98 (These can also be specified- in the source files with pragmas)-\end_layout--\begin_layout Itemize-and many more ...-\end_layout--\begin_layout Standard-Because more than one executable and a library can be build from one package,- it is possible to have cabal files with more than one build info.- The package editor deals with this by the buttons Add / Remove Build Info.- Every build info gets an index number, and for executables and a library- you specify the index of the build info.- -\end_layout--\begin_layout Subsubsection-Initializing a package: Clean and configure operations-\end_layout--\begin_layout Standard-Before a package can be acted on it must be configured; you may clean a- package (i.e., delete its -\emph on-dist-\emph default- folder) to start afresh.-\end_layout--\begin_layout Standard-Configure checks that the packages the current packages depend on are installed- in GHC package manager; it checks for name and version, if you specify- them.- If an Hackage package is missing, you can -\noun on-cabal install-\noun default- it in a terminal window.- -\end_layout--\begin_layout Standard-Two types of errors regarding packages may be reported:-\end_layout--\begin_layout Standard-While configuring, Cabal checks that the packages you have listed in the- depends on section are installed on your computer.- If one of your packages is missing (or missing the version that is needed)- you can install it either -- for packages you have the source on your computer,- e.g.- because you wrote them -- by switching Leksah to the folder where this- package is and configure, build and install them with the command -\emph on-cabal install-\emph default-.- For packages that are on Hackage -- use a console, go to the directory- where you keep such sources and type cabal install packageName (possibly- package_name-version); cabal then recursively installs the package and- all packages it depends on.-\end_layout--\begin_layout Standard-Separate from this error message the case, where the compiler misses a module- you want to import.- Ghc provides an error message, indicating what package you have to add- to the depends on' section in the cabal file.- Edit the package, add the dependency and do configure/build.-\end_layout--\begin_layout Standard-You have to take care as well, that there is a user and a global package- db.- Leksah uses the --user flag by default, to minimize errors.- -\end_layout--\begin_layout Subsubsection-Building-\end_layout--\begin_layout Standard-The most frequently used functionality with packages is to make a build.- If the package was not configured before, Leksah does that step automatically.- When you start a build, you can see the standard output of the Cabal build- procedure in the Log pane.- -\end_layout--\begin_layout Standard-A build may produce errors and warnings.- If this is the case the focus is set to the first error/warning in the- Log and the corresponding source file will open with the focus at the point- where the compiler reports the error.- You can navigate to the next or previous errors by clicking on the error- or warning in the log window, or by using the menu, the toolbar or a keystroke.-\end_layout--\begin_layout Standard-In the statusbar the state regarding to the build is displayed in the third- compartment from the right.- It reads -\emph on-Building-\emph default- as long as a build is on the way and displays the numbers of errors and- warnings after a build.-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_make.png- width 0.5cm--\end_inset--This is the symbol, which initiates a -\noun on-build-\noun default- when clicked on the toolbar (Ctrl-b).-\end_layout--\begin_layout Standard-The error pane (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Error-Pane"--\end_inset--) shows the errors in the form of a table and provides the same functionality- you find in the log, but it may be more convenient to use.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_error_pane.png- width 50text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Error-Pane"--\end_inset--Error Pane-\end_layout--\end_inset---\end_layout--\begin_layout Plain Layout--\end_layout--\end_inset---\end_layout--\begin_layout Subsubsection-Run-\end_layout--\begin_layout Standard-You can run your program after the build operation has compiled and linked- it.- there is a convenient button -\begin_inset Graphics- filename ../pics/ide_run.png- width 0.5cm--\end_inset-- to start it!-\end_layout--\begin_layout Subsubsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Background-Build"--\end_inset--Background build-\end_layout--\begin_layout Standard-Leksah can run builds while you work and highlight errors as it finds them.- This works with a timer that runs continuously in the background.- If there are changes made to any open file it \SpecialChar \ldots{}--\end_layout--\begin_layout Itemize-interrupts any running build by sending SIGINT (this step is OS X and Linux- only at this point, it's not working on MS Windows)-\end_layout--\begin_layout Itemize-waits for any running build processes to finish-\end_layout--\begin_layout Itemize-saves all the modified files-\end_layout--\begin_layout Itemize-starts a new build-\end_layout--\begin_layout Standard-Current limitation: Because we can't interrupt the build on windows there- is an option in the Leksah build preferences to have it skip the linking- stage in background builds.- This reduces the delay before a next build starts.- Background build and linking can be configured in the preferences and as- well switched on and off from the toolbar.-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_build.png- width 0.5cm--\end_inset--This is the toggle, which switches -\noun on-background build-\noun default- on or off in the toolbar.-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_link.png- width 0.5cm--\end_inset--The-\noun on- Linking-\noun default- toggle that switches background build-\noun on- -\noun default-on or off-\noun on-.-\end_layout--\begin_layout Subsubsection-Build system flags-\end_layout--\begin_layout Standard-Cabal allows more operations than just build; for example producing documentatio-n with Haddock (with The -\begin_inset Quotes eld-\end_inset--Build documentation-\begin_inset Quotes erd-\end_inset-- item in the package menu).- For each of these operations you can enter the specific flags they require- for you special case.- We give here two often examples of flags, others work similarly and we- recommend that you consult the respective documentations.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_package_flags.png- width 50text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Package Flags-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-(-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Workspace-Menu"--\end_inset--) consult the -\begin_inset CommandInset href-LatexCommand href-name "Cabal User's Guide"-target "http://www.haskell.org/ghc/docs/latest/html/Cabal/index.html"--\end_inset--.- -\end_layout--\begin_layout Standard-Cabal needs the --user flag (which is set by default in Leksah) to install- the result of a built in the user package database (the alternative is- --global to put the resulting files in global space in ghc-pkg).-\end_layout--\begin_layout Standard-Haddock documentation for the leksah source will not be build, because it- is not a library unless you pass the --executable flag.- The flags are stored in a file called IDE.flags in the root folder of the- project.-\end_layout--\begin_layout Subsection-Import Helper-\end_layout--\begin_layout Standard-A frequent and annoying error is the -\noun on-Not in scope-\noun default- compiler error.- In the majority of cases it means that an import statement is missing and- to write import statements is a frequent and annoying task.- In Leksah if the compiler informs about a missing import, you can choose- -\emph on-Add import -\emph default-from the context menu in the log pane.- Leksah will then add an import statement to the import list.- If there is more than one module that exports this identifier, a dialog- will appear which queries you about the module you want to import it from.-\end_layout--\begin_layout Standard-Leksah then adds a line or an entry to the import list of the affected module- with the compiler error.- Leksah imports individual elements, but imports all elements of a class- or data structure if one of them is needed.- The import helper can work with qualified identifiers and will add a correct- import statement.- You can as well select -\emph on-add all imports-\emph default- from the context menu, in which case all -\emph on-Not in scope -\emph default-errors-\emph on- -\emph default-will be treated sequentially.- -\end_layout--\begin_layout Standard-\begin_inset Box Framed-position "t"-hor_pos "c"-has_inner_box 0-inner_pos "t"-use_parbox 0-width "100col%"-special "none"-height "1in"-height_special "totalheight"-status open--\begin_layout Plain Layout-When Leksah does not find an identifier update the Leksah database.- -\end_layout--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_rebuild_meta.png- width 0.5cm--\end_inset---\noun on-Update Metadata or (Ctrl-m)-\end_layout--\end_inset---\end_layout--\begin_layout Standard-The import helper just looks in imported packages, so if you miss a package- import, you have to fix it manually.- -\end_layout--\begin_layout Standard-Obviously some not in scope errors have other reasons, e.g.- you have misspelled some identifier, which can't be resolved by adding- imports.- After adding all imports, you have to save the file and then start a new- build.- -\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-Module Browser and Metadata-\end_layout--\begin_layout Standard-\begin_inset Wrap table-lines 0-placement o-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\begin_inset Tabular-<lyxtabular version="3" rows="11" columns="2">-<features>-<column alignment="left" valignment="top" width="0">-<column alignment="center" valignment="top" width="0">-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-sort-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-symbol-\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-function-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_function.png- width 0.5cm--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-data-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_data.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset space ~-\end_inset---\begin_inset space ~-\end_inset--constructor-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_konstructor.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset space ~-\end_inset---\begin_inset space ~-\end_inset--slot-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_slot.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-type -\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_type.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-newtype-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_newtype.png- width 0.5cm--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-class-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_class.png- width 0.5cm--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset space ~-\end_inset---\begin_inset space ~-\end_inset--member -\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_method.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-instance-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_instance.png- width 0.5cm--\end_inset---\end_layout--\end_inset-</cell>-</row>-<row>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-rule-\end_layout--\end_inset-</cell>-<cell alignment="center" valignment="top" usebox="none">-\begin_inset Text--\begin_layout Plain Layout-\begin_inset Graphics- filename ../pics/ide_rule.png--\end_inset---\end_layout--\end_inset-</cell>-</row>-</lyxtabular>--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "tab:Sorts-of-identifiers"--\end_inset--Sorts of identifiers-\end_layout--\end_inset---\end_layout--\end_inset--Leksah collects data about the modules of all installed Haskell packages- on your system.- It does this by reading the Haskell interface files .hi files (from GHC).- It as well collects source positions and comments from sources.- For this it looks in the source directories you specified in the preferences- and downloads and unpacks sources from Hackage depending on your settings.- Starting from the current version, Leksah can as well use prebuild metadata- it might find on the web, to provide metadata for packages you have sources- for, but the call to the Haddock library fails for some reason.- -\end_layout--\begin_layout Standard-The packages in the workspace are treated differently, as not only external- exported entities are collected, but all exports from all modules are collected.- As well identifiers, which are not exported from a module get listed.- The source symbol for them is shown in gray.-\end_layout--\begin_layout Standard-This metadata is used to answer questions like: -\end_layout--\begin_layout Itemize-Which packages and modules export this identifier?-\end_layout--\begin_layout Itemize-What is the type of the exported identifier?-\end_layout--\begin_layout Standard-If the source was found, it lists as well : -\end_layout--\begin_layout Itemize-The comment for this identifier -\end_layout--\begin_layout Itemize-and can mark the item in the source file at the correct position-\end_layout--\begin_layout Standard-If you like to get information about some identifier in the code, the easiest- way is to press -\noun on-Ctrl -\noun default-and-\noun on- double click-\noun default- on it.-\end_layout--\begin_layout Standard-More precisely the operation starts with a release of the left mouse button- with a selection with -\noun on-Ctrl-\noun default- pressed; You can use this if the double click doesn't select the intended- area.- If the identifier is known unambiguously the modules and info pane will- show information about it.- If more than one possibility exist the search pane will open and present- the alternatives.-\end_layout--\begin_layout Standard-The sorts of the identifiers shown are differentiated by the symbols you- find in Table -\begin_inset CommandInset ref-LatexCommand ref-reference "tab:Sorts-of-identifiers"--\end_inset--.- Note as well the special symbol for identifiers exposed, but only indirectly,- because the definition is imported from another module.- -\begin_inset Graphics- filename /home/jutaro/Develop/lws/leksah/pics/ide_reexported.png- width 0.5cm--\end_inset---\end_layout--\begin_layout Subsection-The Module Browser-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_module_browser.png- width 80text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Modules-browser"--\end_inset--Module browser-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-The module browser (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Modules-browser"--\end_inset--) shows information about modules and their interface separated in scopes:- package, workspace, and system.- If no package or workspace is open only the system scope has information.- (If a workspace/package is open, it's name(s) are displayed in the third- subdivision from the left of the status and in the title bar.)-\end_layout--\begin_layout Standard-The scope of the displayed information is selected with the radio button- on top of the modules pane: The -\emph on-Package-\emph default- scope shows only modules which are part of the active project.- The -\emph on-Workspace-\emph default- scope shows all modules of all packages in the workspace.- The -\emph on-System-\emph default- scope shows all modules of installed packages of the system.- -\end_layout--\begin_layout Standard-(It lists all modules of installed packages.- These you would get with -\emph on-ghc-pkg-\emph default- list.- Leksah scans the user and the global package database, when both are present).-\end_layout--\begin_layout Standard-The amount of information displayed may overwhelm you with details from- packages that are not of interest to you (Like e.g.- like Haskell-98, ghc, or base-3.0*).- Such packages can be excluded, by blacklisting them.- The packages you want to hide can be specified in the preferences and you- can use the radio button at the right to hide them.-\end_layout--\begin_layout Standard-If you select a module in the modules list, its interface is displayed in- the interface list on the right.- You can search for a module or package by selecting the modules list and- typing some text.- With the up and down arrows you find the next/previous matching item.- With the escape key or by selecting any other GUI element you leave the- search mode.- -\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_source.png- width 0.5cm--\end_inset--If this icon shows up, Leksah has found a -\noun on-source-\noun default- file or source position for this element.- You can open the source file, or bring it to the front and display the- source for the selected location with a -\emph on-double click-\emph default- on the element.- (the same is achieved with selecting -\emph on-Go to definition-\emph default- from the context menu.-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename /home/jutaro/Develop/lws/leksah/pics/ide_source_local.png- width 0.5cm--\end_inset--This is the same as before, but is used for definitions not exported from- the module.- -\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_reexported.png- width 0.5cm--\end_inset--This icon indicates that the symbol is -\noun on-reexported-\noun default- from another module., because its long list is not much hierarchically structure-d.-\end_layout--\begin_layout Standard-By selecting an element in the Interface List the so called Info Pane is- shown with detailed information (see next subsection).-\end_layout--\begin_layout Standard-The modules pane provides detailed information and are the quickest way- to open a source file for edit.- Go to the modules pane, select package or workspace scope, possibly find- the module by entering some text, and double click on the module's name- to open the file in the editor for editing the file.-\end_layout--\begin_layout Standard-\begin_inset Float figure-placement h-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_construct_module.png- scale 37--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Construct-module-dialog"--\end_inset--Construct module dialog-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-From the context menu of (right-click) the modules pane you can add a new- module by selecting -\emph on-Add modul-\emph default-e.- The Construct Module dialog will open (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Construct-module-dialog"--\end_inset--).- You have to enter the name of the module, the source path to use if alternative-s exist.- If the project is a library you have to specify if the module is exposed.- Leksah will construct the directory, modify the cabal file and construct- an empty module file from a template (The template is stored in the file- module.lksht in the data folder of the project, and will be read from the- .leksah-** folder if you want to provide a different template file there.- -\end_layout--\begin_layout Standard-The modification of the cabal file will currently only happen, if it does- not contain configurations.- -\end_layout--\begin_layout Subsubsection*-The Info Pane-\end_layout--\begin_layout Standard-The Info Pane is the lower pane of the module browser and shows information- about an interface element, which may be a function, a class, a data definition- or a type (selected, for example, in the modules pane).- It shows the identifier, the package and module that it is exported by,- it's Haskell type and, if found, the Haddock documentation inserted in- the source as a comment.- -\end_layout--\begin_layout Standard-If you select and initiate an identifier search in an editor pane, the informati-on about this identifier is automatically displayed in the info pane (maybe- nothing!).- The easiest way to do this is to double click on an identifier while pressing- -\noun on-Ctrl-\noun default-.- -\end_layout--\begin_layout Standard-Only previously collected metadata is available this way.- If the item has changed you could initiate an update of the information- collected with update workspace metadata (menu configuration → update workspace- data, or Ctrl-m).-\end_layout--\begin_layout Standard-If a source location is attached, you can go to the definition by clicking- the -\emph on-Source-\emph default- button.- -\end_layout--\begin_layout Standard-You can select the module and the interface element in the modules pane- by clicking the -\emph on-Modules-\emph default- button.-\end_layout--\begin_layout Standard-With the -\emph on-Refs-\emph default- button a pane opens which displays modules which uses this element.-\end_layout--\begin_layout Standard-With the -\emph on-Docu-\emph default- button you can initiate an external search in a browser with e.g.- Hayoo or Hoogle, depending on the configuration in the Preferences.-\end_layout--\begin_layout Standard-With the -\emph on-Search-\emph default- button you can initiate a metadata search for the identifier.-\end_layout--\begin_layout Subsection-The Search Pane-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_serach_pane.png- width 80text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Search-pane"--\end_inset--Search pane-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-You can search for an identifier in the metadata by typing in characters- in the entry at the bottom of the pane (not the search entry at the bottom- of the window!).- The search result depends on the settings in the search pane (-\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Search-pane"--\end_inset--).- You can choose:-\end_layout--\begin_layout Enumerate-The scope in which to search, which can be Package, Workspace or System.- For Package and Workspace scopes you can search with or without imports,- which gives 5 different scopes.- -\end_layout--\begin_layout Enumerate-The way the search is executed, which can be exact, prefix or as a regular- expression.-\end_layout--\begin_layout Enumerate-You can choose if the search shall be case sensitive or not.-\end_layout--\begin_layout Standard-The result of the search is displayed in the list part of the Search pane.- -\end_layout--\begin_layout Standard-You can see if the module reexports the identifier, or if the source of- the identifier is reachable.- When you single click on a search result, the module browser shows the- corresponding information.- If you double click on an entry, the modules and info pane shows the correspond-ing information.-\end_layout--\begin_layout Standard-If you double click on an identifier while pressing Ctrl in an editor pane,- a case sensitive and exact search in the is started.-\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-Debugger and Interpreter mode-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement O-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_debug_menu.png- lyxscale 50- width 25text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset VSpace bigskip-\end_inset---\end_layout--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_buffer_menu.png- lyxscale 50- width 25text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Debug-&-Buffer"--\end_inset--Debug & Buffer menu-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-You can switch Debugger mode on -\emph on-only-\emph default- from the toolbar with the:-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_debug.png- width 0.5cm--\end_inset-- toggle, which switches debugger Mode on or off.- -\end_layout--\begin_layout Standard-In debugger mode the packages and modules for your current project are loaded- into GHCi.-\end_layout--\begin_layout Standard-In debugger mode, the menu entries from the Debug menu are no longer disabled- (Fig -\begin_inset CommandInset ref-LatexCommand ref-reference "fig:Debug-&-Buffer"--\end_inset--), and the context menu of source buffers have entries that were not meaningful- in the regular (GHC) mode.- There is also a group of panes specifically used for debugging, allowing- you to manage breakpoints, observe variables, etc.- -\end_layout--\begin_layout Standard-You can open the debugger group pane by choosing Panes / Debugger.- Commands using the debugger are given mostly in the source editor pane- with a context menu: You select some text and right-click to get the context- menu.- it lets you:-\end_layout--\begin_layout Itemize--\noun on-Evaluate-\noun default- the selected expression in the interpreter and observe the result.- If no text is selected the current line is taken as input.- Select eval.- The result of the evaluation is shown in the log window and as -\emph on-it -\emph default-in the variables pane.- You can as well use the keystroke Ctrl-Enter.- -\begin_inset Newline newline-\end_inset--Choose -\begin_inset Quotes eld-\end_inset--Eval & Insert-\begin_inset Quotes erd-\end_inset--, to insert a string representation of the result after the selected expression.-\end_layout--\begin_layout Itemize-Determine the -\noun on-type-\noun default- of an expression: Select the expression in a source buffer and select Type- from the context menu.-\end_layout--\begin_layout Itemize-Get-\noun on- info-\noun default- about an identifier select: Select Info from the context menu.-\end_layout--\begin_layout Itemize-Get -\noun on-the kind-\noun default- of a type select: Select Kind-\end_layout--\begin_layout Itemize--\noun on-Step-\noun default- through code: Select the expression in a source buffer.- Select step from the context menu (or F7).- Use the toolbar icons (or shortcuts) for stepping -\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_step.png- width 0.5cm--\end_inset--Step (F6), -\begin_inset Graphics- filename ../pics/ide_local.png- width 0.5cm--\end_inset--Step local (F7)-\end_layout--\begin_layout Standard-\begin_inset Graphics- filename ../pics/ide_module.png- width 0.5cm--\end_inset--Step in module (F8), -\begin_inset Graphics- filename ../pics/ide_continue.png- width 0.5cm--\end_inset--Continue (F9)-\end_layout--\begin_layout Itemize-Set -\noun on-breakpoints-\noun default- by putting the cursor at the breakpoint and select -\emph on-set breakpoint -\emph default-from the context menu.- Run your application or test cases and start stepping at the break point.- After a break point is reached you use the operations of GHCi with convenient- shortcuts.- -\end_layout--\begin_layout Standard-The debugger has a pane in which you can enter expressions and have them- evaluated.- The pane is a Haskell source buffer, which has the reserved name _Eval.- Its contents is saved with the session.-\end_layout--\begin_layout Standard-Note that:-\end_layout--\begin_layout Itemize-breakpoints are set on identifiers selected, not necessarily where you have- found it in the source (e.g., used in an expression); -\end_layout--\begin_layout Itemize-current breakpoints are listed in the breakpoints pane; you can remove breakpoin-ts from this pane-\end_layout--\begin_layout Itemize-While stepping through code, you can observe -\noun on-variables-\noun default- in the variables pane.- You can print or force a variable from the context menu of the variables- pane.- You can update the pane from the context menu.-\end_layout--\begin_layout Itemize-You can observe an execution trace in the traces pane.- Navigation in the traces pane is currently not supported (:back, :forward).-\end_layout--\begin_layout Itemize-You can query information about the current state of GHCi from the Debugger- menu.- E.g.- -\emph on-Show loaded modules-\emph default-, -\emph on-Show packages-\emph default- and -\emph on-Show languages-\emph default-.- -\end_layout--\begin_layout Itemize-You can directly communicate with GHCi by evaluating commands entered as- text in the source editor and select it.- E.g.- -\begin_inset Quotes eld-\end_inset--:set ...-\begin_inset Quotes erd-\end_inset---\end_layout--\begin_layout Standard-For more information about debugging in GHCi read the GHCi section in the- GHC manual.- -\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_debug_pane.png- width 70text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-Debug Pane-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Section-\begin_inset CommandInset label-LatexCommand label-name "sub:Metadata-collection"--\end_inset--Metadata collection-\end_layout--\begin_layout Standard-Remember, that metadata is the data Leksah has collected from all the Haskell- code (including .hi files for installed packages) it could reach on your- computer.- -\end_layout--\begin_layout Standard-The initial scan may take a long time (some minutes); when Leksah starts- later, it checks only for changes, but does not scan all files again.- Metadata collection depends on the local configuration, especially the- list of places where Haskell code may be found, which is entered in the- preferences.- Occasionally, you may find it useful to rebuild the metadata.- -\end_layout--\begin_layout Standard-Metadata collection can be manually triggered: If you select-\emph on- Configuration -> Update workspace data-\emph default-, the metadata for the current project is collected.- This brings the metadata of the current project up-to-date.- You can as well press Ctrl-m or hit this symbol in the toolbar: -\begin_inset Graphics- filename /home/jutaro/Develop/lws/leksah/pics/ide_rebuild_meta.png- width 0.5cm--\end_inset---\end_layout--\begin_layout Standard-If you select-\emph on- Configuration -> Rebuild workspace data-\emph default-, the metadata for the current project is rebuild.-\end_layout--\begin_layout Standard-If you select -\emph on-Configuration -> Update system data,-\emph default- Leksah checks, if a new library has been installed and then collects metadata- for additions.-\end_layout--\begin_layout Standard-If you select -\emph on-Configuration -> Rebuild system data,-\emph default- Leksah rebuilds all metadata, which may take a long time.- Currently the preferred way to do this is to call leksah-server -rbo +RTS- -N2 from the command line.- The reason for this is that the server process may allocate a lot of memory- during collection.- -\end_layout--\begin_layout Subsection-Background infos-\end_layout--\begin_layout Standard-The metadata collection itself proceeds different for workspace and system- packages:-\end_layout--\begin_layout Itemize-For workspace packages Leksah just uses the parser without typechecking- and maybe .hi files if available.-\end_layout--\begin_layout Itemize-For system packages Leksah uses .hi files and if sources are available Haddock- as a library.- -\end_layout--\begin_layout Standard-Collection for system packages works as follows:-\end_layout--\begin_layout Enumerate-Packages you installed with cabal from Hackage.- If Leksah can't find sources, it does a -\emph on-cabal unpack-\emph default- in the source directory you specified for this in the preferences (By default- .-\emph on-leksah-**/packageSources-\emph default-).-\end_layout--\begin_layout Enumerate-Source files in the folders listed as source folder in the preferences.- Leksah looks for all .cabal files it can find below the source folders.- Therefore, Leksah collects source information only from -\begin_inset Quotes eld-\end_inset--Cabalized-\begin_inset Quotes erd-\end_inset-- projects (i.e., projects that have a .cabal file).- From this information the file source_packages.txt in the .leksah folder- is written.- If you miss sources for a package in Leksah, consult this file if the source- place of the package has been correctly found.- You can run this step by typing in a terminal: -\emph on-leksah-server -o-\emph default- (or -\emph on----\emph default-sources).-\end_layout--\begin_layout Enumerate-Problems may occur due to preprocessing, header files, language extensions,- etc.- Error message produced while metadata collection indicate that not all- information for a package was found.- If the Haddock call doesn't succeed, Leksah looks if it can download a- prebuild metadata package from the server, if this option is selected in- the preferences.-\end_layout--\begin_layout Enumerate-The result of metadata collection is stored in the folder -\emph on-.leksah-*.*/metadata-\emph default- in files called -\emph on-*.lkshm.--\emph default- In this folder for every package a metadata file is stored (e.g.- binary-0.4.1.lkshm).- These files are in binary format.- If you want to rebuild just one package you can delete it here and update- the system metadata.- The files .lkshe specify the base path to sources, if the collection for- sources was successfully or if a metdata file could be downloaded for this.-\end_layout--\begin_layout Standard-For the workspace packages a different procedure is used.- -\end_layout--\begin_layout Enumerate-Metadata is collected from the source directories of the packages you are- working on.- The results are stored in a per module base in a folder with the package- name (-\emph on-e.g .leksah-*.*/metadata/package-*.*.*).- -\end_layout--\begin_layout Enumerate-Update happens on a per file base only for changed source files.-\end_layout--\begin_layout Standard-\begin_inset Float figure-wide false-sideways false-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_metadata_prefs.png- width 60text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:Metadata-Preferences"--\end_inset--Metadata Preferences-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-Configuration-\end_layout--\begin_layout Standard-Leksah is highly customizable and can be adapted to your specific needs- and work organization.- What follows here is not needed for initial use of Leksah (and need not- be read on a first lecture of the manual).- Leksah works well with the default settings and a desire to adapt better- to your work habits comes only with extended use of Leksah.- However, with time, you may use one or the other option to tailor Leksah- to your personal preference.- It is easy! Here it is explained how this works.-\end_layout--\begin_layout Subsection-Layout-\end_layout--\begin_layout Standard-\begin_inset Wrap figure-lines 0-placement O-overhang 0in-width "30col%"-status open--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_panes_menu.png- width 15text%--\end_inset---\begin_inset VSpace bigskip-\end_inset---\end_layout--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_view_menu.png- lyxscale 50- width 25text%--\end_inset---\begin_inset VSpace bigskip-\end_inset---\end_layout--\begin_layout Plain Layout-\align center-\begin_inset Graphics- filename screenshots2/screenshot_config_menu.png- width 25text%--\end_inset---\end_layout--\begin_layout Plain Layout-\begin_inset Caption--\begin_layout Plain Layout-\begin_inset CommandInset label-LatexCommand label-name "fig:View-menu"--\end_inset--View and panes menus-\end_layout--\end_inset---\end_layout--\end_inset---\end_layout--\begin_layout Standard-Leksah has always one special pane, which is called the active pane, and- its name is displayed in the second compartment from the left side in the- status bar.- Some actions like moving, splitting, closing panes or finding or replacing- items in a text buffer act on the current pane, so check the display in- the status bar to see if the pane you want to act on, is really the active- one.-\end_layout--\begin_layout Standard-You can tailor the layout with the View menu to suit your work style better.- Internally, the panes are arranged in a layout of a binary tree, where- the leaves are horizontal or vertical splits.- Every area can be split horizontally or vertically and panes can collapse.- With the commands in the View menu you manipulate this tree to change the- layout.-\end_layout--\begin_layout Standard-In the initial pane positions part of the Preferences, you can configure- the placement of panes.- Panes belongs to categories, and a category specify a path were a pane- will open .- -\end_layout--\begin_layout Standard-The layout of the Leksah window contains areas which contain notebooks which- contain panes.- The division between the two areas is adjustable by the user by dragging- a handle.-\end_layout--\begin_layout Standard-Panes can be moved between areas in the window.- This can be done by dragging the notebook tab, and release it on the frame- of another notebook.- Alternatively you can use keystrokes (Shift Alt Arrow) to move panes around.- The tabs of notebooks can be positioned at any of the four directions,- or the tabs can be switched off.- -\end_layout--\begin_layout Standard-Note that holding the mouse over the tabs and selecting the right button- brings up a menu of all panes in this area, so that you can for example- quickly select one of many open source buffers.-\end_layout--\begin_layout Standard-The layout will be saved with sessions.- The session mechanism will be explained in -\begin_inset CommandInset ref-LatexCommand ref-reference "sub:Session-handling"--\end_inset--.-\begin_inset Foot-status open--\begin_layout Plain Layout- Currently there is no way to load different layouts independent of the- other data stored in a sessions.-\end_layout--\end_inset---\end_layout--\begin_layout Subsubsection-Advanced layout: Group panes-\end_layout--\begin_layout Standard-A notebook cannot only contain single panes, but it can as well contain- group panes, which have a layout on their own and may contain arbitrary- other panes; the debug pane is an example for a group pane.- This gives you the possibility to arrange the subpanes in a debugger pane- as it fits you best.- -\end_layout--\begin_layout Standard-A new group starts by selecting -\noun on-View / Group -\noun default-from the menu.- You have to give a unique name for the group.- Then you can arrange panes in the group as you like.- When closing a group, and the group is not empty, you have to confirm it.-\end_layout--\begin_layout Subsubsection-Using Leksah with multiple displays: Detached windows-\end_layout--\begin_layout Standard-This feature allows you to move panes to a separate window on a separate- display.- This is as simple as: You select a notebook and choose -\noun on-View / Detach-\noun default- from the menu bar.- Then the notebook is opened in a new window, which you can then move to- another screen.- -\end_layout--\begin_layout Standard-When you close the detached window, the pane goes back to the place where- it was before detaching.- The state of detached window is remembered, when you close Leksah, and- they will be reopened when you restart Leksah.-\end_layout--\begin_layout Standard-It is possible to drag and drop panes between windows.- But splitting and collapsing of panes is disabled for detached windows.- So a recommended way to use this feature is to split a pane, arrange the- panes that you want to detach in the area of the new notebook.- Select the new notebook and detach.-\end_layout--\begin_layout Standard-The detached windows have no menu bar, toolbar and status bar on their own.- This may be a problem, when you want to select a menu entry: the focus- changes from a pane in the detached window to a pane in the main window,- and you may not be able to do what you want.- We recommend that you use keystrokes or context menus.- -\end_layout--\begin_layout Subsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Session-handling"--\end_inset--Session handling-\end_layout--\begin_layout Standard-When you close Leksah the current state is saved in the file -\emph on-current.lksks-\emph default- in the -\emph on-~/.leksah-*.*-\emph default- folder.- A session contains the layout of the window, its content, the active package- and some other state.- When you restart Leksah it recovers the state from this information.- -\end_layout--\begin_layout Standard-When you close a workspace, the session is saved in the folder of the workspace- -\emph on-in -\emph default-a file named-\emph on- workspacename.lksks-\emph default-.- When you open a workspace and Leksah finds a -\emph on-workspacename.lksks-\emph default- file together with the workspace file you are going to open, you get prompted- if you want to open this session (this means mostly opening the files you- had open before in the editor).- This helps you to switch between different workspaces you are working on.-\end_layout--\begin_layout Standard-In addition, sessions can be stored and loaded with a name manually by using- the session menu, but the need to use these features occurs rarely.- The menu Configuration -> Forget Session is useful if you inadvertently- changed the layout drastically and do not want the current session to be- stored.- -\end_layout--\begin_layout Subsection-\begin_inset CommandInset label-LatexCommand label-name "sub:Shortcuts"--\end_inset--Shortcuts-\end_layout--\begin_layout Standard-You can configure the keystrokes by providing a keymap file, which should- be be in the ~/.leksah-0.8 folder.- The name of the key map file to be used can be specified in the Preferences- dialog (without extension!).- -\end_layout--\begin_layout Standard-A line in the .keymap file looks like:-\end_layout--\begin_layout Standard-<ctrl>o -> FileOpen "Opens an existing file"-\end_layout--\begin_layout Standard-Description of the key or key combination: Allowed modifiers are <shift>- <ctrl> <alt> <apple> <compose>.- <apple> is on a Microsoft keyboard the windows key (and on a Mac, obviously,- the apple key!).- <compose> is right ALT key, often labeled Alt Gr.- It is as well possible to specify Emacs like keystrokes in the following- way: <ctrl>x/<ctrl>f -> FileOpen "Opens an existing file"-\end_layout--\begin_layout Standard-The name of the action can be any one of the -\emph on-ActionDescr's-\emph default- given in the -\emph on-action-\emph default- function in the Module -\emph on-IDE.-\emph default-Command.- The comment following will be displayed as tool tip for the toolbar button,- if one exists for this action.- -\end_layout--\begin_layout Standard-Every keystroke must at most be associated with one action, and every action- may only have one associated keystroke.-\end_layout--\begin_layout Standard-Simple keystrokes are shown in the menu, but Emacs like keystrokes are not.- This is because simple keystrokes are handled by the standard GTK mechanism,- while other keystrokes are handled by Leksah.-\end_layout--\begin_layout Standard-Independently how you initiated an action, by a menu, a toolbar button or- a keystroke, the keystroke with its associated ActionsString is displayed- in the Status bar in the leftmost compartment.- -\end_layout--\begin_layout Subsection-Configuration files-\end_layout--\begin_layout Standard-Leksah stores its configuration in a directory called ~/.leksah-*.* under- your home folder.- Indexing the hidden Leksah directory with the version number avoids that- changes to preferences file layout from version to version cause difficulties.- Moving your preferences from a previous version can potentially be automatic.-\end_layout--\begin_layout Standard-The file -\emph on-prefs.lkshp-\emph default- stores the general preferences.- It is a text file you could edit with a text editor, but more comfortable- and safer is to do it in Leksah with the menu -\noun on-Configuration / Edit Prefs-\noun default- from the menu.- -\end_layout--\begin_layout Standard-If no preference file is found in your .leksah-*.* folder then the global- prefs.lkshp in the installed data folder will be used.- If a preference file get corrupted, which means Leksah does not start;- it is then often sufficient to just delete the preference file.-\end_layout--\begin_layout Standard-The source_packages.txt file stores source locations for installed packages.- It can be rebuild by calling leksah-server in a terminal with the -o or- --sources argument .- Do this after you moved your source or added sources for previous installed- packages without sources.- -\end_layout--\begin_layout Standard-Files for Keymaps (keymap.lkshk) and SourceCandy(candy.lkshc) may be stored- in the ~/.leksah-*.* folder and will be found according to the name selected- in the Preferences Dialog.- Leksah first searches in this folder and after this in the /data folder.- -\begin_inset Newpage pagebreak-\end_inset---\end_layout--\begin_layout Section-The Leksah Project-\end_layout--\begin_layout Standard-The development of an integrated Development Environment is a major undertaking- and Leksah should become increasingly supported by the user community.- If you are a user or just test Leksah, we would appreciate to here from- you.- Do not miss to report bugs, unclear or wrong information in the documentation- and suggestion for improvements on the Leksah issue tracker.-\end_layout--\begin_layout Standard-Everyone is invited to contribute.- Spreading the word, supplying error reports, providing keymap and candy- files, providing a tutorial, caring for a platform will develop are all- helpful and meaningful ways to contribute.-\end_layout--\begin_layout Standard-Leksah will advance over time and become more useful.- Possible extension and enhancements are:-\end_layout--\begin_layout Itemize-Package editor with configurations-\end_layout--\begin_layout Itemize-Add traces to the Debugger-\end_layout--\begin_layout Itemize-Support for some kind of plug-ins or extensions-\end_layout--\begin_layout Itemize-Context enriched completion-\end_layout--\begin_layout Itemize-Version Control (Darcs, ...)-\end_layout--\begin_layout Itemize-Testing (Quick check,...)-\end_layout--\begin_layout Itemize-Object browser-\end_layout--\begin_layout Itemize-Coverage (HPC,...)-\end_layout--\begin_layout Itemize-Profiling (Ghc Profiler,...)-\end_layout--\begin_layout Itemize-Re-factoring (HaRe,...)-\end_layout--\begin_layout Itemize-FAD (Functional Analysis and Design,...)-\end_layout--\begin_layout Standard-Acknowledgment -\end_layout--\begin_layout Standard-Thanks to Ricardo Herrmann for making the new Leksah logo.- -\end_layout--\begin_layout Standard-Thanks to Fabian Emmes, who created the icons for the module browser.-\end_layout--\begin_layout Standard-Thanks to Lakshmi Narasimhan for packaging for Fedora.-\end_layout--\begin_layout Standard-Thanks to all others who helped us with patches, bug reports and helpful- feedback.- -\end_layout--\begin_layout Standard-\begin_inset Newpage newpage-\end_inset---\end_layout--\begin_layout Section-Appendix-\end_layout--\begin_layout Subsection-Command line arguments-\end_layout--\begin_layout Standard-for leksah-server:-\end_layout--\begin_layout LyX-Code--\size scriptsize-Leksah Haskell IDE (server) Usage: leksah-server [OPTION...] files...- -\end_layout--\begin_layout LyX-Code--\size scriptsize--s --system Collects new information for installed- packages -\end_layout--\begin_layout LyX-Code--\size scriptsize--r[Maybe Port] --server[=Maybe Port] Start as server.- -\end_layout--\begin_layout LyX-Code--\size scriptsize--b --rebuild Modifier for -s and -p: Rebuild metadata- -\end_layout--\begin_layout LyX-Code--\size scriptsize--o --sources Modifier for -s: Gather info about- pathes to sources -\end_layout--\begin_layout LyX-Code--\size scriptsize--v --version Show the version number of ide - -\end_layout--\begin_layout LyX-Code--\size scriptsize--h --help Display command line options -\end_layout--\begin_layout LyX-Code--\size scriptsize--d --debug Write ascii pack files -\end_layout--\begin_layout LyX-Code--\size scriptsize--e Verbosity --verbosity=Verbosity One of DEBUG, INFO, NOTICE, WARNING,- ERROR, CRITICAL, ALERT, EMERGENCY -\end_layout--\begin_layout LyX-Code--\size scriptsize--l LogFile --logfile=LogFile File path for logging messages - -\end_layout--\begin_layout LyX-Code--\size scriptsize--f --forever Don't end the server when last connection- ends -\end_layout--\begin_layout LyX-Code--\size scriptsize--c --endWithLast End the server when last connection- ends -\size default- -\end_layout--\begin_layout Standard-for leksah:-\end_layout--\begin_layout LyX-Code--\size scriptsize-Usage: leksah [OPTION...] files...- -\end_layout--\begin_layout LyX-Code--\size scriptsize--v --Version Show the version number of ide -\end_layout--\begin_layout LyX-Code--\size scriptsize--l NAME --LoadSession=NAME Load session -\end_layout--\begin_layout LyX-Code--\size scriptsize--h --Help Display command line options -\end_layout--\begin_layout LyX-Code--\size scriptsize--e Verbosity --verbosity=Verbosity One of DEBUG, INFO, NOTICE, WARNING,- -\end_layout--\begin_layout LyX-Code--\size scriptsize- ERROR, CRITICAL, ALERT, EMERGENCY-\end_layout--\begin_layout Subsection-The Candy file-\end_layout--\begin_layout LyX-Code--\size scriptsize-"->" 0x2192 Trimming --RIGHTWARDS ARROW -\end_layout--\begin_layout LyX-Code--\size scriptsize-"<-" 0x2190 Trimming --LEFTWARDS ARROW -\end_layout--\begin_layout LyX-Code--\size scriptsize-"=>" 0x21d2 --RIGHTWARDS DOUBLE ARROW -\end_layout--\begin_layout LyX-Code--\size scriptsize-">=" 0x2265 --GREATER-THAN OR EQUAL TO -\end_layout--\begin_layout LyX-Code--\size scriptsize-"<=" 0x2264 --LESS-THAN OR EQUAL TO -\end_layout--\begin_layout LyX-Code--\size scriptsize-"/=" 0x2260 --NOT EQUAL TO -\end_layout--\begin_layout LyX-Code--\size scriptsize-"&&" 0x2227 --LOGICAL AND -\end_layout--\begin_layout LyX-Code--\size scriptsize-"||" 0x2228 --LOGICAL OR -\end_layout--\begin_layout LyX-Code--\size scriptsize-"++" 0x2295 --CIRCLED PLUS -\end_layout--\begin_layout LyX-Code--\size scriptsize--- "::" 0x2237 Trimming --PROPORTION -\end_layout--\begin_layout LyX-Code--\size scriptsize--- ".." 0x2025 --TWO DOT LEADER -\end_layout--\begin_layout LyX-Code--\size scriptsize-"^" 0x2191 --UPWARDS ARROW -\end_layout--\begin_layout LyX-Code--\size scriptsize-"==" 0x2261 --IDENTICAL TO -\end_layout--\begin_layout LyX-Code--\size scriptsize-" .- " 0x2218 --RING OPERATOR -\end_layout--\begin_layout LyX-Code--\size scriptsize-"-\backslash-" 0x03bb --GREEK SMALL LETTER LAMBDA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"=<<" 0x291e -- -\end_layout--\begin_layout LyX-Code--\size scriptsize-">>=" 0x21a0 -- -\end_layout--\begin_layout LyX-Code--\size scriptsize--- "$" 0x25ca -- -\end_layout--\begin_layout LyX-Code--\size scriptsize-">>" 0x226b -- MUCH GREATER THEN -\end_layout--\begin_layout LyX-Code--\size scriptsize-"forall" 0x2200 --FOR ALL -\end_layout--\begin_layout LyX-Code--\size scriptsize--- "exist" 0x2203 --THERE EXISTS -\end_layout--\begin_layout LyX-Code--\size scriptsize-"not" 0x00ac --NOT SIGN-\end_layout--\begin_layout LyX-Code--\size scriptsize-"alpha" 0x03b1 --ALPHA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"beta" 0x03b2 --BETA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"gamma" 0x03b3 --GAMMA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"delta" 0x03b4 --DELTA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"epsilon" 0x03b5 --EPSILON -\end_layout--\begin_layout LyX-Code--\size scriptsize-"zeta" 0x03b6 --ZETA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"eta" 0x03b7 --ETA -\end_layout--\begin_layout LyX-Code--\size scriptsize-"theta" 0x03b8 --THETA-\end_layout--\begin_layout Subsection-The Keymap file-\end_layout--\begin_layout LyX-Code--\size tiny---Default Keymap file for Leksah-\end_layout--\begin_layout LyX-Code--\size tiny---Allowed Modifiers are <shift> <ctrl> <alt> <apple> <compose>-\end_layout--\begin_layout LyX-Code--\size tiny---<apple> is the Windows key on PC keyboards-\end_layout--\begin_layout LyX-Code--\size tiny---<compose> is often labelled Alt Gr.-\end_layout--\begin_layout LyX-Code--\size tiny---The defined values for the keys can can be found at-\end_layout--\begin_layout LyX-Code--\size tiny--- http://gitweb.freedesktop.org/?p=xorg/proto/x11proto.git;a=blob_plain;f=keysymde-f.h.-\end_layout--\begin_layout LyX-Code--\size tiny--- The names of the keys are the names of the macros without the prefix.-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny---File-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>n -> FileNew "Opens a new empty- buffer"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>o -> FileOpen "Opens an existing- file"-\end_layout--\begin_layout LyX-Code--\size tiny---<ctrl>x/<ctrl>f -> FileOpen "Opens an existing- file"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>s -> FileSave "Saves the current- buffer"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>s -> FileSaveAll "Saves all modified- buffers"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>w -> FileClose "Closes the current- buffer"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<alt>F4 -> Quit "Quits this program"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny---Edit-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>z -> EditUndo "Undos the last user- action"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<shift><ctrl>y -> EditRedo "Redos the last user- action"-\end_layout--\begin_layout LyX-Code--\size tiny---<ctrl>x/r -> EditRedo "Redos the last user- action"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>a -> EditSelectAll "Select the whole- text in the current buffer"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>f -> EditFind "Search for a text- string (Toggles the "-\end_layout--\begin_layout LyX-Code--\size tiny-F3 -> EditFindNext "Find the next- occurence of the text string"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<shift>F3 -> EditFindPrevious "Find the previous- occurence of the text string"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>l -> EditGotoLine "Go to line with- a known index"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><alt>Right -> EditComment "Add a line style- comment to the selected lies"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><alt>Left -> EditUncomment "Remove a line style- comment"-\end_layout--\begin_layout LyX-Code--\size tiny-<alt>Right -> EditShiftRight "Shift right"-\end_layout--\begin_layout LyX-Code--\size tiny-<alt>Left -> EditShiftLeft "Shift Left"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny---View-\end_layout--\begin_layout LyX-Code--\size tiny-<alt><shift>Left -> ViewMoveLeft "Move the current- pane left"-\end_layout--\begin_layout LyX-Code--\size tiny-<alt><shift>Right -> ViewMoveRight "Move the current- pane right"-\end_layout--\begin_layout LyX-Code--\size tiny-<alt><shift>Up -> ViewMoveUp "Move the current- pane up"-\end_layout--\begin_layout LyX-Code--\size tiny-<alt><shift>Down -> ViewMoveDown "Move the current- pane down"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>2 -> ViewSplitHorizontal-\end_layout--\begin_layout LyX-Code--\size tiny- "Split the current pane- in horizontal direction"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>3 -> ViewSplitVertical-\end_layout--\begin_layout LyX-Code--\size tiny- "Split the current pane- in vertical direction"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>1 -> ViewCollapse "Collapse the panes- around the currentla selected pane into one"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny- -> ViewTabsLeft "Shows the tabs of the- current notebook on the left"-\end_layout--\begin_layout LyX-Code--\size tiny- -> ViewTabsRight "Shows the tabs of the- current notebook on the right"-\end_layout--\begin_layout LyX-Code--\size tiny- -> ViewTabsUp "Shows the tabs of the- current notebook on the top"-\end_layout--\begin_layout LyX-Code--\size tiny- -> ViewTabsDown "Shows the tabs of the- current notebook on the bottom"-\end_layout--\begin_layout LyX-Code--\size tiny- -> ViewSwitchTabs "Switches if tabs for- the current notebook are visible"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>t -> ToggleToolbar-\end_layout--\begin_layout LyX-Code--\size tiny- -> HelpDebug-\end_layout--\begin_layout LyX-Code--\size tiny- -> HelpAbout-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>b -> BuildPackage-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>r -> AddAllImports-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><alt>r -> RunPackage-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>j -> NextError-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>j -> PreviousError-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>o -> ShowModules-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny---<ctrl>i -> ShowInterface-\end_layout--\begin_layout LyX-Code--\size tiny--- <ctrl>i -> ShowInfo-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>e -> EditAlignEqual-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>l -> EditAlignLeftArrow-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>r -> EditAlignRightArrow-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl><shift>t -> EditAlignTypeSig-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<alt>i -> AddOneImport-\end_layout--\begin_layout LyX-Code--\size tiny-<alt><shift>i -> AddAllImports-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny--- "For the next to entries the <ctrl> modifier is mandatory"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>Page_Up -> FlipUp "Switch to next pane- in reverse recently used oder"-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>Page_Down -> FlipDown "Switch to next pane- in recently used oder"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>space -> StartComplete "Initiate complete in- a source buffer"-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-F6 -> DebugStep-\end_layout--\begin_layout LyX-Code--\size tiny-F7 -> DebugStepLocal-\end_layout--\begin_layout LyX-Code--\size tiny-F8 -> DebugStepModule-\end_layout--\begin_layout LyX-Code--\size tiny-F9 -> DebugContinue-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>Return -> ExecuteSelection-\end_layout--\begin_layout LyX-Code--\size tiny-<ctrl>m -> UpdateMetadataCurrent-\end_layout--\begin_layout LyX-Code--\end_layout--\begin_layout LyX-Code--\end_layout--\end_body-\end_document
binary file changed (20899 → absent bytes)
− doc/screenshots2/screenshot_completion.png
binary file changed (44944 → absent bytes)
binary file changed (11280 → absent bytes)
− doc/screenshots2/screenshot_construct_module.png
binary file changed (13750 → absent bytes)
binary file changed (13557 → absent bytes)
− doc/screenshots2/screenshot_debug_pane.png
binary file changed (23853 → absent bytes)
binary file changed (27508 → absent bytes)
− doc/screenshots2/screenshot_error_pane.png
binary file changed (68766 → absent bytes)
binary file changed (19782 → absent bytes)
− doc/screenshots2/screenshot_findbar.png
binary file changed (10400 → absent bytes)
− doc/screenshots2/screenshot_first_start.png
binary file changed (54948 → absent bytes)
− doc/screenshots2/screenshot_grep.png
binary file changed (94039 → absent bytes)
binary file changed (3249 → absent bytes)
− doc/screenshots2/screenshot_metadata_prefs.png
binary file changed (51760 → absent bytes)
− doc/screenshots2/screenshot_module_browser.png
binary file changed (78083 → absent bytes)
− doc/screenshots2/screenshot_package_editor_1.png
binary file changed (55153 → absent bytes)
− doc/screenshots2/screenshot_package_flags.png
binary file changed (22767 → absent bytes)
binary file changed (19896 → absent bytes)
binary file changed (7113 → absent bytes)
− doc/screenshots2/screenshot_prefs_editor.png
binary file changed (65463 → absent bytes)
− doc/screenshots2/screenshot_serach_pane.png
binary file changed (92625 → absent bytes)
− doc/screenshots2/screenshot_source_candy.png
binary file changed (31551 → absent bytes)
binary file changed (21466 → absent bytes)
− doc/screenshots2/screenshot_welcome.png
binary file changed (171095 → absent bytes)
binary file changed (15935 → absent bytes)
language-specs/haskell.lang view
@@ -206,11 +206,12 @@ <keyword>=</keyword> <keyword>\|</keyword> <keyword>\</keyword>- <keyword>-></keyword>- <keyword><-</keyword> <keyword>@</keyword> <keyword>~</keyword> <keyword>=></keyword>+ <keyword>-></keyword>+ <keyword><-</keyword>+ <keyword>\\</keyword> </context> <define-regex id="escaped-character" extended="true">
leksah.cabal view
@@ -1,10 +1,10 @@ name: leksah-version: 0.15.2.0+version: 0.16.2.2 cabal-version: >=1.18 build-type: Simple license: GPL license-file: LICENSE-copyright: 2007-2014 Juergen Nicklisch-Franken, Hamish Mackenzie+copyright: 2007-2016 Juergen Nicklisch-Franken, Hamish Mackenzie, Jacco Krijnen, JP Moresmau maintainer: maintainer@leksah.org stability: provisional homepage: http://www.leksah.org@@ -14,8 +14,8 @@ description: An Integrated Development Environment for Haskell written in Haskell. category: Development, IDE, Editor-author: Juergen Nicklisch-Franken, Hamish Mackenzie-tested-with: GHC ==7.2.2+author: Juergen Nicklisch-Franken, Hamish Mackenzie, Jacco Krijnen, JP Moresmau+tested-with: GHC == 8.2.1, GHC == 8.0.2 data-files: LICENSE Readme.md@@ -34,6 +34,7 @@ data/testmain.lksht data/module.lksht data/welcome.txt+ data/leksah-welcome/cabal.project data/leksah-welcome/Setup.lhs data/leksah-welcome/leksah-welcome.cabal data/leksah-welcome/LICENSE@@ -63,6 +64,7 @@ pics/ide_error_next.png pics/ide_error_prev.png pics/ide_function.png+ pics/ide_git.png pics/ide_instance.png pics/ide_konstructor.png pics/ide_make.png@@ -91,33 +93,9 @@ pics/ide_error.png pics/ide_warning.png pics/ide_suggestion.png- doc/Keybindings.svg- doc/leksah_manual.lyx- doc/screenshots2/screenshot_buffer_menu.png- doc/screenshots2/screenshot_completion.png- doc/screenshots2/screenshot_config_menu.png- doc/screenshots2/screenshot_construct_module.png- doc/screenshots2/screenshot_debug_menu.png- doc/screenshots2/screenshot_debug_pane.png- doc/screenshots2/screenshot_edit_menu.png- doc/screenshots2/screenshot_error_pane.png- doc/screenshots2/screenshot_file_menu.png- doc/screenshots2/screenshot_findbar.png- doc/screenshots2/screenshot_first_start.png- doc/screenshots2/screenshot_grep.png- doc/screenshots2/screenshot_help_menu.png- doc/screenshots2/screenshot_metadata_prefs.png- doc/screenshots2/screenshot_module_browser.png- doc/screenshots2/screenshot_package_editor_1.png- doc/screenshots2/screenshot_package_flags.png- doc/screenshots2/screenshot_package_menu.png- doc/screenshots2/screenshot_panes_menu.png- doc/screenshots2/screenshot_prefs_editor.png- doc/screenshots2/screenshot_serach_pane.png- doc/screenshots2/screenshot_source_candy.png- doc/screenshots2/screenshot_view_menu.png- doc/screenshots2/screenshot_welcome.png- doc/screenshots2/screenshot_workspace_menu.png+ pics/ide_doc_build.png+ pics/ide_bench_build.png+ pics/ide_test_build.png scripts/clean.sh scripts/stage.sh osx/bundle.sh@@ -182,11 +160,21 @@ type: git location: https://github.com/leksah/leksah +flag webkit2+ description:+ Use WebKit 2 version of WebKitGTK++ default: True+ flag yi description: Experimental Yi support default: False +flag codemirror+ description:+ Experimental codemirror editor+ default: False+ flag dyre description: Experimental Yi support@@ -204,6 +192,14 @@ description: Get Network.URI from the network-uri package +flag gtk-318+ description:+ GTK+ is 3.18 or later++flag gtk-320+ description:+ GTK+ is 3.20 or later+ library if os(windows)@@ -217,13 +213,20 @@ if os(osx) build-depends:- gtk3-mac-integration >=0.3.1.0 && <0.4+ gi-gtkosxapplication >=2.0.2 && <2.1 + if flag(webkit2) && !os(windows)+ build-depends:+ gi-webkit2 >=4.0.6 && <4.1+ else+ build-depends:+ gi-webkit >=3.0.6 && <3.1+ if flag(yi) build-depends:- yi >=0.11.2 && <0.12,- yi-language >=0.1.0.8 && <0.2,- yi-rope >=0.7.0.0 && <0.8+ yi >=0.12.4 && <0.13,+ yi-language >=0.2.0 && <0.3,+ yi-rope >=0.7.0.1 && <0.8 cpp-options: -DLEKSAH_WITH_YI if (flag(yi) && flag(dyre))@@ -231,6 +234,12 @@ dyre >=0.8.3 && <0.9 cpp-options: -DLEKSAH_WITH_YI_DYRE + if (flag(codemirror))+ build-depends:+ jsaddle >=0.4.0.0 && <0.5,+ lens -any+ cpp-options: -DLEKSAH_WITH_CODE_MIRROR+ if (flag(loc) && os(linux)) build-depends: hgettext -any,@@ -248,21 +257,36 @@ if impl(ghc >=7.2) build-depends: binary-shared >=0.8.2++ if flag(gtk-318)+ cpp-options: -DMIN_VERSION_GTK_3_18+ pkgconfig-depends: gtk+-3.0 >=3.18++ if flag(gtk-320)+ cpp-options: -DMIN_VERSION_GTK_3_20+ pkgconfig-depends: gtk+-3.0 >=3.20++ if !impl(ghcjs)+ build-depends:+ ghc >=6.10.1 && <8.3,+ haskell-src-exts >=1.13.5 && <1.19,+ leksah-server >=0.16.2.0 && <0.17+ exposed-modules: IDE.HLint IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find- IDE.Sandbox IDE.Session IDE.Command IDE.Keymap+ IDE.Utils.CabalUtils IDE.Utils.DirectoryUtils IDE.Utils.GUIUtils IDE.SymbolNavigation IDE.Package- IDE.YiConfig+ IDE.TextEditor.Yi.Config IDE.OSX IDE.GUIHistory IDE.SourceCandy@@ -314,26 +338,30 @@ IDE.TextEditor.Yi IDE.TextEditor.GtkSourceView IDE.Utils.ExternalTool- IDE.Utils.GtkBindings+ IDE.LPaste build-depends: base-compat >=0.9.0 && <0.10,- gtk3 >=0.14.1 && <0.15,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 >=0.13 && <0.15,- webkitgtk3-javascriptcore -any,- jsaddle >=0.3.0.0 && <0.4,+ haskell-gi-base >=0.18 && <0.21,+ gi-glib >=2.0.6 && <2.1,+ gi-gobject >=2.0.6 && <2.1,+ gi-gio >=2.0.6 && <2.1,+ gi-cairo >=1.0.6 && <1.1,+ gi-gdk >=3.0.6 && <3.1,+ gi-gdkpixbuf >=2.0.6 && <2.1,+ gi-gtk >=3.0.13 && <3.1,+ gi-pango >=1.0.6 && <1.1,+ gi-gtksource >=3.0.6 && <3.1,+ gi-gtk-hs >=0.3.0.0 && <0.4, ghcjs-codemirror -any, blaze-html -any,- lens -any, pretty-show >=1.6.3 && <1.7,- Cabal >=1.10.2.0 && <1.23,- base >=4.0.0.0 && <4.9,- binary >=0.5.0.0 && <0.8,+ Cabal >=1.24.0.0 && <2.1,+ base >=4.0.0.0 && <4.11,+ binary >=0.5.0.0 && <0.9, bytestring >=0.9.0.1 && <0.11, containers >=0.2.0.0 && <0.6,- directory >=1.0.0.2 && <3.1,+ directory >=1.0.0.2 && <1.4, filepath >=1.1.0.1 && <1.5,- glib >=0.13.2.1 && <0.14, mtl >=1.1.0.2 && <2.3, old-time >=1.0.0.1 && <1.2, parsec >=2.1.0.1 && <3.2,@@ -343,29 +371,28 @@ 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.4 && <0.16,+ time >=0.1 && <1.9,+ ltk >=0.16.0.0 && <0.17, binary-shared >=0.8 && <0.9, deepseq >=1.1.0.0 && <1.5, hslogger >=1.0.7 && <1.3,- leksah-server >=0.15.2.0 && <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,+ transformers >=0.2.2.0 && <0.6, executable-path >=0.0.3 && <0.1,- vcsgui >=0.1.0 && <0.2,+ vcsgui >=0.2.0 && <0.3, vcswrapper >=0.1.0 && <0.2,- QuickCheck >=2.4.2 && <2.9,- haskell-src-exts >=1.13.5 && <1.18,- hlint >=1.9.21 && <1.10,+ QuickCheck >=2.4.2 && <2.10,+ hlint >=1.9.21 && <2.1, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1,- cpphs >=1.19 && <1.20,- stm >=2.4.4 && <2.5- cpp-options: -DWEBKITGTK -DLEKSAH_WITH_CODE_MIRROR+ cpphs >=1.19 && <1.21,+ stm >=2.4.4 && <2.5,+ split >= 0.2.3.1,+ HTTP >= 4000.3.3,+ fsnotify >=0.2.1 && <0.3,+ haskell-gi-overloading ==0.0.* default-language: Haskell2010 default-extensions: ViewPatterns hs-source-dirs: src@@ -398,57 +425,62 @@ if os(osx) ghc-options: -optl-headerpad_max_install_names++ if !impl(ghcjs)+ build-depends:+ leksah-server -any+ main-is: Main.hs build-depends:- leksah ==0.15.2.0,- base >=4.0.0.0 && <=4.9,- gtk3 >=0.14.1 && <0.15,+ leksah,+ base >=4.0.0.0 && <4.11,+ gi-gtk-hs >=0.3.1.0 && <0.4, stm >=2.4.4 && <2.5 default-language: Haskell2010 hs-source-dirs: main ghc-options: -rtsopts -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans -executable bewleksah- main-is: Main.hs- build-depends:- leksah ==0.15.2.0,- base >=4.0.0.0 && <=4.9,- jsaddle -any,- ghcjs-dom >=0.2.1.0 && <0.3,- gtk3 >=0.14.1 && <0.15,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 >=0.13 && <0.15,- webkitgtk3-javascriptcore -any,- stm >=2.4.4 && <2.5- default-language: Haskell2010- hs-source-dirs: bew--test-suite tests+--executable bewleksah+-- main-is: Main.hs+-- build-depends:+-- leksah,+-- base >=4.0.0.0 && <4.11,+-- jsaddle -any,+-- ghcjs-dom >=0.4.0.0 && <0.5,+-- gi-gtk-hs >=0.3.0.0 && <0.4,+-- gi-gtksource >=3.0.2 && <3.1,+-- gi-webkit2 >=4.0.6 && <4.1,+-- webkitgtk3-javascriptcore -any,+-- stm >=2.4.4 && <2.5+-- default-language: Haskell2010+-- hs-source-dirs: bew - if flag(yi)- build-depends:- yi -any- type: exitcode-stdio-1.0- main-is: Tests.hs- 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.2.0,- containers -any,- ltk -any,- leksah-server -any,- hslogger -any,- transformers -any,- glib -any,- monad-loops -any,- text -any,- gtk3 >=0.14.1 && <0.15,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 -any,- stm >=2.4.4 && <2.5- default-language: Haskell2010- hs-source-dirs: tests- other-modules:- IDE.TextEditor.Tests- ghc-options: -threaded+--test-suite tests+--+-- if flag(yi)+-- build-depends:+-- yi -any+-- type: exitcode-stdio-1.0+-- main-is: Tests.hs+-- build-depends:+-- base >=4.0.0.0 && <4.11,+-- Cabal >=1.24.0.0 && <2.1,+-- QuickCheck >=2.4.2 && <2.10,+-- leksah,+-- containers -any,+-- ltk -any,+-- leksah-server -any,+-- hslogger -any,+-- transformers -any,+-- monad-loops -any,+-- text -any,+-- gi-glib >=2.0.2 && <2.1,+-- gi-gtk >=3.0.2 && <3.1,+-- gi-gtksource >=3.0.2 && <3.1,+-- gi-gtk-hs >=0.3.0.0 && <0.4,+-- stm >=2.4.4 && <2.5+-- default-language: Haskell2010+-- hs-source-dirs: tests+-- other-modules:+-- IDE.TextEditor.Tests+-- ghc-options: -threaded
main/Main.hs view
@@ -17,7 +17,7 @@ module Main (main) where import IDE.Leksah (leksah)-import IDE.YiConfig (defaultYiConfig)+import IDE.TextEditor.Yi.Config (defaultYiConfig) #ifdef LOCALIZATION
osx/Info.plist view
@@ -7,7 +7,7 @@ <key>CFBundleExecutable</key> <string>Leksah</string> <key>CFBundleGetInfoString</key>- <string>0.15.0.0</string>+ <string>0.16.1.0</string> <key>CFBundleIconFile</key> <string>leksah.icns</string> <key>CFBundleIdentifier</key>@@ -17,11 +17,11 @@ <key>CFBundlePackageType</key> <string>APPL</string> <key>CFBundleShortVersionString</key>- <string>0.15.0.0</string>+ <string>0.16.1.0</string> <key>CFBundleSignature</key> <string>????</string> <key>CFBundleVersion</key>- <string>0.15.0.0</string>+ <string>0.16.1.0</string> <key>NSHumanReadableCopyright</key> <string>2007-2011 Jürgen Nicklisch-Franken, GNU General Public License.</string> <key>LSMinimumSystemVersion</key>
osx/launcher.sh view
@@ -1,5 +1,9 @@ #!/bin/bash +if test -e /etc/profile; then+ . /etc/profile+fi+ if test -e ~/.bash_profile; then . ~/.bash_profile elif test -e ~/.profile; then@@ -36,7 +40,7 @@ export PATH="$bundle_bin":$PATH export GTK2_RC_FILES="$bundle_etc/gtk-3.0/gtkrc"-export GDK_PIXBUF_MODULE_FILE="$bundle_etc/gtk-3.0/gdk-pixbuf.loaders"+export GDK_PIXBUF_MODULE_FILE="$bundle_lib/gdk-pixbuf-2.0/2.10.0/loaders.cache" export FONTCONFIG_PATH="$bundle_etc/fonts" export PANGO_RC_FILE="$bundle_etc/pango/pangorc" export PANGO_LIBDIR="$bundle_lib"
osx/leksah.bundle view
@@ -57,13 +57,23 @@ --> <plist>${project}/Info.plist</plist> - <main-binary>${prefix:leksah-bin}/bin/leksah</main-binary>+ <main-binary>${prefix:leksah-bin}/c/leksah/build/leksah/leksah</main-binary> - <binary>${prefix:leksah-server-bin}/bin/leksahecho</binary>- <binary>${prefix:leksah-server-bin}/bin/leksahtrue</binary>- <binary>${prefix:leksah-server-bin}/bin/leksah-server</binary>- <binary>${prefix:vcsgui-bin}/bin/vcsgui</binary>- <binary>${prefix:vcsgui-bin}/bin/vcsgui-askpass</binary>+ <binary dest="${bundle}/Contents/Resources/bin/leksahecho">+ ${prefix:leksah-server-bin}/c/leksahecho/build/leksahecho/leksahecho+ </binary>+ <binary dest="${bundle}/Contents/Resources/bin/leksahtrue">+ ${prefix:leksah-server-bin}/c/leksahtrue/build/leksahtrue/leksahtrue+ </binary>+ <binary dest="${bundle}/Contents/Resources/bin/leksah-server">+ ${prefix:leksah-server-bin}/c/leksah-server/build/leksah-server/leksah-server+ </binary>+ <binary dest="${bundle}/Contents/Resources/bin/vcsgui">+ ${prefix:vcsgui-bin}/c/vcsgui/build/vcsgui/vcsgui+ </binary>+ <binary dest="${bundle}/Contents/Resources/bin/vcsgui-askpass">+ ${prefix:vcsgui-bin}/c/vcsgui-askpass/build/vcsgui-askpass/vcsgui-askpass+ </binary> <!-- Copy in the input methods. Dunno if they actually work with OSX. Note the ${gtkdir} macro, which expands to the correct@@ -121,16 +131,40 @@ ${prefix}/share/gtksourceview-3.0 </data> - <data dest="${bundle}/Contents/Resources/share/leksah">- ${prefix:leksah}+ <data dest="${bundle}/Contents/Resources/share/leksah/LICENSE">+ ${prefix:leksah}/LICENSE </data> + <data dest="${bundle}/Contents/Resources/share/leksah/Readme.md">+ ${prefix:leksah}/Readme.md+ </data>++ <data dest="${bundle}/Contents/Resources/share/leksah/data">+ ${prefix:leksah}/data+ </data>++ <data dest="${bundle}/Contents/Resources/share/leksah/docs">+ ${prefix:leksah}/docs+ </data>++ <data dest="${bundle}/Contents/Resources/share/leksah/language-specs">+ ${prefix:leksah}/language-specs+ </data>++ <data dest="${bundle}/Contents/Resources/share/leksah/pics">+ ${prefix:leksah}/pics+ </data>+ <data dest="${bundle}/Contents/Resources/share/hlint"> ${prefix:hlint}/share </data> - <data dest="${bundle}/Contents/Resources/share/vcsgui">- ${prefix:vcsgui}/share+ <data dest="${bundle}/Contents/Resources/share/vcsgui/LICENSE">+ ${prefix:vcsgui}/LICENSE+ </data>++ <data dest="${bundle}/Contents/Resources/share/vcsgui/data">+ ${prefix:vcsgui}/data </data> <!-- Copy in the themes data. You may want to trim this to save space
osx/makedmg.sh view
@@ -4,15 +4,17 @@ . scripts/stage.sh || exit -export GHC_USER_PREFIX=$HOME/Library/Haskell/ghc-`ghc$GHCVERSION --numeric-version`/lib-export LEKSAH_BIN_DIR=$GHC_USER_PREFIX/$LEKSAH_X_X_X_X-export LEKSAH_PREFIX=$GHC_USER_PREFIX/$LEKSAH_X_X_X_X/share-export LEKSAH_SERVER_BIN_DIR=$GHC_USER_PREFIX/$LEKSAH_SERVER_X_X_X_X-export LEKSAH_SERVER_PREFIX=$GHC_USER_PREFIX/$LEKSAH_SERVER_X_X_X_X/share-export VCSGUI_BIN_DIR=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`-export VCSGUI_PREFIX=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`-export HLINT_PREFIX=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *hlint-' | head -n1 | tr -d ' \n'`+GHCVERSIONNUM=`ghc$GHCVERSION --numeric-version` +export CABAL_STORE=$HOME/.cabal/store/ghc-$GHCVERSIONNUM+export LEKSAH_BIN_DIR=`pwd`/dist-newstyle/build/x86_64-osx/ghc-$GHCVERSIONNUM/$LEKSAH_X_X_X_X+export LEKSAH_PREFIX=`pwd`+export LEKSAH_SERVER_BIN_DIR=`pwd`/dist-newstyle/build/x86_64-osx/ghc-$GHCVERSIONNUM/$LEKSAH_SERVER_X_X_X_X+export LEKSAH_SERVER_PREFIX=`pwd`/vendor/leksah-server+export VCSGUI_BIN_DIR=`pwd`/`ls -d dist-newstyle/build/x86_64-osx/ghc-$GHCVERSIONNUM/vcsgui-*`+export VCSGUI_PREFIX=`pwd`/vendor/haskellVCSGUI/vcsgui+export HLINT_PREFIX=$CABAL_STORE/`sed 's/^.*\(hlint-[0-9\.]*-[0-9a-f]*\).*$/\1/' < dist-newstyle/cache/plan.json`+ #export SANDBOX_BIN_DIR=$PWD/.cabal-sandbox #export SANDBOX_SHARE=$PWD/.cabal-sandbox/share/x86_64-osx-ghc-`ghc$GHCVERSION --numeric-version` #export LEKSAH_BIN_DIR=$SANDBOX_BIN_DIR@@ -37,7 +39,7 @@ echo Bundle Leksah if test -e "Leksah"; then- rm -rf "Leksah"+ rm -rf "Leksah" || rm -rf "Leksah" fi JHBUILD_PREFIX=/opt/local ./bundle.sh || exit @@ -60,13 +62,12 @@ sed -i "" -e "s|@executable_path/../Resources/|@executable_path/../|" Leksah/Leksah.app/Contents/Resources/etc/gtk-3.0/gtk.immodules || exit echo Fixing pixbuf loader paths-sed -i "" -e "s|@executable_path/../Resources/|@executable_path/../|" Leksah/Leksah.app/Contents/Resources/etc/gtk-3.0/gdk-pixbuf.loaders || exit+sed -i "" -e "s|@executable_path/../Resources/|@executable_path/../|" Leksah/Leksah.app/Contents/Resources/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache || exit LEKSAH_DMG="$LEKSAH_X_X_X_X_GHC_X_X_X.dmg" if test -e "$LEKSAH_DMG"; then rm "$LEKSAH_DMG" fi-hdiutil create -size 500m -srcfolder "Leksah" "$LEKSAH_DMG" || exit+hdiutil create -size 800m -srcfolder "Leksah" "$LEKSAH_DMG" || exit -scp "$LEKSAH_DMG" server:leksah/
osx/makedmgs.sh view
@@ -1,12 +1,12 @@ #!/bin/sh -ex -#export GHCVERSION=-7.8.3+export GHCVERSION=-8.0.2+scripts/clean.sh+osx/makedmg.sh+#export GHCVERSION=-8.2.1 #scripts/clean.sh #osx/makedmg.sh-export GHCVERSION=-7.10.2-#scripts/clean.sh-osx/makedmg.sh export GHCVERSION=-#scripts/clean.sh+scripts/clean.sh osx/makedmg.sh
+ pics/ide_bench_build.png view
binary file changed (absent → 16543 bytes)
+ pics/ide_doc_build.png view
binary file changed (absent → 47138 bytes)
+ pics/ide_git.png view
binary file changed (absent → 392 bytes)
+ pics/ide_test_build.png view
binary file changed (absent → 10082 bytes)
scripts/stage.sh view
@@ -30,17 +30,15 @@ # export DYLD_LIBRARY_PATH="/System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ImageIO.framework/Versions/A/Resources:$GTK_PREFIX/lib:$DYLD_LIBRARY_PATH" if test "`uname`" = "Darwin"; then- cd ./vendor/ltk || exit- cabal install -j4 --with-ghc=ghc$GHCVERSION || exit- cd ../leksah-server || exit- cabal install --enable-tests -j4 --with-ghc=ghc$GHCVERSION || exit- cabal test || exit-# cd ../yi || exit-# cabal install -j4 -fpango --with-ghc=ghc$GHCVERSION || exit- cd ../.. || exit- cabal install -j4 -fwebkit -f-yi --with-ghc=ghc$GHCVERSION || exit+ cabal new-build --with-ghc=ghc$GHCVERSION \+ leksah-server:exe:leksah-server \+ leksah-server:exe:leksahecho \+ leksah-server:exe:leksahtrue \+ vcsgui:exe:vcsgui \+ vcsgui:exe:vcsgui-askpass \+ leksah:exe:leksah || exit else- $WINE cabal install ./ ./vendor/ltk ./vendor/leksah-server gtk3 ghcjs-dom jsaddle vendor/haskellVCSWrapper/vcswrapper vendor/haskellVCSGUI/vcsgui --with-ghc=ghc$GHCVERSION -j4 -fwebkit -f-yi -fpango -f-vty --force-reinstalls || exit+ $WINE cabal install ./ ./vendor/ltk ./vendor/leksah-server vendor/haskellVCSWrapper/vcswrapper vendor/haskellVCSGUI/vcsgui --with-ghc=ghc$GHCVERSION -j1 -fwebkit -f-yi -fpango -f-vty --force-reinstalls || exit # if [ "$GHC_VER" != "7.0.3" ] && [ "$GHC_VER" != "7.0.4" ] && [ "$GHC_VER" != "7.6.1" ]; then # echo https://github.com/yi-editor/yi.git >> sources.txt # export LEKSAH_CONFIG_ARGS="$LEKSAH_CONFIG_ARGS -fyi -f-vty -f-dyre -fpango"
src/IDE/BufferMode.hs view
@@ -39,14 +39,16 @@ import Control.Monad (when) import Data.Maybe (mapMaybe, catMaybes) import IDE.Utils.FileUtils-import Graphics.UI.Gtk- (Notebook, castToWidget, notebookPageNum, ScrolledWindow) import Control.Monad.IO.Class (MonadIO(..)) import Data.Time (UTCTime) import Data.Text (Text) import Data.Monoid ((<>)) import qualified Data.Text as T- (isPrefixOf, lines, unlines, count, isInfixOf)+ (isPrefixOf, lines, unlines, count, isInfixOf, pack)+import GI.Gtk.Objects.ScrolledWindow (ScrolledWindow(..))+import GI.Gtk.Objects.Widget (toWidget)+import GI.Gtk.Objects.Notebook (notebookPageNum, Notebook(..))+import GI.Gtk (Box) -- * Buffer Basics @@ -58,7 +60,7 @@ , bufferName :: Text , addedIndex :: Int , sourceView :: EditorView editor-, scrolledWindow :: ScrolledWindow+, vBox :: Box , modTime :: IORef (Maybe UTCTime) , mode :: Mode } deriving (Typeable)@@ -66,8 +68,9 @@ instance Pane IDEBuffer IDEM where primPaneName = bufferName+ paneTooltipText p = fmap T.pack (fileName p) getAddedIndex = addedIndex- getTopWidget = castToWidget . scrolledWindow+ getTopWidget = liftIO . toWidget . vBox paneId b = "" data BufferState = BufferState FilePath Int@@ -117,14 +120,14 @@ inBufContext def (ideBuf@IDEBuffer{sourceView = v}) f = do (pane,_) <- liftIDE $ guiPropertiesFromName (paneName ideBuf) nb <- liftIDE $ getNotebook pane- mbI <- liftIO $ notebookPageNum nb (scrolledWindow ideBuf)- case mbI of- Nothing -> liftIO $ do+ i <- notebookPageNum nb (vBox ideBuf)+ if i < 0+ then do sysMessage Normal $ bufferName ideBuf <> " notebook page not found: unexpected" return def- Just i -> do+ else do ebuf <- liftIDE $ getBuffer v- f nb v ebuf ideBuf i+ f nb v ebuf ideBuf (fromIntegral i) inActiveBufContext :: alpha -> (forall editor. TextEditor editor => Notebook -> EditorView editor -> EditorBuffer editor -> IDEBuffer -> Int -> IDEM alpha) -> IDEM alpha inActiveBufContext def f = do@@ -153,19 +156,19 @@ modeTransformToCandy :: forall editor . TextEditor editor => (Text -> Bool) -> EditorBuffer editor -> IDEAction, modeTransformFromCandy :: forall editor . TextEditor editor => EditorBuffer editor -> IDEAction, modeEditFromCandy :: IDEAction,- modeEditKeystrokeCandy :: Maybe Char -> (Text -> Bool) -> IDEAction,+ modeEditKeystrokeCandy :: Char -> (Text -> Bool) -> IDEAction, modeEditInsertCode :: forall editor . TextEditor editor => Text -> EditorIter editor -> EditorBuffer editor -> IDEAction, modeEditInCommentOrString :: Text -> Bool } -- | Assumes-modFromFileName :: Maybe FilePath -> Mode-modFromFileName Nothing = haskellMode-modFromFileName (Just fn) | ".hs" `isSuffixOf` fn = haskellMode- | ".lhs" `isSuffixOf` fn = literalHaskellMode- | ".cabal" `isSuffixOf` fn = cabalMode- | otherwise = otherMode+modeFromFileName :: Maybe FilePath -> Mode+modeFromFileName Nothing = haskellMode+modeFromFileName (Just fn) | ".hs" `isSuffixOf` fn = haskellMode+ | ".lhs" `isSuffixOf` fn = literalHaskellMode+ | ".cabal" `isSuffixOf` fn = cabalMode+ | otherwise = otherMode haskellMode = Mode { modeName = "Haskell",@@ -321,7 +324,7 @@ editFromCandy :: IDEAction editFromCandy = withCurrentMode () modeEditFromCandy -editKeystrokeCandy :: Maybe Char -> IDEAction+editKeystrokeCandy :: Char -> IDEAction editKeystrokeCandy c = withCurrentMode () (\m -> modeEditKeystrokeCandy m c (modeEditInCommentOrString m))
src/IDE/Build.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC #-} -----------------------------------------------------------------------------@@ -26,30 +27,35 @@ import Data.Map (Map) import IDE.Core.State (postAsyncIDE, postSyncIDE, triggerEventIDE, readIDE, IDEAction,- Workspace(..), ipdPackageId, ipdDepends, IDEPackage)+ Workspace(..), Project(..), ipdPackageId, ipdDepends, IDEPackage(..)) import qualified Data.Map as Map (insert, empty, lookup, toList, fromList) import Data.Graph (edges, topSort, graphFromEdges, Vertex, Graph, transposeG) import Distribution.Package (pkgVersion, pkgName, Dependency(..))-import Data.List (delete, nub, (\\), find)+import Data.List (deleteFirstsBy, nubBy, delete, nub, (\\), find) import Distribution.Version (withinRange) import Data.Maybe (fromMaybe, mapMaybe) import IDE.Package- (packageClean', packageCopy', packageRegister', buildPackage, packageConfig',- packageTest', packageDoc')+ (packageClean', buildPackage, packageConfig',+ packageTest', packageDoc', packageBench', packageInstall') import IDE.Core.Types- (IDEEvent(..), Prefs(..), IDE(..), WorkspaceAction)+ (ipdPackageName, pjPackages, IDEEvent(..), Prefs(..), IDE(..),+ WorkspaceAction) import Control.Event (EventSource(..)) import Control.Monad.Trans.Reader (ask) import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (void) import Control.Arrow ((***)) import Data.Text (Text) import Distribution.Text (disp) import Data.Monoid ((<>)) import qualified Data.Text as T (pack, unpack)+import System.Log.Logger (debugM)+import qualified Control.Arrow as Arrow (Arrow(..))+import qualified Data.Function as F (on) -- import Debug.Trace (trace) trace a b = b@@ -61,7 +67,9 @@ msSingleBuildWithoutLinking :: Bool, msSaveAllBeforeBuild :: Bool, msBackgroundBuild :: Bool,+ msMakeDocs :: Bool, msRunUnitTests :: Bool,+ msRunBenchmarks :: Bool, msJumpToWarnings :: Bool, msDontInstallLast :: Bool} @@ -72,7 +80,9 @@ msSingleBuildWithoutLinking = singleBuildWithoutLinking prefs, msSaveAllBeforeBuild = saveAllBeforeBuild prefs, msBackgroundBuild = backgroundBuild prefs,+ msMakeDocs = makeDocs prefs, msRunUnitTests = runUnitTests prefs,+ msRunBenchmarks = runBenchmarks prefs, msJumpToWarnings = jumpToWarnings prefs, msDontInstallLast = dontInstallLast prefs} @@ -81,8 +91,8 @@ MoConfigure | MoBuild | MoTest- | MoCopy- | MoRegister+ | MoBench+ | MoInstall | MoClean | MoDocu | MoOther Text@@ -98,19 +108,20 @@ -- The restOp will be applied to all other targets -- The finishOp will be applied to the last target after any op succeeded, -- but it is applied after restOp has been tried on the last target-makePackages :: MakeSettings -> [IDEPackage] -> MakeOp -> MakeOp -> MakeOp -> WorkspaceAction-makePackages ms targets firstOp restOp finishOp = trace ("makePackages : " ++ show firstOp ++ " " ++ show restOp) $ do- ws <- ask- lift $ do- prefs' <- readIDE prefs- let plan = constrMakeChain ms ws targets firstOp restOp finishOp- trace ("makeChain : " ++ show plan) $ doBuildChain ms plan+makePackages :: MakeSettings -> [(Project, [IDEPackage])] -> MakeOp -> MakeOp -> MakeOp -> IDEAction+makePackages ms targets firstOp restOp finishOp = do+ liftIO $ debugM "leksah" $ "makePackages : "+ <> "targets = " <> show (map (pjFile *** map ipdPackageName) targets)+ <> ", fistOp = " <> show firstOp+ <> ", restOp = " <> show restOp+ prefs' <- readIDE prefs+ let plan = constrMakeChain ms targets firstOp restOp finishOp+ liftIO $ debugM "leksah" $ "makePackages : makeChain : " <> show plan+ doBuildChain ms plan -- ** Types -type MyGraph a = Map a [a]--type MakeGraph = MyGraph IDEPackage+type MakeGraph = [(IDEPackage, [IDEPackage])] data Chain alpha beta = Chain {@@ -127,76 +138,80 @@ -- Consumes settings, the workspace and a list of targets. -- The first op is applied to the first target. -constrMakeChain :: MakeSettings -> Workspace -> [IDEPackage] -> MakeOp ->- MakeOp -> MakeOp -> Chain MakeOp IDEPackage+constrMakeChain :: MakeSettings -> [(Project, [IDEPackage])] -> MakeOp ->+ MakeOp -> MakeOp -> Chain MakeOp (Project, IDEPackage) -- No more targets-constrMakeChain _ _ [] _ _ _ = EmptyChain+constrMakeChain _ [] _ _ _ = EmptyChain constrMakeChain ms@MakeSettings{msMakeMode = makeMode}- Workspace{wsPackages = packages, wsNobuildPack = noBuilds} targets firstOp restOp finishOp =- trace (T.unpack $ "topsorted: " <> showTopSorted topsorted)- constrElem targets topsorted depGraph ms noBuilds+-- trace (T.unpack $ "topsorted: " <> showTopSorted topsorted)+ constrElem (map addTopSorted targets) ms firstOp restOp finishOp False where- depGraph | makeMode = constrDepGraph packages- | otherwise = Map.empty- topsorted = reverse $ topSortGraph $ constrParentGraph packages+ depGraph packages | makeMode = constrDepGraph packages+ | otherwise = []+ addTopSorted (project, targets) = (project, targets, reverse $ topSortGraph $ constrParentGraph $ pjPackages project, depGraph $ pjPackages project) -- Constructs a make chain-chainFor :: IDEPackage -> MakeSettings -> MakeOp -> Chain MakeOp IDEPackage- -> Maybe (Chain MakeOp IDEPackage)- -> Chain MakeOp IDEPackage-chainFor target settings (MoComposed [hdOp]) cont mbNegCont =- chainFor target settings hdOp cont mbNegCont-chainFor target settings (MoComposed (hdOp:rest)) cont mbNegCont =- chainFor target settings hdOp (chainFor target settings (MoComposed rest) cont mbNegCont)+chainFor :: Project -> IDEPackage -> MakeSettings -> MakeOp -> Chain MakeOp (Project, IDEPackage)+ -> Maybe (Chain MakeOp (Project, IDEPackage))+ -> Chain MakeOp (Project, IDEPackage)+chainFor project target settings (MoComposed [hdOp]) cont mbNegCont =+ chainFor project target settings hdOp cont mbNegCont+chainFor project target settings (MoComposed (hdOp:rest)) cont mbNegCont =+ chainFor project target settings hdOp (chainFor project target settings (MoComposed rest) cont mbNegCont) mbNegCont-chainFor target settings op cont mbNegCont = Chain {+chainFor project target settings op cont mbNegCont = Chain { mcAction = op,- mcEle = target,+ mcEle = (project, target), mcPos = cont, mcNeg = mbNegCont} +equalOnCabalFile :: IDEPackage -> IDEPackage -> Bool+equalOnCabalFile = (==) `F.on` ipdCabalFile+ -- Recursive building of a make chain -- The first list of packages are the targets -- The second list of packages is the topsorted graph of all deps of all targets-constrElem :: [IDEPackage] -> [IDEPackage] -> MakeGraph -> MakeSettings -> [IDEPackage]- -> MakeOp -> MakeOp -> MakeOp -> Bool -> Chain MakeOp IDEPackage-constrElem currentTargets tops depGraph ms noBuilds+constrElem :: [(Project, [IDEPackage], [IDEPackage], MakeGraph)] -> MakeSettings+ -> MakeOp -> MakeOp -> MakeOp -> Bool -> Chain MakeOp (Project, IDEPackage)+constrElem [] _ _ _ _ _ = EmptyChain+constrElem ((project, currentTargets, tops, depGraph):rest) ms firstOp restOp finishOp doneAnything -- finished traversing the topsorted deps or no targets- | null currentTargets || null tops = EmptyChain+ | null currentTargets || null tops = constrElem rest ms+ firstOp restOp finishOp doneAnything -- operations have to be applied to current- | elem (head tops) currentTargets && notElem (head tops) noBuilds =+ | ipdCabalFile (head tops) `elem` map ipdCabalFile currentTargets = let current = head tops dependents = fromMaybe (trace ("Build>>constrMakeChain: unknown package" ++ show current) [])- (Map.lookup current depGraph)- withoutInstall = msDontInstallLast ms && null (delete current dependents)+ (Map.lookup (ipdCabalFile current) depMap)+ depMap = Map.fromList $ map (Arrow.first ipdCabalFile) depGraph+ withoutInstall = msDontInstallLast ms && all (equalOnCabalFile current) dependents filteredOps = case firstOp of- MoComposed l -> MoComposed (filter (\e -> e /= MoCopy && e /= MoRegister) l)- MoCopy -> MoComposed []- MoRegister -> MoComposed []+ MoComposed l -> MoComposed (filter (/= MoInstall) l)+ MoInstall -> MoComposed [] other -> other in trace ("constrElem1 deps: " ++ show dependents ++ " withoutInstall: " ++ show withoutInstall) $- chainFor current ms (if withoutInstall then filteredOps else firstOp)- (constrElem (nub $ currentTargets ++ dependents)- (tail tops) depGraph ms noBuilds restOp restOp finishOp True)+ chainFor project current ms (if withoutInstall then filteredOps else firstOp)+ (constrElem ((project, nubBy equalOnCabalFile $ currentTargets ++ dependents, tail tops, depGraph):rest)+ ms restOp restOp finishOp True) (Just $ if doneAnything- then chainFor current ms finishOp EmptyChain Nothing+ then chainFor project current ms finishOp EmptyChain Nothing else EmptyChain) -- no operations have to be applied to current, just try the next | otherwise = trace ("constrElem2 " ++ show restOp) $- constrElem currentTargets (tail tops) depGraph ms noBuilds+ constrElem ((project, currentTargets, tail tops, depGraph):rest) ms firstOp restOp finishOp doneAnything -- | Performs the operations of a build chain-doBuildChain :: MakeSettings -> Chain MakeOp IDEPackage -> IDEAction+doBuildChain :: MakeSettings -> Chain MakeOp (Project, IDEPackage) -> IDEAction doBuildChain _ EmptyChain = return () doBuildChain ms chain@Chain{mcAction = MoConfigure} = postAsyncIDE $ packageConfig' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))@@ -206,11 +221,11 @@ doBuildChain ms chain@Chain{mcAction = MoDocu} = postAsyncIDE $ packageDoc' (msBackgroundBuild ms) (msJumpToWarnings ms) (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoTest} =- postAsyncIDE $ packageTest' (msBackgroundBuild ms) (msJumpToWarnings ms) (mcEle chain) False (constrCont ms (mcPos chain) (mcNeg chain))-doBuildChain ms chain@Chain{mcAction = MoCopy} =- postAsyncIDE $ packageCopy' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))-doBuildChain ms chain@Chain{mcAction = MoRegister} =- postAsyncIDE $ packageRegister' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))+ postAsyncIDE $ packageTest' (msBackgroundBuild ms) (msJumpToWarnings ms) (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))+doBuildChain ms chain@Chain{mcAction = MoBench} =+ postAsyncIDE $ packageBench' (msBackgroundBuild ms) (msJumpToWarnings ms) (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))+doBuildChain ms chain@Chain{mcAction = MoInstall} =+ postAsyncIDE $ packageInstall' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoClean} = postAsyncIDE $ packageClean' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoMetaInfo} =@@ -225,8 +240,7 @@ constrParentGraph :: [IDEPackage] -> MakeGraph constrParentGraph targets = trace (T.unpack $ "parentGraph : " <> showGraph parGraph) parGraph where- parGraph = Map.fromList- $ map (\ p -> (p,nub $ mapMaybe (depToTarget targets)(ipdDepends p))) targets+ parGraph = map (\ p -> (p,nubBy equalOnCabalFile $ mapMaybe (depToTarget targets)(ipdDepends p))) targets -- | Construct a dependency graph for a package -- pointing to the packages which depend on the subject package@@ -238,8 +252,8 @@ showGraph :: MakeGraph -> Text showGraph mg = T.pack $ show- $ map (\(k,v) -> (disp (ipdPackageId k), map (disp . ipdPackageId) v))- $ Map.toList mg+ $ map (\(k,v) -> (k, map (disp . ipdPackageId) v))+ $ mg showTopSorted :: [IDEPackage] -> Text showTopSorted = T.pack . show . map (disp .ipdPackageId)@@ -254,37 +268,36 @@ name == pkgName (ipdPackageId thePack) && withinRange (pkgVersion (ipdPackageId thePack)) versionRange -reverseGraph :: Ord alpha => MyGraph alpha -> MyGraph alpha+reverseGraph :: MakeGraph -> MakeGraph reverseGraph = withIndexGraph transposeG -topSortGraph :: Ord alpha => MyGraph alpha -> [alpha]-topSortGraph myGraph = map ((\ (_,x,_)-> x) . lookup) $ topSort graph+topSortGraph :: MakeGraph -> [IDEPackage]+topSortGraph myGraph = map ((\ (x,_,_)-> x) . lookup) $ topSort graph where (graph,lookup,_) = fromMyGraph myGraph -withIndexGraph :: Ord alpha => (Graph -> Graph) -> MyGraph alpha -> MyGraph alpha+withIndexGraph :: (Graph -> Graph) -> MakeGraph -> MakeGraph withIndexGraph idxOp myGraph = toMyGraph (idxOp graph) lookup where (graph,lookup,_) = fromMyGraph myGraph -fromMyGraph :: Ord alpha => MyGraph alpha -> (Graph, Vertex -> ((), alpha , [alpha]), alpha -> Maybe Vertex)-fromMyGraph myGraph =+fromMyGraph :: MakeGraph -> (Graph, Vertex -> (IDEPackage, FilePath, [FilePath]), FilePath -> Maybe Vertex)+fromMyGraph graphList = graphFromEdges- $ map (\(e,l)-> ((),e,l))+ $ map (\(e,l)-> (e,ipdCabalFile e, map ipdCabalFile l)) $ graphList ++ map (\e-> (e,[])) missingEdges where- mentionedEdges = nub $ concatMap snd graphList- graphList = Map.toList myGraph- missingEdges = mentionedEdges \\ map fst graphList+ mentionedEdges = nubBy equalOnCabalFile $ concatMap snd graphList+ missingEdges = deleteFirstsBy equalOnCabalFile mentionedEdges $ map fst graphList -toMyGraph :: Ord alpha => Graph -> (Vertex -> ((), alpha, [alpha])) -> MyGraph alpha-toMyGraph graph lookup = foldr constr Map.empty myEdges+toMyGraph :: Graph -> (Vertex -> (IDEPackage, FilePath, [FilePath])) -> MakeGraph+toMyGraph graph lookup' = foldr constr [] myEdges where- constr (from,to) map = case Map.lookup from map of- Nothing -> Map.insert from [to] map- Just l -> Map.insert from (to : l) map+ constr (from,to) m = case lookup (ipdCabalFile from) (map (Arrow.first ipdCabalFile) m) of+ Nothing -> (from, [to]):m+ Just l -> (from, (to : l)):m myEdges = map (lookItUp *** lookItUp) $ edges graph- lookItUp = (\(_,e,_)-> e) . lookup+ lookItUp = (\(e,_,_)-> e) . lookup'
src/IDE/Command.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Menu@@ -35,32 +35,10 @@ , instrumentSecWindow ) where -import Graphics.UI.Gtk- (iconThemeAddBuiltinIcon, iconThemeLoadIcon, iconThemeGetDefault,- toToolbar, ToolbarClass, Toolbar(..), keyToChar, eventKeyVal,- eventModifier, eventKeyName, EKey, containerAdd,- windowAddAccelGroup, keyPressEvent, boxPackEnd, boxPackStart,- widgetSetName, vBoxNew, windowSetIconFromFile, Widget, Window,- actionGroupGetAction, uiManagerGetActionGroups, Action,- actionSetSensitive, iconFactoryAdd, iconSetNewFromPixbuf,- pixbufNewFromFile, iconFactoryAddDefault, iconFactoryNew,- dialogRun, aboutDialogAuthors, aboutDialogWebsite,- aboutDialogLicense, aboutDialogComments, aboutDialogCopyright,- aboutDialogVersion, aboutDialogName, aboutDialogNew, mainQuit,- widgetHide, widgetShow, castToWidget, separatorMenuItemNew,- containerGetChildren, Menu, widgetSetSizeRequest, toolbarSetStyle,- set, AttrOp(..), castToToolbar, castToMenuBar, uiManagerGetWidget,- uiManagerGetAccelGroup, actionActivated, actionNew,- actionGroupAddActionWithAccel, actionToggled, toggleActionNew,- uiManagerAddUiFromString, uiManagerInsertActionGroup,- actionGroupNew, UIManager, widgetShowAll, menuItemSetSubmenu,- widgetDestroy, menuItemGetSubmenu, menuShellAppend,- menuItemActivate, menuItemNewWithLabel, menuNew, Packing(..),- ToolbarStyle(..), PositionType(..), on, IconSize(..), Modifier(..),- widgetSetSensitive)+import Prelude ()+import Prelude.Compat import System.FilePath import Data.Version-import Prelude hiding (catch) import Control.Exception import Data.Maybe @@ -72,7 +50,6 @@ import IDE.Package import IDE.Preferences (runPreferencesDialog, applyInterfaceTheme) import IDE.HLint-import IDE.Sandbox import IDE.Pane.Log import IDE.Pane.Modules import IDE.Find@@ -88,7 +65,6 @@ import IDE.LogRef import IDE.Debug import System.Directory (doesFileExist)-import Graphics.UI.Gtk.Gdk.EventM (EventM) import qualified Data.Map as Map (lookup, empty) import Data.List (sort) import Control.Event (registerEvent)@@ -112,7 +88,6 @@ import Foreign.C.Types (CInt(..)) import Foreign.Ptr (Ptr(..)) import Foreign.ForeignPtr (withForeignPtr)-import Graphics.UI.GtkInternals (unToolbar) import IDE.Session (saveSessionAs, loadSession, saveSession, sessionClosePane, loadSessionPrompt, saveSessionAsPrompt, viewFullScreen)@@ -124,19 +99,65 @@ import Data.Monoid (Monoid(..), (<>)) import qualified Text.Printf as S (printf) import Text.Printf (PrintfType)-import Graphics.UI.Gtk.General.IconTheme (IconLookupFlags(..))+import GI.Gtk.Enums+ (IconSize(..), ToolbarStyle(..), PositionType(..), Orientation(..))+import GI.Gtk.Objects.Menu (Menu(..), menuNew)+import GI.Gtk.Objects.MenuItem+ (toMenuItem, menuItemSetSubmenu, menuItemGetSubmenu,+ onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.Widget+ (IsWidget, onWidgetKeyPressEvent, widgetSetName,+ Widget(..), widgetShow, widgetSetSizeRequest, widgetShowAll,+ widgetDestroy, widgetHide, widgetSetSensitive)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Gtk.Objects.UIManager+ (uIManagerGetActionGroups, uIManagerGetWidget,+ uIManagerGetAccelGroup, uIManagerAddUiFromString,+ uIManagerInsertActionGroup, UIManager(..))+import GI.Gtk.Objects.ActionGroup+ (actionGroupGetAction, actionGroupAddActionWithAccel,+ actionGroupNew)+import GI.Gtk.Objects.ToggleAction+ (onToggleActionToggled, toggleActionNew)+import GI.Gtk.Objects.Action+ (onActionActivate, Action(..), actionSetSensitive, actionNew)+import Data.GI.Base (on, set, unsafeCastTo)+import GI.Gtk.Objects.MenuBar (MenuBar(..))+import GI.Gtk.Objects.Toolbar+ (toolbarSetIconSize, toolbarSetStyle, Toolbar(..))+import GI.Gtk.Objects.Container+ (containerAdd, containerGetChildren, Container(..))+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import GI.Gtk.Functions (mainQuit)+import GI.Gtk.Objects.AboutDialog+ (aboutDialogSetAuthors, setAboutDialogAuthors,+ setAboutDialogProgramName, setAboutDialogAuthors, setAboutDialogWebsite,+ setAboutDialogLicense, setAboutDialogComments, setAboutDialogCopyright,+ setAboutDialogVersion, aboutDialogNew)+import GI.Gtk.Objects.Dialog (dialogRun)+import GI.Gtk.Objects.IconFactory+ (iconFactoryAdd, iconFactoryAddDefault, iconFactoryNew)+import GI.GdkPixbuf.Objects.Pixbuf (pixbufNewFromFile)+import GI.Gtk.Structs.IconSet (iconSetNewFromPixbuf)+import GI.Gtk.Objects.IconTheme (iconThemeAddBuiltinIcon)+import GI.Gtk.Objects.Window+ (IsWindow, windowAddAccelGroup, windowSetIconFromFile, Window(..))+import GI.Gtk.Objects.Box (boxNew)+import Graphics.UI.Editor.Parameters+ (boxPackEnd', Packing(..), boxPackStart')+import GI.Gdk.Structs.EventKey+ (getEventKeyState, getEventKeyKeyval, EventKey(..))+import GI.Gdk.Functions (keyvalToUnicode, keyvalName)+import GI.Gdk.Flags (ModifierType, ModifierType(..))+import GI.Gtk.Objects.AccelGroup (AccelGroup(..))+import Data.GI.Base.BasicTypes (NullToNothing(..)) +import IDE.LPaste+import GI.Gio.Objects.Application (applicationQuit)+ printf :: PrintfType r => Text -> r printf = S.printf . T.unpack -foreign import ccall safe "gtk_toolbar_set_icon_size"- gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO ()--toolbarSetIconSize :: ToolbarClass self => self -> IconSize -> IO ()-toolbarSetIconSize self iconSize =- withForeignPtr (unToolbar $ toToolbar self) $- \selfPtr ->gtk_toolbar_set_icon_size selfPtr (fromIntegral $ fromEnum iconSize)- -- -- | The Actions known to the system (they can be activated by keystrokes or menus) --@@ -149,6 +170,8 @@ ,AD "FileNew" (__ "_New") Nothing Nothing (return ()) [] False ,AD "FileNewWorkspace" (__ "_Workspace...") Nothing Nothing (workspaceNew >> showWorkspacePane) [] False+ ,AD "FileNewProject" (__ "Pro_ject...") Nothing Nothing+ (showWorkspacePane >> workspaceTry projectNew) [] False ,AD "FileNewPackage" (__ "_Package...") Nothing Nothing (showWorkspacePane >> workspaceTry workspacePackageNew) [] False ,AD "FileNewModule" (__ "_Module...") Nothing (Just "gtk-new")@@ -158,8 +181,10 @@ ,AD "FileOpen" (__ "_Open") Nothing Nothing (return ()) [] False ,AD "FileOpenWorkspace" (__ "_Workspace...") Nothing Nothing (workspaceOpen >> showWorkspacePane) [] False+ ,AD "FileOpenProject" (__ "Pro_ject...") Nothing Nothing+ (showWorkspacePane >> workspaceTry projectOpen) [] False ,AD "FileOpenPackage" (__ "_Package...") Nothing Nothing- (showWorkspacePane >> workspaceTry workspaceAddPackage) [] False+ (showWorkspacePane >> projectTry projectAddPackage) [] False ,AD "FileOpenFile" (__ "_File...") Nothing (Just "gtk-open") fileOpen [] False ,AD "FileRecentFiles" (__ "Recent Files") Nothing Nothing (return ()) [] False@@ -228,9 +253,9 @@ ,AD "Workspace" (__ "_Workspace") Nothing Nothing (return ()) [] False ,AD "WorkspaceAddPackage" (__ "_Add Package...") Nothing Nothing- (showWorkspacePane >> workspaceTry workspaceAddPackage) [] False+ (showWorkspacePane >> projectTry projectAddPackage) [] False ,AD "WorkspaceAddPackageCopy" (__ "_Add Copy Of Installed Package...") Nothing Nothing- (showWorkspacePane >> workspaceTry workspacePackageClone) [] False+ (showWorkspacePane >> projectTry projectPackageClone) [] False ,AD "CleanWorkspace" (__ "Cl_ean All packages") (Just (__ "Cleans all packages in the workspace")) (Just "ide_clean") (workspaceTry workspaceClean) [] False ,AD "MakeWorkspace" (__ "_Build All packages") (Just (__ "Builds all of the packages in the workspace")) (Just "ide_configure")@@ -243,27 +268,15 @@ ,AD "Package" (__ "_Package") Nothing Nothing (return ()) [] False -- ,AD "RecentPackages" "_Recent Packages" Nothing Nothing (return ()) [] False ,AD "PackageEdit" (__ "_Edit") Nothing Nothing (return ()) [] False- ,AD "EditPackage" (__ "With _Package Editor") Nothing Nothing+ ,AD "EditPackage" (__ "Edit _Package") Nothing Nothing (packageTry packageEdit) [] False- ,AD "EditPackageText" (__ "With _Text Editor") Nothing Nothing+ ,AD "EditPackageText" (__ "Edit Package as _Text") Nothing Nothing (packageTry packageEditText) [] False -- ,AD "RemovePackage" "_Close Package" Nothing Nothing -- removePackage [] False- ,AD "PackageFlags" (__ "Package Flags") (Just (__ "Edit the package flags used")) Nothing+ ,AD "PackageFlags" (__ "_Flags") (Just (__ "Edit the cabal and stack command line flags used")) Nothing (getFlags Nothing >>= \ p -> displayPane p False) [] False - ,AD "PackageSandbox" (__ "_Sandbox") Nothing Nothing (return ()) [] False- ,AD "SandboxInit" (__ "_Init") (Just (__ "Initialise a cabal sandbox for the package")) Nothing- (packageTry sandboxInit) [] False- ,AD "SandboxInitShared" (__ "Init _Shared...") (Just (__ "Initialise or use a cabal sandbox in a selected directory")) Nothing- (packageTry sandboxInitShared) [] False- ,AD "SandboxDelete" (__ "_Delete") (Just (__ "Delete the cabal sandbox")) Nothing- (packageTry sandboxDelete) [] False- ,AD "SandboxAddSource" (__ "_Add Source...") (Just (__ "Add a source package into the sandbox")) Nothing- (packageTry (sandboxAddSource False)) [] False- ,AD "SandboxAddSourceSnapshot" (__ "Add Source S_napshot...") (Just (__ "Add a snapshot of a source package into the sandbox")) Nothing- (packageTry (sandboxAddSource True)) [] False- ,AD "CleanPackage" (__ "Cl_ean") (Just (__ "Cleans the package")) (Just "ide_clean") (packageTry packageClean) [] False ,AD "ConfigPackage" (__ "_Configure") (Just (__ "Configures the package")) (Just "ide_configure")@@ -281,14 +294,14 @@ ,AD "ResolveErrors" (__ "Resol_ve Errors") (Just (__ "Resolve 'Hidden package' and 'Not in scope' errors by adding the necessary dependancies or imports")) Nothing resolveErrors [] False - ,AD "InstallDependenciesPackage" (__ "_Install Dependencies") (Just (__ "Install the package's dependencies from the hackage server")) Nothing- (packageTry packageInstallDependencies) [] False- ,AD "RegisterPackage" (__ "_Register") Nothing Nothing- (packageTry packageRegister) [] False+ ,AD "InstallPackage" (__ "_Install") Nothing Nothing+ (packageTry packageInstall) [] False ,AD "HLintPackage" (__ "_HLint") Nothing Nothing (packageTry packageHLint) [] False ,AD "TestPackage" (__ "Test") Nothing Nothing (packageTry packageTest) [] False+ ,AD "BenchPackage" (__ "Benchmark") Nothing Nothing+ (packageTry packageBench) [] False ,AD "SdistPackage" (__ "Source Dist") Nothing Nothing (packageTry packageSdist) [] False ,AD "OpenDocPackage" (__ "_Open Documentation") Nothing Nothing@@ -422,11 +435,11 @@ (viewMove TopP) [] False ,AD "ViewMoveDown" (__ "Move _Down") Nothing Nothing (viewMove BottomP) [] False- ,AD "ViewSplitHorizontal" (__ "Split H_orizontal") Nothing Nothing+ ,AD "ViewSplitHorizontal" (__ "Split T_op/Bottom") Nothing Nothing viewSplitHorizontal [] False- ,AD "ViewSplitVertical" (__ "Split _Vertical") Nothing Nothing+ ,AD "ViewSplitVertical" (__ "Split L_eft/Right") Nothing Nothing viewSplitVertical [] False- ,AD "ViewCollapse" (__ "_Collapse") Nothing Nothing+ ,AD "ViewCollapse" (__ "_Collapse Active Split") Nothing Nothing viewCollapse [] False ,AD "ViewNest" (__ "_Group") Nothing Nothing viewNewGroup [] False@@ -437,13 +450,13 @@ ,AD "UseDarkInterface" (__ "_Use Dark Interface") Nothing Nothing viewUseDarkInterface [] True ,AD "ViewTabsLeft" (__ "Tabs Left") Nothing Nothing- (viewTabsPos PosLeft) [] False+ (viewTabsPos PositionTypeLeft) [] False ,AD "ViewTabsRight" (__ "Tabs Right") Nothing Nothing- (viewTabsPos PosRight) [] False+ (viewTabsPos PositionTypeRight) [] False ,AD "ViewTabsUp" (__ "Tabs Up") Nothing Nothing- (viewTabsPos PosTop) [] False+ (viewTabsPos PositionTypeTop) [] False ,AD "ViewTabsDown" (__ "Tabs Down") Nothing Nothing- (viewTabsPos PosBottom) [] False+ (viewTabsPos PositionTypeBottom) [] False ,AD "ViewSwitchTabs" (__ "Tabs On/Off") Nothing Nothing viewSwitchTabs [] False @@ -481,10 +494,14 @@ ,AD "HelpHomepage" (__ "Homepage") Nothing Nothing (openBrowser "http://leksah.org") [] False ,AD "HelpAbout" (__ "About") Nothing (Just "gtk-about") (liftIO aboutDialog) [] False - ,AD "BackgroundBuildToggled" (__ "_BackgroundBuild") (Just (__ "Build in the background and report errors")) (Just "ide_build")+ ,AD "BackgroundBuildToggled" (__ "_Build in the background") (Just (__ "Build in the background and report errors")) (Just "ide_build") backgroundBuildToggled [] True- ,AD "RunUnitTestsToggled" (__ "_RunUnitTests") (Just (__ "Run unit tests when building")) (Just "gtk-apply")+ ,AD "MakeDocsToggled" (__ "Build with _documentation") (Just (__ "Make documentation when building")) (Just "ide_doc_build")+ makeDocsToggled [] True+ ,AD "RunUnitTestsToggled" (__ "Run _unit tests when building") (Just (__ "Run unit tests when building")) (Just "ide_test_build") runUnitTestsToggled [] True+ ,AD "RunBenchmarksToggled" (__ "_Run benchmarks when building") (Just (__ "Run benchmarks when building")) (Just "ide_bench_build")+ runBenchmarksToggled [] True ,AD "MakeModeToggled" (__ "_MakeMode") (Just (__ "Make dependent packages")) (Just "ide_make") makeModeToggled [] True ,AD "DebugToggled" "_Enable GHCi" (Just (__ "Use GHCi debugger to build and run")) (Just "ide_debug")@@ -519,13 +536,14 @@ else forM_ recentFiles' $ \s -> do mi <- menuItemNewWithLabel $ T.pack s- mi `on` menuItemActivate $ reflectIDE (fileOpen' s) ideR+ onMenuItemActivate mi $ reflectIDE (fileOpen' s) ideR menuShellAppend recentFilesMenu mi- oldSubmenu <- menuItemGetSubmenu recentFilesItem- when (isJust oldSubmenu) $ do- widgetHide (fromJust oldSubmenu)- widgetDestroy (fromJust oldSubmenu)- menuItemSetSubmenu recentFilesItem recentFilesMenu+ menuItemGetSubmenu recentFilesItem >>= \case+ Just oldSubmenu -> do+ widgetHide oldSubmenu+ widgetDestroy oldSubmenu+ Nothing -> return ()+ menuItemSetSubmenu recentFilesItem (Just recentFilesMenu) widgetShowAll recentFilesMenu recentWorkspacesMenu <- menuNew@@ -538,14 +556,15 @@ else forM_ existingRecentWorkspaces $ \s -> do mi <- menuItemNewWithLabel $ T.pack s- mi `on` menuItemActivate $ reflectIDE (workspaceOpenThis True (Just s) >> showWorkspacePane) ideR+ onMenuItemActivate mi $ reflectIDE (workspaceOpenThis True s >> showWorkspacePane) ideR menuShellAppend recentWorkspacesMenu mi - oldSubmenu <- menuItemGetSubmenu recentWorkspacesItem- when (isJust oldSubmenu) $ do- widgetHide (fromJust oldSubmenu)- widgetDestroy (fromJust oldSubmenu)- menuItemSetSubmenu recentWorkspacesItem recentWorkspacesMenu+ menuItemGetSubmenu recentWorkspacesItem >>= \case+ Just oldSubmenu -> do+ widgetHide oldSubmenu+ widgetDestroy oldSubmenu+ Nothing -> return ()+ menuItemSetSubmenu recentWorkspacesItem (Just recentWorkspacesMenu) widgetShowAll recentWorkspacesMenu) @@ -554,10 +573,10 @@ -- makeMenu :: UIManager -> [ActionDescr IDERef] -> Text -> IDEAction makeMenu uiManager actions menuDescription = reifyIDE (\ideR -> do- actionGroupGlobal <- actionGroupNew ("global" :: Text)+ actionGroupGlobal <- actionGroupNew "global" mapM_ (actm ideR actionGroupGlobal) actions- uiManagerInsertActionGroup uiManager actionGroupGlobal 1- uiManagerAddUiFromString uiManager menuDescription+ uIManagerInsertActionGroup uiManager actionGroupGlobal 1+ uIManagerAddUiFromString uiManager menuDescription (-1) return ()) where actm ideR ag (AD name label tooltip stockId ideAction accs isToggle) = do@@ -566,12 +585,12 @@ else (Just (head accs), head accs <> "=" <> name) if isToggle then do- act <- toggleActionNew name label tooltip stockId- on act actionToggled $ doAction ideAction ideR accString+ act <- toggleActionNew name (Just label) tooltip stockId+ onToggleActionToggled act $ doAction ideAction ideR accString actionGroupAddActionWithAccel ag act acc else do- act <- actionNew name label tooltip stockId- on act actionActivated $ doAction ideAction ideR accString+ act <- actionNew name (Just label) tooltip stockId+ onActionActivate act $ doAction ideAction ideR accString actionGroupAddActionWithAccel ag act acc doAction ideAction ideR accStr = reflectIDE (do@@ -579,19 +598,13 @@ triggerEventIDE (StatusbarChanged [CompartmentCommand accStr]) return ()) ideR --- getMenuAndToolbars :: UIManager -> IO (AccelGroup, MenuBar, Toolbar)+getMenuAndToolbars :: MonadIO m => UIManager -> m (AccelGroup, MenuBar, Toolbar) getMenuAndToolbars uiManager = do- accGroup <- uiManagerGetAccelGroup uiManager- mbMenu <- uiManagerGetWidget uiManager ("/ui/menubar" :: Text)- let menu = case mbMenu of- Just it -> castToMenuBar it- Nothing -> throwIDE (__ "Menu>>makeMenu: failed to create menubar")- mbToolbar <- uiManagerGetWidget uiManager ("/ui/toolbar" :: Text)- let toolbar = case mbToolbar of- Just it -> castToToolbar it- Nothing -> throwIDE (__ "Menu>>makeMenu: failed to create toolbar")- toolbarSetStyle toolbar ToolbarIcons- toolbarSetIconSize toolbar IconSizeSmallToolbar+ accGroup <- uIManagerGetAccelGroup uiManager+ menu <- uIManagerGetWidget uiManager "/ui/menubar" >>= liftIO . unsafeCastTo MenuBar . fromMaybe (error "Failed to get /ui/menubar!")+ toolbar <- uIManagerGetWidget uiManager "/ui/toolbar" >>= liftIO . unsafeCastTo Toolbar . fromMaybe (error "Failed to get /ui/toolbar!")+ toolbarSetStyle toolbar ToolbarStyleIcons+ toolbarSetIconSize toolbar IconSizeLargeToolbar widgetSetSizeRequest toolbar 700 (-1) return (accGroup,menu,toolbar) @@ -600,39 +613,39 @@ let reflectIDE_ x = reflectIDE x ideR items <- containerGetChildren menu mi1 <- menuItemNewWithLabel (__ "Eval")- mi1 `on` menuItemActivate $ reflectIDE_ debugExecuteSelection+ onMenuItemActivate mi1 $ reflectIDE_ debugExecuteSelection menuShellAppend menu mi1 mi11 <- menuItemNewWithLabel (__ "Eval & Insert")- mi11 `on` menuItemActivate $+ onMenuItemActivate mi11 $ reflectIDE_ debugExecuteAndShowSelection menuShellAppend menu mi11 mi12 <- menuItemNewWithLabel (__ "Step")- mi12 `on` menuItemActivate $ reflectIDE_ debugStepExpression+ onMenuItemActivate mi12 $ reflectIDE_ debugStepExpression menuShellAppend menu mi12 mi13 <- menuItemNewWithLabel (__ "Trace")- mi13 `on` menuItemActivate $ reflectIDE_ debugTraceExpression+ onMenuItemActivate mi13 $ reflectIDE_ debugTraceExpression menuShellAppend menu mi13 mi16 <- menuItemNewWithLabel (__ "Set Breakpoint")- mi16 `on` menuItemActivate $ reflectIDE_ debugSetBreakpoint+ onMenuItemActivate mi16 $ reflectIDE_ debugSetBreakpoint menuShellAppend menu mi16- sep1 <- separatorMenuItemNew+ sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem menuShellAppend menu sep1 mi14 <- menuItemNewWithLabel (__ "Type")- mi14 `on` menuItemActivate $ reflectIDE_ debugType+ onMenuItemActivate mi14 $ reflectIDE_ debugType menuShellAppend menu mi14 mi141 <- menuItemNewWithLabel (__ "Info")- mi141 `on` menuItemActivate $ reflectIDE_ debugInformation+ onMenuItemActivate mi141 $ reflectIDE_ debugInformation menuShellAppend menu mi141 mi15 <- menuItemNewWithLabel (__ "Kind")- mi15 `on` menuItemActivate $ reflectIDE_ debugKind+ onMenuItemActivate mi15 $ reflectIDE_ debugKind menuShellAppend menu mi15- sep2 <- separatorMenuItemNew+ sep2 <- separatorMenuItemNew >>= liftIO . toMenuItem menuShellAppend menu sep2 mi2 <- menuItemNewWithLabel (__ "Find (text)")- mi2 `on` menuItemActivate $ reflectIDE_ (editFindInc Initial)+ onMenuItemActivate mi2 $ reflectIDE_ (editFindInc Initial) menuShellAppend menu mi2 mi3 <- menuItemNewWithLabel (__ "Search (metadata)")- mi3 `on` menuItemActivate $+ onMenuItemActivate mi3 $ reflectIDE_ $ do mbtext <- selectedTextOrCurrentIdentifier -- if no text selected, search for current identifier searchPane <- getSearch Nothing@@ -640,12 +653,15 @@ Just t -> searchMetaGUI searchPane t Nothing -> ideMessage Normal (__ "No identifier selected") menuShellAppend menu mi3- let interpretingEntries = [castToWidget mi16]+ mi4 <- menuItemNewWithLabel (__ "Upload to lpaste.net")+ onMenuItemActivate mi4 $ reflectIDE_ uploadToLpaste+ menuShellAppend menu mi4+ let interpretingEntries = [mi16] let interpretingSelEntries- = [castToWidget mi1, castToWidget mi11, castToWidget mi12,- castToWidget mi13, castToWidget mi14, castToWidget mi141,- castToWidget mi15]- let otherEntries = [castToWidget mi2, castToWidget mi3]+ = [mi1, mi11, mi12,+ mi13, mi14, mi141,+ mi15]+ let otherEntries = [mi2, mi3, mi4] -- isInterpreting' <- (reflectIDE isInterpreting ideR) selected <- reflectIDE selectedText ideR -- unless isInterpreting'@@ -655,7 +671,7 @@ mapM_ widgetShow interpretingEntries mapM_ widgetShow interpretingSelEntries mapM_ widgetShow- (castToWidget sep1 : castToWidget sep2 : otherEntries)+ (sep1 : sep2 : otherEntries) mapM_ widgetHide $ take 2 (reverse items) canQuit :: IDEM Bool@@ -672,25 +688,27 @@ quit :: IDEAction quit = do can <- canQuit- when can $ liftIO mainQuit+ app <- readIDE application+ when can $ applicationQuit app -- -- | Show the about dialog -- aboutDialog :: IO () aboutDialog = do+ liftIO $ debugM "leksah" "aboutDialog" d <- aboutDialogNew dd <- getDataDir- (year, _, _) <- liftM (toGregorian . utctDay) getCurrentTime+ (year, _, _) <- toGregorian . utctDay <$> getCurrentTime license <- catch (T.readFile $ dd </> T.unpack (__ "LICENSE")) (\ (_ :: SomeException) -> return "")- set d [ aboutDialogName := ("Leksah" :: Text)- , aboutDialogVersion := T.pack $ showVersion version- , aboutDialogCopyright := __ "Copyright 2007-" <> T.pack (show year) <> " Jürgen Nicklisch-Franken, Hamish Mackenzie"- , aboutDialogComments := __ "An integrated development environement (IDE) for the " <>+ setAboutDialogProgramName d "Leksah"+ setAboutDialogVersion d . T.pack $ showVersion version+ setAboutDialogCopyright d $ __ "Copyright 2007-" <> T.pack (show year) <> " Jürgen Nicklisch-Franken, Hamish Mackenzie,\nJacco Krijnen, JP Moresmau"+ setAboutDialogComments d $ __ "An integrated development environement (IDE) for the " <> __ "programming language Haskell and the Glasgow Haskell Compiler"- , aboutDialogLicense := Just license- , aboutDialogWebsite := ("http://leksah.org/" :: Text)- , aboutDialogAuthors := ["Jürgen Nicklisch-Franken","Hamish Mackenzie" :: Text] ]+ setAboutDialogLicense d license+ setAboutDialogWebsite d "http://leksah.org/"+ aboutDialogSetAuthors d ["Jürgen Nicklisch-Franken","Hamish Mackenzie","Jacco Krijnen","JP Moresmau"] dialogRun d widgetDestroy d return ()@@ -709,21 +727,21 @@ "ide_debug", "ide_step", "ide_local", "ide_module", "ide_continue", "ide_rebuild_meta", "ide_empty","ide_source_local", "ide_js", "ide_folder", "ide_source_folder", "ide_cabal_file", "ide_package", "ide_component", "ide_source_dependency", "ide_error",- "ide_warning", "ide_suggestion" ]+ "ide_warning", "ide_suggestion", "ide_git", "ide_test_build", "ide_bench_build", "ide_doc_build" ] iconFactoryAddDefault iconFactory) (\(e :: SomeException) -> getDataDir >>= \dataDir -> throwIDE (T.pack $ printf (__ "Can't load icons from %s %s") dataDir (show e))) where loadIcon dataDir iconFactory name = do- pb <- pixbufNewFromFile $ dataDir </> "pics" </> (name <> ".png")+ pb <- pixbufNewFromFile . T.pack $ dataDir </> "pics" </> (name <> ".png") icon <- iconSetNewFromPixbuf pb iconFactoryAdd iconFactory (T.pack name) icon- iconThemeAddBuiltinIcon name 16 pb+ iconThemeAddBuiltinIcon (T.pack name) 16 pb setSensitivity :: [(SensitivityMask, Bool)] -> IDEAction setSensitivity = mapM_ setSensitivitySingle where setSensitivitySingle (sens,bool) = do actions <- getActionsFor sens- liftIO $ mapM_ (`actionSetSensitive` bool) actions+ mapM_ (`actionSetSensitive` bool) actions let additionalActions = getAdditionalActionsFor sens mapM_ (\a -> a bool) additionalActions @@ -732,8 +750,8 @@ getActionsFor SensitivityBackwardHist = getActionsFor' ["ViewHistoryBack"] getActionsFor SensitivityProjectActive = getActionsFor' ["EditPackage", "PackageFlags", "ConfigPackage", "BuildPackage"- ,"DocPackage", "CleanPackage", "CopyPackage", "RunPackage","InstallDependenciesPackage"- ,"RegisterPackage", "TestPackage","SdistPackage"+ ,"DocPackage", "CleanPackage", "CopyPackage", "RunPackage"+ ,"InstallPackage", "TestPackage","SdistPackage" ,"OpenDocPackage","FileCloseAll"] getActionsFor SensitivityError = getActionsFor' ["NextError", "PreviousError"] getActionsFor SensitivityEditor = getActionsFor' ["EditUndo", "EditRedo",@@ -751,8 +769,8 @@ where getActionFor string = do uiManager' <- getUiManager- actionGroups <- liftIO $ uiManagerGetActionGroups uiManager'- res <- liftIO $ actionGroupGetAction (head actionGroups) string+ actionGroups <- uIManagerGetActionGroups uiManager'+ res <- actionGroupGetAction (head actionGroups) string when (isNothing res) $ ideMessage Normal $ T.pack $ printf (__ "Can't find UI Action %s") (T.unpack string) return res @@ -767,7 +785,7 @@ Nothing -> return () Just (win,wid) -> do instrumentSecWindow win- liftIO $ widgetShowAll win+ widgetShowAll win viewUseDarkInterface :: IDEAction viewUseDarkInterface = do@@ -779,36 +797,35 @@ applyInterfaceTheme -instrumentWindow :: Window -> Prefs -> Widget -> IDEAction+instrumentWindow :: IsWidget topWidget => Window -> Prefs -> topWidget -> IDEAction instrumentWindow win prefs topWidget = do -- sets the icon ideR <- ask uiManager' <- getUiManager- liftIO $ do- dataDir <- getDataDir- let iconPath = dataDir </> "pics" </> "leksah.png"- iconExists <- doesFileExist iconPath- when iconExists $- windowSetIconFromFile win iconPath- vb <- vBoxNew False 1 -- Top-level vbox- widgetSetName vb ("topBox" :: Text)- (acc,menu,toolbar) <- getMenuAndToolbars uiManager'- boxPackStart vb menu PackNatural 0- boxPackStart vb toolbar PackNatural 0- boxPackStart vb topWidget PackGrow 0- findbar <- reflectIDE (do- modifyIDE_ (\ide -> ide{toolbar = (True,Just toolbar)})- constructFindReplace ) ideR- boxPackStart vb findbar PackNatural 0- statusBar <- buildStatusbar- boxPackEnd vb statusBar PackNatural 0- win `on` keyPressEvent $ handleSpecialKeystrokes ideR- windowAddAccelGroup win acc- containerAdd win vb- reflectIDE (do- setBackgroundBuildToggled (backgroundBuild prefs)- setRunUnitTests (runUnitTests prefs)- setMakeModeToggled (makeMode prefs)) ideR+ dataDir <- getDataDir+ let iconPath = dataDir </> "pics" </> "leksah.png"+ iconExists <- liftIO $ doesFileExist iconPath+ when iconExists $+ windowSetIconFromFile win iconPath+ vb <- boxNew OrientationVertical 1 -- Top-level vbox+ widgetSetName vb "topBox"+ (acc,menu,toolbar) <- getMenuAndToolbars uiManager'+ boxPackStart' vb menu PackNatural 0+ boxPackStart' vb toolbar PackNatural 0+ boxPackStart' vb topWidget PackGrow 0+ modifyIDE_ (\ide -> ide{toolbar = (True,Just toolbar)})+ findbar <- constructFindReplace+ boxPackStart' vb findbar PackNatural 0+ statusBar <- buildStatusbar+ boxPackEnd' vb statusBar PackNatural 0+ onWidgetKeyPressEvent win $ handleSpecialKeystrokes ideR+ windowAddAccelGroup win acc+ containerAdd win vb+ setBackgroundBuildToggled (backgroundBuild prefs)+ setMakeDocs (makeDocs prefs)+ setRunUnitTests (runUnitTests prefs)+ setRunBenchmarks (runBenchmarks prefs)+ setMakeModeToggled (makeMode prefs) instrumentSecWindow :: Window -> IDEAction instrumentSecWindow win = do@@ -824,31 +841,31 @@ (acc,_,_) <- getMenuAndToolbars uiManager' windowAddAccelGroup win acc- win `on` keyPressEvent $ handleSpecialKeystrokes ideR+ onWidgetKeyPressEvent win $ handleSpecialKeystrokes ideR return () -- -- | Callback function for onKeyPress of the main window, so 'preprocess' any key ---handleSpecialKeystrokes :: IDERef -> EventM EKey Bool-handleSpecialKeystrokes ideR = do- name <- eventKeyName- mods <- eventModifier- keyVal <- eventKeyVal- let mbChar = keyToChar keyVal+handleSpecialKeystrokes :: IDERef -> EventKey -> IO Bool+handleSpecialKeystrokes ideR e = do+ keyVal <- getEventKeyKeyval e+ name <- fromMaybe "" <$> keyvalName keyVal+ mods <- getEventKeyState e+ char <- toEnum . fromIntegral <$> keyvalToUnicode keyVal liftIO $ (`reflectIDE` ideR) $ do prefs' <- readIDE prefs case (name, mods) of- (tab, [Control]) | (tab == "Tab" || tab == "ISO_Left_Tab")- && useCtrlTabFlipping prefs' -> do+ (tab, [ModifierTypeControlMask]) | (tab == "Tab" || tab == "ISO_Left_Tab")+ && useCtrlTabFlipping prefs' -> do flipDown return True- (tab, [Shift, Control]) | (tab == "Tab" || tab == "ISO_Left_Tab")- && useCtrlTabFlipping prefs' -> do+ (tab, [ModifierTypeShiftMask, ModifierTypeControlMask]) | (tab == "Tab" || tab == "ISO_Left_Tab")+ && useCtrlTabFlipping prefs' -> do flipUp return True- _ -> do- when (candyState prefs') (editKeystrokeCandy mbChar)+ _ -> do+ when (candyState prefs') (editKeystrokeCandy char) sk <- readIDE specialKey sks <- readIDE specialKeys case sk of@@ -875,7 +892,7 @@ modifyIDE_ (\ide -> ide{specialKey = Nothing}) return True where- printMods :: [Modifier] -> Text+ printMods :: [ModifierType] -> Text printMods = mconcat . map (T.pack . show) setSymbol :: Text -> Bool -> IDEAction@@ -952,6 +969,8 @@ (\ e@(ErrorChanged show') -> postAsyncIDE (fillErrorList show') >> return e) registerEvent stRef "ErrorAdded" (\ e@(ErrorAdded show' i ref) -> postAsyncIDE (addErrorToList show' i ref) >> return e)+ registerEvent stRef "ErrorsRemoved"+ (\ e@(ErrorsRemoved show' toRemove) -> postAsyncIDE (removeErrorsFromList show' toRemove) >> return e) registerEvent stRef "CurrentErrorChanged" (\ e@(CurrentErrorChanged mbLogRef) -> postAsyncIDE (selectRef mbLogRef) >> return e) registerEvent stRef "BreakpointChanged"
src/IDE/Command/VCS/Common.hs view
@@ -33,7 +33,6 @@ import qualified VCSWrapper.Common as VCS import qualified VCSGui.Common as VCSGUI -import qualified Graphics.UI.Gtk as Gtk import Control.Monad.Reader import Control.Monad.Trans(liftIO) import qualified Control.Exception as Exc@@ -41,56 +40,64 @@ import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T (pack)+import qualified GI.Gtk.Objects.Menu as Gtk (menuNew, Menu(..))+import qualified GI.Gtk.Objects.MenuItem as Gtk+ (menuItemGetSubmenu, menuItemSetSubmenu, menuItemNewWithMnemonic,+ menuItemNewWithLabel)+import GI.Gtk.Objects.MenuItem (MenuItem(..), onMenuItemActivate)+import qualified GI.Gtk.Objects.MenuShell as Gtk (menuShellAppend)+import qualified GI.Gtk.Objects.Widget as Gtk (widgetShowAll)+import Data.GI.Base (unsafeCastTo)+import GI.Gtk.Objects.Menu (Menu(..)) setMenuForPackage :: Gtk.Menu -> FilePath -> Maybe VCSConf -> IDEAction setMenuForPackage vcsMenu cabalFp mbVCSConf = do- ideR <- ask+ ideR <- ask - -- create or get packageItem and set it to ide to be able to get it later again- (oldMenuItems,pw) <- readIDE vcsData- packageItem <-- case Map.lookup cabalFp oldMenuItems of- Nothing -> liftIO . Gtk.menuItemNewWithLabel $ T.pack cabalFp- Just menuItem -> return menuItem- let newMenuItems = Map.insert cabalFp packageItem oldMenuItems- modifyIDE_ (\ide -> ide {vcsData = (newMenuItems,pw)})+ -- create or get packageItem and set it to ide to be able to get it later again+ (oldMenuItems,pw) <- readIDE vcsData+ packageItem <-+ case Map.lookup cabalFp oldMenuItems of+ Nothing -> Gtk.menuItemNewWithLabel $ T.pack cabalFp+ Just menuItem -> return menuItem+ let newMenuItems = Map.insert cabalFp packageItem oldMenuItems+ modifyIDE_ (\ide -> ide {vcsData = (newMenuItems,pw)}) - packageMenu <- liftIO Gtk.menuNew+ packageMenu <- liftIO Gtk.menuNew - -- build and set set-up repo action- setupActionItem <- liftIO $ Gtk.menuItemNewWithMnemonic (__"_Setup Repo")- liftIO $ setupActionItem `Gtk.on` Gtk.menuItemActivate $- reflectIDE (- runSetupRepoActionWithContext cabalFp- ) ideR- liftIO $ Gtk.menuShellAppend packageMenu setupActionItem+ -- build and set set-up repo action+ setupActionItem <- Gtk.menuItemNewWithMnemonic (__"_Setup Repo")+ onMenuItemActivate setupActionItem $+ reflectIDE (+ runSetupRepoActionWithContext cabalFp+ ) ideR+ Gtk.menuShellAppend packageMenu setupActionItem - -- build and set other actions- let packageMenuOperations = case mbVCSConf of- Nothing -> []- Just (vcsType,_,_) -> mkVCSActions vcsType- liftIO $ addActions cabalFp packageMenu ideR packageMenuOperations+ -- build and set other actions+ let packageMenuOperations = case mbVCSConf of+ Nothing -> []+ Just (vcsType,_,_) -> mkVCSActions vcsType+ addActions cabalFp packageMenu ideR packageMenuOperations - -- set menus- liftIO $ Gtk.menuItemRemoveSubmenu packageItem- liftIO $ Gtk.menuItemSetSubmenu packageItem packageMenu- liftIO $ Gtk.menuShellAppend vcsMenu packageItem- liftIO $ Gtk.widgetShowAll vcsMenu- return ()- where- addActions cabalFp packageMenu ideR- = mapM_- (\ (name, action) ->- do actionItem <- Gtk.menuItemNewWithMnemonic name- actionItem `Gtk.on` Gtk.menuItemActivate $- reflectIDE (runActionWithContext action cabalFp) ideR- Gtk.menuShellAppend packageMenu actionItem)- mkVCSActions :: VCS.VCSType -> [(Text, Types.VCSAction ())]- mkVCSActions VCS.SVN = SVN.mkSVNActions- mkVCSActions VCS.GIT = GIT.mkGITActions- mkVCSActions VCS.Mercurial = Mercurial.mkMercurialActions+ -- set menus+ Gtk.menuItemSetSubmenu packageItem (Just packageMenu)+ Gtk.menuShellAppend vcsMenu packageItem+ Gtk.widgetShowAll vcsMenu+ return ()+ where+ addActions cabalFp packageMenu ideR+ = mapM_+ (\ (name, action) ->+ do actionItem <- Gtk.menuItemNewWithMnemonic name+ onMenuItemActivate actionItem $+ reflectIDE (runActionWithContext action cabalFp) ideR+ Gtk.menuShellAppend packageMenu actionItem)+ mkVCSActions :: VCS.VCSType -> [(Text, Types.VCSAction ())]+ mkVCSActions VCS.SVN = SVN.mkSVNActions+ mkVCSActions VCS.GIT = GIT.mkGITActions+ mkVCSActions VCS.Mercurial = Mercurial.mkMercurialActions @@ -115,9 +122,10 @@ runSetupRepoActionWithContext :: FilePath -> IDEAction runSetupRepoActionWithContext packageFp = do+ mainWindow <- getMainWindow eConfigErr <- getVCSConf packageFp case eConfigErr of- Left error -> liftIO $ GUIUtils.showErrorDialog error+ Left error -> liftIO $ GUIUtils.showErrorDialog (Just mainWindow) error Right mbConfig -> do ide <- ask liftIO $ VCSGUI.showSetupConfigGUI mbConfig (callback ide packageFp)@@ -139,8 +147,7 @@ workspaceSetVCSConfig :: FilePath -> Maybe VCSConf -> IDEAction workspaceSetVCSConfig pathToPackage mbVCSConf = do vcsItem <- GUIUtils.getVCS- mbVcsMenu <- liftIO $ Gtk.menuItemGetSubmenu vcsItem- let vcsMenu = Gtk.castToMenu $ fromJust mbVcsMenu+ vcsMenu <- Gtk.menuItemGetSubmenu vcsItem >>= liftIO . unsafeCastTo Menu . fromJust setMenuForPackage vcsMenu pathToPackage mbVCSConf modifyIDE_ (\ide -> do let oldWs = fromJust (workspace ide)
src/IDE/Command/VCS/Common/Workspaces.hs view
@@ -35,20 +35,20 @@ import Control.Monad.Reader(liftIO,ask,when) import Graphics.UI.Frame.Panes-import Graphics.UI.Gtk (- menuNew, menuItemNewWithLabel, menuItemActivate, menuShellAppend, menuItemSetSubmenu- ,widgetShowAll, menuItemNewWithMnemonic, menuItemGetSubmenu, widgetHide, widgetDestroy, menuItemRemoveSubmenu) import Data.Maybe import Data.List import System.Log.Logger (debugM) import Data.Monoid ((<>)) import qualified Data.Text as T (unpack, pack)+import GI.Gtk.Objects.MenuItem (menuItemSetSubmenu)+import GI.Gtk.Objects.Menu (noMenu, menuNew)+import GI.Gtk.Objects.Widget (widgetShowAll) onWorkspaceClose :: IDEAction onWorkspaceClose = do vcsItem <- GUIUtils.getVCS- liftIO $ menuItemRemoveSubmenu vcsItem+ menuItemSetSubmenu vcsItem noMenu onWorkspaceOpen :: Workspace -> IDEAction onWorkspaceOpen ws = do@@ -64,11 +64,11 @@ --for each package add an extra menu containing vcs specific menuitems mapM_ (\(p,mbVcsConf) -> do Common.setMenuForPackage vcsMenu (ipdCabalFile p) mbVcsConf- liftIO $ menuItemSetSubmenu vcsItem vcsMenu+ menuItemSetSubmenu vcsItem (Just vcsMenu) ) packages - liftIO $ widgetShowAll vcsItem+ widgetShowAll vcsItem return () where mapper :: Workspace -> IDEPackage -> IDEM (IDEPackage, Maybe VCSConf)
src/IDE/Command/VCS/SVN.hs view
@@ -32,8 +32,6 @@ import qualified VCSWrapper.Svn as Wrapper.Svn import qualified VCSWrapper.Common as Wrapper -import Graphics.UI.Gtk.ActionMenuToolbar.UIManager(MergeId)- import Control.Monad.Reader(liftIO,ask,lift) import Data.IORef(atomicModifyIORef, IORef) import Data.Either
src/IDE/Completion.hs view
@@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module IDE.Completion (complete, cancel, setCompletionSize) where+module IDE.Completion (complete, cancel, setCompletionSize, smartIndent) where import Prelude hiding(getChar, getLine) @@ -21,10 +21,9 @@ import Data.Char import Data.IORef import Control.Monad-import Graphics.UI.Gtk as Gtk-import Graphics.UI.Gtk.Gdk.EventM as Gtk import IDE.Core.State-import IDE.Metainfo.Provider(getDescription,getCompletionOptions)+import IDE.Metainfo.Provider+ (keywords, getDescription, getCompletionOptions) import IDE.TextEditor as TE import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Reader (ask)@@ -33,9 +32,79 @@ import Control.Applicative ((<$>)) import Data.Text (Text) import qualified Data.Text as T- (empty, commonPrefixes, pack, unpack, null, stripPrefix,+ (replicate, empty, commonPrefixes, pack, unpack, null, stripPrefix, isPrefixOf) import System.Log.Logger (debugM)+import GI.Gtk.Objects.Window+ (windowMove, windowGetScreen, windowGetSize, Window(..),+ windowNew, setWindowTransientFor, setWindowDefaultHeight,+ setWindowDefaultWidth, setWindowResizable, setWindowDecorated,+ setWindowTypeHint, windowResize)+import Data.GI.Base+ (unsafeManagedPtrGetPtr, unsafeCastTo, get, set)+import GI.Gdk.Enums (GrabStatus(..), WindowTypeHint(..))+import GI.Gtk.Objects.Container+ (containerRemove, containerAdd, containerSetBorderWidth)+import GI.Gtk.Objects.Paned (panedNew)+import GI.Gtk.Objects.ScrolledWindow (scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Widget+ (Widget(..), widgetShowAll, widgetGetAllocation, widgetGetParent,+ widgetHide, onWidgetButtonReleaseEvent, onWidgetMotionNotifyEvent,+ widgetGetWindow, onWidgetButtonPressEvent, getWidgetVisible,+ widgetModifyFont, widgetSetSizeRequest)+import GI.Gtk.Objects.TreeView+ (treeViewSetCursor, onTreeViewRowActivated, treeViewRowActivated,+ treeViewScrollToCell, treeViewGetColumn, treeViewGetModel,+ TreeView(..), treeViewGetSelection, setTreeViewHeadersVisible,+ treeViewAppendColumn, treeViewSetModel, treeViewNew)+import Data.GI.Gtk.ModelView.SeqStore+ (seqStoreAppend, seqStoreClear, seqStoreGetValue, SeqStore(..),+ seqStoreNew)+import GI.Pango.Structs.FontDescription+ (fontDescriptionSetFamily, fontDescriptionNew,+ fontDescriptionFromString)+import GI.Gtk.Objects.TreeViewColumn+ (noTreeViewColumn, treeViewColumnPackStart, setTreeViewColumnMinWidth,+ setTreeViewColumnSizing, treeViewColumnNew)+import GI.Gtk.Enums (TreeViewColumnSizing(..), WindowType(..), Orientation(..))+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (treeSelectionGetSelected, treeSelectionSelectPath,+ treeSelectionSelectedForeach,+ onTreeSelectionChanged)+import GI.Gtk.Objects.Paned+ (panedSetPosition, panedGetPosition, panedGetChild2, Paned(..),+ panedGetChild1, panedAdd2, panedAdd1)+import GI.Gdk.Structs.EventKey+ (getEventKeyKeyval, getEventKeyState)+import GI.Gdk.Functions+ (pointerUngrab, pointerGrab, keyvalToUnicode, keyvalName)+import GI.Gtk.Interfaces.TreeModel+ (treeModelGetPath, treeModelIterNChildren)+import GI.Gdk.Structs.EventButton+ (getEventButtonTime, getEventButtonY, getEventButtonX,+ getEventButtonButton)+import GI.Gdk.Flags (EventMask(..))+import GI.Gdk.Objects.Cursor (noCursor)+import GI.Gdk.Structs.EventMotion+ (getEventMotionY, getEventMotionX)+import GI.Gtk.Structs.TreePath (treePathGetIndices, TreePath(..))+import Graphics.UI.Frame.Rectangle+ (getRectangleHeight, getRectangleWidth, getRectangleY,+ getRectangleX, Rectangle(..))+import GI.Gdk.Objects.Window (windowGetOrigin)+import qualified GI.Gdk.Objects.Window as Gdk (noWindow)+import GI.Gdk.Objects.Screen+ (screenGetHeight, screenGetWidth, screenGetMonitorAtPoint)+import Data.GI.Gtk.ModelView.Types+ (equalManagedPtr, treePathGetIndices', treePathNewFromIndices')+import Data.Maybe (fromJust)+import Data.Monoid ((<>))+import GI.Gtk (widgetOverrideFont) complete :: TextEditor editor => EditorView editor -> Bool -> IDEAction complete sourceView always = do@@ -59,14 +128,14 @@ cancelCompletion window tv st conn _ -> return () -setCompletionSize :: (Int, Int) -> IDEAction-setCompletionSize (x, y) | x > 10 && y > 10 = do+setCompletionSize :: Int -> Int -> IDEAction+setCompletionSize x y | x > 10 && y > 10 = do (_, completion) <- readIDE completion case completion of- Just (CompletionWindow window _ _) -> liftIO $ windowResize window x y+ Just (CompletionWindow window _ _) -> windowResize window (fromIntegral x) (fromIntegral y) Nothing -> return () modifyIDE_ $ \ide -> ide{completion = ((x, y), completion)}-setCompletionSize _ = return ()+setCompletionSize _ _ = return () getIsWordChar :: forall editor. TextEditor editor => EditorView editor -> IDEM (Char -> Bool) getIsWordChar sourceView = do@@ -101,66 +170,60 @@ Nothing -> do windows <- getWindows prefs <- readIDE prefs- window <- liftIO windowNewPopup- liftIO $ set window [- windowTypeHint := WindowTypeHintUtility,- windowDecorated := False,- windowResizable := True,- windowDefaultWidth := width,- windowDefaultHeight := height,- windowTransientFor := head windows]- liftIO $ containerSetBorderWidth window 3- paned <- liftIO hPanedNew- liftIO $ containerAdd window paned- nameScrolledWindow <- liftIO $ scrolledWindowNew Nothing Nothing- liftIO $ widgetSetSizeRequest nameScrolledWindow 250 40- tree <- liftIO treeViewNew- liftIO $ containerAdd nameScrolledWindow tree- store <- liftIO $ listStoreNew []- liftIO $ treeViewSetModel tree store+ window <- windowNew WindowTypePopup+ setWindowTypeHint window WindowTypeHintUtility+ setWindowDecorated window False+ setWindowResizable window True+ setWindowDefaultWidth window $ fromIntegral width+ setWindowDefaultHeight window $ fromIntegral height+ setWindowTransientFor window $ head windows+ containerSetBorderWidth window 3+ paned <- panedNew OrientationHorizontal+ containerAdd window paned+ nameScrolledWindow <- scrolledWindowNew noAdjustment noAdjustment+ widgetSetSizeRequest nameScrolledWindow 250 40+ tree <- treeViewNew+ containerAdd nameScrolledWindow tree+ store <- seqStoreNew []+ treeViewSetModel tree (Just store) - font <- liftIO $ case textviewFont prefs of+ font <- case textviewFont prefs of Just str -> fontDescriptionFromString str Nothing -> do f <- fontDescriptionNew- fontDescriptionSetFamily f ("Monospace" :: Text)+ fontDescriptionSetFamily f "Monospace" return f- liftIO $ widgetModifyFont tree (Just font)+ widgetOverrideFont tree (Just font) - column <- liftIO treeViewColumnNew- liftIO $ set column [- treeViewColumnSizing := TreeViewColumnFixed,- treeViewColumnMinWidth := 800] -- OSX does not like it if there is no hscroll- liftIO $ treeViewAppendColumn tree column- renderer <- liftIO cellRendererTextNew- liftIO $ treeViewColumnPackStart column renderer True- liftIO $ cellLayoutSetAttributes column renderer store (\name -> [ cellText := name ])+ column <- treeViewColumnNew+ setTreeViewColumnSizing column TreeViewColumnSizingFixed+ setTreeViewColumnMinWidth column 800 -- OSX does not like it if there is no hscroll+ treeViewAppendColumn tree column+ renderer <- cellRendererTextNew+ treeViewColumnPackStart column renderer True+ cellLayoutSetDataFunction column renderer store $ setCellRendererTextText renderer - liftIO $ set tree [treeViewHeadersVisible := False]+ setTreeViewHeadersVisible tree False descriptionBuffer <- newDefaultBuffer Nothing ""- descriptionView <- newView descriptionBuffer (textviewFont prefs)+ (descriptionView, descriptionScrolledWindow) <- newView descriptionBuffer (textviewFont prefs) updateStyle descriptionBuffer- descriptionScrolledWindow <- getScrolledWindow descriptionView visible <- liftIO $ newIORef False activeView <- liftIO $ newIORef Nothing - treeSelection <- liftIO $ treeViewGetSelection tree+ treeSelection <- treeViewGetSelection tree - liftIO $ on treeSelection treeSelectionSelectionChanged $- treeSelectionSelectedForeach treeSelection $ \treePath -> do- rows <- treeSelectionGetSelectedRows treeSelection- case rows of- [treePath] -> reflectIDE (withWord store treePath (\name -> do+ onTreeSelectionChanged treeSelection $+ treeSelectionSelectedForeach treeSelection $ \_model treePath _iter ->+ reflectIDE (void $ withWord store treePath (\name -> do description <- getDescription name setText descriptionBuffer description )) ideR- _ -> return () - liftIO $ panedAdd1 paned nameScrolledWindow- liftIO $ panedAdd2 paned descriptionScrolledWindow+ panedAdd1 paned nameScrolledWindow+ panedAdd2 paned descriptionScrolledWindow cids <- addEventHandling window sourceView tree store isWordChar always @@ -168,136 +231,174 @@ completion = ((width, height), Just (CompletionWindow window tree store))}) updateOptions window tree store sourceView cids isWordChar always -addEventHandling :: TextEditor editor => Window -> EditorView editor -> TreeView -> ListStore Text+addEventHandling :: TextEditor editor => Window -> EditorView editor -> TreeView -> SeqStore Text -> (Char -> Bool) -> Bool -> IDEM Connections addEventHandling window sourceView tree store isWordChar always = do ideR <- ask cidsPress <- TE.onKeyPress sourceView $ do- keyVal <- lift eventKeyVal- name <- lift eventKeyName- modifier <- lift eventModifier- char <- liftIO $ keyvalToChar keyVal- Just model <- liftIO $ treeViewGetModel tree- selection <- liftIO $ treeViewGetSelection tree- count <- liftIO $ treeModelIterNChildren model Nothing- Just column <- liftIO $ treeViewGetColumn tree 0- let whenVisible f = liftIO (get tree widgetVisible) >>= \case+ e <- lift ask+ keyVal <- getEventKeyKeyval e+ name <- keyvalName keyVal+ modifier <- getEventKeyState e+ char <- toEnum . fromIntegral <$> keyvalToUnicode keyVal+ Just model <- treeViewGetModel tree+ selection <- treeViewGetSelection tree+ count <- treeModelIterNChildren model Nothing+ Just column <- treeViewGetColumn tree 0+ let whenVisible f = getWidgetVisible tree >>= \case True -> f False -> return False down = whenVisible $ do maybeRow <- liftIO $ getRow tree let newRow = maybe 0 (+ 1) maybeRow- when (newRow < count) . liftIO $ do- treeSelectionSelectPath selection [newRow]- treeViewScrollToCell tree (Just [newRow]) Nothing Nothing+ when (newRow < count) $ do+ path <- treePathNewFromIndices' [newRow]+ treeSelectionSelectPath selection path+ treeViewScrollToCell tree (Just path) noTreeViewColumn False 0 0 return True up = whenVisible $ do maybeRow <- liftIO $ getRow tree let newRow = maybe 0 (\ row -> row - 1) maybeRow- when (newRow >= 0) . liftIO $ do- treeSelectionSelectPath selection [newRow]- treeViewScrollToCell tree (Just [newRow]) Nothing Nothing+ when (newRow >= 0) $ do+ path <- treePathNewFromIndices' [newRow]+ treeSelectionSelectPath selection path+ treeViewScrollToCell tree (Just path) noTreeViewColumn False 0 0 return True case (name, modifier, char) of- ("Tab", _, _) -> whenVisible . liftIDE $ do+ (Just "Tab", _, _) -> whenVisible . liftIDE $ do tryToUpdateOptions window tree store sourceView True isWordChar always return True- ("Return", _, _) -> whenVisible $ do- maybeRow <- liftIO $ getRow tree- case maybeRow of- Just row -> do- liftIO $ treeViewRowActivated tree [row] column- return True- Nothing -> do- liftIDE cancel- return False- ("Down", _, _) -> down- ("Up", _, _) -> up- (super, _, Just 'a') | super `elem` ["Super_L", "Super_R"] -> do+ (Just "Return", _, _) -> getWidgetVisible tree >>= \case+ True -> do+ maybeRow <- liftIO $ getRow tree+ case maybeRow of+ Just row -> do+ path <- treePathNewFromIndices' [row]+ liftIDE $ withWord store path (replaceWordStart sourceView isWordChar) >>= \case+ Just True -> liftIDE $ smartIndent sourceView+ _ -> return ()+ liftIDE $ postAsyncIDE cancel+ return True+ Nothing -> liftIDE $ do+ cancel+ smartIndent sourceView+ return True+ False -> liftIDE $ do+ smartIndent sourceView+ return True+ (Just "Down", _, _) -> down+ (Just "Up", _, _) -> up+ (Just super, _, 'a') | super `elem` ["Super_L", "Super_R"] -> do liftIO $ debugM "leksah" "Completion - Super 'a' key press" down- (super, _, Just 'l') | super `elem` ["Super_L", "Super_R"] -> do+ (Just super, _, 'l') | super `elem` ["Super_L", "Super_R"] -> do liftIO $ debugM "leksah" "Completion - Super 'l' key press" up- (_, _, Just c) | isWordChar c -> return False- ("BackSpace", _, _) -> return False- (key, _, _) | key `elem` ["Shift_L", "Shift_R", "Super_L", "Super_R"] -> return False+ (_, _, c) | isWordChar c -> return False+ (Just "BackSpace", _, _) -> return False+ (Just key, _, _) | key `elem` ["Shift_L", "Shift_R", "Super_L", "Super_R"] -> return False _ -> do liftIDE cancel return False cidsRelease <- TE.onKeyRelease sourceView $ do- name <- lift eventKeyName- modifier <- lift eventModifier+ e <- lift ask+ name <- getEventKeyKeyval e >>= keyvalName+ modifier <- getEventKeyState e case (name, modifier) of- ("BackSpace", _) -> do+ (Just "BackSpace", _) -> do liftIDE $ complete sourceView False return False _ -> return False - liftIO $ do- resizeHandler <- newIORef Nothing+ resizeHandler <- liftIO $ newIORef Nothing - idButtonPress <- window `on` buttonPressEvent $ do- button <- eventButton- (x, y) <- eventCoordinates- time <- eventTime+ idButtonPress <- ConnectC window <$> onWidgetButtonPressEvent window (\e -> do+ button <- getEventButtonButton e+ x <- getEventButtonX e+ y <- getEventButtonY e+ time <- getEventButtonTime e - mbDrawWindow <- Gtk.liftIO $ widgetGetWindow window- case mbDrawWindow of- Just drawWindow -> do- status <- Gtk.liftIO $ pointerGrab- drawWindow- False- [PointerMotionMask, ButtonReleaseMask]- (Nothing:: Maybe DrawWindow)- Nothing- time- when (status == GrabSuccess) $ Gtk.liftIO $ do- (width, height) <- windowGetSize window- writeIORef resizeHandler $ Just $ \(newX, newY) ->- reflectIDE (- setCompletionSize (width + floor (newX - x), height + floor (newY - y))) ideR- Nothing -> return ()+ widgetGetWindow window >>= \case+ Nothing -> return ()+ Just drawWindow -> do+ status <- pointerGrab+ drawWindow+ False+ [EventMaskPointerMotionMask, EventMaskButtonReleaseMask]+ Gdk.noWindow+ noCursor+ time+ when (status == GrabStatusSuccess) $ do+ (width, height) <- windowGetSize window+ liftIO $ writeIORef resizeHandler $ Just $ \newX newY ->+ reflectIDE (+ setCompletionSize (fromIntegral width + floor (newX - x)) (fromIntegral height + floor (newY - y))) ideR - return True+ return True) - idMotion <- window `on` motionNotifyEvent $ do- mbResize <- Gtk.liftIO $ readIORef resizeHandler- case mbResize of- Just resize -> eventCoordinates >>= (Gtk.liftIO . resize) >> return True- Nothing -> return False+ idMotion <- ConnectC window <$> onWidgetMotionNotifyEvent window (\e -> do+ mbResize <- readIORef resizeHandler+ case mbResize of+ Just resize -> do+ x <- getEventMotionX e+ y <- getEventMotionY e+ resize x y+ return True+ Nothing -> return False) - idButtonRelease <- window `on` buttonReleaseEvent $ do- mbResize <- Gtk.liftIO $ readIORef resizeHandler- case mbResize of- Just resize -> do- eventCoordinates >>= (Gtk.liftIO . resize)- eventTime >>= (Gtk.liftIO . pointerUngrab)- Gtk.liftIO $ writeIORef resizeHandler Nothing- return True- Nothing -> return False+ idButtonRelease <- ConnectC window <$> onWidgetButtonReleaseEvent window (\e -> do+ mbResize <- liftIO $ readIORef resizeHandler+ case mbResize of+ Just resize -> do+ x <- getEventButtonX e+ y <- getEventButtonY e+ resize x y+ getEventButtonTime e >>= pointerUngrab+ liftIO $ writeIORef resizeHandler Nothing+ return True+ Nothing -> return False) - idSelected <- on tree rowActivated $ \treePath column -> do- reflectIDE (withWord store treePath (replaceWordStart sourceView isWordChar)) ideR- liftIO $ postGUIAsync $ reflectIDE cancel ideR+ idSelected <- ConnectC tree <$> onTreeViewRowActivated tree (\treePath column -> (`reflectIDE` ideR) $ do+ withWord store treePath (replaceWordStart sourceView isWordChar)+ postAsyncIDE cancel) - return $ concat [cidsPress, cidsRelease, [ConnectC idButtonPress, ConnectC idMotion, ConnectC idButtonRelease, ConnectC idSelected]]+ return $ concat [cidsPress, cidsRelease, [idButtonPress, idMotion, idButtonRelease, idSelected]] -withWord :: ListStore Text -> TreePath -> (Text -> IDEM ()) -> IDEM ()+smartIndent :: TextEditor editor => EditorView editor -> IDEM ()+smartIndent sourceView = do+ indentWidth <- tabWidth <$> readIDE prefs+ buffer <- getBuffer sourceView+ (selStart, selEnd) <- getSelectionBounds buffer+ lineStart <- backwardToLineStartC selStart+ line <- getText buffer lineStart selStart True+ let lastWord = reverse . takeWhile (\c -> isAlphaNum c || c `elem` ['\'','_']) . reverse $ T.unpack line+ lastOp = reverse . takeWhile (\c -> not (isAlphaNum c) && c `notElem` ['\'','_','\"',' ',']',')','}',',',';']) . reverse $ T.unpack line+ indentAmount = length . takeWhile (==' ') $ T.unpack line+ extraIndent = T.pack lastWord `elem` keywords || (not (null lastOp) && lastOp `notElem` ["--", "\\"])+ newIndent = if extraIndent+ then (indentAmount `div` indentWidth + 1) * indentWidth+ else indentAmount+ delete buffer selStart selEnd+ insert buffer selStart $ "\n" <> T.replicate newIndent " "++withWord :: SeqStore Text -> TreePath -> (Text -> IDEM a) -> IDEM (Maybe a) withWord store treePath f =- case treePath of- [row] -> do- value <- liftIO $ listStoreGetValue store row- f value- _ -> return ()+ treePathGetIndices' treePath >>= \case+ [row] -> do+ value <- seqStoreGetValue store row+ Just <$> f value+ _ -> return Nothing -replaceWordStart :: TextEditor editor => EditorView editor -> (Char -> Bool) -> Text -> IDEM ()+-- Return value indicates if the we did nothing and return key should+-- still be cause a new line to be started.+replaceWordStart :: TextEditor editor => EditorView editor -> (Char -> Bool) -> Text -> IDEM Bool replaceWordStart sourceView isWordChar name = do buffer <- getBuffer sourceView (selStart, selEnd) <- getSelectionBounds buffer start <- findWordStart selStart isWordChar wordStart <- getText buffer start selEnd True case T.stripPrefix wordStart name of+ Just "" -> return True Just extra -> do end <- findWordEnd selEnd isWordChar wordFinish <- getText buffer selEnd end True@@ -306,26 +407,25 @@ selectRange buffer end end insert buffer end extra2 _ -> insert buffer selEnd extra- Nothing -> return ()+ return False+ Nothing -> return False -cancelCompletion :: Window -> TreeView -> ListStore Text -> Connections -> IDEAction+cancelCompletion :: Window -> TreeView -> SeqStore Text -> Connections -> IDEAction cancelCompletion window tree store connections = do- liftIO (do- listStoreClear (store :: ListStore Text)- signalDisconnectAll connections- widgetHide window- )+ seqStoreClear (store :: SeqStore Text)+ signalDisconnectAll connections+ widgetHide window modifyIDE_ (\ide -> ide{currentState = IsRunning}) -updateOptions :: forall editor. TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Connections -> (Char -> Bool) -> Bool -> IDEAction+updateOptions :: forall editor. TextEditor editor => Window -> TreeView -> SeqStore Text -> EditorView editor -> Connections -> (Char -> Bool) -> Bool -> IDEAction updateOptions window tree store sourceView connections isWordChar always = do result <- tryToUpdateOptions window tree store sourceView False isWordChar always unless result $ cancelCompletion window tree store connections -tryToUpdateOptions :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Bool -> (Char -> Bool) -> Bool -> IDEM Bool+tryToUpdateOptions :: TextEditor editor => Window -> TreeView -> SeqStore Text -> EditorView editor -> Bool -> (Char -> Bool) -> Bool -> IDEM Bool tryToUpdateOptions window tree store sourceView selectLCP isWordChar always = do ideR <- ask- liftIO $ listStoreClear (store :: ListStore Text)+ seqStoreClear (store :: SeqStore Text) buffer <- getBuffer sourceView (selStart, end) <- getSelectionBounds buffer start <- findWordStart selStart isWordChar@@ -359,7 +459,7 @@ Nothing -> T.empty Just (p, _, _) -> p -processResults :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Text -> [Text]+processResults :: TextEditor editor => Window -> TreeView -> SeqStore Text -> EditorView editor -> Text -> [Text] -> Bool -> (Char -> Bool) -> Bool -> IDEAction processResults window tree store sourceView wordStart options selectLCP isWordChar always = case options of@@ -375,62 +475,71 @@ else currentWordStart when (T.isPrefixOf wordStart newWordStart) $ do- liftIO $ listStoreClear store+ seqStoreClear store let newOptions = List.filter (T.isPrefixOf newWordStart) options- liftIO $ forM_ (take 200 newOptions) (listStoreAppend store)- Rectangle startx starty width height <- getIterLocation sourceView start- (wWindow, hWindow) <- liftIO $ windowGetSize window- (x, y) <- bufferToWindowCoords sourceView (startx, starty+height)- mbDrawWindow <- getWindow sourceView+ forM_ (take 200 newOptions) (seqStoreAppend store)+ rect <- getIterLocation sourceView start+ startx <- getRectangleX rect+ starty <- getRectangleY rect+ width <- getRectangleWidth rect+ height <- getRectangleHeight rect+ (wWindow, hWindow) <- windowGetSize window+ (x, y) <- bufferToWindowCoords sourceView (fromIntegral startx, fromIntegral (starty+height))+ mbDrawWindow <- getWindow sourceView case mbDrawWindow of Nothing -> return () Just drawWindow -> do- (ox, oy) <- liftIO $ drawWindowGetOrigin drawWindow- Just namesSW <- liftIO $ widgetGetParent tree- (Rectangle _ _ wNames hNames) <- liftIO $ widgetGetAllocation namesSW- Just paned <- liftIO $ widgetGetParent namesSW- Just first <- liftIO $ panedGetChild1 (castToPaned paned)- Just second <- liftIO $ panedGetChild2 (castToPaned paned)- screen <- liftIO $ windowGetScreen window- monitor <- liftIO $ screenGetMonitorAtPoint screen (ox+x) (oy+y)- monitorLeft <- liftIO $ screenGetMonitorAtPoint screen (ox+x-wWindow+wNames) (oy+y)- monitorRight <- liftIO $ screenGetMonitorAtPoint screen (ox+x+wWindow) (oy+y)- monitorBelow <- liftIO $ screenGetMonitorAtPoint screen (ox+x) (oy+y+hWindow)- wScreen <- liftIO $ screenGetWidth screen- hScreen <- liftIO $ screenGetHeight screen- top <- if monitorBelow /= monitor || (oy+y+hWindow) > hScreen+ (_, ox, oy) <- windowGetOrigin drawWindow+ Just namesSW <- widgetGetParent tree+ rNames <- widgetGetAllocation namesSW+ wNames <- getRectangleWidth rNames+ hNames <- getRectangleHeight rNames+ paned <- widgetGetParent namesSW >>= liftIO . unsafeCastTo Paned . fromJust+ Just first <- panedGetChild1 paned+ Just second <- panedGetChild2 paned+ screen <- windowGetScreen window+ monitor <- screenGetMonitorAtPoint screen (ox+fromIntegral x) (oy+fromIntegral y)+ monitorLeft <- screenGetMonitorAtPoint screen (ox+fromIntegral x-wWindow+wNames) (oy+fromIntegral y)+ monitorRight <- screenGetMonitorAtPoint screen (ox+fromIntegral x+wWindow) (oy+fromIntegral y)+ monitorBelow <- screenGetMonitorAtPoint screen (ox+fromIntegral x) (oy+fromIntegral y+hWindow)+ wScreen <- screenGetWidth screen+ hScreen <- screenGetHeight screen+ top <- if monitorBelow /= monitor || (oy+fromIntegral y+hWindow) > hScreen then do sourceSW <- getScrolledWindow sourceView- (Rectangle _ _ _ hSource) <- liftIO $ widgetGetAllocation sourceSW+ hSource <- widgetGetAllocation sourceSW >>= getRectangleHeight scrollToIter sourceView end 0.1 (Just (1.0, 1.0 - (fromIntegral hWindow / fromIntegral hSource)))- (_, newy) <- bufferToWindowCoords sourceView (startx, starty+height)- return (oy+newy)- else return (oy+y)- swap <- if (monitorRight /= monitor || (ox+x+wWindow) > wScreen) && monitorLeft == monitor && (ox+x-wWindow+wNames) > 0+ (_, newy) <- bufferToWindowCoords sourceView (fromIntegral startx, fromIntegral (starty+height))+ return (oy+fromIntegral newy)+ else return (oy+fromIntegral y)+ liftIO $ debugM "leksah" $ "Completion processResults " <> show (monitorRight /= monitor, monitorLeft /= monitor, ox, x, wWindow, wScreen, wNames)+ swap <- if (monitorRight /= monitor || (ox+fromIntegral x+wWindow) > wScreen) && monitorLeft == monitor && (ox+fromIntegral x-wWindow+wNames) > 0 then do- liftIO $ windowMove window (ox+x-wWindow+wNames) top- return $ first == namesSW+ windowMove window (ox+fromIntegral x-wWindow+wNames) top+ return $ first `equalManagedPtr` namesSW else do- liftIO $ windowMove window (ox+x) top- return $ first /= namesSW- when swap $ liftIO $ do- pos <- panedGetPosition (castToPaned paned)- containerRemove (castToPaned paned) first- containerRemove (castToPaned paned) second- panedAdd1 (castToPaned paned) second- panedAdd2 (castToPaned paned) first- panedSetPosition (castToPaned paned) (wWindow-pos)- unless (null newOptions) $ liftIO $ treeViewSetCursor tree [0] Nothing- liftIO $ widgetShowAll window+ windowMove window (ox+fromIntegral x) top+ return . not $ first `equalManagedPtr` namesSW+ when swap $ do+ pos <- panedGetPosition paned+ containerRemove paned first+ containerRemove paned second+ panedAdd1 paned second+ panedAdd2 paned first+ panedSetPosition paned (wWindow-pos)+ unless (null newOptions) $ do+ path <- treePathNewFromIndices' [0]+ treeViewSetCursor tree path noTreeViewColumn False+ widgetShowAll window when (newWordStart /= currentWordStart) $- replaceWordStart sourceView isWordChar newWordStart+ void $ replaceWordStart sourceView isWordChar newWordStart getRow tree = do Just model <- treeViewGetModel tree- selection <- treeViewGetSelection tree- maybeIter <- treeSelectionGetSelected selection- case maybeIter of- Just iter -> do [row] <- treeModelGetPath model iter- return $ Just row- Nothing -> return Nothing+ selection <- treeViewGetSelection tree+ treeSelectionGetSelected selection >>= \case+ (True, _, iter) -> do+ [row] <- treeModelGetPath model iter >>= treePathGetIndices+ return $ Just row+ _ -> return Nothing
src/IDE/Core/State.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeSynonymInstances,- MultiParamTypeClasses, ScopedTypeVariables, CPP,- DeriveDataTypeable, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Core.State@@ -69,6 +73,7 @@ --, deactivatePaneIfActive --, closePane , changePackage+, changeProject , liftYiControl , liftYi@@ -82,12 +87,10 @@ ) where -import Graphics.UI.Gtk hiding (get)-import Graphics.UI.Gtk.SourceView.SourceView ()-+import Prelude ()+import Prelude.Compat import Data.IORef import Control.Exception-import Prelude hiding (catch) import Control.Monad.IO.Class (MonadIO, liftIO) import IDE.Core.Types as Reexported import Graphics.UI.Frame.Panes as Reexported@@ -102,7 +105,7 @@ import IDE.Utils.Utils as Reexported import qualified Data.Map as Map (empty, lookup) import Data.Typeable(Typeable)-import qualified IDE.YiConfig as Yi+import qualified IDE.TextEditor.Yi.Config as Yi import Data.Conduit (($$)) import qualified Data.Conduit as C (transPipe, Sink, awaitForever, yield, leftover, ($$))@@ -119,6 +122,15 @@ import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar) import qualified Data.Sequence as Seq (filter) import Data.Sequence (Seq)+import GI.Gtk.Objects.Widget+ (noWidget, Widget(..), widgetDestroy, widgetShowAll, widgetSetName,+ widgetGrabFocus)+import GI.Gtk.Objects.Notebook+ (Notebook(..), notebookRemovePage, notebookPageNum)+import Data.Int (Int32)+import GI.GLib (pattern PRIORITY_DEFAULT_IDLE, pattern PRIORITY_DEFAULT, idleAdd)+import GI.Gtk.Objects.Label (noLabel)+import Data.Foldable (forM_) instance PaneMonad IDEM where getFrameState = readIDE frameState@@ -148,8 +160,8 @@ -- displayThisPane :: Bool -> delta alpha displayThisPane pane shallGrabFocus = do- liftIO $ bringPaneToFront pane- when shallGrabFocus $ liftIO $ widgetGrabFocus $ getTopWidget pane+ bringPaneToFront pane+ when shallGrabFocus $ widgetGrabFocus =<< getTopWidget pane -- buildThisPane :: forall alpha beta . RecoverablePane alpha beta delta => PanePath -> -- Notebook -> -- (PanePath -> Notebook -> Window -> delta (alpha,Connections)) ->@@ -171,13 +183,13 @@ Just it -> False if b1 && b2 then do- notebookInsertOrdered notebook (getTopWidget buf) (paneName buf) Nothing False+ topWidget <- getTopWidget buf+ notebookInsertOrdered notebook topWidget (paneName buf) noLabel (paneTooltipText buf) False addPaneAdmin buf cids panePath- liftIO $ do- widgetSetName (getTopWidget buf) (paneName buf)- widgetShowAll (getTopWidget buf)- widgetGrabFocus (getTopWidget buf)- bringPaneToFront buf+ widgetSetName topWidget (paneName buf)+ widgetShowAll topWidget+ widgetGrabFocus topWidget+ bringPaneToFront buf return (Just buf) else return Nothing --activateThisPane :: forall alpha beta . RecoverablePane alpha beta delta => alpha -> Connections -> delta ()@@ -188,7 +200,7 @@ _ -> do deactivatePaneWithout triggerEventIDE (StatusbarChanged [CompartmentPane (Just (PaneC pane))])- liftIO $ bringPaneToFront pane+ bringPaneToFront pane setActivePane (Just (paneName pane,conn)) trigger (Just (paneName pane)) (case mbAP of@@ -208,16 +220,15 @@ closeThisPane pane = do (panePath,_) <- guiPropertiesFromName (paneName pane) nb <- getNotebook panePath- mbI <- liftIO $notebookPageNum nb (getTopWidget pane)- case mbI of- Nothing -> liftIO $ do+ i <- notebookPageNum nb =<< getTopWidget pane+ if i < 0+ then liftIO $ do error ("notebook page not found: unexpected " ++ T.unpack (paneName pane) ++ " " ++ show panePath) return False- Just i -> do+ else do deactivatePaneIfActive pane- liftIO $ do- notebookRemovePage nb i- widgetDestroy (getTopWidget pane)+ notebookRemovePage nb i+ widgetDestroy =<< getTopWidget pane removePaneAdmin pane modifyIDE_ (\ide -> ide{recentPanes = filter (/= paneName pane) (recentPanes ide)}) return True@@ -326,31 +337,31 @@ forkIDE :: MonadIDE m => IDEAction -> m () forkIDE block = reifyIDE (void . forkIO . reflectIDE block) -postSyncIDE' :: MonadIDE m => Priority -> IDEM a -> m a+postSyncIDE' :: MonadIDE m => Int32 -> IDEM a -> m a postSyncIDE' priority f = reifyIDE $ \ideR -> do resultVar <- newEmptyMVar- idleAdd (reflectIDE f ideR >>= putMVar resultVar >> return False) priority+ idleAdd priority $ reflectIDE f ideR >>= putMVar resultVar >> return False takeMVar resultVar postSyncIDE :: MonadIDE m => IDEM a -> m a-postSyncIDE = postSyncIDE' priorityDefault+postSyncIDE = postSyncIDE' PRIORITY_DEFAULT postSyncIDEIdle :: MonadIDE m => IDEM a -> m a-postSyncIDEIdle = postSyncIDE' priorityDefaultIdle+postSyncIDEIdle = postSyncIDE' PRIORITY_DEFAULT_IDLE -postAsyncIDE' :: MonadIDE m => Priority -> IDEM () -> m ()+postAsyncIDE' :: MonadIDE m => Int32 -> IDEM () -> m () postAsyncIDE' priority f = reifyIDE $ \ideR ->- void $ idleAdd (reflectIDE f ideR >> return False) priority+ void . idleAdd priority $ reflectIDE f ideR >> return False postAsyncIDE :: MonadIDE m => IDEM () -> m ()-postAsyncIDE = postAsyncIDE' priorityDefault+postAsyncIDE = postAsyncIDE' PRIORITY_DEFAULT postAsyncIDEIdle :: MonadIDE m => IDEM () -> m ()-postAsyncIDEIdle = postAsyncIDE' priorityDefaultIdle+postAsyncIDEIdle = postAsyncIDE' PRIORITY_DEFAULT_IDLE -onIDE obj signal callback = do+onIDE onSignal obj callback = do ideRef <- ask- liftIO (obj `on` signal $ runReaderT callback ideRef)+ liftIO (ConnectC obj <$> onSignal obj (\e -> runReaderT (runReaderT callback ideRef) e)) -- --------------------------------------------------------------------- -- Convenience methods for accesing the IDE State@@ -415,8 +426,7 @@ triggerEventIDE (StatusbarChanged [CompartmentPane Nothing]) mbAP <- getActivePane case mbAP of- Just (_,signals) -> liftIO $do- signalDisconnectAll signals+ Just (_,signals) -> signalDisconnectAll signals Nothing -> return () setActivePane Nothing @@ -435,21 +445,32 @@ oldWorkspace <- readIDE workspace case oldWorkspace of Nothing -> return ()- Just ws -> do- let ps = map exchange (wsPackages ws)- modifyIDE_ (\ide -> ide{workspace = Just ws {wsPackages = ps},- bufferProjCache = Map.empty})- mbActivePack <- readIDE activePack- case mbActivePack of- Just activePack | key ideP == key activePack ->- modifyIDE_ (\ide -> ide{activePack = Just ideP})- _ -> return ()+ Just ws ->+ modifyIDE_ $ \ide -> ide{workspace = Just ws {+ wsProjects = map (\p -> p {+ pjPackageMap = mkPackageMap $ map exchange (pjPackages p)}) (wsProjects ws)},+ bufferProjCache = Map.empty} where key = ipdPackageDir idePKey = key ideP exchange p | key p == idePKey = ideP | otherwise = p +-- | Replaces an 'Project' in the workspace by the given 'Project' and+-- replaces the current package if it matches.+-- Comparison is done based on the package's build directory.+changeProject :: Project -> IDEAction+changeProject project =+ readIDE workspace >>= \case+ Nothing -> return ()+ Just ws -> do+ let ps = map exchange (wsProjects ws)+ modifyIDE_ (\ide -> ide{workspace = Just ws {wsProjects = ps},+ bufferProjCache = Map.empty})+ where+ exchange p | pjFile p == pjFile project = project+ | otherwise = p+ -- | Find a directory relative to the leksah install directory leksahSubDir :: FilePath -- ^ Sub directory to look for -> IO (Maybe FilePath)@@ -476,6 +497,6 @@ Just result -> return result Nothing -> getPackageDir -getDataDir :: IO FilePath-getDataDir = leksahOrPackageDir "leksah" P.getDataDir+getDataDir :: MonadIO m => m FilePath+getDataDir = liftIO $ leksahOrPackageDir "leksah" P.getDataDir
src/IDE/Core/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -22,6 +22,9 @@ module IDE.Core.Types ( IDE(..)+, activeProject+, activePack+, activeComponent , IDEState(..) , IDERef , IDEM@@ -36,6 +39,10 @@ , WorkspaceAction , runWorkspace +, ProjectM+, ProjectAction+, runProject+ , PackageM , PackageAction , runPackage@@ -45,11 +52,22 @@ , runDebug , IDEPackage(..)+, mkPackageMap , ipdPackageDir-, ipdAllDirs , ipdLib , ipdPackageName+, ProjectTool(..)+, Project(..)+, pjPackages+, pjLookupPackage+, pjDir+, pjToolCommand , Workspace(..)+, wsProjectFiles+, wsLookupProject+, wsActiveProject+, wsActivePackage+, wsPackages , wsAllPackages , VCSConf @@ -59,7 +77,6 @@ , Prefs(..) , candyState-, cabalCommand , EditorStyle(..) , editorStyle @@ -93,24 +110,25 @@ , SensitivityMask(..) , SearchMode(..) , StatusbarCompartment(..)++, Color(..)+, toGdkColor+, fromGdkColor+, KeyVal ) where -import qualified IDE.YiConfig as Yi-import Graphics.UI.Gtk- (TextBuffer, MenuItem, Window(..), KeyVal(..), Color(..), Menu(..),- TreeView(..), ListStore(..), Toolbar(..))+import Control.Applicative (Applicative)+import qualified IDE.TextEditor.Yi.Config as Yi import Data.Unique (newUnique, Unique(..)) import Graphics.UI.Frame.Panes import Distribution.Package- (PackageName(..), PackageIdentifier(..), Dependency(..))+ (PackageName(..), unPackageName, PackageIdentifier(..), Dependency(..)) import Distribution.PackageDescription (BuildInfo) import Data.Map (Map(..)) import Data.Set (Set(..))-import Data.List (nubBy)+import Data.List (find, nubBy) import Control.Concurrent (MVar) import Distribution.ModuleName (ModuleName(..))-import Graphics.UI.Gtk.Gdk.EventM (Modifier(..))-import Graphics.UI.Gtk.ActionMenuToolbar.UIManager(MergeId) import System.Time (ClockTime(..)) import Distribution.Simple (Extension(..)) import IDE.Utils.Tool (ToolState(..), ProcessHandle)@@ -118,7 +136,7 @@ import Numeric (showHex) import Control.Event (EventSelector(..), EventSource(..), Event(..))-import System.FilePath (dropFileName, (</>))+import System.FilePath (dropFileName, (</>), isAbsolute, makeRelative) import IDE.Core.CTypes import IDE.StrippedPrefs(RetrieveStrategy) import System.IO (Handle)@@ -142,6 +160,20 @@ import Control.Concurrent.STM.TVar (TVar) import Data.Sequence (Seq) import Data.Maybe (maybeToList)+import GI.Gtk.Objects.Toolbar (Toolbar(..))+import Data.GI.Gtk.ModelView.SeqStore (SeqStore(..))+import GI.Gtk.Objects.MenuItem (MenuItem(..))+import GI.Gtk.Objects.TreeView (TreeView(..))+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gdk.Flags (ModifierType)+import GI.Gtk.Objects.TextBuffer (TextBuffer(..))+import Data.Word (Word32)+import GI.Gtk.Objects.Window (Window(..))+import Text.PrinterParser (Color(..), toGdkColor, fromGdkColor)+import GI.Gtk.Objects.Application (Application(..))+import Control.Monad ((>=>))+import System.FSNotify (StopListening, WatchManager)+import qualified Data.Map as M (fromList, lookup, keys, elems) -- --------------------------------------------------------------------- -- IDE State@@ -151,43 +183,54 @@ -- | The IDE state -- data IDE = IDE {- frameState :: FrameState IDEM -- ^ state of the windows framework-, recentPanes :: [PaneName] -- ^ a list of panes which were selected last-, specialKeys :: SpecialKeyTable IDERef -- ^ a structure for emacs like keystrokes-, specialKey :: SpecialKeyCons IDERef -- ^ the first of a double keystroke-, candy :: CandyTable -- ^ table for source candy-, prefs :: Prefs -- ^ configuration preferences-, workspace :: Maybe Workspace -- ^ may be a workspace (set of packages)-, activePack :: Maybe IDEPackage-, activeExe :: Maybe Text-, bufferProjCache :: Map FilePath [IDEPackage] -- ^ cache the associated packages for a file-, allLogRefs :: Seq LogRef-, currentEBC :: (Maybe LogRef, Maybe LogRef, Maybe LogRef)-, currentHist :: Int-, systemInfo :: Maybe GenScope -- ^ the system scope-, packageInfo :: Maybe (GenScope, GenScope) -- ^ the second are the imports-, workspaceInfo :: Maybe (GenScope, GenScope) -- ^ the second are the imports-, workspInfoCache :: PackageDescrCache-, handlers :: Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -- ^ event handling table-, currentState :: IDEState-, guiHistory :: (Bool,[GUIHistory],Int)-, findbar :: (Bool,Maybe (Toolbar,ListStore Text))-, toolbar :: (Bool,Maybe Toolbar)-, recentFiles :: [FilePath]-, recentWorkspaces :: [FilePath]-, runningTool :: Maybe ProcessHandle-, debugState :: Maybe (IDEPackage, ToolState)-, completion :: ((Int, Int), Maybe CompletionWindow)-, yiControl :: Yi.Control-, serverQueue :: Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ()))-, server :: Maybe Handle-, hlintQueue :: Maybe (TVar [Either FilePath FilePath])-, vcsData :: (Map FilePath MenuItem, Maybe (Maybe Text)) -- menus for packages, password-, logLaunches :: Map.Map Text LogLaunchData-, autoCommand :: IDEAction-, autoURI :: Maybe Text+ application :: Application+, frameState :: FrameState IDEM -- ^ state of the windows framework+, recentPanes :: [PaneName] -- ^ a list of panes which were selected last+, specialKeys :: SpecialKeyTable IDERef -- ^ a structure for emacs like keystrokes+, specialKey :: SpecialKeyCons IDERef -- ^ the first of a double keystroke+, candy :: CandyTable -- ^ table for source candy+, prefs :: Prefs -- ^ configuration preferences+, workspace :: Maybe Workspace -- ^ may be a workspace (set of packages)+, bufferProjCache :: Map FilePath [IDEPackage] -- ^ cache the associated packages for a file+, allLogRefs :: Seq LogRef+, currentEBC :: (Maybe LogRef, Maybe LogRef, Maybe LogRef)+, currentHist :: Int+, systemInfo :: Maybe GenScope -- ^ the system scope+, packageInfo :: Maybe (GenScope, GenScope) -- ^ the second are the imports+, workspaceInfo :: Maybe (GenScope, GenScope) -- ^ the second are the imports+, workspInfoCache :: PackageDescrCache+, handlers :: Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -- ^ event handling table+, currentState :: IDEState+, guiHistory :: (Bool,[GUIHistory],Int)+, findbar :: (Bool,Maybe (Toolbar,SeqStore Text))+, toolbar :: (Bool,Maybe Toolbar)+, recentFiles :: [FilePath]+, recentWorkspaces :: [FilePath]+, runningTool :: Maybe ProcessHandle+, debugState :: Maybe (IDEPackage, ToolState)+, completion :: ((Int, Int), Maybe CompletionWindow)+, yiControl :: Yi.Control+, serverQueue :: Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ()))+, server :: Maybe Handle+, hlintQueue :: Maybe (TVar [Either FilePath FilePath])+, vcsData :: (Map FilePath MenuItem, Maybe (Maybe Text)) -- menus for packages, password+, logLaunches :: Map.Map Text LogLaunchData+, autoCommand :: IDEAction+, autoURI :: Maybe Text+, triggerBuild :: MVar ()+, stopWorkspaceNotify :: StopListening+, fsnotify :: WatchManager } --deriving Show +activeProject :: IDE -> Maybe Project+activeProject ide = workspace ide >>= wsActiveProject++activePack :: IDE -> Maybe IDEPackage+activePack ide = workspace ide >>= wsActivePackage++activeComponent :: IDE -> Maybe Text+activeComponent ide = workspace ide >>= wsActiveComponent+ -- -- | A mutable reference to the IDE state --@@ -218,7 +261,7 @@ | IsCompleting Connections -class (Functor m, Monad m, MonadIO m) => MonadIDE m where+class (Applicative m, Monad m, MonadIO m) => MonadIDE m where liftIDE :: IDEM a -> m a instance MonadIDE IDEM where@@ -237,7 +280,7 @@ -- --------------------------------------------------------------------- -- Monad for Gtk events (use onIDE instead of on) ---type IDEEventM t = ReaderT IDERef (ReaderT (Ptr t) IO)+type IDEEventM t = ReaderT IDERef (ReaderT t IO) instance MonadIDE (IDEEventM t) where liftIDE f = do@@ -256,13 +299,25 @@ -- --------------------------------------------------------------------- -- Monad for functions that need an active package ---type PackageM = ReaderT IDEPackage WorkspaceM+type ProjectM = ReaderT Project WorkspaceM+type ProjectAction = ProjectM ()++instance MonadIDE ProjectM where+ liftIDE = lift . lift++runProject :: ProjectM a -> Project -> WorkspaceM a+runProject = runReaderT++-- ---------------------------------------------------------------------+-- Monad for functions that need an active package+--+type PackageM = ReaderT IDEPackage ProjectM type PackageAction = PackageM () instance MonadIDE PackageM where- liftIDE = lift . lift+ liftIDE = lift . lift . lift -runPackage :: PackageM a -> IDEPackage -> WorkspaceM a+runPackage :: PackageM a -> IDEPackage -> ProjectM a runPackage = runReaderT -- ---------------------------------------------------------------------@@ -295,6 +350,7 @@ | VariablesChanged | ErrorChanged Bool | ErrorAdded Bool Int LogRef+ | ErrorsRemoved Bool (LogRef -> Bool) | CurrentErrorChanged (Maybe LogRef) | BreakpointChanged | CurrentBreakChanged (Maybe LogRef)@@ -322,6 +378,7 @@ getSelector VariablesChanged = "VariablesChanged" getSelector (ErrorChanged _) = "ErrorChanged" getSelector (ErrorAdded _ _ _) = "ErrorAdded"+ getSelector (ErrorsRemoved _ _) = "ErrorsRemoved" getSelector (CurrentErrorChanged _) = "CurrentErrorChanged" getSelector BreakpointChanged = "BreakpointChanged" getSelector (CurrentBreakChanged _) = "CurrentBreakChanged"@@ -351,6 +408,7 @@ canTriggerEvent _ "VariablesChanged" = True canTriggerEvent _ "ErrorChanged" = True canTriggerEvent _ "ErrorAdded" = True+ canTriggerEvent _ "ErrorsRemoved" = True canTriggerEvent _ "CurrentErrorChanged" = True canTriggerEvent _ "BreakpointChanged" = True canTriggerEvent _ "CurrentBreakChanged" = True@@ -373,6 +431,31 @@ instance EventSelector Text -- ---------------------------------------------------------------------+-- Project+--+data ProjectTool = CabalTool | StackTool deriving (Show, Eq)++data Project = Project {+ pjTool :: ProjectTool+, pjFile :: FilePath+, pjPackageMap :: Map FilePath IDEPackage+} deriving (Show)++pjPackages :: Project -> [IDEPackage]+pjPackages = M.elems . pjPackageMap++pjLookupPackage :: FilePath -> Project -> Maybe IDEPackage+pjLookupPackage f = M.lookup f . pjPackageMap++pjToolCommand :: Project -> FilePath+pjToolCommand project = case pjTool project of+ StackTool -> "stack"+ CabalTool -> "cabal"++pjDir :: Project -> FilePath+pjDir = dropFileName . pjFile++-- --------------------------------------------------------------------- -- IDEPackages -- data IDEPackage = IDEPackage {@@ -388,60 +471,72 @@ , ipdExtraSrcs :: Set FilePath , ipdSrcDirs :: [FilePath] -- ^ Relative paths to the source directories , ipdExtensions :: [Extension]-, ipdConfigFlags :: [Text]-, ipdBuildFlags :: [Text]-, ipdTestFlags :: [Text]-, ipdHaddockFlags :: [Text]-, ipdExeFlags :: [Text]-, ipdInstallFlags :: [Text]-, ipdRegisterFlags :: [Text]-, ipdUnregisterFlags :: [Text]+, ipdConfigFlags :: [Text] -- ^ Flag for configure+, ipdBuildFlags :: [Text] -- ^ Flags for building+, ipdTestFlags :: [Text] -- ^ Flags for test runs+, ipdBenchmarkFlags :: [Text] -- ^ flags for benchmark runs+, ipdHaddockFlags :: [Text] -- ^ Flags for haddock generation+, ipdExeFlags :: [Text] -- ^ Flags for executable runs+, ipdInstallFlags :: [Text] -- ^ Flags for install+, ipdRegisterFlags :: [Text] -- ^ Flags for register+, ipdUnregisterFlags :: [Text] -- ^ Flags for unregister , ipdSdistFlags :: [Text]-, ipdSandboxSources :: [IDEPackage] } deriving (Eq) instance Show IDEPackage where show p = show "IDEPackage for " ++ (render . disp) (ipdPackageId p) -instance Ord IDEPackage where- compare x y = compare (ipdPackageId x) (ipdPackageId y)- -- | The directory of the cabal file ipdPackageDir :: IDEPackage -> FilePath ipdPackageDir = dropFileName . ipdCabalFile -- | Gets the package name ipdPackageName :: IDEPackage -> Text-ipdPackageName = T.pack . (\(PackageName s) -> s) . pkgName . ipdPackageId+ipdPackageName = T.pack . unPackageName . pkgName . ipdPackageId -- | Gets the library name if the package has a library component ipdLib :: IDEPackage -> Maybe Text ipdLib pkg = if ipdHasLibs pkg then Just (ipdPackageName pkg) else Nothing --- | All directory of the package and those of all its source dependencies-ipdAllDirs :: IDEPackage -> [FilePath]-ipdAllDirs p = ipdPackageDir p : (ipdSandboxSources p >>= ipdAllDirs)+mkPackageMap :: [IDEPackage] -> Map FilePath IDEPackage+mkPackageMap = M.fromList . map (\p -> (ipdCabalFile p, p)) -- --------------------------------------------------------------------- -- Workspace -- data Workspace = Workspace {- wsVersion :: Int-, wsSaveTime :: Text-, wsName :: Text-, wsFile :: FilePath-, wsPackages :: [IDEPackage]-, wsPackagesFiles :: [FilePath]-, wsActivePackFile:: Maybe FilePath-, wsActiveExe :: Maybe Text-, wsNobuildPack :: [IDEPackage]-, packageVcsConf :: Map FilePath VCSConf -- ^ (FilePath to package, Version-Control-System Configuration)+ wsVersion :: Int+, wsSaveTime :: Text+, wsName :: Text+, wsFile :: FilePath+, wsProjects :: [Project]+, wsActiveProjectFile :: Maybe FilePath+, wsActivePackFile :: Maybe FilePath+, wsActiveComponent :: Maybe Text+, packageVcsConf :: Map FilePath VCSConf -- ^ (FilePath to package, Version-Control-System Configuration) } deriving Show +wsProjectFiles :: Workspace -> [FilePath]+wsProjectFiles = map pjFile . wsProjects++wsLookupProject :: FilePath -> Workspace -> Maybe Project+wsLookupProject f = find ((==f) . pjFile) . wsProjects++wsActiveProject :: Workspace -> Maybe Project+wsActiveProject w = wsActiveProjectFile w >>= (`wsLookupProject` w)++wsActivePackage :: Workspace -> Maybe IDEPackage+wsActivePackage w = do+ project <- wsActiveProject w+ wsActivePackFile w >>= (`pjLookupPackage` project)++wsPackages :: Workspace -> [IDEPackage]+wsPackages = wsProjects >=> pjPackages+ -- | Includes sandbox sources wsAllPackages :: Workspace -> [IDEPackage]-wsAllPackages w = nubBy ((==) `on` ipdCabalFile) $ wsPackages w ++ (wsPackages w >>= ipdSandboxSources)+wsAllPackages w = nubBy ((==) `on` ipdCabalFile) $ wsPackages w -- --------------------------------------------------------------------- -- Other data structures which are used in the state@@ -481,6 +576,7 @@ , forceLineEnds :: Bool , removeTBlanks :: Bool , textviewFont :: Maybe Text+ , workspaceFont :: (Bool, Maybe Text) , sourceStyle :: (Bool, Text) , foundBackgroundLight :: Color , matchBackgroundLight :: Color@@ -494,7 +590,7 @@ , lintBackgroundDark :: Color , autoLoad :: Bool , textEditorType :: Text- , logviewFont :: Maybe Text+ , logviewFont :: (Bool, Maybe Text) , defaultSize :: (Int,Int) , browser :: Text , pathForCategory :: [(Text, PanePath)]@@ -508,9 +604,10 @@ , saveAllBeforeBuild :: Bool , jumpToWarnings :: Bool , useVado :: Bool- , useCabalDev :: Bool , backgroundBuild :: Bool- , runUnitTests :: Bool+ , makeDocs :: Bool -- ^ Make documentation on build+ , runUnitTests :: Bool -- ^ Run unit tests on build?+ , runBenchmarks :: Bool -- ^ Run benchmarks on build? , makeMode :: Bool , singleBuildWithoutLinking :: Bool , dontInstallLast :: Bool@@ -522,6 +619,7 @@ , showHiddenFiles :: Bool , showWorkspaceIcons :: Bool , hlintOnSave :: Bool+ , collapseErrors :: Bool -- As well used by server , serverPort :: Int , sourceDirectories :: [FilePath]@@ -531,9 +629,6 @@ , endWithLastConn :: Bool } deriving(Eq,Show) -cabalCommand :: Prefs -> FilePath-cabalCommand p = if useCabalDev p then "cabal-dev" else "cabal"- candyState :: Prefs -> Bool candyState = fst . sourceCandy @@ -561,11 +656,6 @@ data SearchHint = Forward | Backward | Insert | Delete | Initial deriving (Eq) -#ifndef LEKSAH_WITH_YI-instance Ord Modifier- where compare a b = compare (fromEnum a) (fromEnum b)-#endif- -- Version-Control-System Configuration type VCSConf = (VCS.VCSType, VCS.Config, Maybe VCSGUI.MergeTool) @@ -591,12 +681,12 @@ -- | Represents a message about a part of the source code data LogRef = LogRef { logRefSrcSpan :: SrcSpan-, logRefPackage :: IDEPackage+, logRefCabalFile :: FilePath , refDescription :: Text , logRefIdea :: Maybe (Text, Idea) , logLines :: Maybe (Int, Int) , logRefType :: LogRefType-} deriving (Eq)+} deriving(Eq) instance Show LogRef where show lr = T.unpack (refDescription lr) ++ displaySrcSpan (logRefSrcSpan lr)@@ -610,15 +700,26 @@ else show (srcSpanStartLine s) ++ ":" ++ show (srcSpanStartColumn s) ++ "-" ++ show (srcSpanEndColumn s) +-- | The root folder of the package the message references logRefRootPath :: LogRef -> FilePath-logRefRootPath = ipdPackageDir . logRefPackage+logRefRootPath = dropFileName . logRefCabalFile +-- | The file path the message references, relative to the root path logRefFilePath :: LogRef -> FilePath-logRefFilePath = srcSpanFilename . logRefSrcSpan+logRefFilePath lr = let+ f =srcSpanFilename $ logRefSrcSpan lr+ in if isAbsolute f -- can happen, at least when building with stack a source file that is present in several components (ie library and test)+ then makeRelative (logRefRootPath lr) f+ else f +-- | The absolute file path the message references logRefFullFilePath :: LogRef -- ^ The log ref -> FilePath -- ^ the result-logRefFullFilePath lr = logRefRootPath lr </> logRefFilePath lr+logRefFullFilePath lr = let+ f = srcSpanFilename $ logRefSrcSpan lr+ in if isAbsolute f+ then f+ else logRefRootPath lr </> f isError :: LogRef -> Bool isError = (== ErrorRef) . logRefType@@ -645,10 +746,12 @@ newtype KeymapI = KM (Map ActionString [(Maybe (Either KeyString (KeyString,KeyString)), Maybe Text)]) -type SpecialKeyTable alpha = Map (KeyVal,[Modifier]) (Map (KeyVal,[Modifier]) (ActionDescr alpha))+type KeyVal = Word32 -type SpecialKeyCons alpha = Maybe (Map (KeyVal, [Modifier]) (ActionDescr alpha), Text)+type SpecialKeyTable alpha = Map (KeyVal,[ModifierType]) (Map (KeyVal,[ModifierType]) (ActionDescr alpha)) +type SpecialKeyCons alpha = Maybe (Map (KeyVal, [ModifierType]) (ActionDescr alpha), Text)+ data LogTag = LogTag | ErrorTag | FrameTag | InputTag | InfoTag -- | the first one is the new and the second the old state@@ -685,7 +788,7 @@ data CompletionWindow = CompletionWindow { cwWindow :: Window, cwTreeView :: TreeView,- cwListStore :: ListStore Text}+ cwSeqStore :: SeqStore Text} data StatusbarCompartment = CompartmentCommand Text@@ -699,3 +802,4 @@ type PackageDescrCache = Map PackageIdentifier ModuleDescrCache type ModuleDescrCache = Map ModuleKey (UTCTime, Maybe FilePath, ModuleDescr)+
src/IDE/Find.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Find@@ -32,33 +32,7 @@ , toggleToolbar ) where -import Graphics.UI.Gtk- (toToolbar, ToolbarClass, toggleToolButtonSetActive,- castToToggleToolButton, toggleToolButtonGetActive, castToBin,- binGetChild, widgetGetName, containerGetChildren,- listStoreGetValue, treeModelGetPath, TreeIter, ListStore,- widgetModifyText, widgetModifyBase, toolbarChildHomogeneous, after,- entryActivate, spinButtonSetRange, focusInEvent, keyPressEvent,- deleteText, insertText, treeModelGetValue, matchSelected,- entryCompletionSetMatchFunc, cellText, cellLayoutSetAttributes,- cellLayoutPackStart, cellRendererTextNew, entryCompletionModel,- entrySetCompletion, entryCompletionNew, makeColumnIdString,- customStoreSetColumn, listStoreNew, toolItemSetExpand,- toolButtonSetLabel, toggleToolButtonNew, entryNew,- onToolButtonClicked, Widget, toolButtonNew, separatorToolItemNew,- labelNew, containerAdd, widgetSetName, spinButtonNewWithRange,- toolItemNew, toolbarInsert, toolButtonNewFromStock,- toolbarSetStyle, toolbarNew, Toolbar, widgetGrabFocus,- widgetShowAll, widgetHide, listStoreAppend, listStoreClear,- entrySetText, spinButtonSetValue, listStoreToList, castToEntry,- entryGetText, castToSpinButton, spinButtonGetValueAsInt,- StateType(..), ToolbarStyle(..), IconSize(..), AttrOp(..), set, on,- Color(..), widgetTooltipText)-import Graphics.UI.Gtk.Gdk.EventM-import qualified Graphics.UI.Gtk as Gtk-import Graphics.UI.Gtk.Buttons.ToggleButton-import Graphics.UI.Gtk.Buttons.CheckButton-+import Control.Applicative (Applicative) import IDE.Core.State import IDE.Utils.GUIUtils import IDE.TextEditor hiding(afterFocusIn)@@ -69,29 +43,73 @@ import Text.Regex.TDFA.Text (compile) import Data.List (find, isPrefixOf) import Data.Array (bounds, (!), inRange)+import Data.Maybe (fromJust) import IDE.Pane.Grep (grepWorkspace) import IDE.Workspaces (workspaceTry, packageTry) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Reader (ask) import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad (liftM, filterM, when, unless)+import Control.Monad (liftM, filterM, when, unless, void) import Foreign.C.Types (CInt(..)) import Foreign.Ptr (Ptr(..)) import Foreign.ForeignPtr (withForeignPtr)-import Graphics.UI.GtkInternals (unToolbar) import Data.Text (Text) import qualified Data.Text as T (pack, unpack, singleton, isPrefixOf, length, null, toLower) import Data.Monoid ((<>))-import Graphics.UI.Gtk.Entry.Entry (entrySetPlaceholderText)--foreign import ccall safe "gtk_toolbar_set_icon_size"- gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO ()--toolbarSetIconSize :: ToolbarClass self => self -> IconSize -> IO ()-toolbarSetIconSize self iconSize =- withForeignPtr (unToolbar $ toToolbar self) $- \selfPtr ->gtk_toolbar_set_icon_size selfPtr (fromIntegral $ fromEnum iconSize)+import GI.Gtk.Objects.SpinButton+ (spinButtonSetRange, spinButtonNewWithRange, spinButtonSetValue,+ SpinButton(..), spinButtonGetValueAsInt)+import Data.GI.Base (set, unsafeCastTo, nullToNothing)+import GI.Gtk.Objects.Entry+ (afterEntryActivate, onEntryActivate, entrySetCompletion,+ entrySetPlaceholderText, entryNew, entrySetText, entryGetText,+ Entry(..))+import Data.GI.Gtk.ModelView.SeqStore+ (seqStoreGetValue, SeqStore(..), seqStoreNew, seqStoreAppend,+ seqStoreClear, seqStoreToList)+import GI.Gtk.Objects.Widget+ (widgetGetName, widgetModifyText, widgetModifyBase,+ afterWidgetFocusInEvent, onWidgetKeyPressEvent,+ onWidgetFocusInEvent, setWidgetTooltipText, Widget(..), widgetSetName,+ widgetGrabFocus, widgetShowAll, widgetHide)+import GI.Gtk.Objects.Toolbar+ (toolbarInsert, toolbarSetIconSize, toolbarSetStyle, toolbarNew,+ Toolbar(..))+import GI.Gtk.Enums (StateType(..), IconSize(..), ToolbarStyle(..))+import GI.Gtk.Objects.ToolButton+ (toolButtonSetLabel, onToolButtonClicked, toolButtonNew,+ toolButtonNewFromStock)+import GI.Gtk.Objects.ToolItem (toolItemSetExpand, toolItemNew)+import GI.Gtk.Objects.Container+ (containerGetChildren, containerChildSetProperty, containerAdd)+import GI.Gtk.Objects.Label (labelNew)+import GI.Gtk.Objects.SeparatorToolItem (separatorToolItemNew)+import GI.Gtk.Objects.ToggleToolButton+ (ToggleToolButton(..), toggleToolButtonSetActive,+ toggleToolButtonGetActive, toggleToolButtonNew)+import Data.GI.Gtk.ModelView.TreeModel (makeColumnIdString, treeModelGetPath, treeModelGetValue)+import Data.GI.Gtk.ModelView.CustomStore (customStoreSetColumn)+import GI.Gtk.Objects.EntryCompletion+ (EntryCompletion(..), onEntryCompletionMatchSelected,+ entryCompletionSetMatchFunc, setEntryCompletionModel,+ entryCompletionNew)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction, cellLayoutPackStart)+import GI.Gtk.Interfaces.Editable+ (afterEditableDeleteText, afterEditableInsertText)+import GI.Gdk.Structs.EventKey+ (getEventKeyState, getEventKeyKeyval)+import GI.Gdk.Functions (keyvalName)+import GI.Gdk.Flags (ModifierType(..))+import Data.GI.Base.GValue (IsGValue(..))+import GI.Gtk.Structs.TreeIter (TreeIter(..))+import GI.Gtk.Objects.Bin (Bin(..), binGetChild)+import IDE.Core.Types (toGdkColor)+import GI.Gtk.Structs.TreePath (treePathGetIndices)+import GI.Gtk (noWidget, imageNewFromIconName) data FindState = FindState { entryStr :: Text@@ -108,11 +126,11 @@ getFindState :: IDEM FindState getFindState = do (fb,ls) <- needFindbar- liftIO $ do- lineNr <- getLineEntry fb >>= (spinButtonGetValueAsInt . castToSpinButton)- replaceStr <- getReplaceEntry fb >>= (entryGetText . castToEntry)- entryStr <- getFindEntry fb >>= (entryGetText . castToEntry)- entryHist <- listStoreToList ls+ do+ lineNr <- getLineEntry fb >>= spinButtonGetValueAsInt+ replaceStr <- getReplaceEntry fb >>= entryGetText+ entryStr <- getFindEntry fb >>= entryGetText+ entryHist <- seqStoreToList ls entireWord <- getEntireWord fb wrapAround <- getWrapAround fb caseSensitive <- getCaseSensitive fb@@ -126,21 +144,20 @@ , entireWord = entireWord , wrapAround = wrapAround , regex = regex- , lineNr = lineNr}+ , lineNr = fromIntegral lineNr} setFindState :: FindState -> IDEAction setFindState fs = do (fb,ls) <- needFindbar- liftIO $ do- getLineEntry fb >>= (\e -> spinButtonSetValue (castToSpinButton e) (fromIntegral (lineNr fs)))- getReplaceEntry fb >>= (\e -> entrySetText (castToEntry e) (replaceStr fs))- getFindEntry fb >>= (\e -> entrySetText (castToEntry e) (entryStr fs))- listStoreClear ls- mapM_ (listStoreAppend ls) (entryHist fs)- setEntireWord fb (entireWord fs)- setWrapAround fb (wrapAround fs)- setCaseSensitive fb (caseSensitive fs)- setRegex fb (regex fs)+ getLineEntry fb >>= (\sb -> spinButtonSetValue sb (fromIntegral (lineNr fs)))+ getReplaceEntry fb >>= (\e -> entrySetText e (replaceStr fs))+ getFindEntry fb >>= (\e -> entrySetText e (entryStr fs))+ seqStoreClear ls+ mapM_ (seqStoreAppend ls) (entryHist fs)+ setEntireWord fb (entireWord fs)+ setWrapAround fb (wrapAround fs)+ setCaseSensitive fb (caseSensitive fs)+ setRegex fb (regex fs) hideToolbar :: IDEAction hideToolbar = do@@ -149,7 +166,7 @@ Nothing -> return () Just tb -> do modifyIDE_ (\ide -> ide{toolbar = (False,snd (toolbar ide))})- liftIO $ widgetHide tb+ widgetHide tb showToolbar :: IDEAction showToolbar = do@@ -158,7 +175,7 @@ Nothing -> return () Just tb -> do modifyIDE_ (\ide -> ide{toolbar = (True,snd (toolbar ide))})- liftIO $ widgetShowAll tb+ widgetShowAll tb toggleToolbar :: IDEAction toggleToolbar = do@@ -173,7 +190,11 @@ modifyIDE_ (\ide -> ide{findbar = (False,mbfb)}) case mbfb of Nothing -> return ()- Just (fb,_) -> liftIO $ widgetHide fb+ Just (fb,_) -> do+ widgetHide fb+ void $ inActiveBufContext False $ \_ sv ebuf _ _ -> do+ removeTagByName ebuf "search-match"+ return True showFindbar :: IDEAction showFindbar = do@@ -181,12 +202,12 @@ modifyIDE_ (\ide -> ide{findbar = (True,mbfb)}) case mbfb of Nothing -> return ()- Just (fb,_) -> liftIO $ widgetShowAll fb+ Just (fb,_) -> widgetShowAll fb focusFindEntry :: IDEAction focusFindEntry = do (fb,_) <- needFindbar- liftIO $ do+ do entry <- getFindEntry fb widgetGrabFocus entry @@ -198,18 +219,23 @@ else showFindbar constructFindReplace :: IDEM Toolbar-constructFindReplace = reifyIDE $ \ ideR -> do+constructFindReplace = do+ ideR <- ask toolbar <- toolbarNew- toolbarSetStyle toolbar ToolbarIcons+ toolbarSetStyle toolbar ToolbarStyleIcons toolbarSetIconSize toolbar IconSizeSmallToolbar- closeButton <- toolButtonNewFromStock "gtk-close"+ let newButtonFromIconName name = imageNewFromIconName+ (Just name)+ (fromIntegral $ fromEnum IconSizeSmallToolbar)+ >>= (`toolButtonNew` Nothing) . Just+ closeButton <- newButtonFromIconName "window-close" toolbarInsert toolbar closeButton 0 spinTool <- toolItemNew spinL <- spinButtonNewWithRange 1.0 1000.0 10.0- widgetSetName spinL ("gotoLineEntry" :: Text)+ widgetSetName spinL "gotoLineEntry" containerAdd spinTool spinL- widgetSetName spinTool ("gotoLineEntryTool" :: Text)+ widgetSetName spinTool "gotoLineEntryTool" toolbarInsert toolbar spinTool 0 labelTool3 <- toolItemNew@@ -220,71 +246,71 @@ sep1 <- separatorToolItemNew toolbarInsert toolbar sep1 0 - let performGrep = reflectIDE (packageTry $ doGrep toolbar) ideR- grepButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Grep"))+ let performGrep = reflectIDE (workspaceTry $ doGrep toolbar) ideR+ grepButton <- toolButtonNew noWidget (Just (__"Grep")) toolbarInsert toolbar grepButton 0- grepButton `onToolButtonClicked` performGrep- set grepButton [widgetTooltipText := Just (__"Search in multiple files")]+ onToolButtonClicked grepButton performGrep+ setWidgetTooltipText grepButton $ __"Search in multiple files" sep1 <- separatorToolItemNew toolbarInsert toolbar sep1 0 - replaceAllButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Replace All"))+ replaceAllButton <- toolButtonNew noWidget (Just (__"Replace All")) toolbarInsert toolbar replaceAllButton 0 - replaceButton <- toolButtonNewFromStock "gtk-find-and-replace"+ replaceButton <- newButtonFromIconName "edit-find-replace" toolbarInsert toolbar replaceButton 0 replaceTool <- toolItemNew rentry <- entryNew- widgetSetName rentry ("replaceEntry" :: Text)- entrySetPlaceholderText rentry $ Just ("Replace with" :: Text)+ widgetSetName rentry "replaceEntry"+ entrySetPlaceholderText rentry (Just "Replace with") containerAdd replaceTool rentry- widgetSetName replaceTool ("replaceTool" :: Text)+ widgetSetName replaceTool "replaceTool" toolbarInsert toolbar replaceTool 0 sep2 <- separatorToolItemNew toolbarInsert toolbar sep2 0 - nextButton <- toolButtonNewFromStock "gtk-go-forward"+ nextButton <- newButtonFromIconName "go-next" toolbarInsert toolbar nextButton 0- set nextButton [widgetTooltipText := Just (__"Search for the next match in the current file")]+ setWidgetTooltipText nextButton $ __"Search for the next match in the current file" nextButton `onToolButtonClicked` doSearch toolbar Forward ideR wrapAroundButton <- toggleToolButtonNew toolButtonSetLabel wrapAroundButton (Just (__"Wrap"))- widgetSetName wrapAroundButton ("wrapAroundButton" :: Text)+ widgetSetName wrapAroundButton "wrapAroundButton" toolbarInsert toolbar wrapAroundButton 0- set wrapAroundButton [widgetTooltipText := Just (__"When selected searching will continue from the top when no more matches are found")]+ setWidgetTooltipText wrapAroundButton $ __"When selected searching will continue from the top when no more matches are found" - previousButton <- toolButtonNewFromStock "gtk-go-back"+ previousButton <- newButtonFromIconName "go-previous" toolbarInsert toolbar previousButton 0- set previousButton [widgetTooltipText := Just (__"Search for the previous match in the current file")]+ setWidgetTooltipText previousButton $ __"Search for the previous match in the current file" previousButton `onToolButtonClicked` doSearch toolbar Backward ideR entryTool <- toolItemNew entry <- entryNew- widgetSetName entry ("searchEntry" :: Text)- entrySetPlaceholderText entry $ Just ("Find" :: Text)+ widgetSetName entry "searchEntry"+ entrySetPlaceholderText entry (Just "Find") containerAdd entryTool entry- widgetSetName entryTool ("searchEntryTool" :: Text)+ widgetSetName entryTool "searchEntryTool" toolItemSetExpand entryTool True toolbarInsert toolbar entryTool 0 let column0 = makeColumnIdString 0- store <- listStoreNew []+ store <- seqStoreNew [] customStoreSetColumn store column0 id completion <- entryCompletionNew- entrySetCompletion entry completion+ entrySetCompletion entry (Just completion) - set completion [entryCompletionModel := Just store]+ setEntryCompletionModel completion store cell <- cellRendererTextNew cellLayoutPackStart completion cell True- cellLayoutSetAttributes completion cell store- (\ cd -> [cellText := cd])+ cellLayoutSetDataFunction completion cell store+ (setCellRendererTextText cell) entryCompletionSetMatchFunc completion (matchFunc store)- on completion matchSelected $ \ model iter -> do+ onEntryCompletionMatchSelected completion $ \ model iter -> do txt <- treeModelGetValue model iter column0 entrySetText entry txt doSearch toolbar Forward ideR@@ -292,39 +318,39 @@ regexButton <- toggleToolButtonNew toolButtonSetLabel regexButton (Just (__"Regex"))- widgetSetName regexButton ("regexButton" :: Text)+ widgetSetName regexButton "regexButton" toolbarInsert toolbar regexButton 0- regexButton `onToolButtonClicked` doSearch toolbar Insert ideR- set regexButton [widgetTooltipText := Just (__"When selected the search string is used as a regular expression")]+ onToolButtonClicked regexButton $ doSearch toolbar Insert ideR+ setWidgetTooltipText regexButton $ __"When selected the search string is used as a regular expression" entireWordButton <- toggleToolButtonNew toolButtonSetLabel entireWordButton (Just (__"Words"))- widgetSetName entireWordButton ("entireWordButton" :: Text)+ widgetSetName entireWordButton "entireWordButton" toolbarInsert toolbar entireWordButton 0 entireWordButton `onToolButtonClicked` doSearch toolbar Insert ideR- set entireWordButton [widgetTooltipText := Just (__"When selected only entire words are matched")]+ setWidgetTooltipText entireWordButton $ __"When selected only entire words are matched" caseSensitiveButton <- toggleToolButtonNew toolButtonSetLabel caseSensitiveButton (Just (__"Case"))- widgetSetName caseSensitiveButton ("caseSensitiveButton" :: Text)+ widgetSetName caseSensitiveButton "caseSensitiveButton" toolbarInsert toolbar caseSensitiveButton 0 caseSensitiveButton `onToolButtonClicked` doSearch toolbar Insert ideR- set caseSensitiveButton [widgetTooltipText := Just (__"When selected the search is case sensitive")]+ setWidgetTooltipText caseSensitiveButton $ __"When selected the search is case sensitive" - after entry insertText (\ (t::Text) i -> do+ afterEditableInsertText entry (\ t _ i -> do doSearch toolbar Insert ideR return i)- after entry deleteText (\ _ _ -> doSearch toolbar Delete ideR)+ afterEditableDeleteText entry (\ _ _ -> doSearch toolbar Delete ideR) - on entry entryActivate $ doSearch toolbar Forward ideR- on entry focusInEvent $ do- liftIO $ reflectIDE (triggerEventIDE (Sensitivity [(SensitivityEditor, False)])) ideR+ onEntryActivate entry $ doSearch toolbar Forward ideR+ onIDE onWidgetFocusInEvent entry $ do+ liftIDE $ triggerEventIDE (Sensitivity [(SensitivityEditor, False)]) return False - replaceButton `onToolButtonClicked` replace toolbar Forward ideR+ onToolButtonClicked replaceButton $ replace toolbar Forward ideR let performReplaceAll = replaceAll toolbar Initial ideR- replaceAllButton `onToolButtonClicked` performReplaceAll+ onToolButtonClicked replaceAllButton performReplaceAll let ctrl "c" = toggleToolButton caseSensitiveButton >> return True ctrl "e" = toggleToolButton regexButton >> return True@@ -337,146 +363,147 @@ old <- toggleToolButtonGetActive btn toggleToolButtonSetActive btn $ not old - entry `on` keyPressEvent $ do- name <- eventKeyName- mods <- eventModifier- case name of- "Down" -> liftIO $ doSearch toolbar Forward ideR >> return True- "Up" -> liftIO $ doSearch toolbar Backward ideR >> return True- "Escape" -> liftIO $ getOut ideR >> return True- "Tab" -> liftIO $ do+ onWidgetKeyPressEvent entry $ \e -> do+ mbName <- getEventKeyKeyval e >>= keyvalName+ mods <- getEventKeyState e+ case mbName of+ Just "Return" | ModifierTypeShiftMask `elem` mods ->+ doSearch toolbar Backward ideR >> return True+ Just "Down" -> doSearch toolbar Forward ideR >> return True+ Just "Up" -> doSearch toolbar Backward ideR >> return True+ Just "Escape" -> getOut ideR >> return True+ Just "Tab" -> do re <- getReplaceEntry toolbar widgetGrabFocus re --- widgetAc return True- _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name+ Just name | mapControlCommand ModifierTypeControlMask `elem` mods -> ctrl $ T.toLower name _ -> return False - rentry `on` keyPressEvent $ do- name <- eventKeyName- mods <- eventModifier- case () of- _ | name == "Tab" || name == "ISO_Left_Tab" -> liftIO $ do+ onWidgetKeyPressEvent rentry $ \e -> do+ mbName <- getEventKeyKeyval e >>= keyvalName+ mods <- getEventKeyState e+ case mbName of+ Just name+ | name == "Tab" || name == "ISO_Left_Tab" -> do fe <- getFindEntry toolbar widgetGrabFocus fe return True- | mapControlCommand Control `elem` mods ->- liftIO . ctrl $ T.toLower name- | otherwise -> return False+ | mapControlCommand ModifierTypeControlMask `elem` mods ->+ ctrl $ T.toLower name+ _ -> return False - after spinL focusInEvent . liftIO $ reflectIDE (inActiveBufContext True $ \ _ _ ebuf _ _ -> do+ onIDE afterWidgetFocusInEvent spinL . liftIDE $ inActiveBufContext True $ \ _ _ ebuf _ _ -> do max <- getLineCount ebuf- liftIO $ spinButtonSetRange spinL 1.0 (fromIntegral max)- return True) ideR+ spinButtonSetRange spinL 1.0 (fromIntegral max)+ return True - spinL `on` keyPressEvent $ do- name <- eventKeyName- mods <- eventModifier- case name of- "Escape" -> liftIO $ getOut ideR >> return True- "Tab" -> liftIO $ do+ onWidgetKeyPressEvent spinL $ \e -> do+ mbName <- getEventKeyKeyval e >>= keyvalName+ mods <- getEventKeyState e+ case mbName of+ Just "Escape" -> getOut ideR >> return True+ Just "Tab" -> do re <- getFindEntry toolbar widgetGrabFocus re return True- _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name+ Just name | mapControlCommand ModifierTypeControlMask `elem` mods -> ctrl $ T.toLower name _ -> return False - after spinL entryActivate $ reflectIDE (inActiveBufContext () $ \ _ sv ebuf _ _ -> do- line <- liftIO $ spinButtonGetValueAsInt spinL- iter <- getIterAtLine ebuf (line - 1)+ afterEntryActivate spinL . (`reflectIDE` ideR) $ inActiveBufContext () $ \ _ sv ebuf _ _ -> do+ line <- spinButtonGetValueAsInt spinL+ iter <- getIterAtLine ebuf (fromIntegral line - 1) placeCursor ebuf iter scrollToIter sv iter 0.2 Nothing- liftIO $ getOut ideR- return ()) ideR+ getOut ideR+ return () - closeButton `onToolButtonClicked` reflectIDE hideFindbar ideR+ onToolButtonClicked closeButton $ reflectIDE hideFindbar ideR - set toolbar [toolbarChildHomogeneous spinTool := False]- set toolbar [toolbarChildHomogeneous wrapAroundButton := False]- set toolbar [toolbarChildHomogeneous entireWordButton := False]- set toolbar [toolbarChildHomogeneous caseSensitiveButton := False]- set toolbar [toolbarChildHomogeneous regexButton := False]- set toolbar [toolbarChildHomogeneous replaceAllButton := False]- set toolbar [toolbarChildHomogeneous labelTool3 := False]+ liftIO $ do+ containerChildSetProperty toolbar spinTool "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar wrapAroundButton "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar entireWordButton "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar caseSensitiveButton "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar regexButton "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar replaceAllButton "homogeneous" =<< toGValue False+ containerChildSetProperty toolbar labelTool3 "homogeneous" =<< toGValue False - reflectIDE (modifyIDE_ (\ ide -> ide{findbar = (False, Just (toolbar, store))})) ideR+ modifyIDE_ (\ ide -> ide{findbar = (False, Just (toolbar, store))}) return toolbar where- getOut = reflectIDE $ do+ getOut ideR = liftIO $ reflectIDE (do hideFindbar- maybeActiveBuf ?>>= makeActive+ maybeActiveBuf ?>>= makeActive) ideR doSearch :: Toolbar -> SearchHint -> IDERef -> IO () doSearch fb hint ideR = do entry <- getFindEntry fb- search <- entryGetText (castToEntry entry)+ search <- entryGetText entry entireWord <- getEntireWord fb caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb regex <- getRegex fb- mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search+ mbExpAndMatchIndex <- regexAndMatchIndex caseSensitive entireWord regex search case mbExpAndMatchIndex of Just (exp, matchIndex) -> do res <- reflectIDE (editFind entireWord caseSensitive wrapAround regex search "" hint) ideR if res || T.null search then do- widgetModifyBase entry StateNormal white- widgetModifyText entry StateNormal black+ widgetModifyBase entry StateTypeNormal . Just =<< toGdkColor white+ widgetModifyText entry StateTypeNormal . Just =<< toGdkColor black else do- widgetModifyBase entry StateNormal red- widgetModifyText entry StateNormal white+ widgetModifyBase entry StateTypeNormal . Just =<< toGdkColor red+ widgetModifyText entry StateTypeNormal . Just =<< toGdkColor white Nothing -> if T.null search then do- widgetModifyBase entry StateNormal white- widgetModifyText entry StateNormal black+ widgetModifyBase entry StateTypeNormal . Just =<< toGdkColor white+ widgetModifyText entry StateTypeNormal . Just =<< toGdkColor black else do- widgetModifyBase entry StateNormal orange- widgetModifyText entry StateNormal black+ widgetModifyBase entry StateTypeNormal . Just =<< toGdkColor orange+ widgetModifyText entry StateTypeNormal . Just =<< toGdkColor black reflectIDE (addToHist search) ideR return () -doGrep :: Toolbar -> PackageAction+doGrep :: Toolbar -> WorkspaceAction doGrep fb = do package <- ask ideR <- lift ask- entry <- liftIO $ getFindEntry fb- search <- liftIO $ entryGetText (castToEntry entry)- entireWord <- liftIO $ getEntireWord fb- caseSensitive <- liftIO $ getCaseSensitive fb- wrapAround <- liftIO $ getWrapAround fb- regex <- liftIO $ getRegex fb+ entry <- getFindEntry fb+ search <- entryGetText entry+ entireWord <- getEntireWord fb+ caseSensitive <- getCaseSensitive fb+ wrapAround <- getWrapAround fb+ regex <- getRegex fb let (regexString, _) = regexStringAndMatchIndex entireWord regex search liftIDE $ workspaceTry $ grepWorkspace regexString caseSensitive -matchFunc :: ListStore Text -> Text -> TreeIter -> IO Bool-matchFunc model str iter = do- tp <- treeModelGetPath model iter+matchFunc :: (Applicative m, MonadIO m) => SeqStore Text -> EntryCompletion -> Text -> TreeIter -> m Bool+matchFunc model completion str iter = do+ tp <- treeModelGetPath model iter >>= treePathGetIndices case tp of- (i:_) -> do row <- listStoreGetValue model i+ (i:_) -> do row <- seqStoreGetValue model i return (T.isPrefixOf (T.toLower str) (T.toLower row) && T.length str < T.length row)- otherwise -> return False+ _ -> return False addToHist :: Text -> IDEAction addToHist str =- unless (T.null str) $- do (_, ls) <- needFindbar- liftIO $- do entryHist <- listStoreToList ls- unless (any (str `T.isPrefixOf`) entryHist) $- do let newList- = take 12- (str : filter (\ e -> not (e `T.isPrefixOf` str)) entryHist)- listStoreClear ls- mapM_ (listStoreAppend ls) newList+ unless (T.null str) $ do+ (_, ls) <- needFindbar+ entryHist <- seqStoreToList ls+ unless (any (str `T.isPrefixOf`) entryHist) $ do+ let newList = take 12 (str : filter (\ e -> not (e `T.isPrefixOf` str)) entryHist)+ seqStoreClear ls+ mapM_ (seqStoreAppend ls) newList replace :: Toolbar -> SearchHint -> IDERef -> IO () replace fb hint ideR = do entry <- getFindEntry fb- search <- entryGetText (castToEntry entry)+ search <- entryGetText entry rentry <- getReplaceEntry fb- replace <- entryGetText (castToEntry rentry)+ replace <- entryGetText rentry entireWord <- getEntireWord fb caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb@@ -488,9 +515,9 @@ replaceAll :: Toolbar -> SearchHint -> IDERef -> IO () replaceAll fb hint ideR = do entry <- getFindEntry fb- search <- entryGetText (castToEntry entry)+ search <- entryGetText entry rentry <- getReplaceEntry fb- replace <- entryGetText (castToEntry rentry)+ replace <- entryGetText rentry entireWord <- getEntireWord fb caseSensitive <- getCaseSensitive fb wrapAround <- getWrapAround fb@@ -501,7 +528,7 @@ editFind :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool editFind entireWord caseSensitive wrapAround regex search dummy hint = do- mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search+ mbExpAndMatchIndex <- regexAndMatchIndex caseSensitive entireWord regex search case mbExpAndMatchIndex of Nothing -> return False Just (exp, matchIndex) -> editFind' exp matchIndex wrapAround dummy hint@@ -512,7 +539,7 @@ i1 <- getStartIter ebuf i2 <- getEndIter ebuf text <- getText ebuf i1 i2 True- removeTagByName ebuf "found"+ removeTagByName ebuf "search-match" startMark <- getInsertMark ebuf st1 <- getIterAtMark ebuf startMark mbsr2 <-@@ -544,7 +571,7 @@ Just (start,end,_) -> do --found --widgetGrabFocus sourceView scrollToIter sv start 0.2 Nothing- applyTagByName ebuf "found" start end+ applyTagByName ebuf "search-match" start end placeCursor ebuf start return True Nothing -> return False@@ -559,7 +586,7 @@ initialSearch exp matchIndex ebuf text iter = findMatch exp matchIndex ebuf text (>= 0) False -regexAndMatchIndex :: Bool -> Bool -> Bool -> Text -> IO (Maybe (Regex, Int))+regexAndMatchIndex :: MonadIO m => Bool -> Bool -> Bool -> Text -> m (Maybe (Regex, Int)) regexAndMatchIndex caseSensitive entireWord regex string = if T.null string then return Nothing@@ -604,7 +631,7 @@ iter <- getIterAtMark ebuf insertMark offset <- getOffset iter let offset' = if fromStart then 0 else offset- mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search+ mbExpAndMatchIndex <- regexAndMatchIndex caseSensitive entireWord regex search case mbExpAndMatchIndex of Just (exp, matchIndex) -> do iStart <- getStartIter ebuf@@ -613,7 +640,7 @@ match <- findMatch exp matchIndex ebuf text (== offset') False case match of Just (iterStart, iterEnd, matches) -> do- mbText <- liftIO $ replacementText regex text matchIndex matches $ T.unpack replace+ mbText <- replacementText regex text matchIndex matches $ T.unpack replace case mbText of Just text -> do beginUserAction ebuf@@ -677,7 +704,7 @@ white = Color 64000 64000 64000 black = Color 0 0 0 -needFindbar :: IDEM (Toolbar,ListStore Text)+needFindbar :: IDEM (Toolbar,SeqStore Text) needFindbar = do (_,mbfb) <- readIDE findbar case mbfb of@@ -691,11 +718,11 @@ (fb,_) <- needFindbar case hint of Initial -> do- mbtext <- selectedTextOrCurrentIdentifier -- if no text selected, search for current identifier+ mbtext <- selectedText -- if no text selected, search for the last query case mbtext of Just text -> do- findEntry <- liftIO $ getFindEntry fb- liftIO $ entrySetText (castToEntry findEntry) text+ findEntry <- getFindEntry fb+ entrySetText findEntry text Nothing -> return () _ -> return () showFindbar@@ -711,50 +738,48 @@ editGotoLine = do showFindbar (fb,_) <- needFindbar- entry <- liftIO $ getLineEntry fb- liftIO $ widgetGrabFocus entry+ entry <- getLineEntry fb+ widgetGrabFocus entry -getLineEntry, getReplaceEntry, getFindEntry :: Toolbar -> IO Widget-getLineEntry = getWidget "gotoLineEntryTool"-getReplaceEntry = getWidget "replaceTool"-getFindEntry = getWidget "searchEntryTool"+getLineEntry :: (Applicative m, MonadIO m) => Toolbar -> m SpinButton+getLineEntry tb = getWidget "gotoLineEntryTool" tb >>= liftIO . unsafeCastTo SpinButton -getWidget :: Text -> Toolbar -> IO Widget+getReplaceEntry, getFindEntry :: (Applicative m, MonadIO m) => Toolbar -> m Entry+getReplaceEntry tb = getWidget "replaceTool" tb >>= liftIO . unsafeCastTo Entry+getFindEntry tb = getWidget "searchEntryTool" tb >>= liftIO . unsafeCastTo Entry++getWidget :: (Applicative m, MonadIO m) => Text -> Toolbar -> m Widget getWidget str tb = do widgets <- containerGetChildren tb- entryL <- filterM (liftM (== str) . widgetGetName) widgets+ entryL <- filterM (fmap (== str) . widgetGetName) widgets case entryL of- [w] -> do- mbw <- binGetChild (castToBin w)- case mbw of- Nothing -> throwIDE "Find>>getWidget not found(1)"- Just w -> return w+ [w] -> liftIO (unsafeCastTo Bin w) >>= (fmap fromJust . nullToNothing . binGetChild) _ -> throwIDE "Find>>getWidget not found(2)" -getEntireWord, getWrapAround, getCaseSensitive, getRegex :: Toolbar -> IO Bool+getEntireWord, getWrapAround, getCaseSensitive, getRegex :: (Applicative m, MonadIO m) => Toolbar -> m Bool getEntireWord = getSelection "entireWordButton" getWrapAround = getSelection "wrapAroundButton" getCaseSensitive = getSelection "caseSensitiveButton" getRegex = getSelection "regexButton" -getSelection :: Text -> Toolbar -> IO Bool+getSelection :: (Applicative m, MonadIO m) => Text -> Toolbar -> m Bool getSelection str tb = do widgets <- containerGetChildren tb- entryL <- filterM (liftM (== str) . widgetGetName) widgets+ entryL <- filterM (fmap (== str) . widgetGetName) widgets case entryL of- [w] -> toggleToolButtonGetActive (castToToggleToolButton w)+ [w] -> liftIO (unsafeCastTo ToggleToolButton w) >>= toggleToolButtonGetActive _ -> throwIDE "Find>>getIt widget not found" -setEntireWord, setWrapAround, setCaseSensitive, setRegex :: Toolbar -> Bool -> IO ()+setEntireWord, setWrapAround, setCaseSensitive, setRegex :: (Applicative m, MonadIO m) => Toolbar -> Bool -> m () setEntireWord = setSelection "entireWordButton" setWrapAround = setSelection "wrapAroundButton" setCaseSensitive = setSelection "caseSensitiveButton" setRegex = setSelection "regexButton" -setSelection :: Text -> Toolbar -> Bool -> IO ()+setSelection :: (Applicative m, MonadIO m) => Text -> Toolbar -> Bool -> m () setSelection str tb bool = do widgets <- containerGetChildren tb- entryL <- filterM (liftM (== str) . widgetGetName ) widgets+ entryL <- filterM (fmap (== str) . widgetGetName ) widgets case entryL of- [w] -> toggleToolButtonSetActive (castToToggleToolButton w) bool+ [w] -> liftIO (unsafeCastTo ToggleToolButton w) >>= \ttb -> toggleToolButtonSetActive ttb bool _ -> throwIDE "Find>>getIt widget not found"
src/IDE/HLint.hs view
@@ -25,9 +25,9 @@ import Control.Applicative import Prelude hiding(getChar, getLine) import IDE.Core.Types- (logRefFullFilePath, Prefs(..), LogRef(..), LogRefType(..),- wsAllPackages, ipdPackageDir, IDEM, IDEAction, IDE(..),- IDEPackage(..), PackageAction)+ (MonadIDE(..), logRefFullFilePath, Prefs(..), LogRef(..),+ LogRefType(..), wsAllPackages, ipdPackageDir, IDEM, IDEAction,+ IDE(..), IDEPackage(..), PackageAction) import Control.Monad.Reader (asks, MonadReader(..)) import IDE.Core.State (postSyncIDE, catchIDE, MessageLevel(..), ideMessage,@@ -63,7 +63,7 @@ import Distribution.ModuleName (ModuleName) import IDE.Core.CTypes (SrcSpan(..), mdMbSourcePath, pdModules, mdModuleId, modu,- PackScope(..), GenScope(..), GenScope)+ PackScope(..), GenScope(..), GenScope, packageIdentifierToString) import IDE.Metainfo.Provider (getWorkspaceInfo) import qualified Language.Haskell.Exts.SrcLoc as HSE (SrcLoc(..), SrcSpan(..))@@ -78,9 +78,10 @@ import IDE.BufferMode (IDEBuffer(..), editInsertCode) import Data.Ord (comparing) import qualified Data.Foldable as F (toList)+import IDE.Utils.CabalProject (findProjectRoot) packageHLint :: PackageAction-packageHLint = asks ipdCabalFile >>= (lift . lift . scheduleHLint . Left)+packageHLint = asks ipdCabalFile >>= (liftIDE . scheduleHLint . Left) scheduleHLint :: Either FilePath FilePath -> IDEAction scheduleHLint what = do@@ -130,17 +131,16 @@ paths <- case mbSourceFile of Just f -> return [f] Nothing -> getSourcePaths (ipdPackageId package) modules- res <- forM paths $ \ full -> do- let file = makeRelative (ipdPackageDir package) full- postSyncIDE $ removeLintLogRefs (ipdPackageDir package) file- text <- liftIO $ T.readFile full- liftIO . debugM "leksah" $ "runHLint parsing " <> full- do result <- liftIO $ parseModuleEx flags full (Just (T.unpack text))+ res <- forM paths $ \ path -> do+ postSyncIDE $ removeLintLogRefs path+ text <- liftIO $ T.readFile path+ liftIO . debugM "leksah" $ "runHLint parsing " <> path+ do result <- liftIO $ parseModuleEx flags path (Just (T.unpack text)) case result of Left e -> logHLintError (isJust mbSourceFile) package e >> return Nothing Right r -> do- liftIO . debugM "leksah" $ "runHLint parsed " <> full- return $ Just (r, (full, text))+ liftIO . debugM "leksah" $ "runHLint parsed " <> path+ return $ Just (r, (path, text)) `catchIDE` (\(e :: SomeException) -> do reflectIDE (ideMessage Normal . T.pack $ "HLint Exception : " <> show e) ideR return Nothing)@@ -172,7 +172,10 @@ hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint) hlintSettings package = do mbHlintDir <- liftIO $ leksahSubDir "hlint"- let cabalMacros = ipdPackageDir package </> "dist/build/autogen/cabal_macros.h"+ projectRoot <- liftIO $ findProjectRoot (ipdPackageDir package)+ let cabalMacros = projectRoot </> "dist-newstyle/build"+ </> T.unpack (packageIdentifierToString $ ipdPackageId package)+ </> "build/autogen/cabal_macros.h" cabalMacrosExist <- liftIO $ doesFileExist cabalMacros defines <- liftIO $ if cabalMacrosExist then do@@ -205,7 +208,7 @@ fixTail (x:xs) = T.take (HSE.srcSpanEndColumn ideaSpan - 1) x : xs from = T.reverse . T.drop 1 . T.reverse . T.unlines . fixHead . reverse . fixTail $ reverse fromLines- ref = LogRef srcSpan package (T.pack $ showHLint idea)+ ref = LogRef srcSpan (ipdCabalFile package) (T.pack $ showHLint idea) (Just (from, idea)) Nothing LintRef postSyncIDE $ addLogRef fileScope fileScope ref return ()@@ -218,7 +221,7 @@ (HSE.srcColumn loc - 1) (HSE.srcLine loc) (HSE.srcColumn loc - 1)- ref = LogRef srcSpan package ("Hlint Parse Error: " <> T.pack (parseErrorMessage error)) Nothing Nothing LintRef+ ref = LogRef srcSpan (ipdCabalFile package) ("Hlint Parse Error: " <> T.pack (parseErrorMessage error)) Nothing Nothing LintRef postSyncIDE $ addLogRef fileScope fileScope ref -- Cut down version of showEx from HLint
src/IDE/ImportTool.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.ImportTool@@ -31,14 +33,15 @@ import Distribution.Text (simpleParse, display, disp) import IDE.Pane.SourceBuffer import IDE.HLint (resolveActiveHLint)-import Graphics.UI.Gtk import IDE.Utils.GUIUtils+import IDE.Utils.CabalUtils (writeGenericPackageDescription') import Text.ParserCombinators.Parsec.Language (haskellStyle) import Graphics.UI.Editor.MakeEditor (getRealWidget, FieldDescription(..), buildEditor, mkField) import Graphics.UI.Editor.Parameters- ((<<<-), paraMinSize, emptyParams, Parameter(..), paraMultiSel,- paraName)+ (dialogRun', dialogSetDefaultResponse', Packing(..), boxPackStart',+ dialogAddButton', (<<<-), paraMinSize, emptyParams, Parameter(..),+ paraMultiSel, paraName) import Text.ParserCombinators.Parsec hiding (parse) import qualified Text.ParserCombinators.Parsec as Parsec (parse) import Graphics.UI.Editor.Simple (staticListEditor)@@ -58,9 +61,15 @@ import Distribution.Verbosity (normal) import IDE.Pane.PackageEditor (hasConfigs) import Distribution.Package+#if MIN_VERSION_Cabal(2,0,0) import Distribution.Version (anyVersion, orLaterVersion, intersectVersionRanges,+ earlierVersion, Version(..), versionNumbers, mkVersion)+#else+import Distribution.Version+ (anyVersion, orLaterVersion, intersectVersionRanges, earlierVersion, Version(..))+#endif import Distribution.PackageDescription (GenericPackageDescription(..), Benchmark(..), TestSuite(..), Executable(..), BuildInfo(..), Library(..), CondTree(..),@@ -69,18 +78,39 @@ (flattenPackageDescription) import IDE.BufferMode (editInsertCode) import Control.Monad.IO.Class (MonadIO(..))-import Distribution.PackageDescription.PrettyPrint- (writeGenericPackageDescription) import qualified Data.Text as T (takeWhile, stripPrefix, lines, dropWhile, empty, length, take, pack, unpack)-import Language.Haskell.Exts (KnownExtension)+import Language.Haskell.Exts (KnownExtension(..)) import Data.Text (Text) import Data.Monoid ((<>)) import System.Log.Logger (debugM) import qualified Data.Traversable as Tr (forM) import qualified Data.Foldable as F (toList, foldr, or)+import GI.Gtk.Objects.Window (setWindowTransientFor, Window(..))+import GI.Gtk.Objects.Dialog (Dialog(..), dialogGetContentArea)+import Data.GI.Base (new', unsafeCastTo, set)+import GI.Gtk.Enums (ResponseType(..))+import GI.Gtk.Objects.Box (Box(..), boxPackStart)+import GI.Gtk.Objects.Widget+ (widgetDestroy, widgetHide, widgetGrabDefault, setWidgetCanDefault,+ widgetShowAll)+import GI.Gtk.Objects.MenuItem+ (onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Gtk (constructDialogUseHeaderBar) +#if !MIN_VERSION_Cabal(2,0,0)+versionNumbers :: Version -> [Int]+versionNumbers = versionBranch+mkPackageName :: String -> PackageName+mkPackageName = PackageName+mkVersion :: [Int] -> Version+mkVersion = (`Version` [])+mkUnqualComponentName :: String -> String+mkUnqualComponentName = id+#endif+ readMaybe :: Read a => Text -> Maybe a readMaybe s = case reads $ T.unpack s of [(x, "")] -> Just x@@ -189,12 +219,12 @@ let packs = nub $ mapMaybe (\error -> case parseHiddenModule $ refDescription error of Nothing -> Nothing- Just (HiddenModuleResult _ pack) -> Just (ipdCabalFile (logRefPackage error), dep pack)) errors+ Just (HiddenModuleResult _ pack) -> Just (logRefCabalFile error, dep pack)) errors forM_ packs $ \(cabalFile, d) -> do gpd <- liftIO $ readPackageDescription normal cabalFile ideMessage Normal $ "Adding build-depends " <> T.pack (display d <> " to " <> cabalFile)- liftIO $ writeGenericPackageDescription cabalFile+ liftIO $ writeGenericPackageDescription' cabalFile gpd { condLibrary = addDepToLib d (condLibrary gpd), condExecutables = map (addDepToExe d) (condExecutables gpd),@@ -228,12 +258,12 @@ condTreeConstraints = deps <> [d], condTreeData = bm { benchmarkBuildInfo = bi {targetBuildDepends = targetBuildDepends bi <> [d]}}}) -- Empty version is probably only going to happen for ghc-prim- dep p | null . versionBranch $ packageVersion p = Dependency (packageName p) anyVersion+ dep p | null . versionNumbers $ packageVersion p = Dependency (packageName p) anyVersion dep p = Dependency (packageName p) ( intersectVersionRanges (orLaterVersion (packageVersion p)) (earlierVersion (majorAndMinor (packageVersion p)))) - majorAndMinor v@Version{versionBranch = b} = v{versionBranch = nextMinor b}+ majorAndMinor v = mkVersion . nextMinor $ versionNumbers v nextMinor = nextMinor' . (++[0,0]) nextMinor' (major:minor:_) = [major, minor+1] nextMinor' _ = undefined@@ -339,6 +369,7 @@ getReal (FieldDescr d) = IThingAll (dscName d) getReal (ConstructorDescr d) = IThingAll (dscName d) getReal (MethodDescr d) = IThingAll (dscName d)+ getReal PatternSynonymDescr = IVar ("pattern " <> id) getReal _ = IVar id qualString :: ImportDecl -> Text@@ -371,46 +402,52 @@ scopeParser :: CharParser () NotInScopeParseResult scopeParser = do whiteSpace- symbol "Not in scope:"- isSub <- optionMaybe+ isSub <- (do+ symbol "Not in scope:"+ isJust <$> optionMaybe (try (choice- [symbol "type constructor or class", symbol "data constructor"]))- (do char '`'+ [symbol "type constructor or class", symbol "data constructor"])))+ <|>+ (do optionMaybe (symbol "•" >> whiteSpace)+ (symbol "Variable not in scope:" >> return False)+ <|> (symbol "Data constructor not in scope:" >> return True))+ (do choice [char '\8219', char '\8216'] mbQual <- optionMaybe- (try- (do q <- lexeme conid- dot- return q))- id <- optionMaybe (try identifier)- case id of- Just id -> return- (NotInScopeParseResult mbQual (T.take (T.length id - 1) id)- (isJust isSub)- False)- Nothing -> do op <- operator- char '\''- return (NotInScopeParseResult mbQual op (isJust isSub) True))- <|>- (do choice [char '\8219', char '\8216']- mbQual <- optionMaybe (try- (do q <- lexeme conid- dot- return q))- id <- optionMaybe (try identifier)- result <- case id of+ (lexeme conid))+ id <- optionMaybe (try identifier)+ result <- case id of Just id -> return- (NotInScopeParseResult mbQual id (isJust isSub) False)+ (NotInScopeParseResult mbQual id isSub False) Nothing -> do op <- operator- return (NotInScopeParseResult mbQual op (isJust isSub) True)- char '\8217'- return result)+ return (NotInScopeParseResult mbQual op isSub True)+ char '\8217'+ return result)+ <|>+ (do whiteSpace+ (do mbQual <- optionMaybe+ (try+ (lexeme conid))+ result <- optionMaybe (try identifier) >>= \case+ Just id -> return+ (NotInScopeParseResult mbQual id isSub False)+ Nothing -> do op <- operator+ return (NotInScopeParseResult mbQual op isSub True)+ many anyChar+ return result)+ <|> (do+ char '('+ op <- operator+ char ')'+ many anyChar+ return (NotInScopeParseResult Nothing op isSub True))) <?> "scopeParser" conid = do c <- upper cs <- many (alphaNum <|> oneOf "_'")+ dot return (c:cs) <?> "conid" @@ -447,25 +484,25 @@ let qualId = case mbQual of Nothing -> id Just str -> str <> "." <> id- dia <- dialogNew- set dia [ windowTransientFor := parentWindow ]- upper <- dialogGetContentArea dia- okButton <- dialogAddButton dia (__"Add Import") ResponseOk- dialogAddButton dia (__"Cancel") ResponseCancel+ dia <- new' Dialog [constructDialogUseHeaderBar 1]+ setWindowTransientFor dia parentWindow+ upper <- dialogGetContentArea dia >>= unsafeCastTo Box+ okButton <- dialogAddButton' dia (__"Add Import") ResponseTypeOk+ dialogAddButton' dia (__"Cancel") ResponseTypeCancel (widget,inj,ext,_) <- buildEditor (moduleFields selectionList qualId) realSelectionString- boxPackStart (castToBox upper) widget PackGrow 7- dialogSetDefaultResponse dia ResponseOk --does not work for the tree view+ boxPackStart' upper widget PackGrow 7+ dialogSetDefaultResponse' dia ResponseTypeOk --does not work for the tree view widgetShowAll dia rw <- getRealWidget widget- set okButton [widgetCanDefault := True]+ setWidgetCanDefault okButton True widgetGrabDefault okButton- resp <- dialogRun dia+ resp <- dialogRun' dia value <- ext T.empty widgetHide dia widgetDestroy dia --find case (resp,value) of- (ResponseOk,Just v) -> return (Just (head+ (ResponseTypeOk,Just v) -> return (Just (head (filter (\e -> case dsMbModu e of Nothing -> False Just pm -> (T.pack . render . disp . modu) pm == v) list)))@@ -488,7 +525,7 @@ hiddenModuleParser :: CharParser () (Text, Text) hiddenModuleParser = do whiteSpace- symbol "Could not find module "+ symbol "Could not find module " <|> symbol "Failed to load interface for " char '`' <|> char '‛' <|> char '‘' mod <- T.pack <$> many (noneOf "'’") many (noneOf "\n")@@ -517,9 +554,13 @@ concatMap (parseLine . T.dropWhile (==' ')) . T.lines where parseLine :: Text -> [KnownExtension]+ parseLine "parse error on input ‘case’" = [LambdaCase] parseLine line = take 1 . mapMaybe readMaybe $ catMaybes [ T.stripPrefix "Perhaps you intended to use -X" line , T.stripPrefix "Perhaps you intended to use " line+ , T.stripPrefix "Illegal tuple section: use " line+ , T.stripPrefix "Package-qualified imports are not enabled; use " line+ , T.stripPrefix "Type signatures are only allowed in patterns with " line , T.takeWhile (/=' ') <$> T.stripPrefix "Use -X" line , T.takeWhile (/=' ') <$> T.stripPrefix "Use " line , T.takeWhile (/=' ') <$> T.stripPrefix "(Use -X" line@@ -567,6 +608,6 @@ where addFixMenuItem name fix = do item <- menuItemNewWithLabel name- item `on` menuItemActivate $ reflectIDE (void fix) ideR+ onMenuItemActivate item $ reflectIDE (void fix) ideR menuShellAppend theMenu item
src/IDE/Keymap.hs view
@@ -7,8 +7,6 @@ Keymap(..) ) where -import Graphics.UI.Gtk (keyvalFromName, KeyVal)-import Graphics.UI.Gtk.Gdk.Events(Modifier(..)) import qualified Data.Map as Map import Text.ParserCombinators.Parsec import qualified Text.ParserCombinators.Parsec.Token as P@@ -22,6 +20,8 @@ import Data.Text (Text) import qualified Data.Text as T (toLower, unpack, pack) import Control.Applicative ((<$>))+import IDE.Core.Types (KeyVal)+import GI.Gdk (keyvalFromName, ModifierType(..)) class Keymap alpha where parseKeymap :: FilePath -> IO alpha@@ -71,7 +71,7 @@ let map1 = Map.fromListWith (++) $concat pseudoTriples return (Map.map Map.fromList map1) where- build :: ActionDescr IDERef -> IO [((KeyVal,[Modifier]),[((KeyVal, [Modifier]), ActionDescr IDERef)])]+ build :: ActionDescr IDERef -> IO [((KeyVal,[ModifierType]),[((KeyVal, [ModifierType]), ActionDescr IDERef)])] build act = case Map.lookup (name act) keymap of Nothing -> return []@@ -135,7 +135,7 @@ -------------------------------------------------- -- Have to write this until gtk_accelerator_parse gets bound in gtk2hs ---accParse :: Text -> IO (KeyVal,[Modifier])+accParse :: Text -> IO (KeyVal,[ModifierType]) accParse str = case parse accparser "accelerator" (T.unpack str) of Right (ks,mods) -> do key <- keyvalFromName $ T.toLower ks@@ -151,34 +151,34 @@ identifier2 = T.pack <$> P.identifier lexer2 whiteSpace2 = P.whiteSpace lexer2 -accparser :: GenParser Char () (Text,[Modifier])+accparser :: GenParser Char () (Text,[ModifierType]) accparser = do whiteSpace2 mods <- many modparser key <- identifier2 return (key, mods) -modparser :: GenParser Char () Modifier+modparser :: GenParser Char () ModifierType modparser = do try $symbol2 "<shift>"- return Shift+ return ModifierTypeShiftMask <|> do try $symbol2 "<control>"- return Control+ return ModifierTypeControlMask <|> do try $symbol2 "<ctrl>"- return Control+ return ModifierTypeControlMask <|> do try $symbol2 "<alt>"- return Alt+ return ModifierTypeMod1Mask <|> do try $symbol2 "<super>"- return Super+ return ModifierTypeSuperMask <|> do try $symbol2 "<meta>"- return Meta+ return ModifierTypeMetaMask <|> do try $symbol2 "<compose>"- return Hyper+ return ModifierTypeHyperMask <?>"modparser"
+ src/IDE/LPaste.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings#-}+module IDE.LPaste (uploadToLpaste) where++import IDE.Core.State+import IDE.Core.Types+import IDE.Pane.SourceBuffer+import IDE.Utils.GUIUtils (showDialog, showInputDialog, showDialogOptions)++import Control.Monad.IO.Class (liftIO)+import Data.Maybe+import Network.HTTP++import qualified Data.Text as T+import Data.Monoid+import GI.Gtk.Enums (MessageType(..))+import Control.Monad (void)+import Control.Exception (SomeException, catch)+import Network.Stream (ConnError(..))+import GI.Gtk (Window)++type Parameter = (String, String)++baseUrl :: String+baseUrl = "http://lpaste.net"++-- | Default Leksah parameters+leksahParams :: [Parameter]+leksahParams =+ [ ("private", "Private")+ , ("author" , "Leksah Haskell IDE")+ , ("channel", "")+ , ("language", "haskell") -- Might change in the future+ , ("email" , "")+ ]++mkReq :: String -> String+mkReq str =+ let post = [("title", ""), ("paste", str)] -- Randomly generate title?+ in baseUrl ++ "/new?" ++ urlEncodeVars (leksahParams ++ post)++-- | Lookup the value of the location header.+locationLookup :: [Header] -> String+locationLookup [] = ""+locationLookup (Header k v:xs) =+ if HdrLocation == k then v else locationLookup xs++-- | Main purpose function: Perform all the necessary actions for uploading and+-- return the link to the submission.+uploadSelected :: String -> IO (Maybe String)+uploadSelected str = do+ result <- simpleHTTP (postRequest $ mkReq str) `catch` handler+ case result of+ Right x -> return . Just . (++) baseUrl . locationLookup $ rspHeaders x+ Left _ -> return Nothing+ where+ handler e = return . Left . ErrorMisc $ show (e :: SomeException)++uploadToLpaste :: IDEM ()+uploadToLpaste = do+ mainWindow <- getMainWindow+ maybeText <- selectedTextOrCurrentLine+ liftIO $ showDialogOptions+ (Just mainWindow)+ "Confirm upload to lpaste.net?"+ MessageTypeQuestion+ [("OK", uploadToLpaste' mainWindow maybeText), ("Cancel", return ())]+ (Just 0)++uploadToLpaste' :: Window -> Maybe T.Text -> IO ()+uploadToLpaste' mainWindow maybeText =+ case maybeText of+ Just text -> do+ mbLink <- uploadSelected $ T.unpack text+ case mbLink of+ Just link -> void $ showInputDialog (Just mainWindow) "LPaste link:" (T.pack link)+ Nothing -> showDialog (Just mainWindow) ("Could not reach " <> T.pack baseUrl) MessageTypeError+ Nothing ->+ showDialog (Just mainWindow) "Please select some text in the editor" MessageTypeError
src/IDE/Leksah.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, LambdaCase #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, LambdaCase, PatternSynonyms #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Leksah@@ -18,7 +19,8 @@ leksah ) where -import Graphics.UI.Gtk+import Prelude ()+import Prelude.Compat import Control.Concurrent import Data.IORef import Data.Maybe@@ -26,10 +28,9 @@ import System.Console.GetOpt import System.Environment import Data.Version-import Prelude hiding(catch) import qualified IDE.OSX as OSX-import qualified IDE.YiConfig as Yi+import qualified IDE.TextEditor.Yi.Config as Yi #ifdef LEKSAH_WITH_YI_DYRE import System.Directory (getAppUserDataDirectory)@@ -55,8 +56,8 @@ (stringEditor, enumEditor, textEditor) import IDE.Metainfo.Provider (initInfo) import IDE.Workspaces- (workspaceAddPackage', workspaceTryQuiet, workspaceNewHere,- workspaceOpenThis, backgroundMake)+ (projectTryQuiet, projectAddPackage', workspaceTryQuiet,+ workspaceNewHere, workspaceOpenThis, backgroundMake, projectOpenThis) import IDE.Utils.GUIUtils import Network (withSocketsDo) import Control.Exception@@ -75,17 +76,55 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import Data.Conduit (($$))-import Control.Monad (void, when, unless, liftM)+import Control.Monad (forever, forM_, void, when, unless, liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Applicative ((<$>)) import qualified Data.Text as T (pack, unpack, stripPrefix, unlines) import Data.Text (Text) import Data.Monoid ((<>))-import Graphics.UI.Gtk.General.CssProvider- (cssProviderLoadFromString, cssProviderNew)-import Graphics.UI.Gtk.General.StyleContext- (styleContextAddProviderForScreen) import qualified Data.Sequence as Seq (empty)+import qualified GI.Gtk.Functions as Gtk (main, init)+import GI.GLib.Functions (idleAdd, timeoutAdd, timeoutAddSeconds)+import GI.GLib.Constants+ (pattern PRIORITY_DEFAULT_IDLE, pattern PRIORITY_DEFAULT, pattern PRIORITY_LOW)+import GI.Gdk.Objects.Screen (screenGetDefault)+import GI.Gtk.Objects.CssProvider+ (CssProvider(..), cssProviderLoadFromData, cssProviderNew)+import GI.Gtk.Objects.StyleContext+ (styleContextAddProviderForScreen)+import qualified Data.ByteString.Char8 as B (unlines)+import GI.GLib.Structs.Source (sourceRemove)+import GI.Gtk.Functions+ (mainIterationDo, eventsPending, mainIteration)+import GI.Gtk.Objects.Window+ (setWindowDeletable, windowSetIconFromFile, IsWindow, toWindow,+ setWindowWindowPosition, setWindowTitle, windowSetDefaultSize, windowNew)+import GI.Gtk.Objects.Widget+ (widgetDestroy, widgetHide, widgetShowAll, widgetGetWindow,+ onWidgetRealize, onWidgetDeleteEvent, widgetSetName)+import GI.Gtk.Objects.UIManager (uIManagerNew)+import GI.Gtk.Objects.Notebook (afterNotebookSwitchPage)+import GI.Gtk.Enums+ (Orientation(..), WindowType(..), PolicyType(..), ResponseType(..),+ WindowPosition(..), FileChooserAction(..))+import GI.Gtk.Objects.Dialog+ (dialogRun, dialogResponse, dialogGetContentArea, dialogNew)+import Data.GI.Base (unsafeCastTo, set)+import GI.Gtk.Objects.Label (labelNew)+import GI.Gtk.Objects.Box (Box(..))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import Control.Monad.Reader (MonadReader(..))+import GI.Gtk.Objects.ProgressBar+ (progressBarSetFraction, progressBarSetText, progressBarNew)+import GI.Gtk+ (containerAdd, applicationNew, Application, applicationWindowNew)+import GI.Gio (applicationRun, onApplicationActivate)+import GI.GLib.Structs.MainContext+ (mainContextIteration, mainContextDefault)+import System.FSNotify+ (watchTree, watchDir, withManager, WatchManager) -- -------------------------------------------------------------------- -- Command line options@@ -148,11 +187,11 @@ dataDir <- getDataDir args <- getArgs - (o,files) <- ideOpts $ map T.pack args- isFirstStart <- liftM not $ hasSavedConfigFile standardPreferencesFilename+ (flags,files) <- ideOpts $ map T.pack args+ isFirstStart <- not <$> hasSavedConfigFile standardPreferencesFilename let sessions = mapMaybe (\case SessionN s -> Just s- _ -> Nothing) o+ _ -> Nothing) flags let sessionFPs = filter (\f -> snd (splitExtension f) == leksahSessionFileExtension) $ map T.unpack files let workspaceFPs = filter (\f -> snd (splitExtension f) == leksahWorkspaceFileExtension) $ map T.unpack files@@ -176,10 +215,10 @@ then standardSessionFilename else emptySessionFilename - sessionFP <- if EmptySession `elem` o+ sessionFP <- if EmptySession `elem` flags then getConfigFilePathForLoad emptySessionFilename Nothing dataDir- else if DefaultSession `elem` o+ else if DefaultSession `elem` flags then getConfigFilePathForLoad standardSessionFilename Nothing dataDir else case mbWSessionFP of@@ -188,19 +227,19 @@ ssession Nothing dataDir let verbosity' = mapMaybe (\case Verbosity s -> Just s- _ -> Nothing) o+ _ -> Nothing) flags let verbosity = case verbosity' of [] -> INFO h:_ -> read $ T.unpack h updateGlobalLogger rootLoggerName (setLevel verbosity)- when (VersionF `elem` o)+ when (VersionF `elem` flags) (sysMessage Normal $ "Leksah the Haskell IDE, version " <> T.pack (showVersion version))- when (Help `elem` o)+ when (Help `elem` flags) (sysMessage Normal $ "Leksah the Haskell IDE " <> T.pack (usageInfo header options)) prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir prefs <- readPrefs prefsPath- when (notElem VersionF o && notElem Help o)+ when (notElem VersionF flags && notElem Help flags) (startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs prefs isFirstStart) handleExceptions inner =@@ -214,132 +253,64 @@ startGUI :: Yi.Config -> FilePath -> Maybe FilePath -> [FilePath] -> Prefs -> Bool -> IO () startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs iprefs isFirstStart =- Yi.start yiConfig $ \yiControl -> do- st <- unsafeInitGUIForThreadedRTS- timeout <- if rtsSupportsBoundThreads- then do- setNumCapabilities 2- sysMessage Normal "Linked with -threaded"- return Nothing- else Just <$> timeoutAddFull (yield >> return True) priorityLow 10- mbScreen <- screenGetDefault- case mbScreen of- Just screen -> do- 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- 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- maybe (return ()) timeoutRemove timeout- postGUIAsync $+ withManager $ \fsnotify -> Yi.start yiConfig $ \yiControl -> do+ app <- applicationNew (Just "org.leksah.leksah") []+ onApplicationActivate app $ do+ debugM "leksah" "Application Activate"+ timeout <- if rtsSupportsBoundThreads+ then do+ setNumCapabilities 2+ sysMessage Normal "Linked with -threaded"+ return Nothing+ else Just <$> timeoutAdd PRIORITY_LOW 10 (yield >> return True)+ screenGetDefault >>= \case+ Nothing -> return ()+ Just screen -> do+ debugM "leksah" "Add CSS"+ provider <- cssProviderNew+ cssProviderLoadFromData provider $+ B.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+ 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+ maybe (return ()) (void . sourceRemove) timeout case mbStartupPrefs of Nothing -> return ()- Just startupPrefs -> startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs- startupPrefs isFirstStart- debugM "leksah" "starting mainGUI"- mainGUI- debugM "leksah" "finished mainGUI"--mainLoop :: IO () -> IO ()-mainLoop = mainLoopSingleThread--mainLoopThreaded :: IO () -> IO ()-mainLoopThreaded onIdle = loop- where- loop = do- quit <- loopTillIdle- unless quit $ do- active <- newEmptyMVar- mvarSentIdleMessage <- newEmptyMVar- idleThread <- forkIO $ do- threadDelay 200000- isActive <- isJust <$> tryTakeMVar active- unless isActive $ do- putMVar mvarSentIdleMessage ()- postGUIAsync onIdle- quit <- mainIteration- putMVar active ()- unless quit $ do- -- If an idle message was sent then wait again- sentIdleMessage <- isJust <$> tryTakeMVar mvarSentIdleMessage- quit <- if sentIdleMessage- then mainIteration- else return False- unless quit loop- loopTillIdle = do- pending <- eventsPending- if pending == 0- then return False- else do- quit <- loopn (pending + 2)- if quit- then return True- else loopTillIdle--mainLoopSingleThread :: IO () -> IO ()-mainLoopSingleThread onIdle = eventsPending >>= loop False 50- where- loop :: Bool -> Int -> Int -> IO ()- loop False delay 0 | delay > 2000 = onIdle >> loop True delay 0- loop isIdle delay n = do- quit <- if n > 0- then do- timeout <- timeoutAddFull (yield >> return True) priorityLow 10- quit <- loopn (n+2)- timeoutRemove timeout- return quit- else- loopn (n+2)- unless quit $ do- yield- pending <- eventsPending- if pending > 0- then loop False 50 pending- else do- threadDelay delay- eventsPending >>= loop isIdle (if n > 0- then 50- else min (delay+delay) 50000)--loopn :: Int -> IO Bool-loopn 0 = return False-loopn n = do- quit <- mainIterationDo False- if quit- then return True- else loopn (n - 1)+ Just startupPrefs ->+ startMainWindow app yiControl fsnotify sessionFP mbWorkspaceFP sourceFPs+ startupPrefs isFirstStart+ debugM "leksah" "starting applicationRun"+ applicationRun app Nothing+ debugM "leksah" "finished applicationRun" -startMainWindow :: Yi.Control -> FilePath -> Maybe FilePath -> [FilePath] ->+startMainWindow :: Application -> Yi.Control -> WatchManager -> FilePath -> Maybe FilePath -> [FilePath] -> Prefs -> Bool -> IO ()-startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs startupPrefs isFirstStart = do+startMainWindow app yiControl fsnotify sessionFP mbWorkspaceFP sourceFPs startupPrefs isFirstStart = do timeout <- if rtsSupportsBoundThreads then return Nothing- else Just <$> timeoutAddFull (yield >> return True) priorityLow 10+ else Just <$> timeoutAdd PRIORITY_LOW 10 (yield >> return True) debugM "leksah" "startMainWindow" osxApp <- OSX.applicationNew- uiManager <- uiManagerNew+ uiManager <- uIManagerNew newIcons dataDir <- getDataDir candyPath <- getConfigFilePathForLoad@@ -352,8 +323,8 @@ let accelActions = setKeymap (keyMap :: KeymapI) mkActions specialKeys <- buildSpecialKeys keyMap accelActions - win <- windowNew- widgetSetName win ("Leksah Main Window"::Text)+ win <- toWindow =<< applicationWindowNew app+ widgetSetName win "Leksah Main Window" let fs = FrameState { windows = [win] , uiManager = uiManager@@ -364,16 +335,16 @@ , panePathFromNB = Map.empty } + triggerBuild <- newEmptyMVar let ide = IDE- { frameState = fs+ { application = app+ , frameState = fs , recentPanes = [] , specialKeys = specialKeys , specialKey = Nothing , candy = candySt , prefs = startupPrefs , workspace = Nothing- , activePack = Nothing- , activeExe = Nothing , bufferProjCache = Map.empty , allLogRefs = Seq.empty , currentHist = 0@@ -400,37 +371,38 @@ , logLaunches = Map.empty , autoCommand = return () , autoURI = Nothing+ , triggerBuild = triggerBuild+ , stopWorkspaceNotify = return ()+ , fsnotify = fsnotify } ideR <- newIORef ide- menuDescription' <- menuDescription- reflectIDE (makeMenu uiManager accelActions menuDescription') ideR- nb <- reflectIDE (newNotebook []) ideR- after nb switchPage (\i -> reflectIDE (handleNotebookSwitch nb i) ideR)- widgetSetName nb ("root"::Text)- on win deleteEvent . liftIO $ reflectIDE quit ideR >> return True- reflectIDE (instrumentWindow win startupPrefs (castToWidget nb)) ideR- reflectIDE (do+ (`reflectIDE` ideR) $ do+ menuDescription' <- liftIO menuDescription+ makeMenu uiManager accelActions menuDescription'+ nb <- newNotebook []+ afterNotebookSwitchPage nb (\_ i -> reflectIDE (handleNotebookSwitch nb (fromIntegral i)) ideR)+ widgetSetName nb "root"+ instrumentWindow win startupPrefs nb setBackgroundBuildToggled (backgroundBuild startupPrefs)- setRunUnitTests (runUnitTests startupPrefs)- setMakeModeToggled (makeMode startupPrefs)) ideR- let (x,y) = defaultSize startupPrefs- windowSetDefaultSize win x y- (tbv,fbv) <- reflectIDE (do+ setMakeDocs (makeDocs startupPrefs)+ setRunUnitTests (runUnitTests startupPrefs)+ setRunBenchmarks (runBenchmarks startupPrefs)+ setMakeModeToggled (makeMode startupPrefs)+ let (x,y) = defaultSize startupPrefs+ windowSetDefaultSize win (fromIntegral x) (fromIntegral y) registerLeksahEvents- pair <- recoverSession sessionFP- workspaceOpenThis False mbWorkspaceFP+ (tbv,fbv) <- recoverSession sessionFP+ forM_ mbWorkspaceFP (workspaceOpenThis False) mapM_ fileOpenThis sourceFPs wins <- getWindows mapM_ instrumentSecWindow (tail wins)- return pair- ) ideR - on win realize $ widgetGetWindow win >>= maybe (return ()) OSX.allowFullscreen+ onWidgetRealize win $+ widgetGetWindow win >>= mapM_ OSX.allowFullscreen - debugM "leksah" "Show main window"- widgetShowAll win+ liftIO $ debugM "leksah" "Show main window"+ widgetShowAll win - reflectIDE (do triggerEventIDE UpdateRecent if tbv then showToolbar@@ -438,52 +410,60 @@ if fbv then showFindbar else hideFindbar- OSX.updateMenu osxApp uiManager) ideR+ OSX.updateMenu osxApp uiManager - OSX.applicationReady osxApp+ OSX.applicationReady osxApp - configDir <- getConfigDir- let welcomePath = configDir</>"leksah-welcome"- welcomeExists <- doesDirectoryExist welcomePath- unless welcomeExists $ do- let welcomeSource = dataDir</>"data"</>"leksah-welcome"- 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")- copyFile (welcomeSource</>"src"</>"Main.hs") welcomeMain- copyFile (welcomeSource</>"test"</>"Main.hs") (welcomePath</>"test"</>"Main.hs")- defaultWorkspace <- liftIO $ (</> "leksah.lkshw") <$> getHomeDirectory- defaultExists <- liftIO $ doesFileExist defaultWorkspace- reflectIDE (do+ configDir <- liftIO getConfigDir+ let welcomePath = configDir</>"leksah-welcome"+ welcomeExists <- liftIO $ doesDirectoryExist welcomePath+ unless welcomeExists $ do+ let welcomeSource = dataDir</>"data"</>"leksah-welcome"+ welcomeProject = welcomePath</>"cabal.project"+ welcomeCabal = welcomePath</>"leksah-welcome.cabal"+ welcomeMain = welcomePath</>"src"</>"Main.hs"+ liftIO $ do+ createDirectoryIfMissing True $ welcomePath</>"src"+ createDirectoryIfMissing True $ welcomePath</>"test"+ copyFile (welcomeSource</>"Setup.lhs") (welcomePath</>"Setup.lhs")+ copyFile (welcomeSource</>"cabal.project") welcomeProject+ copyFile (welcomeSource</>"leksah-welcome.cabal") welcomeCabal+ copyFile (welcomeSource</>"LICENSE") (welcomePath</>"LICENSE")+ copyFile (welcomeSource</>"src"</>"Main.hs") welcomeMain+ copyFile (welcomeSource</>"test"</>"Main.hs") (welcomePath</>"test"</>"Main.hs")+ defaultWorkspace <- liftIO $ (</> "leksah.lkshw") <$> getHomeDirectory+ defaultExists <- liftIO $ doesFileExist defaultWorkspace if defaultExists- then workspaceOpenThis False (Just defaultWorkspace)+ then workspaceOpenThis False defaultWorkspace else workspaceNewHere defaultWorkspace- workspaceTryQuiet $ void (workspaceAddPackage' welcomeCabal)- fileOpenThis welcomeMain) ideR- reflectIDE (initInfo (modifyIDE_ (\ide -> ide{currentState = IsRunning}))) ideR- maybe (return ()) timeoutRemove timeout- postGUIAsync . mainLoop $- reflectIDE (do- currentPrefs <- readIDE prefs- when (backgroundBuild currentPrefs) backgroundMake) ideR--- timeoutAddFull (do--- reflectIDE (do--- currentPrefs <- readIDE prefs--- when (backgroundBuild currentPrefs) $ backgroundMake) ideR--- return True) priorityDefaultIdle 1000- reflectIDE (triggerEvent ideR (Sensitivity [(SensitivityInterpreting, False)])) ideR- return ()--- mainGUI+ workspaceTryQuiet $ projectOpenThis welcomeProject+ projectTryQuiet $ void (projectAddPackage' welcomeCabal)+ fileOpenThis welcomeMain+ initInfo (modifyIDE_ (\ide -> ide{currentState = IsRunning}))+ mapM_ sourceRemove timeout+ liftIO . forkIO . forever $ do+ takeMVar triggerBuild+ processing <- newEmptyMVar+ reflectIDE (postAsyncIDE' PRIORITY_LOW $+ eventsPending >>= \case+ True -> do+ liftIO $ tryPutMVar triggerBuild ()+ liftIO $ putMVar processing ()+ False -> do+ liftIO $ tryTakeMVar triggerBuild+ liftIO $ putMVar processing ()+ currentPrefs <- readIDE prefs+ when (backgroundBuild currentPrefs) backgroundMake) ideR+ takeMVar processing + triggerEvent ideR (Sensitivity [(SensitivityInterpreting, False)])+ return ()+ fDescription :: FilePath -> FieldDescription Prefs fDescription configPath = VFD emptyParams [ mkField (paraName <<<- ParaName "Paths under which haskell sources for packages may be found"- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1, 150) $ emptyParams) sourceDirectories@@ -516,38 +496,37 @@ configDir <- getConfigDir dialog <- dialogNew setLeksahIcon dialog- set dialog [- windowTitle := ("Welcome to Leksah, the Haskell IDE"::Text),- windowWindowPosition := WinPosCenter]- dialogAddButton dialog ("gtk-ok"::Text) ResponseOk- dialogAddButton dialog ("gtk-cancel"::Text) ResponseCancel- vb <- dialogGetContentArea dialog+ setWindowTitle dialog "Welcome to Leksah, the Haskell IDE"+ setWindowWindowPosition dialog WindowPositionCenter+ dialogAddButton' dialog "gtk-ok" ResponseTypeOk+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ vb <- dialogGetContentArea dialog >>= liftIO . unsafeCastTo Box label <- labelNew (Just ( "Before you start using Leksah it will collect and download metadata about your installed Haskell packages.\n" <>- "You can add folders under which you have sources for Haskell packages not available from Hackage."::Text))+ "You can add folders under which you have sources for Haskell packages not available from Hackage.")) (widget, setInj, getExt,notifier) <- buildEditor (fDescription configDir) prefs- boxPackStart (castToBox vb) label PackNatural 7- sw <- scrolledWindowNew Nothing Nothing- scrolledWindowAddWithViewport sw widget- scrolledWindowSetPolicy sw PolicyNever PolicyAutomatic- boxPackStart (castToBox vb) sw PackGrow 7+ boxPackStart' vb label PackNatural 7+ sw <- scrolledWindowNew noAdjustment noAdjustment+ containerAdd sw widget+ scrolledWindowSetPolicy sw PolicyTypeNever PolicyTypeAutomatic+ boxPackStart' vb sw PackGrow 7 windowSetDefaultSize dialog 800 630 widgetShowAll dialog- response <- dialogRun dialog+ response <- dialogRun' dialog widgetHide dialog case response of- ResponseOk -> do- mbNewPrefs <- extract prefs [getExt]+ ResponseTypeOk -> do+ mbNewPrefs <- liftIO $ extract prefs [getExt] widgetDestroy dialog case mbNewPrefs of Nothing -> do- sysMessage Normal "No dialog results"+ liftIO $ sysMessage Normal "No dialog results" return False Just newPrefs -> do- fp <- getConfigFilePathForSave standardPreferencesFilename- writePrefs fp newPrefs- fp2 <- getConfigFilePathForSave strippedPreferencesFilename- SP.writeStrippedPrefs fp2+ fp <- liftIO $ getConfigFilePathForSave standardPreferencesFilename+ liftIO $ writePrefs fp newPrefs+ fp2 <- liftIO $ getConfigFilePathForSave strippedPreferencesFilename+ liftIO $ SP.writeStrippedPrefs fp2 SP.Prefs {SP.sourceDirectories = sourceDirectories newPrefs, SP.unpackDirectory = unpackDirectory newPrefs, SP.retrieveURL = retrieveURL newPrefs,@@ -560,7 +539,7 @@ widgetDestroy dialog return False -setLeksahIcon :: (WindowClass self) => self -> IO ()+setLeksahIcon :: (IsWindow self) => self -> IO () setLeksahIcon window = do dataDir <- getDataDir let iconPath = dataDir </> "pics" </> "leksah.png"@@ -568,27 +547,29 @@ when iconExists $ windowSetIconFromFile window iconPath +firstBuild :: Prefs -> IO () firstBuild newPrefs = do dialog <- dialogNew- setLeksahIcon dialog- set dialog [- windowTitle := ("Leksah: Updating Metadata"::Text),- windowWindowPosition := WinPosCenter,- windowDeletable := False]- vb <- dialogGetContentArea dialog+ liftIO $ setLeksahIcon dialog+ setWindowTitle dialog "Leksah: Updating Metadata"+ setWindowWindowPosition dialog WindowPositionCenter+ setWindowDeletable dialog False+ vb <- dialogGetContentArea dialog >>= liftIO . unsafeCastTo Box progressBar <- progressBarNew- progressBarSetText progressBar ("Please wait while Leksah collects information about Haskell packages on your system"::Text)+ progressBarSetText progressBar $ Just "Please wait while Leksah collects information about Haskell packages on your system" progressBarSetFraction progressBar 0.0- boxPackStart (castToBox vb) progressBar PackGrow 7+ boxPackStart' vb progressBar PackGrow 7 forkIO $ do- logger <- getRootLogger- let verbosity = case getLevel logger of- Just level -> ["--verbosity=" <> T.pack (show level)]- Nothing -> []- (output, pid) <- runTool "leksah-server" (["-sbo", "+RTS", "-N2", "-RTS"] ++ verbosity) Nothing- output $$ CL.mapM_ (update progressBar)- waitForProcess pid- postGUIAsync (dialogResponse dialog ResponseOk)+ logger <- getRootLogger+ let verbosity = case getLevel logger of+ Just level -> ["--verbosity=" <> T.pack (show level)]+ Nothing -> []+ (output, pid) <- runTool "leksah-server" (["-sbo", "+RTS", "-N2", "-RTS"] ++ verbosity) Nothing Nothing+ output $$ CL.mapM_ (update progressBar)+ waitForProcess pid+ void . idleAdd PRIORITY_DEFAULT $ do+ dialogResponse' dialog ResponseTypeOk+ return False widgetShowAll dialog dialogRun dialog widgetHide dialog@@ -598,8 +579,10 @@ update pb to = do let str = toolline to case T.stripPrefix "update_toolbar " str of- Just rest -> postGUIAsync $ progressBarSetFraction pb (read $ T.unpack rest)- Nothing -> liftIO $ debugM "leksah" $ T.unpack str+ Just rest -> void . idleAdd PRIORITY_DEFAULT $ do+ progressBarSetFraction pb (read $ T.unpack rest)+ return False+ Nothing -> debugM "leksah" $ T.unpack str
src/IDE/LogRef.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings #-} ----------------------------------------------------------------------------- --@@ -45,7 +46,6 @@ , srcSpanParser ) where -import Graphics.UI.Gtk import Control.Monad.Reader import Text.ParserCombinators.Parsec.Language import Text.ParserCombinators.Parsec hiding(Parser)@@ -56,7 +56,7 @@ import IDE.Pane.SourceBuffer import qualified IDE.Pane.Log as Log import IDE.Utils.Tool-import System.FilePath (equalFilePath)+import System.FilePath (equalFilePath, makeRelative, isAbsolute, (</>)) import Data.List (partition, stripPrefix, elemIndex, isPrefixOf) import Data.Maybe (catMaybes, isJust) import System.Exit (ExitCode(..))@@ -75,11 +75,11 @@ import Data.Monoid ((<>)) import qualified Data.Set as S (notMember, member, insert, empty) import Data.Set (Set)-import System.FilePath.Windows ((</>)) import Data.Sequence (ViewR(..), Seq) import qualified Data.Foldable as F (toList, forM_) import qualified Data.Sequence as Seq (null, singleton, viewr, reverse, fromList)+import System.Directory (doesFileExist) showSourceSpan :: LogRef -> Text showSourceSpan = T.pack . displaySrcSpan . logRefSrcSpan@@ -111,7 +111,7 @@ unmarkLogRefs :: IDEAction unmarkLogRefs =- forOpenLogRefs $ \logRef (IDEBuffer {sourceView = sv}) -> do+ forOpenLogRefs $ \logRef IDEBuffer {sourceView = sv} -> do buf <- getBuffer sv removeTagByName buf (T.pack $ show (logRefType logRef)) @@ -267,6 +267,10 @@ | ErrorLine SrcSpan LogRefType Text | WarningLine Text | OtherLine Text+ | ElmFile FilePath Text+ | ElmLine Int+ | ElmPointLine Int+ | ElmColumn Int Int buildErrorParser :: CharParser () BuildError buildErrorParser = try (do@@ -283,20 +287,50 @@ char ':' whiteSpace refType <- try (do- symbol "Warning:"+ symbol "Warning:" <|> symbol "warning:" return WarningRef)+ <|> (do+ symbol "Error:" <|> symbol "error:"+ return ErrorRef) <|> return ErrorRef text <- T.pack <$> many anyChar return (ErrorLine span refType text)) <|> try (do+ char '-'+ char '-'+ char ' ' whiteSpace+ text <- T.pack . reverse . drop 1 . reverse <$> many (noneOf "-")+ char '-'+ char '-'+ many (char '-')+ whiteSpace+ optional (char '.' >> char '/')+ file <- many anyChar+ return (ElmFile file text))+ <|> try (do+ line <- int+ char '|'+ pointer <- char '>' <|> char ' '+ text <- T.pack <$> many anyChar+ return $ (case pointer of+ '>' -> ElmPointLine+ _ -> ElmLine) line)+ <|> try (do+ col1 <- length <$> many (char ' ')+ char '^'+ col2 <- length <$> many (char '^') eof+ return (ElmColumn col1 (col1 + col2)))+ <|> try (do+ whiteSpace+ eof return EmptyLine) <|> try (do whiteSpace- symbol "Warning:"+ warning <- T.pack <$> (symbol "Warning:" <|> symbol "warning:") text <- T.pack <$> many anyChar- return (WarningLine ("Warning:" <> text)))+ return (WarningLine (warning <> text))) <|> try (do text <- T.pack <$> many anyChar eof@@ -415,6 +449,7 @@ defaultLogLaunch <- lift getDefaultLogLaunch result <- catMaybes <$> logOutputLines defaultLogLaunch paneLineLogger unless (null result) $ do+ liftIO $ debugM "leskah" "logOutputPane has result" new <- liftIO . atomicModifyIORef buffer $ \x -> let new = x ++ result in (new, new) mbURI <- lift $ readIDE autoURI unless (isJust mbURI) . lift . postSyncIDE . setOutput command $ T.unlines new@@ -423,41 +458,57 @@ , inError :: Bool , inDocTest :: Bool , errs :: [LogRef]+ , elmLine :: Int , testFails :: [LogRef] , filesCompiled :: Set FilePath } -- Not quite a Monoid initialState :: IDELog -> BuildOutputState-initialState log = BuildOutputState log False False [] [] S.empty+initialState log = BuildOutputState log False False [] 1 [] S.empty -logOutputForBuild :: IDEPackage+-- Sometimes we get error spans relative to a build dependency+findSourcePackage :: Project -> IDEPackage -> FilePath -> IO IDEPackage+findSourcePackage project package file =+ doesFileExist (ipdPackageDir package </> file) >>= \case+ True -> return package+ False ->+ -- If the file only exists in one package in the project it is probably the right one+ filterM (\p -> doesFileExist $ ipdPackageDir p </> file) (pjPackages project) >>= \case+ [p] -> return p+ _ -> return package -- Not really sure where this file is++logOutputForBuild :: Project+ -> IDEPackage -> Bool -> Bool -> C.Sink ToolOutput IDEM [LogRef]-logOutputForBuild package backgroundBuild jumpToWarnings = do+logOutputForBuild project package backgroundBuild jumpToWarnings = do liftIO $ debugM "leksah" "logOutputForBuild" log <- lift getLog logLaunch <- lift Log.getDefaultLogLaunch+ -- Elm does not log files compiled so just clear all the log refs for elm files+ lift $ postSyncIDE $ removeFileExtLogRefs (ipdPackageDir package) ".elm" [ErrorRef, WarningRef] BuildOutputState {..} <- CL.foldM (readAndShow logLaunch) $ initialState log- ideR <- lift ask- liftIO $ postGUISync $ reflectIDE (do+ lift $ postSyncIDE $ do allErrorLikeRefs <- readIDE errorRefs triggerEventIDE (Sensitivity [(SensitivityError,not (Seq.null allErrorLikeRefs))]) let errorNum = length (filter isError errs) let warnNum = length errs - errorNum triggerEventIDE (StatusbarChanged [CompartmentState (T.pack $ show errorNum ++ " Errors, " ++ show warnNum ++ " Warnings"), CompartmentBuild False])- return errs) ideR+ return errs where readAndShow :: LogLaunch -> BuildOutputState -> ToolOutput -> IDEM BuildOutputState readAndShow logLaunch state@BuildOutputState {..} output = do ideR <- ask let logPrevious (previous:_) = reflectIDE (addLogRef False backgroundBuild previous) ideR logPrevious _ = return ()-- liftIO $ postGUISync $ case output of- ToolError line -> do+ liftIDE $ postSyncIDE $ liftIO $ do+ debugM "leksah" $ "readAndShow " ++ show output+ case output of+ -- stack prints everything to stderr, so let's process errors as normal output first+ ToolError line -> processNormalOutput ideR logLaunch state logPrevious line $ do let parsed = parse buildErrorParser "" $ T.unpack line let nonErrorPrefixes = ["Linking ", "ar:", "ld:", "ld warning:"] tag <- case parsed of@@ -474,17 +525,63 @@ sysMessage Normal . T.pack $ show e return state { inError = False } (Right ne@(ErrorLine span refType str),_) -> do- let ref = LogRef span package str Nothing (Just (lineNr,lineNr)) refType+ foundInPackage <- findSourcePackage project package (srcSpanFilename span)+ let ref = LogRef span (ipdCabalFile foundInPackage) str Nothing (Just (lineNr,lineNr)) refType root = logRefRootPath ref file = logRefFilePath ref fullFilePath = logRefFullFilePath ref unless (fullFilePath `S.member` filesCompiled) $- reflectIDE (removeBuildLogRefs root file) ideR+ reflectIDE (removeBuildLogRefs (root </> file)) ideR when inError $ logPrevious errs return state { inError = True , errs = ref:errs+ , elmLine = 1 , filesCompiled = S.insert fullFilePath filesCompiled }+ (Right (ElmFile efile str),_) -> do+ let ref = LogRef (SrcSpan efile 1 0 1 0) (ipdCabalFile package) str Nothing (Just (lineNr,lineNr)) ErrorRef+ root = logRefRootPath ref+ file = logRefFilePath ref+ fullFilePath = logRefFullFilePath ref+ when inError $ logPrevious errs+ return state { inError = True+ , errs = ref:errs+ , elmLine = 1+ , filesCompiled = S.insert fullFilePath filesCompiled+ }+ (Right (ElmLine eline), _) ->+ if inError+ then return state+ { elmLine = eline+ }+ else return state+ (Right (ElmPointLine eline), ref:tl) ->+ if inError+ then return state+ { errs = ref+ { logRefSrcSpan =+ case logRefSrcSpan ref of+ SrcSpan f 1 0 1 0 -> SrcSpan f eline 0 (eline + 1) 0+ SrcSpan f l _ _ _ -> SrcSpan f l 0 (eline + 1) 0+ } : tl+ }+ else return state+ (Right (ElmColumn c1 c2), ref@LogRef{logRefSrcSpan = span}:tl) ->+ if inError+ then do+ let line = max 1 elmLine+ leftMargin = 2 + length (show line)+ return state+ { errs = ref+ { logRefSrcSpan = (logRefSrcSpan ref)+ { srcSpanStartColumn = max 0 (c1 - leftMargin)+ , srcSpanEndColumn = max 0 (c2 - leftMargin)+ , srcSpanStartLine = line+ , srcSpanEndLine = line+ }+ } : tl+ }+ else return state (Right (OtherLine str1), ref@(LogRef span rootPath str Nothing (Just (l1,l2)) refType):tl) -> if inError then return state { errs = LogRef span rootPath@@ -505,30 +602,14 @@ : tl } else return state+ (Right EmptyLine, _) -> return state -- Elm errors can contain empty lines _ -> do when inError $ logPrevious errs return state { inError = False } ToolOutput line ->- case (parse buildOutputParser "" $ T.unpack line, inDocTest, testFails) of- (Right (BuildProgress n total file), _, _) -> do- logLn <- Log.appendLog log logLaunch (line <> "\n") LogTag- reflectIDE (triggerEventIDE (StatusbarChanged [CompartmentState- (T.pack $ "Compiling " ++ show n ++ " of " ++ show total), CompartmentBuild False])) ideR- let root = ipdPackageDir package- fullFilePath = root </> file- reflectIDE (removeBuildLogRefs root file) ideR- when inDocTest $ logPrevious testFails- return state { inDocTest = False }- (Right (DocTestFailure span exp), _, _) -> do- logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag- when inDocTest $ logPrevious testFails- return state { inDocTest = True- , testFails = LogRef span- package- exp- Nothing (Just (logLn,logLn)) TestFailureRef : testFails- }- (_, True, LogRef span rootPath str Nothing (Just (l1, l2)) refType : tl) -> do+ processNormalOutput ideR logLaunch state logPrevious line $+ case (inDocTest, testFails) of+ (True, LogRef span rootPath str Nothing (Just (l1, l2)) refType : tl) -> do logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag return state { testFails = LogRef span rootPath@@ -564,6 +645,30 @@ ++ show warnNum ++ " warnings -- " ++ show (length testFails) ++ " doctest failures -----\n") FrameTag return state { inError = False, inDocTest = False }+ -- process output line as normal, otherwise calls given alternative+ processNormalOutput :: IORef IDE -> LogLaunch -> BuildOutputState -> ([LogRef]->IO()) -> Text -> IO BuildOutputState -> IO BuildOutputState+ processNormalOutput ideR logLaunch state@BuildOutputState {..} logPrevious line altFunction =+ case parse buildOutputParser "" $ T.unpack line of+ (Right (BuildProgress n total file)) -> do+ logLn <- Log.appendLog log logLaunch (line <> "\n") LogTag+ reflectIDE (triggerEventIDE (StatusbarChanged [CompartmentState+ (T.pack $ "Compiling " ++ show n ++ " of " ++ show total), CompartmentBuild False])) ideR+ f <- if isAbsolute file+ then return file+ else (</> file) . ipdPackageDir <$> findSourcePackage project package file+ reflectIDE (removeBuildLogRefs f) ideR+ when inDocTest $ logPrevious testFails+ return state { inDocTest = False }+ (Right (DocTestFailure span exp)) -> do+ logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag+ when inDocTest $ logPrevious testFails+ return state { inDocTest = True+ , testFails = LogRef span+ (ipdCabalFile package)+ exp+ Nothing (Just (logLn,logLn)) TestFailureRef : testFails+ }+ _ -> altFunction --logOutputLines :: Text -- ^ logLaunch -- -> (LogLaunch -> ToolOutput -> IDEM a)@@ -580,7 +685,7 @@ logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag case parse breaksLineParser "" $ T.unpack line of Right (BreakpointDescription n span) ->- return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef+ return $ Just $ LogRef span (ipdCabalFile package) line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef _ -> return Nothing _ -> do defaultLineLogger log logLaunch out@@ -597,7 +702,7 @@ logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag case parse setBreakpointLineParser "" $ T.unpack line of Right (BreakpointDescription n span) ->- return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef+ return $ Just $ LogRef span (ipdCabalFile package) line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef _ -> return Nothing _ -> do defaultLineLogger log logLaunch out@@ -622,7 +727,7 @@ let contexts = getContexts line if null contexts then return Nothing- else return $ Just $ LogRef (last contexts) package line Nothing (Just (logLineNumber, logLineNumber)) ContextRef+ else return $ Just $ LogRef (last contexts) (ipdCabalFile package) line Nothing (Just (logLineNumber, logLineNumber)) ContextRef _ -> do defaultLineLogger log logLaunch out return Nothing)
src/IDE/Metainfo/Provider.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}@@ -35,11 +36,12 @@ , getPackageImportInfo -- Scope for the import tool , getAllPackageIds-, getAllPackageIds'++, keywords ) where import Prelude ()-import Prelude.Compat hiding(catch, readFile)+import Prelude.Compat hiding(readFile) import System.IO (hClose, openBinaryFile, IOMode(..)) import System.IO.Strict (readFile) import qualified Data.Map as Map@@ -56,6 +58,7 @@ import Distribution.ModuleName import Control.DeepSeq+import IDE.Utils.VersionUtils (supportedGhcVersions) import IDE.Utils.FileUtils import IDE.Core.State import Data.Char (toLower,isUpper,toUpper,isLower)@@ -80,6 +83,7 @@ import qualified Control.Arrow as A (Arrow(..)) import Data.Function (on) import Distribution.Package (PackageIdentifier)+import IDE.Utils.CabalPlan (unitIdToPackageId) -- --------------------------------------------------------------------- -- Updating metadata@@ -101,11 +105,13 @@ where doLoad = do ideMessage Normal "Now loading metadata ..."- loadSystemInfo- ideMessage Normal "Finished loading metadata"- updateWorkspaceInfo' False $ \ _ -> do- void (triggerEventIDE (InfoChanged True))- continuation+ forkIDE $ do+ loadSystemInfo+ postAsyncIDE $ do+ ideMessage Normal "Finished loading metadata"+ updateWorkspaceInfo' False $ \ _ -> do+ void (triggerEventIDE (InfoChanged True))+ continuation updateSystemInfo :: IDEAction updateSystemInfo = do@@ -136,14 +142,17 @@ updateWorkspaceInfo' True $ \ _ -> void (triggerEventIDE (InfoChanged False)) -getAllPackageIds :: IDEM [PackageIdentifier]-getAllPackageIds = either (const []) id <$> getAllPackageIds'--getAllPackageIds' :: IDEM (Either Text [PackageIdentifier])-getAllPackageIds' = do+getAllPackages :: IDEM [(UnitId, [FilePath])]+getAllPackages = do mbWorkspace <- readIDE workspace- liftIO . getInstalledPackageIds' $ map ipdPackageDir (maybe [] wsAllPackages mbWorkspace)+ liftIO $ getInstalledPackages VERSION_ghc+ $ map ipdPackageDir (maybe [] wsAllPackages mbWorkspace) +getAllPackageIds :: IDEM [PackageIdentifier]+getAllPackageIds =+ nub . mapMaybe (unitIdToPackageId . fst) <$>+ getAllPackages+ getAllPackageDBs :: IDEM [[FilePath]] getAllPackageDBs = do mbWorkspace <- readIDE workspace@@ -156,18 +165,14 @@ loadSystemInfo :: IDEAction loadSystemInfo = do collectorPath <- liftIO getCollectorPath- mbPackageIds <- getAllPackageIds'- case mbPackageIds of- Left e -> logMessage ("Please check that ghc-pkg is in your PATH and restart leksah:\n " <> e) ErrorTag- Right packageIds -> do- packageList <- liftIO $ mapM (loadInfosForPackage collectorPath)- (nub packageIds)- let scope = foldr buildScope (PackScope Map.empty getEmptyDefaultScope)- $ catMaybes packageList- -- liftIO performGC- modifyIDE_ (\ide -> ide{systemInfo = Just (GenScopeC (addOtherToScope scope False))})+ packageIds <- getAllPackageIds+ packageList <- liftIO $ mapM (loadInfosForPackage collectorPath) packageIds+ let scope = foldr buildScope (PackScope Map.empty getEmptyDefaultScope)+ $ catMaybes packageList+-- liftIO performGC+ modifyIDE_ (\ide -> ide{systemInfo = Just (GenScopeC (addOtherToScope scope False))}) - return ()+ return () -- -- | Updates the system info@@ -178,29 +183,29 @@ wi <- getSystemInfo case wi of Nothing -> loadSystemInfo- Just (GenScopeC (PackScope psmap psst)) -> do- mbPackageIds <- getAllPackageIds'- case mbPackageIds of- Left e -> logMessage ("Please check that ghc-pkg is in your PATH and restart leksah:\n " <> e) ErrorTag- Right packageIds -> do- let newPackages = filter (`Map.member` psmap) packageIds- let trashPackages = filter (`notElem` packageIds) (Map.keys psmap)- if null newPackages && null trashPackages- then continuation True- else- callCollector rebuild True True $ \ _ -> do- collectorPath <- lift getCollectorPath- newPackageInfos <- liftIO $ mapM (loadInfosForPackage collectorPath)- newPackages- let psmap2 = foldr ((\ e m -> Map.insert (pdPackage e) e m) . fromJust) psmap- (filter isJust newPackageInfos)- let psmap3 = foldr Map.delete psmap2 trashPackages- let scope :: PackScope (Map Text [Descr])- = foldr buildScope (PackScope Map.empty symEmpty)- (Map.elems psmap3)- modifyIDE_ (\ide -> ide{systemInfo = Just (GenScopeC (addOtherToScope scope False))})- continuation True- ideMessage Normal "Finished updating system metadata"+ Just (GenScopeC (PackScope psmap psst)) -> forkIDE $ do+ packageIds <- getAllPackageIds+ let newPackages = filter (`Map.member` psmap) packageIds+ let trashPackages = filter (`notElem` packageIds) (Map.keys psmap)+ if null newPackages && null trashPackages+ then finished+ else+ callCollector rebuild True True $ \ _ -> do+ collectorPath <- lift getCollectorPath+ newPackageInfos <- liftIO $ mapM (loadInfosForPackage collectorPath)+ (nub newPackages)+ let psmap2 = foldr ((\ e m -> Map.insert (pdPackage e) e m) . fromJust) psmap+ (filter isJust newPackageInfos)+ let psmap3 = foldr Map.delete psmap2 trashPackages+ let scope :: PackScope (Map Text [Descr])+ = foldr buildScope (PackScope Map.empty symEmpty)+ (Map.elems psmap3)+ postAsyncIDE $ modifyIDE_ (\ide -> ide{systemInfo = Just (GenScopeC (addOtherToScope scope False))})+ finished+ where+ finished = do+ postAsyncIDE $ ideMessage Normal "Finished updating system metadata"+ continuation True getEmptyDefaultScope :: Map Text [Descr] getEmptyDefaultScope = symEmpty@@ -230,8 +235,7 @@ continuation False Just ws -> updatePackageInfos rebuild (wsAllPackages ws) $ \ _ packDescrs -> do- let dependPackIds = nub (concatMap pdBuildDepends packDescrs) \\- map pdPackage packDescrs+ let dependPackIds = nub (concatMap pdBuildDepends packDescrs) \\ map pdPackage packDescrs let packDescrsI = case systemInfo' of Nothing -> [] Just (GenScopeC (PackScope pdmap _)) ->@@ -270,20 +274,22 @@ (GenScopeC (addOtherToScope scope1 False), GenScopeC(addOtherToScope scope2 False))}) _ -> modifyIDE_ (\ide -> ide{packageInfo = Nothing})+ postAsyncIDE $ ideMessage Normal "Finished updating workspace metadata" continuation True- postAsyncIDE $ ideMessage Normal "Finished updating workspace metadata" -- | Update the metadata on several packages updatePackageInfos :: Bool -> [IDEPackage] -> (Bool -> [PackageDescr] -> IDEAction) -> IDEAction-updatePackageInfos rebuild pkgs continuation = do- -- calculate list of known packages once- knownPackages <- getAllPackageIds- updatePackageInfos' [] knownPackages rebuild pkgs continuation- where- updatePackageInfos' collector _ _ [] continuation = continuation True collector- updatePackageInfos' collector knownPackages rebuild (hd:tail) continuation =- updatePackageInfo knownPackages rebuild hd $ \ _ packDescr ->- updatePackageInfos' (packDescr : collector) knownPackages rebuild tail continuation+updatePackageInfos rebuild pkgs continuation =+ forkIDE $ do+ -- calculate list of known packages once+ knownPackages <- getAllPackageIds+ postAsyncIDE $+ updatePackageInfos' [] knownPackages rebuild pkgs continuation+ where+ updatePackageInfos' collector _ _ [] continuation = continuation True collector+ updatePackageInfos' collector knownPackages rebuild (hd:tail) continuation =+ updatePackageInfo knownPackages rebuild hd $ \ _ packDescr ->+ updatePackageInfos' (packDescr : collector) knownPackages rebuild tail continuation -- | Update the metadata on one package updatePackageInfo :: [PackageIdentifier] -> Bool -> IDEPackage -> (Bool -> PackageDescr -> IDEAction) -> IDEAction@@ -859,7 +865,12 @@ True) keywords misc :: [(Text, String)]-misc = [("--", "Haskell comment"), ("=", "Haskell definition")]+misc = [ ("--", "Haskell comment")+ , ("=" , "Haskell definition")+ , ("\\", "Haskell lambda")+ , ("->", "Haskell arrow")+ , ("<-", "Haskell arrow")+ , ("::", "Haskell type definition")] miscDescrs :: [Descr] miscDescrs = map (\(s, d) -> Real $ RealDescr
src/IDE/NotebookFlipper.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.NotebookFlipper@@ -18,27 +19,46 @@ , flipUp ) where -import Graphics.UI.Gtk- (treeSelectionGetSelectedRows,- treeSelectionSelectionChanged, treeViewGetSelection, rowActivated,- treeViewSetCursor, treeViewGetCursor, treeModelIterNChildren,- treeViewGetModel, treeViewRowActivated, treeViewGetColumn,- widgetShowAll, windowWindowPosition, widgetDestroy, widgetHide,- listStoreGetValue, keyReleaseEvent,- treeViewHeadersVisible, cellText, cellLayoutSetAttributes,- treeViewColumnPackStart, cellRendererTextNew, treeViewAppendColumn,- treeViewColumnNew, treeViewSetModel, listStoreNew, treeViewNew,- containerAdd, windowResizable, windowTransientFor,- windowNewPopup, TreeViewClass, WindowPosition(..),- signalDisconnect, AttrOp(..), set, EventM, EKey, eventKeyName,- windowGetSize, windowTypeHint, WindowTypeHint(..), windowDecorated,- windowDefaultWidth, windowDefaultHeight, scrolledWindowNew) import IDE.Core.State hiding (window, name) import Control.Monad (when) import IDE.Pane.SourceBuffer(recentSourceBuffers) import Control.Monad.IO.Class (MonadIO(..))-import System.Glib.Signals (on) import qualified Control.Monad.Reader as Gtk (liftIO)+import GI.Gtk.Objects.TreeView+ (treeViewRowActivated, treeViewGetColumn, onTreeViewRowActivated,+ treeViewGetSelection, setTreeViewHeadersVisible, treeViewAppendColumn,+ treeViewSetModel, treeViewNew, treeViewSetCursor,+ treeViewGetCursor, treeViewGetModel, IsTreeView)+import GI.Gtk.Interfaces.TreeModel (treeModelIterNChildren)+import GI.Gtk.Objects.Window+ (setWindowWindowPosition, setWindowTransientFor, setWindowDefaultHeight,+ setWindowDefaultWidth, setWindowResizable, setWindowDecorated,+ setWindowTypeHint, windowNew, windowGetSize)+import GI.Gtk.Enums (WindowPosition(..), WindowType(..))+import Data.GI.Base (on, set)+import GI.Gdk.Enums (WindowTypeHint(..))+import GI.Gtk.Objects.ScrolledWindow (scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import Data.GI.Gtk.ModelView.SeqStore+ (seqStoreGetValue, seqStoreNew, SeqStore(..))+import GI.Gtk.Objects.TreeViewColumn+ (noTreeViewColumn, treeViewColumnPackStart, treeViewColumnNew)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (onTreeSelectionChanged)+import GI.Gtk.Objects.Widget+ (widgetShowAll, widgetDestroy, widgetHide, onWidgetKeyReleaseEvent)+import GI.GObject.Functions (signalHandlerDisconnect)+import GI.Gdk.Structs.EventKey+ (getEventKeyKeyval, EventKey(..))+import GI.Gdk.Functions (keyvalName)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathGetIndices',+ treePathNewFromIndices') flipDown :: IDEAction flipDown = do@@ -57,38 +77,40 @@ _ -> return () -- | Moves down in the Flipper state-moveFlipperDown :: TreeViewClass alpha => alpha -> IDEAction-moveFlipperDown tree = liftIO $ do- mbStore <- treeViewGetModel tree- case mbStore of- Nothing -> throwIDE "NotebookFlipper>>setFlipper: no store"- Just store -> do- n <- treeModelIterNChildren store Nothing- when (n /= 0) $ do- (cl, _) <- treeViewGetCursor tree- case cl of+moveFlipperDown :: IsTreeView alpha => alpha -> IDEAction+moveFlipperDown tree = do+ Just store <- treeViewGetModel tree+ n <- treeModelIterNChildren store Nothing+ when (n /= 0) $ do+ indices <- treeViewGetCursor tree >>= \case+ (Just path, _) ->+ treePathGetIndices' path >>= \case (current:_) -> let next = if current == n - 1 then 0 else current + 1- in treeViewSetCursor tree [min (n-1) next] Nothing- [] -> treeViewSetCursor tree [1] Nothing+ in return [min (n-1) next]+ [] -> return [1]+ _ -> return [1]+ p <- treePathNewFromIndices' indices+ treeViewSetCursor tree p noTreeViewColumn False -- | Moves up in the Flipper state-moveFlipperUp :: TreeViewClass alpha => alpha -> IDEAction+moveFlipperUp :: IsTreeView alpha => alpha -> IDEAction moveFlipperUp tree = liftIO $ do- mbStore <- treeViewGetModel tree- case mbStore of- Nothing -> throwIDE "NotebookFlipper>>setFlipper: no store"- Just store -> do- n <- treeModelIterNChildren store Nothing- when (n /= 0) $ do- (cl, _) <- treeViewGetCursor tree- case cl of+ Just store <- treeViewGetModel tree+ n <- treeModelIterNChildren store Nothing+ when (n /= 0) $ do+ indices <- treeViewGetCursor tree >>= \case+ (Just path, _) ->+ treePathGetIndices' path >>= \case (current:_) -> let next = if current == 0 then n - 1 else current - 1- in treeViewSetCursor tree [min (n-1) next] Nothing- [] -> treeViewSetCursor tree [n-1] Nothing+ in return [min (n-1) next]+ [] -> return [1]+ _ -> return [1]+ p <- treePathNewFromIndices' indices+ treeViewSetCursor tree p noTreeViewColumn False -- | Initiate Filpper , If True moves down, if false up initFlipper :: Bool -> IDEAction@@ -96,39 +118,38 @@ mainWindow <- getMainWindow recentPanes' <- recentSourceBuffers (tree', store') <- reifyIDE $ \ideR -> do- window <- windowNewPopup+ window <- windowNew WindowTypePopup (_, height) <- windowGetSize mainWindow- set window [- windowTypeHint := WindowTypeHintUtility,- windowDecorated := False,- windowResizable := True,- windowDefaultWidth := 200,- windowDefaultHeight := height,- windowTransientFor := mainWindow]+ setWindowTypeHint window WindowTypeHintUtility+ setWindowDecorated window False+ setWindowResizable window True+ setWindowDefaultWidth window 200+ setWindowDefaultHeight window height+ setWindowTransientFor window mainWindow - scrolledWindow <- scrolledWindowNew Nothing Nothing+ scrolledWindow <- scrolledWindowNew noAdjustment noAdjustment containerAdd window scrolledWindow tree <- treeViewNew containerAdd scrolledWindow tree - store <- listStoreNew recentPanes'- treeViewSetModel tree store+ store <- seqStoreNew recentPanes'+ treeViewSetModel tree (Just store) column <- treeViewColumnNew _ <- treeViewAppendColumn tree column renderer <- cellRendererTextNew treeViewColumnPackStart column renderer True- cellLayoutSetAttributes column renderer store- (\str -> [ cellText := str])+ cellLayoutSetDataFunction column renderer store $+ setCellRendererTextText renderer - set tree [treeViewHeadersVisible := False]+ setTreeViewHeadersVisible tree False - cid <- mainWindow `on` keyReleaseEvent $ handleKeyRelease tree ideR+ cid <- onWidgetKeyReleaseEvent mainWindow (handleKeyRelease tree ideR) - _ <- tree `on` rowActivated $ \treePath _column -> do- signalDisconnect cid- let [row] = treePath- string <- listStoreGetValue store row+ _ <- onTreeViewRowActivated tree (\treePath _column -> do+ signalHandlerDisconnect mainWindow cid+ [row] <- treePathGetIndices' treePath+ string <- seqStoreGetValue store row reflectIDE (do mbPane <- mbPaneFromName string case mbPane of@@ -139,14 +160,14 @@ Nothing -> return ()) ideR widgetHide window widgetDestroy window- reflectIDE (modifyIDE_ (\ide -> ide{currentState = IsRunning})) ideR+ reflectIDE (modifyIDE_ (\ide -> ide{currentState = IsRunning})) ideR) treeSelection <- treeViewGetSelection tree- _ <- treeSelection `on` treeSelectionSelectionChanged $ do- rows <- treeSelectionGetSelectedRows treeSelection+ _ <- onTreeSelectionChanged treeSelection $ do+ rows <- treeSelectionGetSelectedRows' treeSelection >>= mapM treePathGetIndices' case rows of [[row]] -> do- string <- listStoreGetValue store row+ string <- seqStoreGetValue store row reflectIDE (do mbPane <- mbPaneFromName string case mbPane of@@ -154,29 +175,30 @@ Nothing -> return ()) ideR _ -> return () - set window [windowWindowPosition := WinPosCenterOnParent]+ setWindowWindowPosition window WindowPositionCenterOnParent widgetShowAll window return (tree, store) modifyIDE_ (\ide -> ide{currentState = IsFlipping tree'})- liftIO $ do- -- This is done after currentState is set so we know not to update the- -- previous panes list- n <- treeModelIterNChildren store' Nothing- treeViewSetCursor tree' [if direction then min 1 (n - 1) else n - 1] Nothing- return ()+ -- This is done after currentState is set so we know not to update the+ -- previous panes list+ n <- treeModelIterNChildren store' Nothing+ p <- treePathNewFromIndices' [if direction then min 1 (n - 1) else n - 1]+ treeViewSetCursor tree' p noTreeViewColumn False -handleKeyRelease :: TreeViewClass alpha => alpha -> IDERef -> EventM EKey Bool-handleKeyRelease tree ideR = do- name <- eventKeyName- Gtk.liftIO $ case name of- ctrl | (ctrl == "Control_L") || (ctrl == "Control_R") -> do+handleKeyRelease :: IsTreeView alpha => alpha -> IDERef -> EventKey -> IO Bool+handleKeyRelease tree ideR e = do+ name <- getEventKeyKeyval e >>= keyvalName+ case name of+ Just ctrl | (ctrl == "Control_L") || (ctrl == "Control_R") -> do currentState' <- reflectIDE (readIDE currentState) ideR case currentState' of- IsFlipping _tv -> do- (treePath, _) <- treeViewGetCursor tree- Just column <- treeViewGetColumn tree 0- treeViewRowActivated tree treePath column- return False+ IsFlipping _tv ->+ treeViewGetCursor tree >>= \case+ (Just treePath, _) -> do+ Just column <- treeViewGetColumn tree 0+ treeViewRowActivated tree treePath column+ return False+ _ -> return False _ -> return False _ -> return False
src/IDE/OSX.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.OSX@@ -22,61 +24,74 @@ , allowFullscreen ) where -import Graphics.UI.Gtk+import Control.Monad.IO.Class (MonadIO(..))+import GI.Gdk.Objects.Window (IsWindow)+import GI.Gtk.Objects.UIManager (uIManagerGetWidget, UIManager(..)) import IDE.Core.State #if defined(darwin_HOST_OS) -import Control.Monad.Reader (liftIO) import Control.Monad.Reader.Class (ask)-import Graphics.UI.Gtk.OSX import IDE.Command (canQuit) import Data.Text (Text)+import GI.GtkosxApplication+ (Application(..), applicationReady,+ applicationSetUseQuartzAccelerators,+ onApplicationNSApplicationBlockTermination,+ applicationInsertAppMenuItem, applicationSetMenuBar, Application)+import GI.Gtk.Objects.Widget (widgetHide)+import Data.GI.Base (unsafeCastTo, new')+import GI.Gtk.Objects.MenuShell (MenuShell(..))+import GI.Gtk.Objects.MenuItem (MenuItem(..))+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import Control.Monad.IO.Class (MonadIO)+import Data.GI.Base.BasicTypes (NullToNothing(..)) +applicationNew :: MonadIO m => m Application+applicationNew = new' Application []+ updateMenu :: Application -> UIManager -> IDEM () updateMenu app uiManager = do ideR <- ask- liftIO $ do- mbMenu <- uiManagerGetWidget uiManager ("/ui/menubar" :: Text)- case mbMenu of- Just menu -> do- widgetHide menu- applicationSetMenuBar app (castToMenuShell menu)- Nothing -> return ()+ uIManagerGetWidget uiManager "/ui/menubar" >>= mapM (liftIO . unsafeCastTo MenuShell) >>= \case+ Just menu -> do+ widgetHide menu+ applicationSetMenuBar app menu+ Nothing -> return () - mbQuit <- uiManagerGetWidget uiManager ("/ui/menubar/_File/_Quit" :: Text)- case mbQuit of- Just quit -> widgetHide quit- Nothing -> return ()+ uIManagerGetWidget uiManager "/ui/menubar/_File/_Quit" >>= \case+ Just quit -> widgetHide quit+ Nothing -> return () - mbAbout <- uiManagerGetWidget uiManager ("/ui/menubar/_Help/_About" :: Text)- case mbAbout of- Just about -> do- applicationInsertAppMenuItem app (castToMenuItem about) 0- sep <- separatorMenuItemNew- applicationInsertAppMenuItem app sep 1- Nothing -> return ()+ uIManagerGetWidget uiManager "/ui/menubar/_Help/_About" >>= mapM (liftIO . unsafeCastTo MenuItem) >>= \case+ Just about -> do+ applicationInsertAppMenuItem app about 0+ sep <- separatorMenuItemNew+ applicationInsertAppMenuItem app sep 1+ Nothing -> return () - mbPrefs <- uiManagerGetWidget uiManager ("/ui/menubar/_Tools/_Preferences" :: Text)- case mbPrefs of- Just prefs -> do- applicationInsertAppMenuItem app (castToMenuItem prefs) 2- Nothing -> return ()+ uIManagerGetWidget uiManager "/ui/menubar/_Tools/_Preferences" >>= mapM (liftIO . unsafeCastTo MenuItem) >>= \case+ Just prefs -> do+ applicationInsertAppMenuItem app prefs 2+ Nothing -> return () - app `on` blockTermination $ reflectIDE (fmap not canQuit) ideR+ onApplicationNSApplicationBlockTermination app $ reflectIDE (fmap not canQuit) ideR - applicationSetUseQuartsAccelerators app True+ applicationSetUseQuartzAccelerators app True +allowFullscreen :: IsWindow window => window -> IO ()+allowFullscreen _ = return ()+ #else data Application = Application-applicationNew :: IO Application+applicationNew :: MonadIO m => m Application applicationNew = return Application updateMenu :: Application -> UIManager -> IDEM () updateMenu _ _ = return ()-applicationReady :: Application -> IO ()+applicationReady :: MonadIO m => Application -> m () applicationReady _ = return ()-allowFullscreen :: DrawWindowClass window => window -> IO ()+allowFullscreen :: MonadIO m => IsWindow window => window -> m () allowFullscreen _ = return () #endif
src/IDE/Package.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Package@@ -27,17 +29,17 @@ , packageClean , packageClean' , packageCopy-, packageCopy'+, packageInstall+, packageInstall' , packageRun , packageRunJavaScript , activatePackage , deactivatePackage -, packageInstallDependencies-, packageRegister-, packageRegister' , packageTest , packageTest'+, packageBench+, packageBench' , packageSdist , packageOpenDoc @@ -49,7 +51,9 @@ , delModuleFromPackageDescr , backgroundBuildToggled+, makeDocsToggled , runUnitTestsToggled+, runBenchmarksToggled , makeModeToggled , debugStart@@ -64,12 +68,12 @@ , choosePackageFile -, idePackageFromPath-, refreshPackage+, idePackageFromPath'+, ideProjectFromPath+, writeGenericPackageDescription' ) where -import Graphics.UI.Gtk import Distribution.Package hiding (depends,packageId) import Distribution.PackageDescription import Distribution.PackageDescription.Parse@@ -78,25 +82,30 @@ import System.FilePath import Control.Concurrent import System.Directory- (canonicalizePath, setCurrentDirectory, doesFileExist,- getDirectoryContents, doesDirectoryExist)+ (removeDirectoryRecursive, canonicalizePath, setCurrentDirectory,+ doesFileExist, getDirectoryContents, doesDirectoryExist) import Prelude hiding (catch)+import Data.Char (isSpace) import Data.Maybe- (mapMaybe, listToMaybe, fromMaybe, isNothing, isJust, fromJust,- catMaybes)+ (maybeToList, mapMaybe, listToMaybe, fromMaybe, isNothing, isJust,+ fromJust, catMaybes)+import Data.Function (on) import Control.Exception (SomeException(..), catch) import IDE.Core.State import IDE.Utils.GUIUtils+import IDE.Utils.CabalUtils (writeGenericPackageDescription') import IDE.Pane.Log import IDE.Pane.PackageEditor import IDE.Pane.SourceBuffer import IDE.Pane.PackageFlags (writeFlags, readFlags) import Distribution.Text (display)-import IDE.Utils.FileUtils(getConfigFilePathForLoad)+import IDE.Utils.FileUtils+ (cabalProjectBuildDir, getConfigFilePathForLoad, getPackageDBs') import IDE.LogRef import Distribution.ModuleName (ModuleName(..))-import Data.List (isInfixOf, nub, foldl', delete, find)+import Data.List+ (intercalate, isInfixOf, nub, foldl', delete, find) import IDE.Utils.Tool (ToolOutput(..), runTool, newGhci, ToolState(..), toolline, ProcessHandle, executeGhciCommand) import qualified Data.Set as Set (fromList) import qualified Data.Map as Map (empty, fromList)@@ -110,7 +119,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad (void, when, unless, liftM, forM, forM_) import Distribution.PackageDescription.PrettyPrint- (writeGenericPackageDescription)+ (showGenericPackageDescription) import Debug.Trace (trace) import IDE.Pane.WebKit.Documentation (getDocumentation, loadDoc, reloadDoc)@@ -118,8 +127,8 @@ import System.Log.Logger (debugM) import System.Process.Vado (getMountPoint, vado, readSettings) import qualified Data.Text as T- (lines, isPrefixOf, stripPrefix, replace, unwords, takeWhile, pack,- unpack, isInfixOf)+ (reverse, all, null, dropWhile, lines, isPrefixOf, stripPrefix,+ replace, unwords, takeWhile, pack, unpack, isInfixOf) import IDE.Utils.ExternalTool (runExternalTool', runExternalTool, isRunning, interruptBuild) import Text.PrinterParser (writeFields) import Data.Text (Text)@@ -127,7 +136,43 @@ import qualified Data.Text.IO as T (readFile) import qualified Text.Printf as S (printf) import Text.Printf (PrintfType)+import IDE.Metainfo.Provider (updateSystemInfo)+import GI.GLib.Functions (timeoutAdd)+import GI.GLib.Constants (pattern PRIORITY_DEFAULT, pattern PRIORITY_LOW)+import GI.Gtk.Objects.MessageDialog+ (setMessageDialogText, constructMessageDialogButtons, setMessageDialogMessageType,+ MessageDialog(..))+import GI.Gtk.Objects.Dialog (constructDialogUseHeaderBar)+import GI.Gtk.Enums+ (WindowPosition(..), ResponseType(..), ButtonsType(..),+ MessageType(..))+import GI.Gtk.Objects.Window+ (setWindowWindowPosition, windowSetTransientFor)+import Graphics.UI.Editor.Parameters+ (dialogRun', dialogSetDefaultResponse', dialogAddButton')+import Data.GI.Base (set, new')+import GI.Gtk.Objects.Widget (widgetDestroy)+import IDE.Utils.VersionUtils (getDefaultGhcVersion)+import IDE.Utils.CabalProject (getCabalProjectPackages)+import System.Environment (getEnvironment)+import Distribution.Simple.LocalBuildInfo+ (Component(..), Component)+import Distribution.Simple.Utils (writeUTF8File)+#if MIN_VERSION_Cabal(2,0,0)+import Distribution.Types.ForeignLib (foreignLibName)+import Distribution.Types.UnqualComponentName+ (UnqualComponentName(..), mkUnqualComponentName,+ unUnqualComponentName)+#endif +#if !MIN_VERSION_Cabal(2,0,0)+type UnqualComponentName = String+mkUnqualComponentName :: String -> UnqualComponentName+mkUnqualComponentName = id+unUnqualComponentName :: UnqualComponentName -> String+unUnqualComponentName = id+#endif+ printf :: PrintfType r => Text -> r printf = S.printf . T.unpack @@ -140,16 +185,19 @@ myLibModules pd = case library pd of Nothing -> []+#if MIN_VERSION_Cabal(2,0,0)+ Just l -> moduleInfo libBuildInfo explicitLibModules l+#else Just l -> moduleInfo libBuildInfo libModules l+#endif myExeModules pd = concatMap (moduleInfo buildInfo exeModules) (executables pd) myTestModules pd = concatMap (moduleInfo testBuildInfo (otherModules . testBuildInfo)) (testSuites pd) myBenchmarkModules pd = concatMap (moduleInfo benchmarkBuildInfo (otherModules . benchmarkBuildInfo)) (benchmarks pd) -activatePackage :: Maybe FilePath -> Maybe IDEPackage -> Maybe Text -> IDEM ()-activatePackage mbPath mbPack mbExe = do- liftIO $ debugM "leksah" "activatePackage"+activatePackage :: MonadIDE m => Maybe FilePath -> Maybe Project -> Maybe IDEPackage -> Maybe Text -> m ()+activatePackage mbPath mbProject mbPack mbComponent = do+ liftIO $ debugM "leksah" $ "activatePackage " <> show (mbPath, pjFile <$> mbProject, ipdCabalFile <$> mbPack, mbComponent) oldActivePack <- readIDE activePack- modifyIDE_ (\ide -> ide{activePack = mbPack, activeExe = mbExe}) case mbPath of Just p -> liftIO $ setCurrentDirectory (dropFileName p) Nothing -> return ()@@ -168,7 +216,7 @@ return () deactivatePackage :: IDEAction-deactivatePackage = activatePackage Nothing Nothing Nothing+deactivatePackage = activatePackage Nothing Nothing Nothing Nothing interruptSaveAndRun :: MonadIDE m => IDEAction -> m () interruptSaveAndRun action = do@@ -178,11 +226,11 @@ then do liftIO $ debugM "leksah" "interruptSaveAndRun" interruptBuild- liftIO $ timeoutAddFull (do+ timeoutAdd PRIORITY_DEFAULT 200 (do reflectIDE (do interruptSaveAndRun action return False) ideR- return False) priorityDefault 200+ return False) return () else liftIDE run where@@ -193,73 +241,81 @@ packageConfig :: PackageAction packageConfig = do+ project <- lift ask package <- ask- interruptSaveAndRun $ packageConfig' package (\ _ -> return ())+ interruptSaveAndRun $ packageConfig' (project, package) (\ _ -> return ()) -packageConfig' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction-packageConfig' package continuation = do+packageConfig' :: (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageConfig' (project, package) continuation = do prefs <- readIDE prefs- let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- if useStack- then ideMessage Normal (__ "Leksah is not running \"cabal configure\" because a stack.yaml file was found.")- else do+ case pjTool project of+ StackTool -> do+ ideMessage Normal (__ "Stack projects do not require configuration.")+ liftIDE $ continuation True+ CabalTool -> do logLaunch <- getDefaultLogLaunch showDefaultLogLaunch' + let dir = ipdPackageDir package runExternalTool' (__ "Configuring")- (cabalCommand prefs)- ("configure" : ipdConfigFlags package)- dir $ do+ "cabal"+ ("new-configure" : ipdConfigFlags package)+ dir Nothing $ do mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch)- lift $ do- mbPack <- idePackageFromPath (logOutput logLaunch) (ipdCabalFile package)- case mbPack of- Just pack -> do- changePackage pack- triggerEventIDE $ WorkspaceChanged False True- continuation (mbLastOutput == Just (ToolExit ExitSuccess))- return ()- Nothing -> do- postAsyncIDE $ ideMessage Normal (__ "Can't read package file")- continuation False- return()+ lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)) -runCabalBuild :: Bool -> Bool -> Bool -> IDEPackage -> Bool -> (Bool -> IDEAction) -> IDEAction-runCabalBuild backgroundBuild jumpToWarnings withoutLinking package shallConfigure continuation = do+runCabalBuild :: Bool -> Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+runCabalBuild backgroundBuild jumpToWarnings withoutLinking (project, package) continuation = do prefs <- readIDE prefs- let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- let args = ["build"]- ++ ["--with-ld=false" | not useStack && backgroundBuild && withoutLinking]- ++ (if useStack && runUnitTests prefs then ["--test", "--haddock"] else [])+ pd <- liftIO $ fmap flattenPackageDescription+ (readPackageDescription normal (ipdCabalFile package))+ let dir = ipdPackageDir package+ pkgName = ipdPackageName package++ isActiveProject <- maybe False (on (==) pjFile project) <$> readIDE activeProject+ isActivePackage <- (isActiveProject &&) . maybe False (on (==) ipdCabalFile package) <$> readIDE activePack+ mbActiveComponent <- readIDE activeComponent+ let flagsForTests =+ if "--enable-tests" `elem` ipdConfigFlags package+ then case pjTool project of+ StackTool -> ["--test", "--no-run-tests"] -- if we use stack, with tests enabled, we build the tests without running them+ CabalTool -> map (\t -> pkgName <> ":test:" <> T.pack (unUnqualComponentName $ testName t)) $ testSuites pd+ else []+ let flagsForBenchmarks =+ if "--enable-benchmarks" `elem` ipdConfigFlags package+ then case pjTool project of+ StackTool -> ["--bench", "--no-run-benchmarks"] -- if we use stack, with benchmarks enabled, we build the benchmarks without running them+ CabalTool -> map (\t -> pkgName <> ":benchmark:" <> T.pack (unUnqualComponentName $ benchmarkName t)) $ benchmarks pd+ else []+ let args = -- stack needs the package name to actually print the output info+ (case pjTool project of+ StackTool -> ["build", "--stack-yaml", T.pack (makeRelative dir $ pjFile project), ipdPackageName package]+ CabalTool -> ["new-build", "--project-file", T.pack (makeRelative dir $ pjFile project)])+ ++ ["--with-ld=false" | pjTool project == CabalTool && backgroundBuild && withoutLinking]+ ++ (if isActivePackage then maybeToList mbActiveComponent else [])+ ++ flagsForTests+ ++ flagsForBenchmarks ++ ipdBuildFlags package- runExternalTool' (__ "Building") (if useStack then "stack" else cabalCommand prefs) args dir $ do- (mbLastOutput, isConfigErr, _) <- C.getZipSink $ (,,)+ runExternalTool' (__ "Building") (pjToolCommand project) args dir Nothing $ do+ (mbLastOutput, _) <- C.getZipSink $ (,) <$> C.ZipSink sinkLast- <*> C.ZipSink isConfigError- <*> (C.ZipSink $ logOutputForBuild package backgroundBuild jumpToWarnings)+ <*> (C.ZipSink $ logOutputForBuild project package backgroundBuild jumpToWarnings) lift $ do errs <- readIDE errorRefs- if shallConfigure && isConfigErr- then- packageConfig' package (\ b ->- when b $ runCabalBuild backgroundBuild jumpToWarnings withoutLinking package False continuation)- else do- continuation (mbLastOutput == Just (ToolExit ExitSuccess))- return ()+ continuation (mbLastOutput == Just (ToolExit ExitSuccess)) -isConfigError :: Monad m => C.Sink ToolOutput m Bool-isConfigError = CL.foldM (\a b -> return $ a || isCErr b) False- where- isCErr (ToolError str) = str1 `T.isInfixOf` str || str2 `T.isInfixOf` str || str3 `T.isInfixOf` str- isCErr _ = False- str1 = __ "Run the 'configure' command first"- str2 = __ "please re-configure"- str3 = __ "cannot satisfy -package-id"+--isConfigError :: Monad m => C.Sink ToolOutput m Bool+--isConfigError = CL.foldM (\a b -> return $ a || isCErr b) False+-- where+-- isCErr (ToolError str) = str1 `T.isInfixOf` str || str2 `T.isInfixOf` str || str3 `T.isInfixOf` str+-- isCErr _ = False+-- str1 = __ "Run the 'configure' command first"+-- str2 = __ "please re-configure"+-- str3 = __ "cannot satisfy -package-id" -buildPackage :: Bool -> Bool -> Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction-buildPackage backgroundBuild jumpToWarnings withoutLinking package continuation = catchIDE (do+buildPackage :: Bool -> Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+buildPackage backgroundBuild jumpToWarnings withoutLinking (project, package) continuation = catchIDE (do+ liftIO $ debugM "leksah" "buildPackage" ideR <- ask prefs <- readIDE prefs maybeDebug <- readIDE debugState@@ -270,17 +326,21 @@ then do liftIO $ debugM "leksah" "buildPackage interruptBuild" interruptBuild- unless backgroundBuild . liftIO $ do- timeoutAddFull (do- reflectIDE (do- buildPackage backgroundBuild jumpToWarnings withoutLinking- package continuation- return False) ideR- return False) priorityDefault 100- return ()+ timeoutAdd PRIORITY_DEFAULT 100 (do+ reflectIDE (do+ if backgroundBuild+ then do+ tb <- readIDE triggerBuild+ void . liftIO $ tryPutMVar tb ()+ else do+ buildPackage backgroundBuild jumpToWarnings withoutLinking+ (project, package) continuation+ return False) ideR+ return False)+ return () else do when (saveAllBeforeBuild prefs) . liftIDE . void $ fileSaveAll belongsToWorkspace'- runCabalBuild backgroundBuild jumpToWarnings withoutLinking package True $ \f -> do+ runCabalBuild backgroundBuild jumpToWarnings withoutLinking (project, package) $ \f -> do when f $ do mbURI <- readIDE autoURI case mbURI of@@ -290,58 +350,84 @@ Just debug@(_, ghci) -> do -- TODO check debug package matches active package ready <- liftIO $ isEmptyMVar (currentToolCommand ghci)- when ready $ do- let dir = ipdPackageDir package- when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace'; return ())- (`runDebug` debug) . executeDebugCommand ":reload" $ do- errs <- logOutputForBuild package backgroundBuild jumpToWarnings- unless (any isError errs) $ do- cmd <- lift $ readIDE autoCommand- liftIO . postGUISync $ reflectIDE cmd ideR- lift $ continuation True+ if ready+ then do+ let dir = ipdPackageDir package+ when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace'; return ())+ (`runDebug` debug) . executeDebugCommand ":reload" $ do+ errs <- logOutputForBuild project package backgroundBuild jumpToWarnings+ unless (any isError errs) . lift $ do+ cmd <- readIDE autoCommand+ postSyncIDE cmd+ continuation True+ else do+ timeoutAdd PRIORITY_LOW 500 (do+ reflectIDE (do+ tb <- readIDE triggerBuild+ void . liftIO $ tryPutMVar tb ()+ return False) ideR+ return False)+ return () ) (\(e :: SomeException) -> sysMessage Normal (T.pack $ show e)) packageDoc :: PackageAction packageDoc = do+ project <- lift ask package <- ask- interruptSaveAndRun $ packageDoc' False True package (\ _ -> return ())+ interruptSaveAndRun $ packageDoc' False True (project, package) (\ _ -> return ()) -packageDoc' :: Bool -> Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction-packageDoc' backgroundBuild jumpToWarnings package continuation = do+packageDoc' :: Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageDoc' backgroundBuild jumpToWarnings (project, package) continuation = do prefs <- readIDE prefs catchIDE (do let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- if useStack- then continuation True- else- runExternalTool' (__ "Documenting") (cabalCommand prefs) ("haddock" : ipdHaddockFlags package) dir $ do- mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $- logOutputForBuild package backgroundBuild jumpToWarnings)- lift $ postAsyncIDE reloadDoc- lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)))+ flags <- case pjTool project of+ StackTool -> return ["haddock", "--no-haddock-deps"]+ CabalTool -> do+ (buildDir, _) <- liftIO $ cabalProjectBuildDir (pjDir project)+ return+ [ "act-as-setup"+ , "--"+ , "haddock"+ , T.pack ("--builddir=" <> (buildDir </>+ T.unpack (packageIdentifierToString $ ipdPackageId package)))]+ runExternalTool' (__ "Documenting") (pjToolCommand project)+ (flags <> ipdHaddockFlags package) dir Nothing $ do+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $+ logOutputForBuild project package backgroundBuild jumpToWarnings)+ lift $ postAsyncIDE reloadDoc+ lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> print e) packageClean :: PackageAction packageClean = do+ project <- lift ask package <- ask- interruptSaveAndRun $ packageClean' package (\ _ -> return ())+ interruptSaveAndRun $ packageClean' (project, package) (\ _ -> return ()) -packageClean' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction-packageClean' package continuation = do- prefs <- readIDE prefs+packageClean' :: (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageClean' (project, package) continuation = do logLaunch <- getDefaultLogLaunch showDefaultLogLaunch' let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- runExternalTool' (__ "Cleaning")- (if useStack then "stack" else cabalCommand prefs)- ["clean"]- dir $ do- mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch)- lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))+ projectRoot = pjDir project+ case pjTool project of+ CabalTool -> do+ (buildDir, _) <- liftIO $ cabalProjectBuildDir (pjDir project)+ let packageBuildDir = buildDir+ </> T.unpack (packageIdentifierToString $ ipdPackageId package)+ liftIO $ doesDirectoryExist packageBuildDir >>= \case+ True -> removeDirectoryRecursive packageBuildDir+ False -> return ()+ StackTool ->+ runExternalTool' (__ "Cleaning")+ (pjToolCommand project)+ ["clean"]+ dir Nothing $ do+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch)+ lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)) packageCopy :: PackageAction packageCopy = do@@ -359,223 +445,293 @@ Just fp -> do let dir = ipdPackageDir package runExternalTool' (__ "Copying")- (cabalCommand prefs)+ "cabal" ["copy", "--destdir=" <> T.pack fp]- dir+ dir Nothing (logOutput logLaunch)) (\(e :: SomeException) -> print e) -packageInstallDependencies :: PackageAction-packageInstallDependencies = do+packageInstall :: PackageAction+packageInstall = do+ project <- lift ask package <- ask- interruptSaveAndRun $ do- logLaunch <- getDefaultLogLaunch- showDefaultLogLaunch'-- catchIDE (do- prefs <- readIDE prefs- let dir = ipdPackageDir package- runExternalTool' (__ "Installing") (cabalCommand prefs) (- (if useCabalDev prefs- then ["install-deps"]- else ["install","--only-dependencies"])- ++ ipdConfigFlags package- ++ ipdInstallFlags package) dir (logOutput logLaunch))- (\(e :: SomeException) -> print e)+ interruptSaveAndRun $ packageInstall' (project, package) (\ _ -> return ()) -packageCopy' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction-packageCopy' package continuation = do+packageInstall' :: (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageInstall' (project, package) continuation = do prefs <- readIDE prefs logLaunch <- getDefaultLogLaunch showDefaultLogLaunch' catchIDE (do let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- runExternalTool' (__ "Copying")- (if useStack then "stack" else cabalCommand prefs)- ((if useStack then ("install" : ipdBuildFlags package) else ["copy"]) ++ ipdInstallFlags package)- dir $ do+ runExternalTool' (__ "Installing")+ (case pjTool project of+ StackTool -> "stack"+ CabalTool -> "echo" {-cabalCommand prefs-})+ ((case pjTool project of+ StackTool -> "install" : "--stack-yaml" : T.pack (makeRelative dir $ pjFile project) : ipdBuildFlags package+ CabalTool -> ["TODO run cabal new-install"]) ++ ipdInstallFlags package)+ dir Nothing $ do mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch) lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> print e) packageRun :: PackageAction-packageRun = ask >>= (interruptSaveAndRun . packageRun' True)+packageRun = do+ project <- lift ask+ package <- ask+ interruptSaveAndRun $ packageRun' True (project, package) -packageRun' :: Bool -> IDEPackage -> IDEAction-packageRun' removeGhcjsFlagIfPresent package =+packageEnv :: MonadIO m => IDEPackage -> m [(String, String)]+packageEnv package = do+ env <- liftIO getEnvironment+ return $ (T.unpack (ipdPackageName package) <> "_datadir", ipdPackageDir package) : env++packageRun' :: Bool -> (Project, IDEPackage) -> IDEAction+packageRun' removeGhcjsFlagIfPresent (project, package) = if removeGhcjsFlagIfPresent && "--ghcjs" `elem` ipdConfigFlags package then do window <- liftIDE getMainWindow- resp <- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (__ "Package is configured to use GHCJS. Would you like to remove --ghcjs from the configure flags and rebuild?")- dialogAddButton md (__ "Use _GHC") (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "Package is configured to use GHCJS. Would you like to remove --ghcjs from the configure flags and rebuild?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "Use _GHC") (AnotherResponseType 1)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do let packWithNewFlags = package { ipdConfigFlags = filter (/="--ghcjs") $ ipdConfigFlags package } changePackage packWithNewFlags liftIO $ writeFlags (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags- packageConfig' packWithNewFlags $ \ ok -> when ok $- packageRun' False packWithNewFlags+ packageConfig' (project, packWithNewFlags) $ \ ok -> when ok $+ packageRun' False (project, packWithNewFlags) _ -> return () else liftIDE $ catchIDE (do ideR <- ask maybeDebug <- readIDE debugState- pd <- liftIO $ liftM flattenPackageDescription+ pd <- liftIO $ fmap flattenPackageDescription (readPackageDescription normal (ipdCabalFile package))- mbExe <- readIDE activeExe- let exe = take 1 . filter (isActiveExe mbExe) $ executables pd- let defaultLogName = T.pack . display . pkgName $ ipdPackageId package- logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . exeName) exe+ mbComponent <- readIDE activeComponent+ let exe = exeToRun mbComponent $ executables pd+ let defaultLogName = ipdPackageName package+ logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . unUnqualComponentName . exeName) exe (logLaunch,logName) <- buildLogLaunchByName logName showLog case maybeDebug of Nothing -> do+ prefs <- readIDE prefs let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- IDE.Package.runPackage (addLogLaunchData logName logLaunch)- (T.pack $ printf (__ "Running %s") (T.unpack logName))- (if useStack then "stack" else "cabal")- (concat [[if useStack then "exec" else "run"]- , ipdBuildFlags package- , map (T.pack . exeName) exe- , ["--"]- , ipdExeFlags package])- dir- (logOutput logLaunch)+ case pjTool project of+ StackTool -> IDE.Package.runPackage (addLogLaunchData logName logLaunch)+ (T.pack $ printf (__ "Running %s") (T.unpack logName))+ "stack"+ (concat [["exec"]+ , ipdBuildFlags package+ , map (T.pack . unUnqualComponentName . exeName) exe+ , ["--"]+ , ipdExeFlags package])+ dir+ Nothing+ (logOutput logLaunch)+ CabalTool -> do+ (buildDir, cDir) <- liftIO $ cabalProjectBuildDir (pjDir project)+ env <- packageEnv package+ case exe ++ executables pd of+ [] -> return ()+ (Executable {exeName = name} : _) -> do+ let exePath = buildDir+ </> T.unpack (packageIdentifierToString $ ipdPackageId package)+ </> cDir (unUnqualComponentName name) </> unUnqualComponentName name </> unUnqualComponentName name+ IDE.Package.runPackage (addLogLaunchData logName logLaunch)+ (T.pack $ printf (__ "Running %s") (T.unpack logName))+ exePath+ (ipdExeFlags package)+ dir+ (Just env)+ (logOutput logLaunch) Just debug -> -- TODO check debug package matches active package runDebug (do case exe of- [Executable name mainFilePath _] ->+ [Executable {exeName = name, modulePath = mainFilePath}] -> executeDebugCommand (":module *" <> T.pack (map (\c -> if c == '/' then '.' else c) (takeWhile (/= '.') mainFilePath))) (logOutput logLaunch) _ -> return () executeDebugCommand (":main " <> T.unwords (ipdExeFlags package)) (logOutput logLaunch)) debug) (\(e :: SomeException) -> print e)- where- isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) +-- | Is the given executable the active one?+isActiveExe :: Text -> Executable -> Bool+isActiveExe selected Executable {exeName = name} = selected == "exe:" <> T.pack (unUnqualComponentName name)++-- | get executable to run+-- no exe activated, take first one+exeToRun :: Maybe Text -> [Executable] -> [Executable]+exeToRun Nothing (exe:_) = [exe]+exeToRun Nothing _ = []+exeToRun (Just selected) exes = take 1 $ filter (isActiveExe selected) exes+ packageRunJavaScript :: PackageAction-packageRunJavaScript = ask >>= (interruptSaveAndRun . packageRunJavaScript' True)+packageRunJavaScript = do+ project <- lift ask+ package <- ask+ interruptSaveAndRun $ packageRunJavaScript' True (project, package) -packageRunJavaScript' :: Bool -> IDEPackage -> IDEAction-packageRunJavaScript' addFlagIfMissing package =+packageRunJavaScript' :: Bool -> (Project, IDEPackage) -> IDEAction+packageRunJavaScript' addFlagIfMissing (project, package) = if addFlagIfMissing && ("--ghcjs" `notElem` ipdConfigFlags package) then do window <- liftIDE getMainWindow- resp <- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (__ "Package is not configured to use GHCJS. Would you like to add --ghcjs to the configure flags and rebuild?")- dialogAddButton md (__ "Use _GHCJS") (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "Package is not configured to use GHCJS. Would you like to add --ghcjs to the configure flags and rebuild?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "Use _GHCJS") (AnotherResponseType 1)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do let packWithNewFlags = package { ipdConfigFlags = "--ghcjs" : ipdConfigFlags package } changePackage packWithNewFlags liftIO $ writeFlags (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags- packageConfig' packWithNewFlags $ \ ok -> when ok $- packageRunJavaScript' False packWithNewFlags+ packageConfig' (project, packWithNewFlags) $ \ ok -> when ok $+ packageRunJavaScript' False (project, packWithNewFlags) _ -> return ()- else liftIDE $ buildPackage False False True package $ \ ok -> when ok $ liftIDE $ catchIDE (do+ else liftIDE $ buildPackage False False True (project, package) $ \ ok -> when ok $ liftIDE $ catchIDE (do ideR <- ask maybeDebug <- readIDE debugState- pd <- liftIO $ liftM flattenPackageDescription+ pd <- liftIO $ fmap flattenPackageDescription (readPackageDescription normal (ipdCabalFile package))- mbExe <- readIDE activeExe- let exe = take 1 . filter (isActiveExe mbExe) $ executables pd- let defaultLogName = T.pack . display . pkgName $ ipdPackageId package- logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . exeName) exe+ mbComponent <- readIDE activeComponent+ let exe = exeToRun mbComponent $ executables pd+ let defaultLogName = ipdPackageName package+ logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . unUnqualComponentName . exeName) exe (logLaunch,logName) <- buildLogLaunchByName logName let dir = ipdPackageDir package+ projectRoot = pjDir project prefs <- readIDE prefs case exe ++ executables pd of- (Executable name _ _ : _) -> liftIDE $ do- let path = "dist/build" </> name </> name <.> "jsexe" </> "index.html"- dir = ipdPackageDir package-#ifdef WEBKITGTK+ (Executable {exeName = name} : _) -> liftIDE $ do+ (buildDir, cDir) <- liftIO $ cabalProjectBuildDir (pjDir project)+ let path = buildDir+ </> T.unpack (packageIdentifierToString $ ipdPackageId package)+ </> cDir (unUnqualComponentName name) </> unUnqualComponentName name </> unUnqualComponentName name <.> "jsexe" </> "index.html" postAsyncIDE $ do- loadOutputUri ("file:///" ++ dir </> path)+ loadOutputUri ("file:///" ++ path) getOutputPane Nothing >>= \ p -> displayPane p False-#else- openBrowser path-#endif `catchIDE` (\(e :: SomeException) -> print e) _ -> return ()) (\(e :: SomeException) -> print e)- where- isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) -packageRegister :: PackageAction-packageRegister = do+packageTest :: PackageAction+packageTest = do+ project <- lift ask package <- ask- interruptSaveAndRun $ packageRegister' package (\ _ -> return ())+ interruptSaveAndRun $ packageTest' False True (project, package) (\ _ -> return ()) -packageRegister' :: IDEPackage -> (Bool -> IDEAction) -> IDEAction-packageRegister' package continuation =- if ipdHasLibs package+packageTest' :: Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageTest' backgroundBuild jumpToWarnings (project, package) continuation =+ if "--enable-tests" `elem` ipdConfigFlags package then do- logLaunch <- getDefaultLogLaunch- showDefaultLogLaunch'- catchIDE (do- prefs <- readIDE prefs- let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- if useStack- then continuation True- else runExternalTool' (__ "Registering") (cabalCommand prefs) ("register" : ipdRegisterFlags package) dir $ do- mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch)- lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)))- (\(e :: SomeException) -> print e)+ removeTestLogRefs (ipdPackageDir package)+ pd <- liftIO $ fmap flattenPackageDescription+ (readPackageDescription normal (ipdCabalFile package))+ runTests $ testSuites pd else continuation True+ where+ runTests :: [TestSuite] -> IDEAction+ runTests [] = continuation True+ runTests (test:rest) =+ packageRunComponent (CTest test) backgroundBuild jumpToWarnings (project, package) (\ok ->+ when ok $ runTests rest) -packageTest :: PackageAction-packageTest = do+packageRunComponent :: Component -> Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageRunComponent (CLib _) _ _ _ _ = error "packageRunComponent"+packageRunComponent component backgroundBuild jumpToWarnings (project, package) continuation = do+ let name = case component of+ CLib _ -> error "packageRunComponent"+ CExe exe -> exeName exe+ CTest test -> testName test+ CBench bench -> benchmarkName bench+#if MIN_VERSION_Cabal(2,0,0)+ CFLib flib -> foreignLibName flib+#endif+ command = case component of+ CLib _ -> error "packageRunComponent"+ CExe exe -> "run"+ CTest test -> "test"+ CBench bench -> "bench"+#if MIN_VERSION_Cabal(2,0,0)+ CFLib flib -> "flib"+#endif+ dir = ipdPackageDir package+ logLaunch <- getDefaultLogLaunch+ showDefaultLogLaunch'+ catchIDE (do+ prefs <- readIDE prefs+ let projectRoot = pjDir project+ ghcVersion <- liftIO getDefaultGhcVersion+ packageDBs <- liftIO $ getPackageDBs' ghcVersion dir+ let pkgId = packageIdentifierToString $ ipdPackageId package+ pkgName = ipdPackageName package+ args = case pjTool project of+ StackTool -> [command, pkgName <> ":" <> T.pack (unUnqualComponentName name)]+ CabalTool -> []+ (cmd, mbEnv) <- case pjTool project of+ StackTool -> return ("stack", Nothing)+ CabalTool -> do+ (buildDir, cDir) <- liftIO $ cabalProjectBuildDir (pjDir project)+ env <- packageEnv package+ return+ ( buildDir </> T.unpack pkgId </> cDir (unUnqualComponentName name)+ </> unUnqualComponentName name </> unUnqualComponentName name+ , Just $ ("GHC_PACKAGE_PATH", intercalate [searchPathSeparator] packageDBs) : env+ )+ runExternalTool' (__ "Run " <> T.pack (unUnqualComponentName name)) cmd (args+ ++ ipdBuildFlags package ++ ipdTestFlags package) dir mbEnv $ do+ (mbLastOutput, _) <- C.getZipSink $ (,)+ <$> C.ZipSink sinkLast+ <*> (C.ZipSink $ logOutputForBuild project package backgroundBuild jumpToWarnings)+ lift $ do+ errs <- readIDE errorRefs+ when (mbLastOutput == Just (ToolExit ExitSuccess)) $ continuation True)+ (\(e :: SomeException) -> print e)++-- | Run benchmarks as foreground action for current package+packageBench :: PackageAction+packageBench = do+ project <- lift ask package <- ask- interruptSaveAndRun $ packageTest' False True package True (\ _ -> return ())+ interruptSaveAndRun $ packageBench' False True (project, package) (\ _ -> return ()) -packageTest' :: Bool -> Bool -> IDEPackage -> Bool -> (Bool -> IDEAction) -> IDEAction-packageTest' backgroundBuild jumpToWarnings package shallConfigure continuation = do- let dir = ipdPackageDir package- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- if not useStack && "--enable-tests" `elem` ipdConfigFlags package+-- | Run benchmarks+packageBench' :: Bool -> Bool -> (Project, IDEPackage) -> (Bool -> IDEAction) -> IDEAction+packageBench' backgroundBuild jumpToWarnings (project, package) continuation =+ if "--enable-benchmarks" `elem` ipdConfigFlags package then do- logLaunch <- getDefaultLogLaunch- showDefaultLogLaunch'- catchIDE (do- prefs <- readIDE prefs- removeTestLogRefs dir- runExternalTool' (__ "Testing") (cabalCommand prefs) (["test", "--with-ghc=leksahtrue"]- ++ ipdBuildFlags package ++ ipdTestFlags package) dir $ do- (mbLastOutput, isConfigErr, _) <- C.getZipSink $ (,,)- <$> C.ZipSink sinkLast- <*> C.ZipSink isConfigError- <*> (C.ZipSink $ logOutputForBuild package backgroundBuild jumpToWarnings)- lift $ do- errs <- readIDE errorRefs- if shallConfigure && isConfigErr- then- packageConfig' package (\ b ->- when b $ packageTest' backgroundBuild jumpToWarnings package shallConfigure continuation)- else do- continuation (mbLastOutput == Just (ToolExit ExitSuccess))- return ())- (\(e :: SomeException) -> print e)+ pd <- liftIO $ fmap flattenPackageDescription+ (readPackageDescription normal (ipdCabalFile package))+ runBenchs $ benchmarks pd else continuation True+ where+ runBenchs :: [Benchmark] -> IDEAction+ runBenchs [] = continuation True+ runBenchs (bench:rest) =+ packageRunComponent (CBench bench) backgroundBuild jumpToWarnings (project, package) (\ok ->+ when ok $ runBenchs rest) packageSdist :: PackageAction packageSdist = do@@ -587,29 +743,43 @@ catchIDE (do prefs <- readIDE prefs let dir = ipdPackageDir package- runExternalTool' (__ "Source Dist") (cabalCommand prefs) ("sdist" : ipdSdistFlags package) dir (logOutput logLaunch))+ runExternalTool' (__ "Source Dist") "cabal" ("sdist" : ipdSdistFlags package) dir Nothing (logOutput logLaunch)) (\(e :: SomeException) -> print e) +-- | Open generated documentation for package packageOpenDoc :: PackageAction packageOpenDoc = do+ project <- lift ask package <- ask-+ let dir = ipdPackageDir package+ pkgId = packageIdentifierToString $ ipdPackageId package+ projectRoot = pjDir project+ distDir <- case pjTool project of+ StackTool -> do+ --ask stack where its dist directory is+ mvar <- liftIO newEmptyMVar+ runExternalTool' "" "stack" ["path"] dir Nothing $ do+ output <- CL.consume+ liftIO . putMVar mvar $ head $ mapMaybe getDistOutput output+ liftIO $ takeMVar mvar+ CabalTool -> do+ (buildDir, _) <- liftIO $ cabalProjectBuildDir (pjDir project)+ return $ buildDir </> T.unpack pkgId liftIDE $ do prefs <- readIDE prefs- let path = ipdPackageDir package- </> "dist/doc/html"- </> display (pkgName (ipdPackageId package))+ let path = dir </> distDir+ </> "doc/html"+ </> T.unpack (ipdPackageName package) </> "index.html"- dir = ipdPackageDir package-#ifdef WEBKITGTK- loadDoc . T.pack $ "file:///" ++ dir </> path+ loadDoc . T.pack $ "file://" ++ path getDocumentation Nothing >>= \ p -> displayPane p False-#else- openBrowser $ T.pack path-#endif `catchIDE` (\(e :: SomeException) -> print e)+ where+ -- get dist directory from stack path output+ getDistOutput (ToolOutput o) | Just t<-T.stripPrefix "dist-dir:" o = Just $ dropWhile isSpace $ T.unpack t+ getDistOutput _ = Nothing runPackage :: (ProcessHandle -> IDEAction)@@ -617,6 +787,7 @@ -> FilePath -> [Text] -> FilePath+ -> Maybe [(String,String)] -> C.Sink ToolOutput IDEM () -> IDEAction runPackage = runExternalTool (return True) -- TODO here one could check if package to be run is building/configuring/etc atm@@ -671,7 +842,7 @@ liftIDE $ reifyIDE (\ideR -> catch (do gpd <- readPackageDescription normal (ipdCabalFile p) let npd = trace (show gpd) foldr addModule gpd locations- writeGenericPackageDescription (ipdCabalFile p) npd)+ writeGenericPackageDescription' (ipdCabalFile p) npd) (\(e :: SomeException) -> do reflectIDE (ideMessage Normal (__ "Can't update package " <> T.pack (show e))) ideR return ()))@@ -680,7 +851,7 @@ gpd {condLibrary = Just (addModToLib moduleName lib)} addModule LibOtherMod gpd@GenericPackageDescription{condLibrary = Just lib} = gpd {condLibrary = Just (addModToBuildInfoLib moduleName lib)}- addModule (ExeOrTestMod name') gpd = let name = T.unpack name' in gpd {+ addModule (ExeOrTestMod name') gpd = let name = mkUnqualComponentName (T.unpack name') in gpd { condExecutables = map (addModToBuildInfoExe name moduleName) (condExecutables gpd) , condTestSuites = map (addModToBuildInfoTest name moduleName) (condTestSuites gpd) }@@ -697,15 +868,15 @@ ct{condTreeData = lib{libBuildInfo = (libBuildInfo lib){otherModules = modName `inOrderAdd` otherModules (libBuildInfo lib)}}} -addModToBuildInfoExe :: String -> ModuleName -> (String, CondTree ConfVar [Dependency] Executable) ->- (String, CondTree ConfVar [Dependency] Executable)+addModToBuildInfoExe :: UnqualComponentName -> ModuleName -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable) ->+ (UnqualComponentName, CondTree ConfVar [Dependency] Executable) addModToBuildInfoExe name modName (str,ct@CondNode{condTreeData = exe}) | str == name = (str, ct{condTreeData = exe{buildInfo = (buildInfo exe){otherModules = modName `inOrderAdd` otherModules (buildInfo exe)}}}) addModToBuildInfoExe name _ x = x -addModToBuildInfoTest :: String -> ModuleName -> (String, CondTree ConfVar [Dependency] TestSuite) ->- (String, CondTree ConfVar [Dependency] TestSuite)+addModToBuildInfoTest :: UnqualComponentName -> ModuleName -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite) ->+ (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite) addModToBuildInfoTest name modName (str,ct@CondNode{condTreeData = test}) | str == name = (str, ct{condTreeData = test{testBuildInfo = (testBuildInfo test){otherModules = modName `inOrderAdd` otherModules (testBuildInfo test)}}})@@ -734,7 +905,7 @@ (fromJust (condLibrary gpd))), condExecutables = map (delModFromBuildInfoExe moduleName) (condExecutables gpd)}- writeGenericPackageDescription (ipdCabalFile p) npd)+ writeGenericPackageDescription' (ipdCabalFile p) npd) (\(e :: SomeException) -> do reflectIDE (ideMessage Normal (__ "Can't update package " <> T.pack (show e))) ideR return ()))@@ -750,8 +921,8 @@ ct{condTreeData = lib{libBuildInfo = (libBuildInfo lib){otherModules = delete modName (otherModules (libBuildInfo lib))}}} -delModFromBuildInfoExe :: ModuleName -> (String, CondTree ConfVar [Dependency] Executable) ->- (String, CondTree ConfVar [Dependency] Executable)+delModFromBuildInfoExe :: ModuleName -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable) ->+ (UnqualComponentName, CondTree ConfVar [Dependency] Executable) delModFromBuildInfoExe modName (str,ct@CondNode{condTreeData = exe}) = (str, ct{condTreeData = exe{buildInfo = (buildInfo exe){otherModules = delete modName (otherModules (buildInfo exe))}}})@@ -763,17 +934,27 @@ backgroundBuildToggled :: IDEAction backgroundBuildToggled = do toggled <- getBackgroundBuildToggled- modifyIDE_ (\ide -> ide{prefs = (prefs ide){backgroundBuild= toggled}})+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){backgroundBuild = toggled}}) +makeDocsToggled :: IDEAction+makeDocsToggled = do+ toggled <- getMakeDocs+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){makeDocs = toggled}})+ runUnitTestsToggled :: IDEAction runUnitTestsToggled = do toggled <- getRunUnitTests- modifyIDE_ (\ide -> ide{prefs = (prefs ide){runUnitTests= toggled}})+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){runUnitTests = toggled}}) +runBenchmarksToggled :: IDEAction+runBenchmarksToggled = do+ toggled <- getRunBenchmarks+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){runBenchmarks = toggled}})+ makeModeToggled :: IDEAction makeModeToggled = do toggled <- getMakeModeToggled- modifyIDE_ (\ide -> ide{prefs = (prefs ide){makeMode= toggled}})+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){makeMode = toggled}}) -- --------------------------------------------------------------------- -- | * Debug code that needs to use the package@@ -803,24 +984,37 @@ debugStart :: PackageAction debugStart = do- package <- ask+ project <- lift ask+ package <- ask liftIDE $ catchIDE (do ideRef <- ask prefs' <- readIDE prefs maybeDebug <- readIDE debugState case maybeDebug of Nothing -> do- let dir = ipdPackageDir package- mbExe <- readIDE activeExe- ghci <- reifyIDE $ \ideR -> newGhci dir mbExe (interactiveFlags prefs')- $ reflectIDEI (void (logOutputForBuild package True False)) ideR+ mbTarget <- readIDE activeComponent+ let dir = ipdPackageDir package+ name = ipdPackageName package+ (tool, args) = case pjTool project of+ CabalTool -> ("cabal", [ "new-repl"+ , "--project-file"+ , T.pack . makeRelative dir $ pjFile project+ , name <> maybe (":lib:" <> name) (":" <>) mbTarget+ ])+ StackTool -> ("stack", [ "repl"+ , "--stack-yaml"+ , T.pack . makeRelative dir $ pjFile project+ , name <> maybe "" (":" <>) mbTarget+ ])+ ghci <- reifyIDE $ \ideR -> newGhci tool args dir (interactiveFlags prefs')+ $ reflectIDEI (void (logOutputForBuild project package True False)) ideR modifyIDE_ (\ide -> ide {debugState = Just (package, ghci)}) triggerEventIDE (Sensitivity [(SensitivityInterpreting, True)]) setDebugToggled True -- Fork a thread to wait for the output from the process to close liftIO $ forkIO $ do readMVar (outputClosed ghci)- postGUISync . (`reflectIDE` ideRef) $ do+ (`reflectIDE` ideRef) . postSyncIDE $ do setDebugToggled False modifyIDE_ (\ide -> ide {debugState = Nothing, autoCommand = return ()}) triggerEventIDE (Sensitivity [(SensitivityInterpreting, False)])@@ -834,7 +1028,7 @@ -- Lets build to make sure the binaries are up to date mbPackage <- readIDE activePack case mbPackage of- Just package -> runCabalBuild True False False package True (\ _ -> return ())+ Just package -> runCabalBuild True False False (project, package) (\ _ -> return ()) Nothing -> return () return () _ -> do@@ -851,17 +1045,19 @@ liftIDE $ runDebug f debug _ -> do window <- liftIDE getMainWindow- resp <- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (__ "GHCi debugger is not running.")- dialogAddButton md (__ "_Start GHCi") (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "GHCi debugger is not running."+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Start GHCi") (AnotherResponseType 1)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do debugStart maybeDebug <- liftIDE $ readIDE debugState case maybeDebug of@@ -882,17 +1078,17 @@ executeDebugCommand :: Text -> C.Sink ToolOutput IDEM () -> DebugAction executeDebugCommand command handler = do (_, ghci) <- ask- lift $- reifyIDE $ \ideR -> do- liftIO $ postGUIAsync $ reflectIDE (do- triggerEventIDE (StatusbarChanged [CompartmentState command, CompartmentBuild True])- return ()) ideR- executeGhciCommand ghci command $ do- reflectIDEI handler ideR- liftIO $ postGUIAsync $ reflectIDE (do- triggerEventIDE (StatusbarChanged [CompartmentState "", CompartmentBuild False])- return ()) ideR- return ()+ lift $ do+ ideR <- ask+ postAsyncIDE $ do+ triggerEventIDE (StatusbarChanged [CompartmentState command, CompartmentBuild True])+ return ()+ liftIO . executeGhciCommand ghci command $+ reflectIDEI (do+ lift . postSyncIDE $ do+ triggerEventIDE (StatusbarChanged [CompartmentState "", CompartmentBuild False])+ return ()+ handler) ideR -- Includes non buildable allBuildInfo' :: PackageDescription -> [BuildInfo]@@ -918,25 +1114,23 @@ let ipdModules = Map.fromList $ myLibModules packageD ++ myExeModules packageD ++ myTestModules packageD ++ myBenchmarkModules packageD ipdMain = [ (modulePath exe, buildInfo exe, False) | exe <- executables packageD ]- ++ [ (f, bi, True) | TestSuite _ (TestSuiteExeV10 _ f) bi _ <- testSuites packageD ]- ++ [ (f, bi, True) | Benchmark _ (BenchmarkExeV10 _ f) bi _ <- benchmarks packageD ]+ ++ [ (f, bi, True) | TestSuite {testInterface = TestSuiteExeV10 _ f, testBuildInfo = bi} <- testSuites packageD ]+ ++ [ (f, bi, True) | Benchmark {benchmarkInterface = BenchmarkExeV10 _ f, benchmarkBuildInfo = bi} <- benchmarks packageD ] ipdExtraSrcs = Set.fromList $ extraSrcFiles packageD ipdSrcDirs = case nub $ concatMap hsSourceDirs (allBuildInfo' packageD) of [] -> [".","src"] l -> l- ipdExes = [ T.pack $ exeName e | e <- executables packageD- , buildable (buildInfo e) ]+ ipdExes = [ T.pack . unUnqualComponentName $ exeName e | e <- executables packageD ] ipdExtensions = nub $ concatMap oldExtensions (allBuildInfo' packageD)- ipdTests = [ T.pack $ testName t | t <- testSuites packageD- , buildable (testBuildInfo t) ]- ipdBenchmarks = [ T.pack $ benchmarkName b | b <- benchmarks packageD- , buildable (benchmarkBuildInfo b) ]+ ipdTests = [ T.pack . unUnqualComponentName $ testName t | t <- testSuites packageD ]+ ipdBenchmarks = [ T.pack . unUnqualComponentName $ benchmarkName b | b <- benchmarks packageD ] ipdPackageId = package packageD ipdDepends = buildDepends packageD ipdHasLibs = hasLibs packageD ipdConfigFlags = ["--enable-tests"] ipdBuildFlags = [] ipdTestFlags = []+ ipdBenchmarkFlags = [] ipdHaddockFlags = [] ipdExeFlags = [] ipdInstallFlags = []@@ -954,40 +1148,56 @@ return (Just pack) extractStackPackageList :: Text -> [String]-extractStackPackageList = filter (/= ".") .+extractStackPackageList = (\x -> if null x then ["."] else x) . map (stripQuotes . T.unpack . (\x -> fromMaybe x $ T.stripPrefix "location: " x)) .- mapMaybe (T.stripPrefix "- ") .- takeWhile ("- " `T.isPrefixOf`) .+ filterSimple .+ filter (not . T.null) .+ map (T.reverse . T.dropWhile isSpace . T.reverse) . drop 1 . dropWhile (/= "packages:") .+ map (T.pack . stripStackComments . T.unpack) . T.lines where stripQuotes ('\'':rest) | take 1 (reverse rest) == "\'" = init rest stripQuotes x = x + stripStackComments :: String -> String+ stripStackComments "" = ""+ stripStackComments ('#':_) = ""+ stripStackComments (x:xs) = x:stripStackComments xs -idePackageFromPath :: C.Sink ToolOutput IDEM () -> FilePath -> IDEM (Maybe IDEPackage)-idePackageFromPath log filePath = do- mbRootPackage <- idePackageFromPath' filePath- case mbRootPackage of- Nothing -> return Nothing- Just rootPackage -> do- mvar <- liftIO newEmptyMVar- let dir = takeDirectory filePath- useStack <- liftIO . doesFileExist $ dir </> "stack.yaml"- paths <-- if useStack- then liftIO $ map (dir </>) . extractStackPackageList <$> T.readFile (dir </> "stack.yaml")- else do- runExternalTool' "" "cabal" ["sandbox", "list-sources"] dir $ do- output <- CL.consume- liftIO . putMVar mvar $ case take 1 $ reverse output of- [ToolExit ExitSuccess] ->- map (T.unpack . toolline) . takeWhile (/= ToolOutput "") . drop 1 $ dropWhile (/= ToolOutput "") output- _ -> []- liftIO $ takeMVar mvar+ filterSimple [] = []+ filterSimple (x:xs) = let indent = T.takeWhile (==' ') x in+ mapMaybe (T.stripPrefix (indent <> "- ")) $+ takeWhile (\l -> (indent <> "- ") `T.isPrefixOf` l || (indent <> " ") `T.isPrefixOf` l) (x:xs) - sandboxSources <- catMaybes <$> forM paths (\path -> do+extractCabalPackageList :: Text -> [String]+extractCabalPackageList = map (dirOnly .T.unpack . T.dropWhile (==' ')) .+ takeWhile (" " `T.isPrefixOf`) .+ drop 1 .+ dropWhile (/= "packages:") .+ filter (not . T.null) .+ map (T.pack . stripCabalComments . T.unpack) .+ T.lines+ where+ stripCabalComments :: String -> String+ stripCabalComments "" = ""+ stripCabalComments ('-':'-':_) = ""+ stripCabalComments (x:xs) = x:stripCabalComments xs+ dirOnly :: FilePath -> FilePath+ dirOnly f = if takeExtension f == "cabal" then dropFileName f else f++ideProjectFromPath :: FilePath -> IDEM (Maybe Project)+ideProjectFromPath filePath = do+ let toolInfo = case takeExtension filePath of+ ".project" -> Just (CabalTool, extractCabalPackageList)+ ".yaml" -> Just (StackTool, extractStackPackageList)+ _ -> Nothing+ case toolInfo of+ Just (tool, extractPackageList) -> do+ let dir = takeDirectory filePath+ paths <- liftIO $ map (dir </>) . extractPackageList <$> T.readFile filePath+ packages <- catMaybes <$> forM paths (\path -> do exists <- liftIO (doesDirectoryExist path) if exists then do@@ -995,25 +1205,26 @@ contents <- liftIO $ getDirectoryContents cpath let mbCabalFile = find ((== ".cabal") . takeExtension) contents when (isNothing mbCabalFile) $- ideMessage Normal ("Could not find cabal file of the add-source dependency at " <> T.pack cpath)- return (fmap (path </>) mbCabalFile)+ ideMessage Normal ("Could not find cabal file for " <> T.pack cpath)+ return (fmap (cpath </>) mbCabalFile) else do- ideMessage Normal ("Path of add-source dependency does not exist: " <> T.pack path)+ ideMessage Normal ("Path does not exist: " <> T.pack path) return Nothing)- s <- liftM catMaybes . mapM idePackageFromPath' $ nub sandboxSources- return . Just $ rootPackage {ipdSandboxSources = s}+ packages <- fmap catMaybes . mapM idePackageFromPath' $ nub packages+ return . Just $ Project { pjTool = tool, pjFile = filePath, pjPackageMap = mkPackageMap packages }+ Nothing -> return Nothing -refreshPackage :: C.Sink ToolOutput IDEM () -> PackageM (Maybe IDEPackage)-refreshPackage log = do- package <- ask- liftIDE $ do- mbUpdatedPack <- idePackageFromPath log (ipdCabalFile package)- case mbUpdatedPack of- Just updatedPack -> do- changePackage updatedPack- triggerEventIDE $ WorkspaceChanged False True- return mbUpdatedPack- Nothing -> do- postAsyncIDE $ ideMessage Normal (__ "Can't read package file")- return Nothing+--refreshPackage :: C.Sink ToolOutput IDEM () -> PackageM (Maybe IDEPackage)+--refreshPackage log = do+-- package <- ask+-- liftIDE $ do+-- mbUpdatedPack <- idePackageFromPath log (ipdCabalFile package)+-- case mbUpdatedPack of+-- Just updatedPack -> do+-- changePackage updatedPack+-- triggerEventIDE $ WorkspaceChanged False True+-- return mbUpdatedPack+-- Nothing -> do+-- postAsyncIDE $ ideMessage Normal (__ "Can't read package file")+-- return Nothing
src/IDE/Pane/Breakpoints.hs view
@@ -25,12 +25,10 @@ , selectBreak ) where -import Graphics.UI.Gtk+import Prelude ()+import Prelude.Compat import Data.Typeable (Typeable(..)) import IDE.Core.State-import Graphics.UI.Gtk.Gdk.Events (Event(..))-import Graphics.UI.Gtk.General.Enums- (Click(..), MouseButton(..)) import IDE.Debug (debugShowBreakpoints, debugDeleteBreakpoint,@@ -42,13 +40,51 @@ import qualified Data.Text as T (words, unpack) import qualified Data.Foldable as F (toList) import qualified Data.Sequence as Seq (elemIndexL)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TreeView+ (onTreeViewRowActivated, treeViewGetSelection,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreGetValue, ForestStore(..),+ forestStoreInsert, forestStoreClear, forestStoreNew)+import GI.Gtk.Objects.Widget (afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Objects.TreeViewColumn+ (TreeViewColumn(..), treeViewColumnSetReorderable,+ treeViewColumnSetResizable, treeViewColumnSetSizing,+ treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..))+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (treeSelectionSelectPath, treeSelectionUnselectAll,+ treeSelectionSetMode)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew, SeparatorMenuItem(..))+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import Control.Monad.Reader (MonadReader(..))+import GI.Gtk.Objects.MenuItem+ (toMenuItem, onMenuItemActivate, menuItemNewWithLabel)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices') -- | Represents the Breakpoints pane data IDEBreakpoints = IDEBreakpoints { scrolledView :: ScrolledWindow , treeView :: TreeView-, breakpoints :: TreeStore LogRef+, breakpoints :: ForestStore LogRef } deriving Typeable @@ -61,7 +97,7 @@ where primPaneName _ = __ "Breakpoints" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = liftIO . toWidget . scrolledView paneId b = "*Breakpoints" @@ -70,47 +106,48 @@ recoverState pp BreakpointsState = do nb <- getNotebook pp buildPane pp nb builder- builder pp nb windows = reifyIDE $ \ ideR -> do- breakpoints <- treeStoreNew []+ builder pp nb windows = do+ ideR <- ask+ breakpoints <- forestStoreNew [] treeView <- treeViewNew- treeViewSetModel treeView breakpoints+ treeViewSetModel treeView (Just breakpoints) rendererA <- cellRendererTextNew colA <- treeViewColumnNew treeViewColumnSetTitle colA (__ "Location")- treeViewColumnSetSizing colA TreeViewColumnAutosize+ treeViewColumnSetSizing colA TreeViewColumnSizingAutosize treeViewColumnSetResizable colA True treeViewColumnSetReorderable colA True treeViewAppendColumn treeView colA cellLayoutPackStart colA rendererA False- cellLayoutSetAttributes colA rendererA breakpoints- $ \row -> [cellText := showSourceSpan row]+ cellLayoutSetDataFunction colA rendererA breakpoints+ $ \row -> setCellRendererTextText rendererA $ showSourceSpan row rendererB <- cellRendererTextNew colB <- treeViewColumnNew treeViewColumnSetTitle colB (__ "Breakpoints")- treeViewColumnSetSizing colB TreeViewColumnAutosize+ treeViewColumnSetSizing colB TreeViewColumnSizingAutosize treeViewColumnSetResizable colB True treeViewColumnSetReorderable colB True treeViewAppendColumn treeView colB cellLayoutPackStart colB rendererB False- cellLayoutSetAttributes colB rendererB breakpoints- $ \row -> [ cellText := refDescription row]+ cellLayoutSetDataFunction colB rendererB breakpoints+ $ setCellRendererTextText rendererB . refDescription treeViewSetHeadersVisible treeView True selB <- treeViewGetSelection treeView- treeSelectionSetMode selB SelectionSingle- scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn+ treeSelectionSetMode selB SelectionModeSingle+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic let pane = IDEBreakpoints scrolledView treeView breakpoints- cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive pane) ideR+ cid1 <- onIDE afterWidgetFocusInEvent treeView $ do+ liftIDE $ makeActive pane return True- (cid2, cid3) <- treeViewContextMenu treeView $ breakpointsContextMenu ideR breakpoints treeView- cid4 <- treeView `on` rowActivated $ breakpointsSelect ideR breakpoints- return (Just pane, map ConnectC [cid1, cid2, cid3, cid4])+ cids2 <- treeViewContextMenu treeView $ breakpointsContextMenu ideR breakpoints treeView+ cid4 <- ConnectC treeView <$> onTreeViewRowActivated treeView (breakpointsSelect ideR breakpoints)+ return (Just pane, [cid1, cid4] ++ cids2) -- | Get the Breakpoints pane@@ -133,22 +170,22 @@ Nothing -> return () Just b -> do refs <- readIDE breakpointRefs- liftIO $ do- treeStoreClear (breakpoints b)- mapM_ (\ (lr,index) -> treeStoreInsert (breakpoints b) [] index lr)- (zip (F.toList refs) [0..])+ forestStoreClear (breakpoints b)+ emptyPath <- treePathNewFromIndices' []+ mapM_ (\ (lr,index) -> forestStoreInsert (breakpoints b) emptyPath index lr)+ (zip (F.toList refs) [0..]) -- | Try to get the currently selected breakpoint getSelectedBreakpoint :: TreeView- -> TreeStore LogRef+ -> ForestStore LogRef -> IO (Maybe LogRef)-getSelectedBreakpoint treeView treeStore = do+getSelectedBreakpoint treeView forestStore = do treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of a:r -> do- val <- treeStoreGetValue treeStore a+ val <- forestStoreGetValue forestStore a return (Just val) _ -> return Nothing @@ -159,46 +196,44 @@ selectBreak mbLogRef = do breakRefs' <- readIDE breakpointRefs breaks <- forceGetPane (Right "*Breakpoints")- liftIO $ do- selection <- treeViewGetSelection (treeView breaks)- case mbLogRef of- Nothing -> treeSelectionUnselectAll selection- Just lr -> case lr `Seq.elemIndexL` breakRefs' of- Nothing -> return ()- Just ind -> treeSelectionSelectPath selection [ind]+ selection <- treeViewGetSelection (treeView breaks)+ case mbLogRef of+ Nothing -> treeSelectionUnselectAll selection+ Just lr -> case lr `Seq.elemIndexL` breakRefs' of+ Nothing -> return ()+ Just ind -> treeSelectionSelectPath selection =<< treePathNewFromIndices' [fromIntegral ind] -- | Constructs the context menu for the breakpoint breakpointsContextMenu :: IDERef- -> TreeStore LogRef+ -> ForestStore LogRef -> TreeView -> Menu -> IO () breakpointsContextMenu ideR store treeView theMenu = do- item1 <- menuItemNewWithLabel (__ "Remove breakpoint")- item1 `on` menuItemActivate $ do- sel <- getSelectedBreakpoint treeView store+ item1 <- menuItemNewWithLabel (__ "Remove breakpoint")+ onMenuItemActivate item1 $ do+ sel <- getSelectedBreakpoint treeView store case sel of Just ref -> reflectIDE (deleteBreakpoint ref) ideR otherwise -> sysMessage Normal (__ "Debugger>> breakpointViewPopup: no selection2")- sep1 <- separatorMenuItemNew- item2 <- menuItemNewWithLabel (__ "Remove all breakpoints")- item2 `on` menuItemActivate $ reflectIDE debugDeleteAllBreakpoints ideR- item3 <- menuItemNewWithLabel (__ "Update")- item3 `on` menuItemActivate $ reflectIDE debugShowBreakpoints ideR- mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1,- castToMenuItem item2, castToMenuItem item3]+ sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem+ item2 <- menuItemNewWithLabel (__ "Remove all breakpoints")+ onMenuItemActivate item2 $ reflectIDE debugDeleteAllBreakpoints ideR+ item3 <- menuItemNewWithLabel (__ "Update")+ onMenuItemActivate item3 $ reflectIDE debugShowBreakpoints ideR+ mapM_ (menuShellAppend theMenu) [item1, sep1, item2, item3] -- | Set the current breakpoint to a specific entry -- pointed to by the supplied 'TreePath' breakpointsSelect :: IDERef- -> TreeStore LogRef+ -> ForestStore LogRef -> TreePath -> TreeViewColumn -> IO () breakpointsSelect ideR store path _ = do- ref <- treeStoreGetValue store path+ ref <- forestStoreGetValue store path reflectIDE (setCurrentBreak (Just ref)) ideR
src/IDE/Pane/Errors.hs view
@@ -22,12 +22,12 @@ , fillErrorList , getErrors , addErrorToList+, removeErrorsFromList , selectMatchingErrors ) where import Prelude () import Prelude.Compat-import Graphics.UI.Gtk import Data.Typeable (Typeable) import IDE.Core.State import IDE.ImportTool@@ -36,11 +36,11 @@ import IDE.LogRef (showSourceSpan) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils- (treeViewContextMenu', treeViewContextMenu, __, treeViewToggleRow,- treeStoreGetForest)+ (treeViewContextMenu', treeViewContextMenu, __, treeViewToggleRow) import Data.Text (dropWhileEnd, Text) import Control.Applicative (Alternative(..))-import Control.Monad (filterM, foldM_, unless, void, when)+import Control.Monad (filterM, foldM_, unless, void, when, forever)+import Control.Concurrent (forkIO, threadDelay, MVar, newEmptyMVar, takeMVar, tryPutMVar) import qualified Data.Text as T (unlines, dropWhileEnd, unpack, pack, intercalate, lines, takeWhile, length, drop)@@ -50,31 +50,86 @@ import qualified Data.Sequence as Seq (null, elemIndexL) import Data.Monoid ((<>)) import Data.Ord (comparing)-import System.Glib.Properties (newAttrFromMaybeStringProperty) import Data.Char (isSpace) import Data.Tree (Forest, Tree(..), Tree) import Data.Function.Compat ((&)) import System.Log.Logger (debugM) import Data.Foldable (forM_)+import GI.Gtk.Objects.Box (boxNew, Box(..))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TreeView+ (treeViewScrollToCell, treeViewExpandToPath,+ onTreeViewRowActivated, treeViewGetSelection, treeViewAppendColumn,+ treeViewRowExpanded, setTreeViewHeadersVisible, setTreeViewRulesHint,+ setTreeViewLevelIndentation, treeViewSetModel, treeViewNew,+ TreeView(..))+import GI.Gtk.Objects.ToggleButton+ (toggleButtonGetActive, onToggleButtonToggled,+ toggleButtonNewWithLabel, setToggleButtonActive, ToggleButton(..))+import GI.Gtk.Objects.Widget+ (widgetShowAll, afterWidgetFocusInEvent, toWidget)+import Data.GI.Base (set, get)+import GI.Gtk.Objects.Notebook (Notebook(..))+import GI.Gtk.Objects.Window (Window(..))+import Graphics.UI.Editor.Parameters (Packing(..), boxPackStart')+import GI.Gtk.Objects.TreeViewColumn+ (noTreeViewColumn, TreeViewColumn(..), treeViewColumnSetSizing,+ treeViewColumnNew)+import GI.Gtk.Objects.CellRendererPixbuf+ (setCellRendererPixbufIconName, cellRendererPixbufNew)+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunc', cellLayoutSetDataFunction)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..), Orientation(..))+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Interfaces.TreeModel+ (treeModelGetIterFirst, treeModelGetPath)+import Data.GI.Gtk.ModelView.CustomStore (customStoreGetRow)+import GI.Gtk.Objects.TreeSelection+ (treeSelectionSelectPath, treeSelectionUnselectAll,+ treeSelectionSetMode)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreRemove, forestStoreInsert, forestStoreClear,+ forestStoreNew, ForestStore(..), forestStoreGetTree,+ forestStoreGetValue, forestStoreGetForest)+import GI.Gtk.Objects.Button (buttonSetLabel)+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import GI.Gtk.Objects.Clipboard (clipboardSetText, clipboardGet)+import GI.Gdk.Structs.Atom (atomIntern)+import Data.Int (Int32)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices')+import GI.Gtk (getToggleButtonActive)+import Data.Time.Clock (getCurrentTime, diffUTCTime) -- | The representation of the Errors pane data ErrorsPane = ErrorsPane {- vbox :: VBox+ vbox :: Box , scrolledView :: ScrolledWindow , treeView :: TreeView-, errorStore :: TreeStore ErrorRecord+, errorStore :: ForestStore ErrorRecord , autoClose :: IORef Bool -- ^ If the pane was only displayed to show current error , errorsButton :: ToggleButton , warningsButton :: ToggleButton , suggestionsButton :: ToggleButton , testFailsButton :: ToggleButton+, updateButtons :: MVar () } deriving Typeable -- | The data for a single row in the Errors pane data ErrorRecord = ERLogRef LogRef- | ERPackage IDEPackage Text | ERIDE Text | ERFullMessage Text (Maybe LogRef) deriving (Eq)@@ -93,26 +148,26 @@ instance Pane ErrorsPane IDEM where primPaneName _ = __ "Errors"- getTopWidget = castToWidget . vbox+ getTopWidget = liftIO . toWidget . vbox paneId _b = "*Errors" instance RecoverablePane ErrorsPane ErrorsState IDEM where- saveState ErrorsPane{..} = liftIO $ do- showErrors <- get errorsButton toggleButtonActive- showWarnings <- get warningsButton toggleButtonActive- showSuggestions <- get suggestionsButton toggleButtonActive- showTestFails <- get testFailsButton toggleButtonActive+ saveState ErrorsPane{..} = do+ showErrors <- getToggleButtonActive errorsButton+ showWarnings <- getToggleButtonActive warningsButton+ showSuggestions <- getToggleButtonActive suggestionsButton+ showTestFails <- getToggleButtonActive testFailsButton return (Just ErrorsState{..}) recoverState pp ErrorsState{..} = do nb <- getNotebook pp mbErrors <- buildPane pp nb builder- forM_ mbErrors $ \ErrorsPane{..} -> liftIO $ do- set errorsButton [toggleButtonActive := showErrors]- set warningsButton [toggleButtonActive := showWarnings]- set suggestionsButton [toggleButtonActive := showSuggestions]- set testFailsButton [toggleButtonActive := showTestFails]+ forM_ mbErrors $ \ErrorsPane{..} -> do+ setToggleButtonActive errorsButton showErrors+ setToggleButtonActive warningsButton showWarnings+ setToggleButtonActive suggestionsButton showSuggestions+ setToggleButtonActive testFailsButton showTestFails return mbErrors @@ -124,100 +179,100 @@ Notebook -> Window -> IDEM (Maybe ErrorsPane, Connections)-builder' _pp _nb _windows = reifyIDE $ \ ideR -> do- errorStore <- treeStoreNew []+builder' _pp _nb _windows = do+ ideR <- ask+ errorStore <- forestStoreNew [] - vbox <- vBoxNew False 0+ vbox <- boxNew OrientationVertical 0 -- Top box with buttons- hbox <- hBoxNew False 0- boxPackStart vbox hbox PackNatural 0+ hbox <- boxNew OrientationHorizontal 0+ boxPackStart' vbox hbox PackNatural 0 errorsButton <- toggleButtonNewWithLabel (__ "Errors") warningsButton <- toggleButtonNewWithLabel (__ "Warnings") suggestionsButton <- toggleButtonNewWithLabel (__ "Suggestions") testFailsButton <- toggleButtonNewWithLabel (__ "Test Failures")- set suggestionsButton [toggleButtonActive := False]+ setToggleButtonActive suggestionsButton False forM_ [errorsButton, warningsButton, suggestionsButton, testFailsButton] $ \b -> do- set b [toggleButtonActive := True]- boxPackStart hbox b PackNatural 3- b `on` toggled $ reflectIDE (fillErrorList False) ideR--- boxPackStart vbox hbox PackNatural 0-+ setToggleButtonActive b True+ boxPackStart' hbox b PackNatural 3+ onToggleButtonToggled b $ reflectIDE (fillErrorList False) ideR -- TreeView for bottom part of vbox treeView <- treeViewNew- treeViewSetModel treeView errorStore- set treeView- [ treeViewLevelIndentation := 20- , treeViewRulesHint := True- , treeViewHeadersVisible := False]+ treeViewSetModel treeView (Just errorStore)+ setTreeViewLevelIndentation treeView 20+ setTreeViewRulesHint treeView True+ setTreeViewHeadersVisible treeView False column <- treeViewColumnNew iconRenderer <- cellRendererPixbufNew cellLayoutPackStart column iconRenderer False- cellLayoutSetAttributes column iconRenderer errorStore- $ \row -> [ newAttrFromMaybeStringProperty "icon-name" := toIcon row]+ cellLayoutSetDataFunction column iconRenderer errorStore+ $ setCellRendererPixbufIconName iconRenderer . toIcon - treeViewColumnSetSizing column TreeViewColumnAutosize+ treeViewColumnSetSizing column TreeViewColumnSizingAutosize renderer <- cellRendererTextNew cellLayoutPackStart column renderer False - cellLayoutSetAttributeFunc column renderer errorStore $ \iter -> do+ cellLayoutSetDataFunc' column renderer errorStore $ \iter -> do path <- treeModelGetPath errorStore iter- row <- treeModelGetRow errorStore iter+ row <- customStoreGetRow errorStore iter expanded <- treeViewRowExpanded treeView path- set renderer [cellText := toDescription expanded row]+ setCellRendererTextText renderer $ toDescription expanded row treeViewAppendColumn treeView column selB <- treeViewGetSelection treeView- treeSelectionSetMode selB SelectionMultiple- scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn+ treeSelectionSetMode selB SelectionModeMultiple+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic- boxPackStart vbox scrolledView PackGrow 0+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic+ boxPackStart' vbox scrolledView PackGrow 0 - autoClose <- newIORef False+ autoClose <- liftIO $ newIORef False + updateButtons <- liftIO newEmptyMVar+ let pane = ErrorsPane {..}- cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive pane) ideR+ cid1 <- onIDE afterWidgetFocusInEvent treeView $ do+ liftIDE $ makeActive pane return True- (cid2, cid3) <- flip reflectIDE ideR $- treeViewContextMenu' treeView errorStore contextMenuItems- cid4 <- treeView `on` rowActivated $ \path col -> do- record <- treeStoreGetValue errorStore path+ cids2 <- treeViewContextMenu' treeView errorStore contextMenuItems+ cid4 <- ConnectC treeView <$> onTreeViewRowActivated treeView (\path col -> do+ record <- forestStoreGetValue errorStore path case record of ERLogRef logRef -> errorsSelect ideR errorStore path col ERFullMessage _ ref -> errorsSelect ideR errorStore path col- _ -> return ()+ _ -> return ()) - reflectIDE (fillErrorList' pane) ideR- return (Just pane, map ConnectC [cid1, cid2, cid3, cid4])+ fillErrorList' pane+ liftIO . forkIO . forever $ do+ takeMVar updateButtons+ reflectIDE (postSyncIDE (doUpdateFilterButtons pane)) ideR+ threadDelay 200000+ return (Just pane, [cid1, cid4] ++ cids2) -toIcon :: ErrorRecord -> Maybe Text+toIcon :: ErrorRecord -> Text toIcon (ERLogRef logRef) = case logRefType logRef of- ErrorRef -> Just "ide_error"- WarningRef -> Just "ide_warning"- LintRef -> Just "ide_suggestion"- TestFailureRef -> Just "software-update-urgent"- _ -> Nothing-toIcon (ERPackage _ _) = Just "dialog-error"-toIcon (ERIDE _) = Just "dialog-error"-toIcon (ERFullMessage _ _) = Nothing+ ErrorRef -> "ide_error"+ WarningRef -> "ide_warning"+ LintRef -> "ide_suggestion"+ TestFailureRef -> "software-update-urgent"+ _ -> ""+toIcon (ERIDE _) = "dialog-error"+toIcon (ERFullMessage _ _) = "" toDescription :: Bool -> ErrorRecord -> Text@@ -225,14 +280,13 @@ case errorRec of (ERLogRef logRef) -> formatExpandableMessage (T.pack $ logRefFilePath logRef) (refDescription logRef) (ERIDE msg) -> formatExpandableMessage "" msg- (ERPackage pkg msg) -> formatExpandableMessage (packageIdentifierToString (ipdPackageId pkg))- (packageIdentifierToString (ipdPackageId pkg) <> ": \n" <> msg)- (ERFullMessage msg _) -> removeIndentation msg+ (ERFullMessage msg _) -> removeIndentation (cutOffAt 8192 msg) where formatExpandableMessage location msg | expanded = location- | otherwise = location <> ": " <> msg & removeIndentation+ | otherwise = location <> ": " <> msg & cutOffAt 2048+ & removeIndentation & T.lines & map removeTrailingWhiteSpace & T.intercalate " "@@ -257,6 +311,14 @@ getErrors Nothing = forceGetPane (Right "*Errors") getErrors (Just pp) = forceGetPane (Left pp) +timeIt :: String -> IDEM a -> IDEM a+timeIt name f = do+ liftIO $ debugM "leksah" name+ start <- liftIO getCurrentTime+ result <- f+ end <- liftIO getCurrentTime+ liftIO $ debugM "leksah" $ name <> " took " <> show (diffUTCTime end start)+ return result -- | Repopulates the Errors pane fillErrorList :: Bool -- ^ Whether to display the Errors pane@@ -264,30 +326,31 @@ fillErrorList False = getPane >>= maybe (return ()) fillErrorList' fillErrorList True = getErrors Nothing >>= \ p -> fillErrorList' p >> displayPane p False - -- | Fills the pane with the error list from the IDE state fillErrorList' :: ErrorsPane -> IDEAction-fillErrorList' pane = do- liftIO $ debugM "leksah" "fillErrorList'"+fillErrorList' pane = timeIt "fillErrorList'" $ do refs <- F.toList <$> readIDE errorRefs- visibleRefs <- liftIO $ filterM (isRefVisible pane) refs+ visibleRefs <- filterM (isRefVisible pane) refs ac <- liftIO $ readIORef (autoClose pane) when (null refs && ac) . void $ closePane pane updateFilterButtons pane- liftIO $ do- let store = errorStore pane- let view = treeView pane- treeStoreClear store- forM_ (zip visibleRefs [0..]) $ \(ref, n) -> do- treeStoreInsert store [] n (ERLogRef ref)- when (length (T.lines (refDescription ref)) > 1) $ do- treeStoreInsert store [n] 0 (ERFullMessage (refDescription ref) (Just ref))- treeViewExpandToPath view [n,0]+ let store = errorStore pane+ let view = treeView pane+ forestStoreClear store+ forM_ (zip visibleRefs [0..]) $ \(ref, n) -> do+ emptyPath <- treePathNewFromIndices' []+ forestStoreInsert store emptyPath n (ERLogRef ref)+ when (length (T.lines (refDescription ref)) > 1) $ do+ p <- treePathNewFromIndices' [fromIntegral n]+ forestStoreInsert store p 0 (ERFullMessage (refDescription ref) (Just ref))+ collapse <- collapseErrors <$> readIDE prefs+ unless collapse $ do+ treeViewExpandToPath view =<< treePathNewFromIndices' [fromIntegral n,0] -- | Returns whether the `LogRef` should be visible in the errors pane-isRefVisible :: ErrorsPane -> LogRef -> IO Bool+isRefVisible :: MonadIO m => ErrorsPane -> LogRef -> m Bool isRefVisible pane ref = case logRefType ref of ErrorRef -> toggleButtonGetActive (errorsButton pane)@@ -304,29 +367,56 @@ addErrorToList False index lr = getPane >>= maybe (return ()) (addErrorToList' index lr) addErrorToList True index lr = getErrors Nothing >>= \ p -> addErrorToList' index lr p >> displayPane p False - -- | Add a 'LogRef' at a specific index to the Errors pane addErrorToList' :: Int -> LogRef -> ErrorsPane -> IDEAction-addErrorToList' unfilteredIndex ref pane = do- liftIO $ debugM "leksah" "addErrorToList'"- visible <- liftIO $ isRefVisible pane ref+addErrorToList' unfilteredIndex ref pane = timeIt "addErrorToList'" $ do+ visible <- isRefVisible pane ref updateFilterButtons pane when visible $ do refs <- F.toList <$> readIDE errorRefs- index <- liftIO $ length <$> filterM (isRefVisible pane) (take unfilteredIndex refs)+ index <- length <$> filterM (isRefVisible pane) (take unfilteredIndex refs) ac <- liftIO $ readIORef (autoClose pane)- liftIO $ do- let store = errorStore pane- let view = treeView pane- treeStoreInsert store [] index (ERLogRef ref)- when (length (T.lines (refDescription ref)) > 1) $ do- treeStoreInsert store [index] 0 (ERFullMessage (refDescription ref) (Just ref))- treeViewExpandToPath view [index,0]+ let store = errorStore pane+ let view = treeView pane+ emptyPath <- treePathNewFromIndices' []+ forestStoreInsert store emptyPath index (ERLogRef ref)+ when (length (T.lines (refDescription ref)) > 1) $ do+ p <- treePathNewFromIndices' [fromIntegral index]+ forestStoreInsert store p 0 (ERFullMessage (refDescription ref) (Just ref))+ collapse <- collapseErrors <$> readIDE prefs+ unless collapse $+ treeViewExpandToPath view =<< treePathNewFromIndices' [fromIntegral index,0]+ when (index == 0) $ do+ path <- treePathNewFromIndices' [0]+ treeViewScrollToCell view (Just path) noTreeViewColumn False 0 0 --- | Updates the filter buttons in the Error Pane+-- | Add any LogRef to the Errors pane at a given index+removeErrorsFromList :: Bool -- ^ Whether to display the pane+ -> (LogRef -> Bool)+ -> IDEAction+removeErrorsFromList False toRemove = getPane >>= maybe (return ()) (removeErrorsFromList' toRemove)+removeErrorsFromList True toRemove = getErrors Nothing >>= \ p -> removeErrorsFromList' toRemove p >> displayPane p False+++-- | Add a 'LogRef' at a specific index to the Errors pane+removeErrorsFromList' :: (LogRef -> Bool) -> ErrorsPane -> IDEAction+removeErrorsFromList' toRemove pane = timeIt "removeErrorsFromList" $ do+ let store = errorStore pane+ trees <- forestStoreGetForest store+ updateFilterButtons pane+ let refsToRemove = filter (treeToRemove . snd) $ zip [0..] trees+ forM_ (map fst $ reverse refsToRemove) $ \index ->+ forestStoreRemove store =<< treePathNewFromIndices' [fromIntegral index]+ where+ treeToRemove (Node (ERLogRef ref) _) = toRemove ref+ treeToRemove _ = False+ updateFilterButtons :: ErrorsPane -> IDEAction-updateFilterButtons pane = do- liftIO $ debugM "leksah" "updateFilterButtons"+updateFilterButtons pane = void . liftIO $ tryPutMVar (updateButtons pane) ()++-- | Updates the filter buttons in the Error Pane+doUpdateFilterButtons :: ErrorsPane -> IDEAction+doUpdateFilterButtons pane = timeIt "updateFilterButtons" $ do let numRefs refType = length . filter ((== refType) . logRefType) . F.toList <$> readIDE errorRefs let setLabel name amount button = buttonSetLabel button (name <> " (" <> T.pack (show amount) <> ")" ) @@ -335,25 +425,23 @@ numSuggestions <- numRefs LintRef numTestFails <- numRefs TestFailureRef - liftIO $ do- setLabel "Errors" numErrors (errorsButton pane)- setLabel "Warnings" numWarnings (warningsButton pane)- setLabel "Suggestions" numSuggestions (suggestionsButton pane)- setLabel "Test Failures" numTestFails (testFailsButton pane)- widgetShowAll (vbox pane)+ setLabel "Errors" numErrors (errorsButton pane)+ setLabel "Warnings" numWarnings (warningsButton pane)+ setLabel "Suggestions" numSuggestions (suggestionsButton pane)+ setLabel "Test Failures" numTestFails (testFailsButton pane) -- | Get the currently selected error getSelectedError :: TreeView- -> TreeStore ErrorRecord+ -> ForestStore ErrorRecord -> IO (Maybe LogRef) getSelectedError treeView store = do liftIO $ debugM "leksah" "getSelectedError" treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of path:_ -> do- val <- treeStoreGetValue store path+ val <- forestStoreGetValue store path case val of ERLogRef logRef -> return (Just logRef) _ -> return Nothing@@ -371,24 +459,22 @@ displayPane errors False reifyIDE $ \ideR -> do selection <- treeViewGetSelection (treeView errors)+ forest <- forestStoreGetForest (errorStore errors) case mbLogRef of Nothing -> do- empty <- null <$> treeStoreGetTree (errorStore errors) []- unless empty $- treeViewScrollToCell (treeView errors) (Just [0]) Nothing Nothing+ unless (null forest) $ do+ childPath <- treePathNewFromIndices' [0]+ treeViewScrollToCell (treeView errors) (Just childPath) noTreeViewColumn False 0.0 0.0 treeSelectionUnselectAll selection Just lr -> do- let store = errorStore errors- empty <- isNothing <$> treeModelGetIterFirst store- unless empty $ do- forest <- treeStoreGetForest store- let mbPath = forestFind forest (ERLogRef lr)- forM_ mbPath $ \path -> do- treeViewScrollToCell (treeView errors) (Just path) Nothing Nothing- treeSelectionSelectPath selection path+ let mbPath = forestFind forest (ERLogRef lr)+ forM_ mbPath $ \path' -> do+ path <- treePathNewFromIndices' path'+ treeViewScrollToCell (treeView errors) (Just path) noTreeViewColumn False 0.0 0.0+ treeSelectionSelectPath selection path where- forestFind :: Eq a => Forest a -> a -> Maybe TreePath+ forestFind :: Eq a => Forest a -> a -> Maybe [Int32] forestFind = forestFind' [0] where forestFind' path [] _ = Nothing@@ -401,29 +487,28 @@ sibling (x:xs) = x:sibling xs sibling [] = error "Error in selectError sibling function" -contextMenuItems :: ErrorRecord -> TreePath -> TreeStore ErrorRecord -> IDEM [[(Text, IDEAction)]]+contextMenuItems :: ErrorRecord -> TreePath -> ForestStore ErrorRecord -> IDEM [[(Text, IDEAction)]] contextMenuItems record path store = return [("Resolve Errors", resolveErrors) : case record of ERLogRef logRef -> resolveMenuItems logRef ++ [clipboardItem (refDescription logRef)] ERIDE msg -> [clipboardItem msg]- ERPackage _ msg -> [clipboardItem msg] _ -> [] ]--- where clipboardItem str = ("Copy message to clipboard", liftIO $ clipboardGet selectionClipboard >>= flip clipboardSetText str)+ where+ clipboardItem str = ("Copy message to clipboard",+ atomIntern "CLIBPOARD" False >>= clipboardGet >>= (\c -> clipboardSetText c str (-1))) -- | Highlight an error refered to by the 'TreePath' in the given 'TreeViewColumn' errorsSelect :: IDERef- -> TreeStore ErrorRecord+ -> ForestStore ErrorRecord -> TreePath -> TreeViewColumn -> IO () errorsSelect ideR store path _ = do liftIO $ debugM "leksah" "errorsSelect"- record <- treeStoreGetValue store path+ record <- forestStoreGetValue store path case record of ERLogRef logRef -> reflectIDE (setCurrentError (Just logRef)) ideR ERFullMessage _ (Just ref) -> reflectIDE (setCurrentError (Just ref)) ideR@@ -438,8 +523,8 @@ liftIO $ debugM "leksah" "selectMatchingErrors" mbErrors <- getPane forM_ mbErrors $ \pane -> do- treeSel <- liftIO $ treeViewGetSelection (treeView pane)- liftIO $ treeSelectionUnselectAll treeSel+ treeSel <- treeViewGetSelection (treeView pane)+ treeSelectionUnselectAll treeSel forM_ mbSpan $ \span -> do spans <- map logRefSrcSpan . F.toList <$> readIDE errorRefs matches <- matchingRefs span . F.toList <$> readIDE errorRefs
src/IDE/Pane/Files.hs view
@@ -25,18 +25,19 @@ ) where import Prelude hiding (catch)-import Graphics.UI.Gtk import Data.Maybe (fromMaybe, maybeToList, listToMaybe, isJust) import Control.Monad (forM, void, forM_, when) import Data.Typeable (Typeable) import IDE.Core.State (catchIDE, window, getIDE, MessageLevel(..), ipdPackageId, wsPackages, workspace, readIDE, IDEAction, ideMessage, reflectIDE,- reifyIDE, IDEM, IDEPackage, ipdSandboxSources)+ reifyIDE, IDEM, IDEPackage) import IDE.Pane.SourceBuffer (fileNew, goToSourceDefinition')-import IDE.Sandbox import Control.Applicative ((<$>))-import System.FilePath ((</>), takeFileName, dropFileName)+import System.FilePath+ ((</>), takeFileName, dropFileName,+ addTrailingPathSeparator, takeDirectory, takeExtension,+ makeRelative, splitDirectories) import Distribution.Package (PackageIdentifier(..)) import System.Directory (removeDirectoryRecursive, removeDirectory, createDirectory,@@ -48,10 +49,6 @@ (RecoverablePane(..), PanePath, RecoverablePane, Pane(..)) import Graphics.UI.Frame.ViewFrame (getMainWindow, getNotebook) import Graphics.UI.Editor.Basics (Connection(..))-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), PolicyType(..), SelectionMode(..),- TreeViewColumnSizing(..))-import System.Glib.Attributes (set, AttrOp(..)) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (showErrorDialog, showInputDialog, treeViewContextMenu', __,@@ -65,14 +62,10 @@ (ipdLib, WorkspaceAction, Workspace(..), wsAllPackages, WorkspaceM, runPackage, runWorkspace, PackageAction, PackageM, IDEPackage(..), IDE(..), Prefs(..), MonadIDE(..), ipdPackageDir)-import System.Glib.Properties (newAttrFromMaybeStringProperty)-import System.FilePath- (addTrailingPathSeparator, takeDirectory, takeExtension,- makeRelative, splitDirectories) import Control.Monad.Reader.Class (MonadReader(..)) import IDE.Workspaces- (makePackage, workspaceAddPackage', workspaceRemovePackage,- workspaceActivatePackage, workspaceTry, workspaceTryQuiet,+ (makePackage, projectAddPackage', projectRemovePackage,+ workspaceTry, workspaceTryQuiet, packageTry) import Data.List (isSuffixOf, find, stripPrefix, isPrefixOf, sortBy, sort)@@ -80,16 +73,11 @@ import Data.Char (toUpper, toLower) import System.Log.Logger (debugM) import Data.Tree (Forest, Tree(..))-import Graphics.UI.Gtk.MenuComboToolbar.MenuItem- (menuItemActivate, menuItemNewWithLabel) import IDE.Pane.Modules (addModule)-import Graphics.UI.Gtk.Windows.MessageDialog- (ButtonsType(..), MessageType(..), messageDialogNew)-import Graphics.UI.Gtk.ModelView.CellRenderer- (CellRendererMode(..), cellMode) import IDE.Pane.PackageEditor (packageEditText)-import IDE.Utils.GtkBindings (treeViewSetActiveOnSingleClick) import IDE.Package (packageTest, packageRun, packageClean)+import GI.Gtk.Objects.Label (labelNew, Label(..))+import GI.Gtk.Objects.Widget (toWidget) -- * The Files pane@@ -108,7 +96,7 @@ instance Pane IDEFiles IDEM where primPaneName _ = __ "Files" getAddedIndex _ = 0- getTopWidget = castToWidget . deprecatedLabel+ getTopWidget = liftIO . toWidget . deprecatedLabel paneId b = "*Files" instance RecoverablePane IDEFiles FilesState IDEM where@@ -117,5 +105,5 @@ nb <- getNotebook pp buildPane pp nb builder builder pp nb windows = reifyIDE $ \ ideR -> do- deprecatedLabel <- labelNew $ Just ("The Files pane is deprecated and has been combined with the Workspace pane"::Text)+ deprecatedLabel <- labelNew $ Just "The Files pane is deprecated and has been combined with the Workspace pane" return (Just IDEFiles {..}, [])
src/IDE/Pane/Grep.hs view
@@ -1,357 +1,400 @@-{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- --- Module : IDE.Pane.Grep --- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie --- License : GNU-GPL --- --- Maintainer : <maintainer at leksah.org> --- Stability : provisional --- Portability : portable --- --- | The pane of the ide where grep results are displayed --- -------------------------------------------------------------------------------- - -module IDE.Pane.Grep ( - IDEGrep(..) -, grepWorkspace -, GrepState(..) -, getGrep -) where - -import Graphics.UI.Gtk hiding (get) -import qualified Graphics.UI.Gtk.Gdk.Events as Gdk -import Text.ParserCombinators.Parsec.Language -import Text.ParserCombinators.Parsec hiding(Parser) -import qualified Text.ParserCombinators.Parsec.Token as P -import Data.Maybe -import Data.Typeable -import Data.List (isPrefixOf) -import IDE.Core.State -import IDE.BufferMode -import IDE.Utils.Tool (runTool, ToolOutput(..), getProcessExitCode, interruptProcessGroupOf) -import Control.Concurrent - (forkOS, newEmptyMVar, isEmptyMVar, takeMVar, putMVar, MVar, - forkIO) -import IDE.LogRef (logOutput, defaultLineLogger) -import IDE.Pane.SourceBuffer - (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..)) -import IDE.TextEditor (grabFocus) -import Control.Applicative ((<$>)) -import System.FilePath ((</>), dropFileName) -import System.Exit (ExitCode(..)) -import IDE.Pane.Log (getLog, getDefaultLogLaunch) -import Control.DeepSeq -import qualified Data.Conduit as C - (Sink) -import qualified Data.Conduit.List as CL - (foldM, head, isolate, sinkNull) -import Data.Conduit (($$), (=$)) -import Control.Monad (void, foldM, when) -import Control.Monad.Trans.Reader (ask) -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad.IO.Class (MonadIO(..)) -import IDE.Utils.GUIUtils (__) -import System.Directory (getDirectoryContents) -import qualified Data.Text as T (pack, take, unpack) -import System.Log.Logger (debugM) -import Control.Exception (SomeException, catch) -import Data.Text (Text) - --- | Represents a single search result -data GrepRecord = GrepRecord { - file :: FilePath - , line :: Int - , context :: Text - , parDir :: Maybe FilePath - } - - --- | Determines whether a 'GrepRecord' is a directory -isDir :: GrepRecord -> Bool -isDir GrepRecord{parDir = Nothing} = True -isDir otherwies = False - - --- | The representation of the Grep result pane -data IDEGrep = IDEGrep { - scrolledView :: ScrolledWindow -, treeView :: TreeView -, grepStore :: TreeStore GrepRecord -, waitingGrep :: MVar Bool -, activeGrep :: MVar Bool -} deriving Typeable - - --- | The additional state used when recovering the pane -data GrepState = GrepState - deriving(Eq,Ord,Read,Show,Typeable) - - -instance Pane IDEGrep IDEM - where - primPaneName _ = __ "Grep" - getAddedIndex _ = 0 - getTopWidget = castToWidget . scrolledView - paneId b = "*Grep" - - -instance RecoverablePane IDEGrep GrepState IDEM where - saveState p = return (Just GrepState) - recoverState pp GrepState = do - nb <- getNotebook pp - buildPane pp nb builder - builder pp nb windows = reifyIDE $ \ ideR -> do - grepStore <- treeStoreNew [] - treeView <- treeViewNew - treeViewSetModel treeView grepStore - - renderer1 <- cellRendererTextNew - col1 <- treeViewColumnNew - treeViewColumnSetTitle col1 (__ "File") - treeViewColumnSetSizing col1 TreeViewColumnAutosize - treeViewColumnSetResizable col1 True - treeViewColumnSetReorderable col1 True - treeViewAppendColumn treeView col1 - cellLayoutPackStart col1 renderer1 True - cellLayoutSetAttributes col1 renderer1 grepStore - $ \row -> [ cellText := T.pack $ file row] - - renderer2 <- cellRendererTextNew - col2 <- treeViewColumnNew - treeViewColumnSetTitle col2 (__ "Line") - treeViewColumnSetSizing col2 TreeViewColumnAutosize - treeViewColumnSetResizable col2 True - treeViewColumnSetReorderable col2 True - treeViewAppendColumn treeView col2 - cellLayoutPackStart col2 renderer2 True - cellLayoutSetAttributes col2 renderer2 grepStore - $ \row -> [ cellText := T.pack $ show $ line row] - - renderer3 <- cellRendererTextNew - col3 <- treeViewColumnNew - treeViewColumnSetTitle col3 (__ "Context") - treeViewColumnSetSizing col3 TreeViewColumnAutosize - treeViewColumnSetResizable col3 True - treeViewColumnSetReorderable col3 True - treeViewAppendColumn treeView col3 - cellLayoutPackStart col3 renderer3 True - cellLayoutSetAttributes col3 renderer3 grepStore - $ \row -> [ cellText := T.take 2048 $ context row] - - - treeViewSetHeadersVisible treeView True - sel <- treeViewGetSelection treeView - treeSelectionSetMode sel SelectionSingle - - scrolledView <- scrolledWindowNew Nothing Nothing - scrolledWindowSetShadowType scrolledView ShadowIn - containerAdd scrolledView treeView - scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic - - waitingGrep <- newEmptyMVar - activeGrep <- newEmptyMVar - let grep = IDEGrep {..} - let - gotoSource :: Bool -> IO Bool - gotoSource focus = do - sel <- getSelectionGrepRecord treeView grepStore - case sel of - Just record -> reflectIDE ( - case record of - GrepRecord {file=f, line=l, parDir=Just pp} -> - goToSourceDefinition pp (Location f 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 grep) ideR - return True - cid2 <- on treeView keyPressEvent $ do - name <- eventKeyName - liftIO $ case name of - "Return" -> gotoSource True - "Escape" -> do - reflectIDE (do - lastActiveBufferPane ?>>= \paneName -> do - (PaneC pane) <- paneFromName paneName - makeActive pane - return () - triggerEventIDE StartFindInitial) ideR - return True - -- gotoSource True - _ -> return False - on sel treeSelectionSelectionChanged (void (gotoSource False)) - - - return (Just grep,[ConnectC cid1]) - --- | Get the Grep panel -getGrep :: Maybe PanePath -> IDEM IDEGrep -getGrep Nothing = forceGetPane (Right "*Grep") -getGrep (Just pp) = forceGetPane (Left pp) - - --- | Parses a result line of grep output into a 'GrepRecord' -grepLineParser :: CharParser () GrepRecord -grepLineParser = try (do - file <- many (noneOf ":") - char ':' - line <- int - char ':' - context <- T.pack <$> many anyChar - let parDir = Nothing - return GrepRecord {..} - <?> "grepLineParser") - -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 = fromInteger <$> P.integer lexer - - --- | Tries to get the currently selected record in the pane -getSelectionGrepRecord :: TreeView - -> TreeStore GrepRecord - -> IO (Maybe GrepRecord) -getSelectionGrepRecord treeView grepStore = do - treeSelection <- treeViewGetSelection treeView - paths <- treeSelectionGetSelectedRows treeSelection - case paths of - p:_ -> Just <$> treeStoreGetValue grepStore p - _ -> return Nothing - - ---TODO srp use default loglaunch probably --- | Greps the current workspace -grepWorkspace :: Text -- ^ The regex string - -> Bool -- ^ Case sensitive - -> WorkspaceAction -grepWorkspace "" caseSensitive = return () -grepWorkspace regexString caseSensitive = do - ws <- ask - maybeActive <- lift $ readIDE activePack - let packages = case maybeActive of - Just active -> active : filter (/= active) (wsAllPackages ws) - Nothing -> wsAllPackages ws - lift $ grepDirectories regexString caseSensitive $ - map ipdPackageDir packages - - --- | Greps a list of directories -grepDirectories :: Text -- ^ The regex string - -> Bool -- ^ Case sensitive - -> [FilePath] - -> IDEAction -grepDirectories regexString caseSensitive dirs = do - grep <- getGrep Nothing - let store = grepStore grep - ideRef <- ask - liftIO $ do - bringPaneToFront grep - forkIO $ do - putMVar (waitingGrep grep) True - putMVar (activeGrep grep) True - takeMVar (waitingGrep grep) - - postGUISync $ treeStoreClear store - - totalFound <- foldM (\a dir -> do - subDirs <- filter (\f -> - not ("." `isPrefixOf` f) - && f `notElem` ["_darcs", "dist", "vendor"]) <$> getDirectoryContents dir - nooneWaiting <- isEmptyMVar (waitingGrep grep) - found <- if nooneWaiting - then do - (output, pid) <- runTool "grep" ((if caseSensitive then [] else ["-i"]) - ++ ["-R", "-E", "-n", "-I", - "--exclude=*~", - "--exclude-dir=.svn", - "--exclude-dir=_darcs", - "--exclude-dir=.git", - regexString] ++ map T.pack subDirs) (Just dir) - reflectIDE ( - output $$ do - let max = 1000 - CL.isolate max =$ do - n <- setGrepResults dir - when (n >= max) . liftIO $ do - debugM "leksah" "interrupting grep process" - interruptProcessGroupOf pid - `catch` \(_::SomeException) -> return () - postGUISync $ do - nDir <- treeModelIterNChildren store Nothing - treeStoreChange store [nDir-1] (\r -> r{ context = __ "(Stoped Searching)" }) - return () - CL.sinkNull - return n) ideRef - else return 0 - return $ a + found) 0 dirs - - nooneWaiting <- isEmptyMVar (waitingGrep grep) - when nooneWaiting $ postGUISync $ do - nDir <- treeModelIterNChildren store Nothing - treeStoreInsert store [] nDir $ GrepRecord (T.unpack $ __ "Search Complete") totalFound "" Nothing - - void $ takeMVar (activeGrep grep) - return () - - --- | A Sink for processing lines of grep output and counting them -setGrepResults :: FilePath -> C.Sink ToolOutput IDEM Int -setGrepResults dir = do - ideRef <- lift ask - grep <- lift $ getGrep Nothing - log <- lift getLog - defaultLogLaunch <- lift getDefaultLogLaunch - let store = grepStore grep - view = treeView grep - nDir <- liftIO $ postGUISync $ do - nDir <- treeModelIterNChildren store Nothing - treeStoreInsert store [] nDir $ GrepRecord dir 0 "" Nothing - when (nDir == 0) (void $ widgetGrabFocus view) - return nDir - CL.foldM (\count line -> - if isError line - then do - liftIO $ postGUISync $ reflectIDE (void $ defaultLineLogger log defaultLogLaunch line) ideRef - return count - else - case process dir line of - Nothing -> return count - Just record -> liftIO $ do - nooneWaiting <- isEmptyMVar (waitingGrep grep) - when nooneWaiting $ postGUISync $ do - parent <- treeModelGetIter store [nDir] - n <- treeModelIterNChildren store parent - treeStoreInsert store [nDir] n record - treeStoreChange store [nDir] (\r -> r{ line = n+1 }) - when (nDir == 0 && n == 0) $ - treeViewExpandAll view - return (count+1)) 0 - where - process pp (ToolOutput line) = - case parse grepLineParser "" $ T.unpack line of - Right record -> Just record{parDir = Just pp} - _ -> Nothing - process _ _ = Nothing - - isError (ToolExit ExitSuccess) = False - isError (ToolExit (ExitFailure 1)) = False - isError o = isNothing (process "" o) - - - - +{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : IDE.Pane.Grep+-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie+-- License : GNU-GPL+--+-- Maintainer : <maintainer at leksah.org>+-- Stability : provisional+-- Portability : portable+--+-- | The pane of the ide where grep results are displayed+--+-------------------------------------------------------------------------------++module IDE.Pane.Grep (+ IDEGrep(..)+, grepWorkspace+, GrepState(..)+, getGrep+) where++import Prelude ()+import Prelude.Compat+import Control.Applicative (Applicative)+import Text.ParserCombinators.Parsec.Language+import Text.ParserCombinators.Parsec hiding(Parser)+import qualified Text.ParserCombinators.Parsec.Token as P+import Data.Maybe+import Data.Typeable+import Data.List (isPrefixOf)+import IDE.Core.State+import IDE.BufferMode+import IDE.Utils.Tool (runTool, ToolOutput(..), getProcessExitCode, interruptProcessGroupOf)+import Control.Concurrent+ (forkOS, newEmptyMVar, isEmptyMVar, takeMVar, putMVar, MVar,+ forkIO)+import IDE.LogRef (logOutput, defaultLineLogger)+import IDE.Pane.SourceBuffer+ (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..))+import IDE.TextEditor (grabFocus)+import System.FilePath ((</>), dropFileName)+import System.Exit (ExitCode(..))+import IDE.Pane.Log (getLog, getDefaultLogLaunch)+import Control.DeepSeq+import qualified Data.Conduit as C+ (Sink)+import qualified Data.Conduit.List as CL+ (foldM, head, isolate, sinkNull)+import Data.Conduit (($$), (=$))+import Control.Monad (void, foldM, when)+import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO(..))+import IDE.Utils.GUIUtils (__, treeViewToggleRow)+import System.Directory (getDirectoryContents)+import qualified Data.Text as T (pack, take, unpack)+import System.Log.Logger (debugM)+import Control.Exception (SomeException, catch)+import Data.Text (Text)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TreeView+ (treeViewExpandAll, treeViewGetSelection,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..), onTreeViewRowActivated)+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreChange, forestStoreGetValue, ForestStore(..),+ forestStoreNew, forestStoreClear, forestStoreInsert)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Objects.TreeViewColumn+ (treeViewColumnSetReorderable, treeViewColumnSetResizable,+ treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..))+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (onTreeSelectionChanged, treeSelectionSetMode)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gtk.Objects.Widget+ (widgetGrabFocus, onWidgetKeyPressEvent, afterWidgetFocusInEvent,+ toWidget)+import GI.Gdk.Structs.EventKey (getEventKeyKeyval)+import GI.Gdk.Functions (keyvalName)+import Data.GI.Gtk.ModelView.TreeModel+ (treeModelGetIter, treeModelIterNChildren)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices')+import qualified Data.Function as F (on)++-- | Represents a single search result+data GrepRecord = GrepRecord {+ file :: FilePath+ , line :: Int+ , context :: Text+ , parDir :: Maybe FilePath+ }+++-- | Determines whether a 'GrepRecord' is a directory+isDir :: GrepRecord -> Bool+isDir GrepRecord{parDir = Nothing} = True+isDir otherwies = False+++-- | The representation of the Grep result pane+data IDEGrep = IDEGrep {+ scrolledView :: ScrolledWindow+, treeView :: TreeView+, grepStore :: ForestStore GrepRecord+, waitingGrep :: MVar Bool+, activeGrep :: MVar Bool+} deriving Typeable+++-- | The additional state used when recovering the pane+data GrepState = GrepState+ deriving(Eq,Ord,Read,Show,Typeable)+++instance Pane IDEGrep IDEM+ where+ primPaneName _ = __ "Grep"+ getAddedIndex _ = 0+ getTopWidget = liftIO . toWidget . scrolledView+ paneId b = "*Grep"+++instance RecoverablePane IDEGrep GrepState IDEM where+ saveState p = return (Just GrepState)+ recoverState pp GrepState = do+ nb <- getNotebook pp+ buildPane pp nb builder+ builder pp nb windows = do+ grepStore <- forestStoreNew []+ treeView <- treeViewNew+ treeViewSetModel treeView (Just grepStore)++ renderer1 <- cellRendererTextNew+ col1 <- treeViewColumnNew+ treeViewColumnSetTitle col1 (__ "File")+ treeViewColumnSetSizing col1 TreeViewColumnSizingAutosize+ treeViewColumnSetResizable col1 True+ treeViewColumnSetReorderable col1 True+ treeViewAppendColumn treeView col1+ cellLayoutPackStart col1 renderer1 True+ cellLayoutSetDataFunction col1 renderer1 grepStore+ $ \row -> setCellRendererTextText renderer1 . T.pack $ file row++ renderer2 <- cellRendererTextNew+ col2 <- treeViewColumnNew+ treeViewColumnSetTitle col2 (__ "Line")+ treeViewColumnSetSizing col2 TreeViewColumnSizingAutosize+ treeViewColumnSetResizable col2 True+ treeViewColumnSetReorderable col2 True+ treeViewAppendColumn treeView col2+ cellLayoutPackStart col2 renderer2 True+ cellLayoutSetDataFunction col2 renderer2 grepStore+ $ setCellRendererTextText renderer2 . T.pack . show . line++ renderer3 <- cellRendererTextNew+ col3 <- treeViewColumnNew+ treeViewColumnSetTitle col3 (__ "Context")+ treeViewColumnSetSizing col3 TreeViewColumnSizingAutosize+ treeViewColumnSetResizable col3 True+ treeViewColumnSetReorderable col3 True+ treeViewAppendColumn treeView col3+ cellLayoutPackStart col3 renderer3 True+ cellLayoutSetDataFunction col3 renderer3 grepStore+ $ setCellRendererTextText renderer3 . T.take 2048 . context+++ treeViewSetHeadersVisible treeView True+ sel <- treeViewGetSelection treeView+ treeSelectionSetMode sel SelectionModeSingle++ onTreeViewRowActivated treeView $ \path col ->+ void $ treeViewToggleRow treeView path++ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn+ containerAdd scrolledView treeView+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic++ waitingGrep <- liftIO newEmptyMVar+ activeGrep <- liftIO newEmptyMVar+ let grep = IDEGrep {..}+ let+ gotoSource :: Bool -> IDEM Bool+ gotoSource focus = do+ sel <- getSelectionGrepRecord treeView grepStore+ case sel of+ Just record ->+ case record of+ GrepRecord {file=f, line=l, parDir=Just pp} ->+ goToSourceDefinition pp (Location f l 0 l 0) ?>>=+ (\ IDEBuffer{sourceView = sv} -> when focus $ grabFocus sv)+ _ -> return ()+ Nothing -> return ()+ return True+ cid1 <- onIDE afterWidgetFocusInEvent treeView $ do+ liftIDE $ makeActive grep+ return True+ cid2 <- onIDE onWidgetKeyPressEvent treeView $ do+ e <- lift ask+ name <- getEventKeyKeyval e >>= keyvalName+ liftIDE $+ case name of+ Just "Return" -> gotoSource True+ Just "Escape" -> do+ lastActiveBufferPane ?>>= \paneName -> do+ (PaneC pane) <- paneFromName paneName+ makeActive pane+ return ()+ triggerEventIDE StartFindInitial+ return True+ -- gotoSource True+ _ -> return False+ ideR <- ask+ onTreeSelectionChanged sel (void (reflectIDE (gotoSource False) ideR))++ return (Just grep,[cid1, cid2])++-- | Get the Grep panel+getGrep :: Maybe PanePath -> IDEM IDEGrep+getGrep Nothing = forceGetPane (Right "*Grep")+getGrep (Just pp) = forceGetPane (Left pp)+++-- | Parses a result line of grep output into a 'GrepRecord'+grepLineParser :: CharParser () GrepRecord+grepLineParser = try (do+ file <- many (noneOf ":")+ char ':'+ line <- int+ char ':'+ context <- T.pack <$> many anyChar+ let parDir = Nothing+ return GrepRecord {..}+ <?> "grepLineParser")++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 = fromInteger <$> P.integer lexer+++-- | Tries to get the currently selected record in the pane+getSelectionGrepRecord :: (Applicative m, MonadIO m)+ => TreeView+ -> ForestStore GrepRecord+ -> m (Maybe GrepRecord)+getSelectionGrepRecord treeView grepStore = do+ treeSelection <- treeViewGetSelection treeView+ paths <- treeSelectionGetSelectedRows' treeSelection+ case paths of+ p:_ -> Just <$> forestStoreGetValue grepStore p+ _ -> return Nothing+++--TODO srp use default loglaunch probably+-- | Greps the current workspace+grepWorkspace :: Text -- ^ The regex string+ -> Bool -- ^ Case sensitive+ -> WorkspaceAction+grepWorkspace "" caseSensitive = return ()+grepWorkspace regexString caseSensitive = do+ ws <- ask+ maybeActive <- lift $ readIDE activePack+ let packages = case maybeActive of+ Just active -> active : filter (((/=) `F.on` ipdCabalFile) active) (wsAllPackages ws)+ Nothing -> wsAllPackages ws+ lift $ grepDirectories regexString caseSensitive $+ map ipdPackageDir packages+++-- | Greps a list of directories+grepDirectories :: Text -- ^ The regex string+ -> Bool -- ^ Case sensitive+ -> [FilePath]+ -> IDEAction+grepDirectories regexString caseSensitive dirs = do+ grep <- getGrep Nothing+ let store = grepStore grep+ ideRef <- ask+ bringPaneToFront grep+ liftIO . forkIO . (`reflectIDE` ideRef) $ do+ liftIO $ do+ putMVar (waitingGrep grep) True+ putMVar (activeGrep grep) True+ takeMVar (waitingGrep grep)++ postSyncIDE $ forestStoreClear store++ totalFound <- foldM (\a dir -> do+ subDirs <- liftIO $ filter (\f ->+ not ("." `isPrefixOf` f)+ && f `notElem` ["_darcs", "dist", "dist-newstyle", "vendor"]) <$> getDirectoryContents dir+ nooneWaiting <- liftIO $ isEmptyMVar (waitingGrep grep)+ found <- if nooneWaiting+ then do+ (output, pid) <- liftIO $ runTool "grep" ((if caseSensitive then [] else ["-i"])+ ++ ["-R", "-E", "-n", "-I",+ "--exclude=*~",+ "--exclude-dir=.svn",+ "--exclude-dir=_darcs",+ "--exclude-dir=.git",+ regexString] ++ map T.pack subDirs) (Just dir) Nothing+ output $$ do+ let max = 1000+ CL.isolate max =$ do+ n <- setGrepResults dir+ when (n >= max) $ do+ liftIO $ debugM "leksah" "interrupting grep process"+ liftIO $ interruptProcessGroupOf pid+ `catch` \(_::SomeException) -> return ()+ lift $ postSyncIDE $ do+ nDir <- treeModelIterNChildren store Nothing+ p <- treePathNewFromIndices' [nDir-1]+ forestStoreChange store p (\r -> r{ context = __ "(Stoped Searching)" })+ return ()+ CL.sinkNull+ return n+ else return 0+ return $ a + found) 0 dirs++ nooneWaiting <- liftIO $ isEmptyMVar (waitingGrep grep)+ when nooneWaiting $ postSyncIDE $ do+ nDir <- treeModelIterNChildren store Nothing+ p <- treePathNewFromIndices' []+ forestStoreInsert store p (fromIntegral nDir) $ GrepRecord (T.unpack $ __ "Search Complete") totalFound "" Nothing++ void $ liftIO $ takeMVar (activeGrep grep)+ return ()+++-- | A Sink for processing lines of grep output and counting them+setGrepResults :: FilePath -> C.Sink ToolOutput IDEM Int+setGrepResults dir = do+ ideRef <- lift ask+ grep <- lift $ getGrep Nothing+ log <- lift getLog+ defaultLogLaunch <- lift getDefaultLogLaunch+ let store = grepStore grep+ view = treeView grep+ nDir <- lift $ postSyncIDE $ do+ nDir <- treeModelIterNChildren store Nothing+ p <- treePathNewFromIndices' []+ forestStoreInsert store p (fromIntegral nDir) $ GrepRecord dir 0 "" Nothing+ when (nDir == 0) (void $ widgetGrabFocus view)+ return nDir+ CL.foldM (\count line ->+ if isError line+ then do+ postSyncIDE $ void $ defaultLineLogger log defaultLogLaunch line+ return count+ else+ case process dir line of+ Nothing -> return count+ Just record -> do+ nooneWaiting <- liftIO $ isEmptyMVar (waitingGrep grep)+ when nooneWaiting . postSyncIDE $ do+ p <- treePathNewFromIndices' [nDir]+ Just parent <- treeModelGetIter store p+ n <- treeModelIterNChildren store (Just parent)+ forestStoreInsert store p (fromIntegral n) record+ forestStoreChange store p (\r -> r{ line = fromIntegral n+1 })+ when (nDir == 0 && n == 0) $+ treeViewExpandAll view+ return (count+1)) 0+ where+ process pp (ToolOutput line) =+ case parse grepLineParser "" $ T.unpack line of+ Right record -> Just record{parDir = Just pp}+ _ -> Nothing+ process _ _ = Nothing++ isError (ToolExit ExitSuccess) = False+ isError (ToolExit (ExitFailure 1)) = False+ isError o = isNothing (process "" o)++++
src/IDE/Pane/HLint.hs view
@@ -26,13 +26,14 @@ import Graphics.UI.Frame.Panes (RecoverablePane(..), RecoverablePane, Pane(..))-import Graphics.UI.Gtk.Display.Label (labelNew, Label) import Data.Typeable (Typeable) import IDE.Core.Types (IDEM)-import Graphics.UI.Gtk.Abstract.Widget (castToWidget) import Graphics.UI.Frame.ViewFrame (getNotebook) import IDE.Core.State (reifyIDE) import Data.Text (Text)+import GI.Gtk.Objects.Label (labelNew, Label(..))+import Control.Monad.IO.Class (MonadIO(..))+import GI.Gtk.Objects.Widget (toWidget, Widget(..)) data IDEHLint = IDEHLint { deprecatedLabel :: Label@@ -45,7 +46,7 @@ where primPaneName _ = "HLint" getAddedIndex _ = 0- getTopWidget = castToWidget . deprecatedLabel+ getTopWidget = liftIO . toWidget . deprecatedLabel paneId b = "*HLint" instance RecoverablePane IDEHLint HLintState IDEM where@@ -54,5 +55,5 @@ nb <- getNotebook pp buildPane pp nb builder builder pp nb windows = reifyIDE $ \ ideR -> do- deprecatedLabel <- labelNew $ Just ("HLint has moved to the Errors pane and Package -> HLint menu item"::Text)+ deprecatedLabel <- labelNew $ Just "HLint has moved to the Errors pane and Package -> HLint menu item" return (Just IDEHLint {..}, [])
src/IDE/Pane/Info.hs view
@@ -42,16 +42,20 @@ import IDE.Utils.GUIUtils (openBrowser, __) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..))-import Graphics.UI.Gtk- (widgetHide, widgetShowAll, menuShellAppend,- menuItemActivate, menuItemNewWithLabel, containerGetChildren, Menu,- scrolledWindowSetPolicy, castToWidget, ScrolledWindow)-import Graphics.UI.Gtk.General.Enums (PolicyType(..))-import System.Glib.Signals (on) import Control.Monad (unless, void) import Data.Foldable (forM_) import qualified Data.Text as T (unpack, pack, null) import Data.Monoid ((<>))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, ScrolledWindow(..))+import GI.Gtk.Objects.Widget (widgetHide, widgetShowAll, toWidget)+import GI.Gtk.Enums (PolicyType(..))+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.Container (containerGetChildren)+import GI.Gtk.Objects.MenuItem+ (onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Gtk.Objects.TextView (textViewSetEditable) -- | Represents the Info pane@@ -71,7 +75,7 @@ where primPaneName _ = __ "Symbol Info" getAddedIndex _ = 0- getTopWidget = castToWidget . sw+ getTopWidget = liftIO . toWidget . sw paneId b = "*Info" @@ -87,12 +91,10 @@ prefs <- readIDE prefs ideR <- ask descriptionBuffer <- newDefaultBuffer Nothing ""- descriptionView <- newView descriptionBuffer (textviewFont prefs)-+ (descriptionView@(GtkView v), sw) <- newView descriptionBuffer (textviewFont prefs)+ textViewSetEditable v False updateStyle descriptionBuffer - sw <- getScrolledWindow descriptionView- createHyperLinkSupport descriptionView sw (\_ _ iter -> do (beg, en) <- getIdentifierUnderCursorFromIter (iter, iter) return (beg, en)) (\_ shift' slice ->@@ -102,13 +104,13 @@ return () ) - liftIO $ scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic --openType currentDescr' <- liftIO $ newIORef idDescr cids1 <- onPopulatePopup descriptionView $ \ menu -> do ideR <- ask- liftIO $ populatePopupMenu ideR currentDescr' menu+ populatePopupMenu ideR currentDescr' menu let info = IDEInfo sw currentDescr' descriptionView -- ids5 <- sv `onLookupInfo` selectInfo descriptionView -- obsolete by hyperlinks cids2 <- descriptionView `afterFocusIn` makeActive info@@ -209,15 +211,15 @@ -- | Builds the context menu of the Info pane-populatePopupMenu :: IDERef -> IORef (Maybe Descr) -> Menu -> IO ()+populatePopupMenu :: MonadIO m => IDERef -> IORef (Maybe Descr) -> Menu -> m () populatePopupMenu ideR currentDescr' menu = do items <- containerGetChildren menu item0 <- menuItemNewWithLabel (__ "Goto Definition")- item0 `on` menuItemActivate $ reflectIDE gotoSource ideR+ onMenuItemActivate item0 $ reflectIDE gotoSource ideR item1 <- menuItemNewWithLabel (__ "Select Module")- item1 `on` menuItemActivate $ reflectIDE gotoModule' ideR+ onMenuItemActivate item1 $ reflectIDE gotoModule' ideR item2 <- menuItemNewWithLabel (__ "Open Documentation")- item2 `on` menuItemActivate $ reflectIDE openDocu ideR+ onMenuItemActivate item2 $ reflectIDE openDocu ideR menuShellAppend menu item0 menuShellAppend menu item1 menuShellAppend menu item2
src/IDE/Pane/Log.hs view
@@ -4,6 +4,9 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- -- Module : IDE.Pane.Log -- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie@@ -38,6 +41,8 @@ , showDefaultLogLaunch' ) where +import Prelude ()+import Prelude.Compat import Data.Typeable (Typeable(..)) import IDE.Core.State import IDE.Core.Types(LogLaunch)@@ -45,37 +50,11 @@ import Control.Monad.Reader (ask, unless) import IDE.Pane.SourceBuffer (markRefInSourceBuf,selectSourceBuf) import System.IO-import Prelude hiding (catch) import Control.Exception hiding (try) import IDE.ImportTool (resolveErrors, addResolveMenuItems) import IDE.Utils.Tool (terminateProcess, runInteractiveProcess, ProcessHandle)-import Graphics.UI.Gtk- (textBufferSetText, textViewScrollToMark,- textBufferGetIterAtLineOffset, textViewScrollMarkOnscreen, textViewSetBuffer,- textBufferGetMark, textBufferMoveMarkByName,- textBufferApplyTagByName, textBufferGetIterAtOffset,- textBufferGetCharCount, textBufferInsert, textBufferSelectRange,- widgetHide, widgetShowAll, menuShellAppend,- menuItemNewWithLabel, containerGetChildren, textIterGetLine,- textViewGetLineAtY, textViewWindowToBufferCoords, widgetGetPointer,- on, populatePopup, eventCoordinates, eventClick, eventButton,- buttonPressEvent, focusInEvent, textBufferNew,- scrolledWindowSetShadowType, scrolledWindowSetPolicy, containerAdd,- containerForeach, containerRemove, changed, Click(..), MouseButton(..),- scrolledWindowNew, widgetModifyFont, fontDescriptionSetFamily,- fontDescriptionNew, fontDescriptionFromString, textViewSetEditable,- textTagBackground, textTagTableAdd, textTagForeground, textTagNew,- textBufferGetTagTable, textBufferCreateMark, textBufferGetEndIter,- textViewGetBuffer, textViewNew, Window, Notebook, castToWidget,- ScrolledWindow, TextView, Container, ComboBox, HBox, VBox, Menu, AttrOp(..), set,- TextWindowType(..), ShadowType(..), PolicyType(..), hBoxNew, buttonNewWithLabel,- vBoxNew, comboBoxNewText, menuItemActivate,- comboBoxAppendText, comboBoxSetActive, comboBoxGetActiveText,- priorityDefault, idleAdd,Frame, frameNew,buttonActivated,- boxPackStart, boxPackEnd, Packing(..), comboBoxGetActive, comboBoxRemoveText,- comboBoxGetModelText, listStoreToList, after) --TODO remove import for logging only import qualified Data.Map as Map import Data.Maybe import Distribution.Package@@ -90,6 +69,68 @@ import Data.List (elemIndex, isPrefixOf, isSuffixOf, findIndex) import qualified Data.Foldable as F (toList, forM_) import qualified Data.Sequence as Seq (empty)+import GI.Gtk.Objects.Box (boxNew, Box(..))+import GI.Gtk.Objects.TextView+ (textViewScrollToMark, textViewGetBuffer,+ textViewScrollMarkOnscreen, textViewGetLineAtY,+ textViewWindowToBufferCoords, onTextViewPopulatePopup,+ textViewSetBuffer, textViewSetEditable, textViewNew, TextView(..))+import GI.Gtk.Objects.ComboBox+ (onComboBoxChanged, comboBoxSetActive, comboBoxGetActive,+ ComboBox(..))+import Data.GI.Gtk.ComboBox+ (comboBoxNewText, comboBoxGetModelText, comboBoxRemoveText,+ comboBoxAppendText, comboBoxGetActiveText)+import Data.GI.Gtk.ModelView.SeqStore (seqStoreToList)+import GI.Gtk.Objects.Widget+ (widgetHide, widgetShowAll, widgetGetPointer,+ onWidgetButtonPressEvent, afterWidgetFocusInEvent,+ widgetModifyFont, toWidget)+import GI.Gtk.Objects.TextBuffer+ (textBufferSetText, textBufferGetIterAtLineOffset,+ textBufferGetMark, textBufferMoveMarkByName,+ textBufferApplyTagByName, textBufferGetIterAtOffset,+ textBufferGetCharCount, textBufferInsert, textBufferSelectRange,+ textBufferGetTagTable, textBufferCreateMark, textBufferGetEndIter,+ textBufferNew)+import GI.Gtk.Objects.TextTag+ (setTextTagBackground, setTextTagForeground, textTagNew)+import Data.GI.Base (unsafeCastTo, set)+import GI.Gtk.Objects.TextTagTable+ (noTextTagTable, textTagTableAdd)+import GI.Gtk.Objects.Notebook (Notebook(..))+import GI.Gtk.Objects.Window (Window(..))+import Graphics.UI.Editor.Parameters+ (Packing(..), boxPackEnd', boxPackStart')+import GI.Gtk.Objects.Button (onButtonClicked, buttonNewWithLabel)+import GI.Pango.Structs.FontDescription+ (fontDescriptionSetFamily, fontDescriptionNew,+ fontDescriptionFromString)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetShadowType, scrolledWindowSetPolicy,+ scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container+ (containerGetChildren, containerAdd)+import GI.Gtk.Enums+ (TextWindowType(..), ShadowType(..), PolicyType(..), Orientation(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import GI.Gdk.Structs.EventButton+ (getEventButtonY, getEventButtonX, getEventButtonButton,+ getEventButtonType)+import GI.Gdk.Enums (EventType(..), EventType)+import Data.Word (Word32)+import GI.Gdk.Constants (pattern BUTTON_PRIMARY)+import GI.Gtk.Structs.TextIter (textIterGetLine)+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.MenuItem+ (onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.GLib.Functions (idleAdd)+import GI.GLib.Constants (pattern PRIORITY_DEFAULT)+import Data.Int (Int32)+import Control.Monad.IO.Class (MonadIO)+import GI.Gtk (widgetOverrideFont) ------------------------------------------------------------------------------- --@@ -102,9 +143,9 @@ data IDELog = IDELog {- logMainContainer :: VBox+ logMainContainer :: Box , logLaunchTextView :: TextView-, logButtons :: HBox+, logButtons :: Box , logLaunchBox :: ComboBox } deriving Typeable @@ -113,7 +154,7 @@ log <- getLog let comboBox = logLaunchBox log launches <- readIDE logLaunches- active <- liftIO $ comboBoxGetActiveText comboBox+ active <- comboBoxGetActiveText comboBox case active of Nothing -> getDefaultLogLaunch Just key -> return $ logLaunch $ launches Map.! key@@ -177,7 +218,7 @@ addLogLaunchData name logLaunch pid = do log <- getLog let comboBox = logLaunchBox log- liftIO $ comboBoxAppendText comboBox name+ comboBoxAppendText comboBox name launches <- readIDE logLaunches let newLaunches = Map.insert name (LogLaunchData logLaunch (Just pid)) launches modifyIDE_ (\ide -> ide {logLaunches = newLaunches})@@ -190,18 +231,18 @@ log <- getLog let comboBox = logLaunchBox log - index <- liftIO $ comboBoxGetActive comboBox- mbTitle <- liftIO $ comboBoxGetActiveText comboBox+ index <- comboBoxGetActive comboBox+ mbTitle <- comboBoxGetActiveText comboBox -- liftIO $ putStrLn $ "Lauch to remove: index " ++ (show index) ++ ", mbTitle: "++ (show mbTitle) let title = fromJust mbTitle --- model <- liftIO $ comboBoxGetModelText comboBox--- list <- liftIO $ listStoreToList model+-- model <- comboBoxGetModelText comboBox+-- list <- seqStoreToList model -- liftIO $ putStrLn $ "Underlying model " ++ (show list) - liftIO $ showDefaultLogLaunch comboBox- liftIO $ comboBoxRemoveText comboBox index+ showDefaultLogLaunch comboBox+ comboBoxRemoveText comboBox index -- liftIO $ putStrLn $ "Removed launch from combobox." launches <- readIDE logLaunches -- liftIO $ putStrLn $ "Number of available launches: "++(show $ length $ Map.toList launches)@@ -209,15 +250,15 @@ modifyIDE_ (\ide -> ide {logLaunches = newLaunches}) -- liftIO $ putStrLn $ "Removed log launch data successfully from ide" -showDefaultLogLaunch :: ComboBox -> IO()+showDefaultLogLaunch :: MonadIO m => ComboBox -> m () showDefaultLogLaunch comboBox = comboBoxSetActive comboBox 0 -showDefaultLogLaunch' :: IDEM ()+showDefaultLogLaunch' :: MonadIDE m => m () showDefaultLogLaunch' = do log <- getLog let comboBox = logLaunchBox log - liftIO $ showDefaultLogLaunch comboBox+ showDefaultLogLaunch comboBox showLogLaunch :: Text -> IDEM () showLogLaunch name = do@@ -225,15 +266,15 @@ log <- getLog let comboBox = logLaunchBox log - model <- liftIO $ comboBoxGetModelText comboBox- list <- liftIO $ listStoreToList model+ model <- comboBoxGetModelText comboBox+ list <- seqStoreToList model let mbIndex = elemIndex name list liftIO $ putStrLn $ "showLogLaunch: mbIndex = " ++ show mbIndex case mbIndex of Nothing -> return() -- TODO errorCalls- Just index -> liftIO $ comboBoxSetActive comboBox index+ Just index -> comboBoxSetActive comboBox (fromIntegral index) liftIO $ putStrLn "switched to loglaunch" data LogState = LogState@@ -243,7 +284,7 @@ where primPaneName _ = __ "Log" getAddedIndex _ = 0- getTopWidget = castToWidget . logMainContainer+ getTopWidget = liftIO . toWidget . logMainContainer paneId b = "*Log" instance RecoverablePane IDELog LogState IDEM where@@ -265,29 +306,29 @@ createNewLogLaunch :: IO LogLaunch createNewLogLaunch = do- buf <- textBufferNew Nothing+ buf <- textBufferNew noTextTagTable iter <- textBufferGetEndIter buf textBufferCreateMark buf (Just "end") iter True tags <- textBufferGetTagTable buf errtag <- textTagNew (Just "err")- set errtag[textTagForeground := ("red" :: Text)]+ setTextTagForeground errtag "red" textTagTableAdd tags errtag frametag <- textTagNew (Just "frame")- set frametag[textTagForeground := ("dark green" :: Text)]+ setTextTagForeground frametag "dark green" textTagTableAdd tags frametag activeErrtag <- textTagNew (Just "activeErr")- set activeErrtag[textTagBackground := ("yellow" :: Text)]+ setTextTagBackground activeErrtag "yellow" textTagTableAdd tags activeErrtag intputTag <- textTagNew (Just "input")- set intputTag[textTagForeground := ("blue" :: Text)]+ setTextTagForeground intputTag "blue" textTagTableAdd tags intputTag infoTag <- textTagNew (Just "info")- set infoTag[textTagForeground := ("grey" :: Text)]+ setTextTagForeground infoTag "grey" textTagTableAdd tags infoTag return $ LogLaunch buf@@ -304,111 +345,112 @@ modifyIDE_ $ \ide -> ide { logLaunches = map} ideR <- ask- reifyIDE $ \ideR -> do- mainContainer <- vBoxNew False 0+ mainContainer <- boxNew OrientationVertical 0 - -- top, buttons and combobox- hBox <- hBoxNew False 0- boxPackStart mainContainer hBox PackNatural 0+ -- top, buttons and combobox+ hBox <- boxNew OrientationHorizontal 0+ boxPackStart' mainContainer hBox PackNatural 0 - terminateBtn <- buttonNewWithLabel (__ "Terminate process")- boxPackStart hBox terminateBtn PackNatural 0- removeBtn <- buttonNewWithLabel (__ "Remove launch")- boxPackStart hBox removeBtn PackNatural 0- comboBox <- comboBoxNewText- boxPackEnd hBox comboBox PackGrow 0+ terminateBtn <- buttonNewWithLabel (__ "Terminate process")+ boxPackStart' hBox terminateBtn PackNatural 0+ removeBtn <- buttonNewWithLabel (__ "Remove launch")+ boxPackStart' hBox removeBtn PackNatural 0+ comboBox <- comboBoxNewText+ boxPackEnd' hBox comboBox PackGrow 0 - -- bot, launch textview in a scrolled window- tv <- textViewNew- textViewSetEditable tv False- fd <- case logviewFont prefs of- Just str -> fontDescriptionFromString str- Nothing -> do- f <- fontDescriptionNew- fontDescriptionSetFamily f ("Sans" :: Text)- return f- widgetModifyFont tv (Just fd)- sw <- scrolledWindowNew Nothing Nothing- containerAdd sw tv- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic- scrolledWindowSetShadowType sw ShadowIn+ -- bot, launch textview in a scrolled window+ tv <- textViewNew+ textViewSetEditable tv False+ fd <- case logviewFont prefs of+ (True, Just str) -> fontDescriptionFromString str+ _ -> do+ f <- fontDescriptionNew+ fontDescriptionSetFamily f "Monospace"+ return f+ widgetOverrideFont tv (Just fd)+ sw <- scrolledWindowNew noAdjustment noAdjustment+ containerAdd sw tv+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic+ scrolledWindowSetShadowType sw ShadowTypeIn - boxPackEnd mainContainer sw PackGrow 0+ boxPackEnd' mainContainer sw PackGrow 0 - -- add default launch- textViewSetBuffer tv (logBuffer newLogLaunch)- index <- comboBoxAppendText comboBox defaultLogName- comboBoxSetActive comboBox index+ -- add default launch+ textViewSetBuffer tv (Just $ logBuffer newLogLaunch)+ index <- comboBoxAppendText comboBox defaultLogName+ comboBoxSetActive comboBox index - on comboBox changed $ do- mbTitle <- comboBoxGetActiveText comboBox- case mbTitle of- Nothing -> showDefaultLogLaunch comboBox- Just title -> reflectIDE (- do- launches <- readIDE logLaunches- log <- getLog- let tv = logLaunchTextView log- let logL = logLaunch $ (Map.!) launches title- let buf = logBuffer logL+ onComboBoxChanged comboBox $ do+ mbTitle <- comboBoxGetActiveText comboBox+ case mbTitle of+ Nothing -> showDefaultLogLaunch comboBox+ Just title -> reflectIDE (+ do+ launches <- readIDE logLaunches+ log <- getLog+ let tv = logLaunchTextView log+ let logL = logLaunch $ (Map.!) launches title+ let buf = logBuffer logL - liftIO $ textViewSetBuffer tv buf- )- ideR+ textViewSetBuffer tv (Just buf)+ )+ ideR - on terminateBtn buttonActivated $ do- mbTitle <- comboBoxGetActiveText comboBox- case mbTitle of- Nothing -> return()- Just title -> reflectIDE (- do- launches <- readIDE logLaunches- terminateLogLaunch title launches- )- ideR+ onButtonClicked terminateBtn $ do+ mbTitle <- comboBoxGetActiveText comboBox+ case mbTitle of+ Nothing -> return()+ Just title -> reflectIDE (+ do+ launches <- readIDE logLaunches+ terminateLogLaunch title launches+ )+ ideR - on removeBtn buttonActivated $ do- mbTitle <- comboBoxGetActiveText comboBox- case mbTitle of- Nothing -> return()- Just title -> unless (title == defaultLogName) $- reflectIDE- (do launches <- readIDE logLaunches- removeActiveLogLaunchData- terminateLogLaunch title launches)- ideR+ onButtonClicked removeBtn $ do+ mbTitle <- comboBoxGetActiveText comboBox+ case mbTitle of+ Nothing -> return()+ Just title -> unless (title == defaultLogName) $+ reflectIDE+ (do launches <- readIDE logLaunches+ removeActiveLogLaunchData+ terminateLogLaunch title launches)+ ideR - let buf = IDELog mainContainer tv hBox comboBox- cid1 <- after tv focusInEvent $ do- liftIO $ reflectIDE (makeActive buf) ideR- return False- cid2 <- on tv buttonPressEvent $ do- click <- eventClick- button <- eventButton- (x, y) <- eventCoordinates- liftIO $ reflectIDE (clicked click button x y buf) ideR- return False- cid3 <- on tv populatePopup $ populatePopupMenu buf ideR- return (Just buf, [ConnectC cid1, ConnectC cid2])- where- terminateLogLaunch title launches = do- let mbPH = mbPid $ fromJust $ Map.lookup title launches- case mbPH of- Nothing -> return ()- Just ph -> liftIO $ terminateProcess ph+ let buf = IDELog mainContainer tv hBox comboBox+ cid1 <- onIDE afterWidgetFocusInEvent tv $ do+ liftIDE $ makeActive buf+ return False+ cid2 <- onIDE onWidgetButtonPressEvent tv $ do+ e <- lift ask+ click <- getEventButtonType e+ button <- getEventButtonButton e+ x <- getEventButtonX e+ y <- getEventButtonY e+ liftIDE $ clicked click (fromIntegral button) x y buf+ return False+ cid3 <- ConnectC tv <$> onTextViewPopulatePopup tv (\w ->+ unsafeCastTo Menu w >>= populatePopupMenu buf ideR)+ return (Just buf, [cid1, cid2, cid3])+ where+ terminateLogLaunch title launches = do+ let mbPH = mbPid $ fromJust $ Map.lookup title launches+ case mbPH of+ Nothing -> return ()+ Just ph -> liftIO $ terminateProcess ph -clicked :: Click -> MouseButton -> Double -> Double -> IDELog -> IDEAction-clicked SingleClick LeftButton x y log = do+clicked :: EventType -> Int32 -> Double -> Double -> IDELog -> IDEAction+clicked EventTypeButtonPress BUTTON_PRIMARY x y log = do logRefs' <- readIDE allLogRefs log <- getLog- line' <- liftIO $ do- let tv = logLaunchTextView log- (x,y) <- widgetGetPointer tv- (_,y') <- textViewWindowToBufferCoords tv TextWindowWidget (x,y)- (iter,_) <- textViewGetLineAtY tv y'- textIterGetLine iter+ let tv = logLaunchTextView log+ (x,y) <- widgetGetPointer tv+ (_,y') <- textViewWindowToBufferCoords tv TextWindowTypeWidget x y+ (iter,_) <- textViewGetLineAtY tv y'+ line' <- fromIntegral <$> textIterGetLine iter case [(s,e,es) | es@LogRef{logLines = Just (s, e)} <- F.toList logRefs', s <= (line'+1) && e >= (line'+1)] of [(s,e,thisRef)] -> do mbBuf <- selectSourceBuf (logRefFullFilePath thisRef)@@ -426,8 +468,8 @@ populatePopupMenu :: IDELog -> IDERef -> Menu -> IO () populatePopupMenu log ideR menu = do items <- containerGetChildren menu- item0 <- menuItemNewWithLabel (__ "Resolve Errors")- item0 `on` menuItemActivate $ reflectIDE resolveErrors ideR+ item0 <- menuItemNewWithLabel (__ "Resolve Errors")+ onMenuItemActivate item0 $ reflectIDE resolveErrors ideR menuShellAppend menu item0 res <- reflectIDE (do log <- getLog@@ -436,9 +478,9 @@ line' <- reifyIDE $ \ideR -> do let tv = logLaunchTextView log (x,y) <- widgetGetPointer tv- (_,y') <- textViewWindowToBufferCoords tv TextWindowWidget (x,y)+ (_,y') <- textViewWindowToBufferCoords tv TextWindowTypeWidget x y (iter,_) <- textViewGetLineAtY tv y'- textIterGetLine iter+ fromIntegral <$> textIterGetLine iter return [es | es@LogRef{logLines = Just (s, e)} <- F.toList logRefs', s <= (line'+1) && e >= (line'+1)]) ideR case res of [thisRef] -> do@@ -448,9 +490,9 @@ otherwise -> return () mapM_ widgetHide $ take 2 (reverse items) -getLog :: IDEM IDELog+getLog :: MonadIDE m => m IDELog getLog = do- mbPane <- getOrBuildPane (Right "*Log")+ mbPane <- liftIDE $ getOrBuildPane (Right "*Log") case mbPane of Nothing -> throwIDE (__ "Can't init log") Just p -> return p@@ -470,7 +512,7 @@ let buf = logBuffer logLaunch iter <- textBufferGetEndIter buf textBufferSelectRange buf iter iter- textBufferInsert buf iter text+ textBufferInsert buf iter text (-1) iter2 <- textBufferGetEndIter buf let tagName = case tag of LogTag -> Nothing@@ -483,39 +525,36 @@ Nothing -> return () Just name -> do len <- textBufferGetCharCount buf- strti <- textBufferGetIterAtOffset buf (len - T.length text)+ strti <- textBufferGetIterAtOffset buf (len - fromIntegral (T.length text)) textBufferApplyTagByName buf name iter2 strti textBufferMoveMarkByName buf "end" iter2 mbMark <- textBufferGetMark buf "end" line <- textIterGetLine iter2 F.forM_ mbMark (textViewScrollMarkOnscreen tv)- return line+ return $ fromIntegral line markErrorInLog :: IDELog -> (Int,Int) -> IDEAction markErrorInLog log (l1,l2) = do let tv = logLaunchTextView log- liftIO $ idleAdd (do+ idleAdd PRIORITY_DEFAULT (do buf <- textViewGetBuffer tv- iter <- textBufferGetIterAtLineOffset buf (l1-1) 0- iter2 <- textBufferGetIterAtLineOffset buf l2 0+ iter <- textBufferGetIterAtLineOffset buf (fromIntegral l1-1) 0+ iter2 <- textBufferGetIterAtLineOffset buf (fromIntegral l2) 0 textBufferSelectRange buf iter iter2 textBufferMoveMarkByName buf "end" iter- mbMark <- textBufferGetMark buf "end"- case mbMark of+ textBufferGetMark buf "end" >>= \case Nothing -> return ()- Just mark -> do- textViewScrollToMark tv mark 0.0 (Just (0.3,0.3))- return ()- return False) priorityDefault+ Just mark -> textViewScrollToMark tv mark 0.0 True 0.3 0.3+ return False) return () clearLog :: IDEAction clearLog = do log <- getLog- buf <- liftIO $ textViewGetBuffer $ logLaunchTextView log- liftIO $ textBufferSetText buf ("" :: Text)+ buf <- textViewGetBuffer $ logLaunchTextView log+ textBufferSetText buf "" 0 modifyIDE_ (\ide -> ide{allLogRefs = Seq.empty}) setCurrentError Nothing setCurrentBreak Nothing
src/IDE/Pane/Modules.hs view
@@ -1,9 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Modules@@ -31,19 +33,18 @@ , addModule ) where -import Graphics.UI.Gtk hiding (get)-import Graphics.UI.Gtk.Gdk.Events+import Prelude ()+import Prelude.Compat import Data.Maybe import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Set as Set import Data.Set (Set) import Data.Tree-import Data.List+import Data.List (find, elemIndex, foldl', nub, partition, sort) import Distribution.Package import Distribution.Version import Data.Char (toLower)-import Prelude hiding (catch) import Data.IORef import IDE.Core.State import IDE.Pane.Info@@ -52,7 +53,6 @@ import Distribution.Text (simpleParse,display) import Data.Typeable (Typeable(..)) import Control.Exception (SomeException(..),catch)-import Control.Applicative ((<$>)) import IDE.Package (packageConfig,addModuleToPackageDescr,delModuleFromPackageDescr,getEmptyModuleTemplate,getPackageDescriptionAndPath, ModuleLocation(..)) import Distribution.PackageDescription (PackageDescription, BuildInfo, hsSourceDirs,@@ -63,13 +63,14 @@ import System.Directory (doesFileExist,createDirectoryIfMissing, removeFile) import Graphics.UI.Editor.MakeEditor (buildEditor,FieldDescription(..),mkField) import Graphics.UI.Editor.Parameters- (paraMinSize, paraMultiSel, Parameter(..), emptyParams, (<<<-),- paraName)+ (dialogRun', dialogSetDefaultResponse', dialogAddButton',+ Packing(..), boxPackEnd', boxPackStart', paraMinSize, paraMultiSel,+ Parameter(..), emptyParams, (<<<-), paraName, dialogResponse') import Graphics.UI.Editor.Simple (textEditor, boolEditor, staticListEditor) import Graphics.UI.Editor.Composite (maybeEditor) import IDE.Utils.GUIUtils- (stockIdFromType, __, treeViewContextMenu)+ (stockIdFromType, __, treeViewContextMenu, treeViewToggleRow) import IDE.Metainfo.Provider (getSystemInfo, getWorkspaceInfo, getPackageInfo) import System.Log.Logger (debugM)@@ -79,14 +80,113 @@ import Control.Monad (when, void) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (ask)-import System.Glib.Properties (newAttrFromMaybeStringProperty) import Data.Text (Text, toCaseFold) import qualified Data.Text as T (unpack, isInfixOf, toLower, pack) import Data.Monoid ((<>)) import qualified Text.Printf as S (printf) import Text.Printf (PrintfType) import qualified Data.Text.IO as T (writeFile)+import GI.Gtk.Objects.Paned (panedNew, Paned(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreInsertTree, forestStoreGetTree, forestStoreGetValue,+ ForestStore(..))+import GI.Gtk.Objects.RadioButton+ (radioButtonNewWithLabelFromWidget, radioButtonNewWithLabel,+ RadioButton(..))+import GI.Gtk.Objects.CheckButton+ (checkButtonNewWithLabel, CheckButton(..))+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import GI.Gtk.Objects.Widget+ (widgetShowAll, widgetGrabDefault, setWidgetCanDefault, widgetShow,+ widgetSetName, widgetDestroy, widgetSetSensitive,+ afterWidgetFocusInEvent, widgetGetAllocation, toWidget)+import GI.Gtk.Objects.Paned+ (panedAdd2, panedAdd1, panedSetPosition, panedGetPosition)+import GI.Gtk.Objects.CellRendererPixbuf+ (setCellRendererPixbufStockId, cellRendererPixbufNew)+import Data.GI.Base (unsafeCastTo, on, set, new')+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Objects.TreeViewColumn+ (TreeViewColumn(..), treeViewColumnSetSortColumnId,+ treeViewColumnSetReorderable, treeViewColumnSetResizable,+ treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Enums+ (ButtonsType(..), MessageType(..), WindowPosition(..),+ ResponseType(..), ButtonBoxStyle(..), PolicyType(..),+ ShadowType(..), SortType(..), TreeViewColumnSizing(..),+ Orientation(..))+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Interfaces.TreeModel+ (treeModelIterNext, treeModelIterChildren, treeModelGetIterFirst,+ treeModelGetPath, treeModelSortNewWithModel)+import GI.Gtk.Interfaces.TreeSortable+ (treeSortableSetSortColumnId, treeSortableSetSortFunc)+import Data.GI.Gtk.ModelView.CustomStore+ (customStoreGetRow)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathGetIndices',+ treePathNewFromIndices', TypedTreeModelSort(..))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import Graphics.UI.Frame.Rectangle+ (getRectangleY, getRectangleX, Rectangle(..))+import GI.Gtk.Objects.Box (boxReorderChild, Box(..), boxSetSpacing, boxNew)+import GI.Gtk.Objects.ButtonBox (buttonBoxSetLayout, buttonBoxNew)+import GI.Gtk.Objects.ToggleButton+ (toggleButtonGetActive, onToggleButtonToggled,+ toggleButtonSetActive)+import GI.Gtk.Objects.TreeView+ (treeViewSetSearchColumn, treeViewCollapseRow, treeViewCollapseAll,+ treeViewExpandAll, treeViewExpandRow, treeViewRowExpanded,+ treeViewScrollToCell, treeViewGetColumn, treeViewExpandToPath,+ treeViewGetSelection, onTreeViewRowActivated,+ treeViewSetSearchEqualFunc, treeViewSetEnableSearch,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..))+import GI.Gtk.Objects.TreeSelection+ (treeSelectionUnselectAll, treeSelectionSelectPath, onTreeSelectionChanged)+import GI.Gtk.Objects.TreeModelSort+ (TreeModelSort(..), treeModelSortConvertPathToChildPath,+ treeModelSortConvertChildPathToPath)+import GI.Gtk.Structs.TreeIter (TreeIter(..))+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.MenuItem+ (toMenuItem, onMenuItemActivate, MenuItem(..), menuItemActivate,+ menuItemNewWithLabel)+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Gtk.Objects.MessageDialog+ (setMessageDialogText, constructMessageDialogButtons, setMessageDialogMessageType,+ MessageDialog(..))+import GI.Gtk.Objects.Dialog+ (Dialog(..), dialogResponse, dialogGetActionArea, dialogGetContentArea,+ constructDialogUseHeaderBar)+import GI.Gtk.Objects.Window+ (windowSetDefaultSize, setWindowTitle, setWindowTransientFor, Window(..),+ setWindowWindowPosition, windowSetTransientFor)+import GI.Gtk.Objects.Button (Button(..), onButtonClicked, buttonNewFromStock)+import GI.Gtk.Objects.Label+ (labelSetText, labelSetLineWrap, labelNew)+import Data.GI.Gtk.ModelView.ForestStore (forestStoreClear, forestStoreNew)+import Data.Int (Int32)+#if MIN_VERSION_Cabal(2,0,0)+import Distribution.Types.UnqualComponentName+ (unUnqualComponentName)+#endif +#if !MIN_VERSION_Cabal(2,0,0)+type UnqualComponentName = String+unUnqualComponentName :: UnqualComponentName -> String+unUnqualComponentName = id+#endif+ printf :: PrintfType r => Text -> r printf = S.printf . T.unpack @@ -96,12 +196,12 @@ type ModuleRecord = (Text, Maybe (ModuleDescr,PackageDescr)) data IDEModules = IDEModules {- outer :: VBox-, paned :: HPaned+ outer :: Box+, paned :: Paned , treeView :: TreeView-, treeStore :: TreeStore ModuleRecord+, forestStore :: ForestStore ModuleRecord , descrView :: TreeView-, descrStore :: TreeStore Descr+, descrStore :: ForestStore Descr , descrSortedStore :: TypedTreeModelSort Descr -- ^ The sorted model for descrs , packageScopeB :: RadioButton , workspaceScopeB :: RadioButton@@ -130,7 +230,7 @@ , systemExpNoBlack :: ExpanderFacet } deriving (Eq,Ord,Show,Read) -type ExpanderFacet = ([TreePath], [TreePath])+type ExpanderFacet = ([[Int]], [[Int]]) data SelectionState = SelectionState { moduleS' :: Maybe ModuleName@@ -143,7 +243,7 @@ where primPaneName _ = __ "Modules" getAddedIndex _ = 0- getTopWidget = castToWidget . outer+ getTopWidget = liftIO . toWidget . outer paneId b = "*Modules" --liftIO $ widgetGrabFocus (descrView p) @@ -156,6 +256,11 @@ pane <- getModules Nothing displayPane pane False +orderToInt32 :: Ordering -> Int32+orderToInt32 LT = -1+orderToInt32 EQ = 0+orderToInt32 GT = 1+ instance RecoverablePane IDEModules ModulesState IDEM where saveState p = do m <- getModules Nothing@@ -165,185 +270,192 @@ expander <- liftIO $ readIORef (expanderState p) case mbModules of Nothing -> return Nothing- Just p -> liftIO $ do+ Just p -> do i <- panedGetPosition (paned p)- mbTreeSelection <- getSelectionTree (treeView m) (treeStore m)+ mbTreeSelection <- getSelectionTree (treeView m) (forestStore m) mbFacetSelection <- getSelectionDescr (descrView m) (descrStore m) (descrSortedStore m) let mbs = (case mbTreeSelection of Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)- otherwise -> Nothing,+ _ -> Nothing, case mbFacetSelection of Nothing -> Nothing Just fw -> Just (dscName fw))- return (Just (ModulesState i sc mbs expander))+ return (Just (ModulesState (fromIntegral i) sc mbs expander)) recoverState pp (ModulesState i sc@(scope,useBlacklist) se exp) = do nb <- getNotebook pp p <- buildPane pp nb builder mod <- getModules Nothing liftIO $ writeIORef (expanderState mod) exp liftIO $ writeIORef (oldSelection mod) (uncurry SelectionState se scope useBlacklist)- liftIO $ panedSetPosition (paned mod) i+ panedSetPosition (paned mod) (fromIntegral i) return p builder pp nb windows = do packageInfo' <- getPackageInfo- reifyIDE $ \ ideR -> do- let forest = case packageInfo' of- Nothing -> []- Just (GenScopeC fst,GenScopeC snd)- -> subForest (buildModulesTree (fst,snd))- treeStore <- treeStoreNew forest- treeView <- treeViewNew- treeViewSetModel treeView treeStore- --treeViewSetRulesHint treeView True+ ideR <- ask+ let forest = case packageInfo' of+ Nothing -> []+ Just (GenScopeC fst, GenScopeC snd)+ -> subForest (buildModulesTree (fst,snd))+ forestStore <- forestStoreNew forest+ treeView <- treeViewNew+ treeViewSetModel treeView (Just forestStore)+ --treeViewSetRulesHint treeView True - renderer0 <- cellRendererPixbufNew- set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := (Nothing :: Maybe Text) ]+ renderer0 <- cellRendererPixbufNew+ setCellRendererPixbufStockId renderer0 "" - renderer <- cellRendererTextNew- col <- treeViewColumnNew- treeViewColumnSetTitle col (__ "Module")- treeViewColumnSetSizing col TreeViewColumnAutosize- treeViewColumnSetResizable col True- treeViewColumnSetReorderable col True- treeViewAppendColumn treeView col- cellLayoutPackStart col renderer0 False- cellLayoutPackStart col renderer True- cellLayoutSetAttributes col renderer treeStore- $ \row -> [ cellText := fst row]- cellLayoutSetAttributes col renderer0 treeStore- $ \row -> [- newAttrFromMaybeStringProperty "stock-id" :=- case snd row of- Nothing -> Nothing+ renderer <- cellRendererTextNew+ col <- treeViewColumnNew+ treeViewColumnSetTitle col (__ "Module")+ treeViewColumnSetSizing col TreeViewColumnSizingAutosize+ treeViewColumnSetResizable col True+ treeViewColumnSetReorderable col True+ treeViewAppendColumn treeView col+ cellLayoutPackStart col renderer0 False+ cellLayoutPackStart col renderer True+ cellLayoutSetDataFunction col renderer forestStore+ $ setCellRendererTextText renderer . fst+ cellLayoutSetDataFunction col renderer0 forestStore+ $ \row ->+ setCellRendererPixbufStockId renderer0 $+ case snd row of+ Nothing -> "" Just pair -> if isJust (mdMbSourcePath (fst pair))- then Just ("ide_source" :: Text)- else Nothing]+ then "ide_source"+ else "" - renderer2 <- cellRendererTextNew- col2 <- treeViewColumnNew- treeViewColumnSetTitle col2 (__ "Package")- treeViewColumnSetSizing col2 TreeViewColumnAutosize- treeViewColumnSetResizable col2 True- treeViewColumnSetReorderable col2 True- treeViewAppendColumn treeView col2- cellLayoutPackStart col2 renderer2 True- cellLayoutSetAttributes col2 renderer2 treeStore- $ \row -> [- cellText := case snd row of- Nothing -> ""- Just pair -> (T.pack . display . pdPackage . snd) pair]+ renderer2 <- cellRendererTextNew+ col2 <- treeViewColumnNew+ treeViewColumnSetTitle col2 (__ "Package")+ treeViewColumnSetSizing col2 TreeViewColumnSizingAutosize+ treeViewColumnSetResizable col2 True+ treeViewColumnSetReorderable col2 True+ treeViewAppendColumn treeView col2+ cellLayoutPackStart col2 renderer2 True+ cellLayoutSetDataFunction col2 renderer2 forestStore+ $ \row ->+ setCellRendererTextText renderer2 $+ case snd row of+ Nothing -> ""+ Just pair -> (T.pack . display . pdPackage . snd) pair - treeViewSetHeadersVisible treeView True- treeViewSetEnableSearch treeView True- treeViewSetSearchEqualFunc treeView (Just (treeViewSearch treeView treeStore))+ treeViewSetHeadersVisible treeView True+ treeViewSetEnableSearch treeView True+ treeViewSetSearchEqualFunc treeView+ (\_ _ key iter -> treeViewSearch treeView forestStore key iter)+ treeViewSetSearchColumn treeView 0 - -- Facet view+ -- Facet view - descrView <- treeViewNew- descrStore <- treeStoreNew []- -- sorted model- descrSortedStore <- treeModelSortNewWithModel descrStore- treeViewSetModel descrView descrSortedStore- renderer30 <- cellRendererPixbufNew- renderer31 <- cellRendererPixbufNew- renderer3 <- cellRendererTextNew- col <- treeViewColumnNew- treeViewColumnSetTitle col (__ "Interface")- --treeViewColumnSetSizing col TreeViewColumnAutosize- treeViewAppendColumn descrView col- cellLayoutPackStart col renderer30 False- cellLayoutPackStart col renderer31 False- cellLayoutPackStart col renderer3 True- cellLayoutSetAttributes col renderer3 descrStore- $ \row -> [ cellText := descrTreeText row]- cellLayoutSetAttributes col renderer30 descrStore- $ \row -> [- cellPixbufStockId := stockIdFromType (descrIdType row)]- cellLayoutSetAttributes col renderer31 descrStore- $ \row -> [- cellPixbufStockId := if isReexported row- then "ide_reexported"- else if isJust (dscMbLocation row)- then- if dscExported row- then ("ide_source" :: Text)- else "ide_source_local"- else "ide_empty"]- -- sort definitions on name, ignoring case- treeSortableSetSortFunc descrSortedStore 2 $ \iter1 iter2 -> do- d1 <- treeModelGetRow descrStore iter1- d2 <- treeModelGetRow descrStore iter2- let cafName = toCaseFold . descrTreeText- return (compare (cafName d1) (cafName d2))- treeViewColumnSetSortColumnId col 2- treeSortableSetSortColumnId descrSortedStore 2 SortAscending- treeViewSetHeadersVisible descrView True- treeViewSetEnableSearch descrView True- treeViewSetSearchEqualFunc descrView (Just (descrViewSearch descrView descrStore))- pane' <- hPanedNew- sw <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType sw ShadowIn- containerAdd sw treeView- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic- sw2 <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType sw2 ShadowIn- containerAdd sw2 descrView- scrolledWindowSetPolicy sw2 PolicyAutomatic PolicyAutomatic- panedAdd1 pane' sw- panedAdd2 pane' sw2- (Rectangle _ _ x y) <- liftIO $ widgetGetAllocation nb- panedSetPosition pane' (max 200 (x `quot` 2))- box <- hButtonBoxNew- boxSetSpacing box 2- buttonBoxSetLayout box ButtonboxSpread- rb1 <- radioButtonNewWithLabel (__ "Package")- rb2 <- radioButtonNewWithLabelFromWidget rb1 (__ "Workspace")- rb3 <- radioButtonNewWithLabelFromWidget rb1 (__ "System")- toggleButtonSetActive rb3 True- cb2 <- checkButtonNewWithLabel (__ "Imports")- cb <- checkButtonNewWithLabel (__ "Blacklist")+ descrView <- treeViewNew+ descrStore <- forestStoreNew []+ -- sorted model+ descrSortedStore <- treeModelSortNewWithModel descrStore+ >>= liftIO . unsafeCastTo TypedTreeModelSort+ treeViewSetModel descrView (Just descrSortedStore)+ renderer30 <- cellRendererPixbufNew+ renderer31 <- cellRendererPixbufNew+ renderer3 <- cellRendererTextNew+ col <- treeViewColumnNew+ treeViewColumnSetTitle col (__ "Interface")+ --treeViewColumnSetSizing col TreeViewColumnSizingAutosize+ treeViewAppendColumn descrView col+ cellLayoutPackStart col renderer30 False+ cellLayoutPackStart col renderer31 False+ cellLayoutPackStart col renderer3 True+ cellLayoutSetDataFunction col renderer3 descrStore+ $ setCellRendererTextText renderer3 . descrTreeText+ cellLayoutSetDataFunction col renderer30 descrStore+ $ setCellRendererPixbufStockId renderer30 . stockIdFromType . descrIdType+ cellLayoutSetDataFunction col renderer31 descrStore+ $ \row ->+ setCellRendererPixbufStockId renderer31 $+ if isReexported row+ then "ide_reexported"+ else if isJust (dscMbLocation row)+ then+ if dscExported row+ then "ide_source"+ else "ide_source_local"+ else "ide_empty"+ -- sort definitions on name, ignoring case+ treeSortableSetSortFunc descrSortedStore 2 $ \_ iter1 iter2 -> do+ d1 <- customStoreGetRow descrStore iter1+ d2 <- customStoreGetRow descrStore iter2+ let cafName = toCaseFold . descrTreeText+ return . orderToInt32 $ compare (cafName d1) (cafName d2)+ treeViewColumnSetSortColumnId col 2+ treeSortableSetSortColumnId descrSortedStore 2 SortTypeAscending+ treeViewSetHeadersVisible descrView True+ treeViewSetEnableSearch descrView True+ treeViewSetSearchEqualFunc descrView+ (\_ _ key iter -> descrViewSearch descrView descrStore key iter)+ pane' <- panedNew OrientationHorizontal+ sw <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType sw ShadowTypeIn+ containerAdd sw treeView+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic+ sw2 <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType sw2 ShadowTypeIn+ containerAdd sw2 descrView+ scrolledWindowSetPolicy sw2 PolicyTypeAutomatic PolicyTypeAutomatic+ panedAdd1 pane' sw+ panedAdd2 pane' sw2+ rect <- widgetGetAllocation nb+ x <- getRectangleX rect+ y <- getRectangleY rect+ panedSetPosition pane' (max 200 (x `quot` 2))+ box <- buttonBoxNew OrientationHorizontal+ boxSetSpacing box 2+ buttonBoxSetLayout box ButtonBoxStyleSpread+ rb1 <- radioButtonNewWithLabel ([]::[RadioButton]) (__ "Package")+ rb2 <- radioButtonNewWithLabelFromWidget (Just rb1) (__ "Workspace")+ rb3 <- radioButtonNewWithLabelFromWidget (Just rb1) (__ "System")+ toggleButtonSetActive rb3 True+ cb2 <- checkButtonNewWithLabel (__ "Imports")+ cb <- checkButtonNewWithLabel (__ "Blacklist") - boxPackStart box rb1 PackGrow 0- boxPackStart box rb2 PackGrow 0- boxPackStart box rb3 PackGrow 0- boxPackEnd box cb PackNatural 0- boxPackEnd box cb2 PackNatural 0+ boxPackStart' box rb1 PackGrow 0+ boxPackStart' box rb2 PackGrow 0+ boxPackStart' box rb3 PackGrow 0+ boxPackEnd' box cb PackNatural 0+ boxPackEnd' box cb2 PackNatural 0 - boxOuter <- vBoxNew False 0- boxPackStart boxOuter box PackNatural 2- boxPackStart boxOuter pane' PackGrow 0- oldState <- liftIO $ newIORef $ SelectionState Nothing Nothing SystemScope False- expanderState <- liftIO $ newIORef emptyExpansion- scopeRef <- newIORef (SystemScope,True)- let modules = IDEModules boxOuter pane' treeView treeStore descrView descrStore descrSortedStore- rb1 rb2 rb3 cb2 cb oldState expanderState- cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive modules) ideR- return True- cid2 <- after descrView focusInEvent $ do- liftIO $ reflectIDE (makeActive modules) ideR- return True- (cid3, cid4) <- treeViewContextMenu treeView $ modulesContextMenu ideR treeStore treeView- cid5 <- treeView `on` rowActivated $ modulesSelect ideR treeStore treeView- (cid6, cid7) <- treeViewContextMenu descrView $ descrViewContextMenu ideR descrStore descrSortedStore descrView- cid8 <- descrView `on` rowActivated $ descrViewSelect ideR descrStore descrSortedStore- on rb1 toggled (reflectIDE scopeSelection ideR)- on rb2 toggled (reflectIDE scopeSelection ideR)- on rb3 toggled (reflectIDE scopeSelection ideR)- on cb toggled (reflectIDE scopeSelection ideR)- on cb2 toggled (reflectIDE scopeSelection ideR)- sel <- treeViewGetSelection treeView- on sel treeSelectionSelectionChanged $ do- fillFacets treeView treeStore descrView descrStore descrSortedStore- reflectIDE recordSelHistory ideR- return ()- sel2 <- treeViewGetSelection descrView- on sel2 treeSelectionSelectionChanged $ do- fillInfo descrView descrStore descrSortedStore ideR- reflectIDE recordSelHistory ideR- return ()- return (Just modules,map ConnectC [cid1, cid2, cid3, cid4, cid5, cid6, cid7, cid8])+ boxOuter <- boxNew OrientationVertical 0+ boxPackStart' boxOuter box PackNatural 2+ boxPackStart' boxOuter pane' PackGrow 0+ oldState <- liftIO $ newIORef $ SelectionState Nothing Nothing SystemScope False+ expanderState <- liftIO $ newIORef emptyExpansion+ scopeRef <- liftIO $ newIORef (SystemScope,True)+ let modules = IDEModules boxOuter pane' treeView forestStore descrView descrStore descrSortedStore+ rb1 rb2 rb3 cb2 cb oldState expanderState+ cid1 <- onIDE afterWidgetFocusInEvent treeView $ do+ liftIDE $ makeActive modules+ return True+ cid2 <- onIDE afterWidgetFocusInEvent descrView $ do+ liftIDE $ makeActive modules+ return True+ cids3 <- treeViewContextMenu treeView $ modulesContextMenu ideR forestStore treeView+ cid5 <- ConnectC treeView <$> onTreeViewRowActivated treeView (modulesSelect ideR forestStore treeView)+ cids6 <- treeViewContextMenu descrView $ descrViewContextMenu ideR descrStore descrSortedStore descrView+ cid8 <- ConnectC descrView <$> onTreeViewRowActivated descrView (descrViewSelect ideR descrStore descrSortedStore)+ onToggleButtonToggled rb1 (reflectIDE scopeSelection ideR)+ onToggleButtonToggled rb2 (reflectIDE scopeSelection ideR)+ onToggleButtonToggled rb3 (reflectIDE scopeSelection ideR)+ onToggleButtonToggled cb (reflectIDE scopeSelection ideR)+ onToggleButtonToggled cb2 (reflectIDE scopeSelection ideR)+ sel <- treeViewGetSelection treeView+ onTreeSelectionChanged sel $ do+ fillFacets treeView forestStore descrView descrStore descrSortedStore+ reflectIDE recordSelHistory ideR+ return ()+ sel2 <- treeViewGetSelection descrView+ onTreeSelectionChanged sel2 $ do+ fillInfo descrView descrStore descrSortedStore ideR+ reflectIDE recordSelHistory ideR+ return ()+ return (Just modules, [cid1, cid2, cid5, cid8] ++ cids3 ++ cids6) selectIdentifier :: Descr -> Bool -> IDEAction selectIdentifier idDescr openSource= do@@ -400,33 +512,34 @@ in do liftIO $ debugM "leksah" $ "selectIdentifier' " <> show moduleName <> " " <> T.unpack symbol mods <- getModules Nothing- mbTree <- liftIO $ treeStoreGetTreeSave (treeStore mods) []+ mbTree <- forestStoreGetTreeSave (forestStore mods) =<< treePathNewFromIndices' [] case treePathFromNameArray mbTree nameArray [] of- Just treePath -> liftIO $ do+ Just treePath' -> do+ treePath <- treePathNewFromIndices' (map fromIntegral treePath') treeViewExpandToPath (treeView mods) treePath sel <- treeViewGetSelection (treeView mods) treeSelectionSelectPath sel treePath- col <- treeViewGetColumn (treeView mods) 0- treeViewScrollToCell (treeView mods) (Just treePath) col (Just (0.3,0.3))- mbFacetTree <- treeStoreGetTreeSave (descrStore mods) []+ Just col <- treeViewGetColumn (treeView mods) 0+ treeViewScrollToCell (treeView mods) (Just treePath) (Just col) True 0.3 0.3+ mbFacetTree <- forestStoreGetTreeSave (descrStore mods) =<< treePathNewFromIndices' [] selF <- treeViewGetSelection (descrView mods) case findPathFor symbol mbFacetTree of Nothing -> sysMessage Normal (__ "no path found") Just childPath -> do- path <- treeModelSortConvertChildPathToPath (descrSortedStore mods) childPath+ Just path <- treeModelSortConvertChildPathToPath (descrSortedStore mods) =<< treePathNewFromIndices' (map fromIntegral childPath) treeViewExpandToPath (descrView mods) path treeSelectionSelectPath selF path- col <- treeViewGetColumn (descrView mods) 0- treeViewScrollToCell (descrView mods) (Just path) col (Just (0.3,0.3))+ Just col <- treeViewGetColumn (descrView mods) 0+ treeViewScrollToCell (descrView mods) (Just path) (Just col) True 0.3 0.3 bringPaneToFront mods Nothing -> return () -findPathFor :: Text -> Maybe (Tree Descr) -> Maybe TreePath+findPathFor :: Text -> Maybe (Tree Descr) -> Maybe [Int] findPathFor symbol (Just (Node _ forest)) = foldr ( \i mbTreePath -> findPathFor' [i] (forest !! i) mbTreePath) Nothing [0 .. (length forest - 1)] where- findPathFor' :: TreePath -> Tree Descr -> Maybe TreePath -> Maybe TreePath+ findPathFor' :: [Int] -> Tree Descr -> Maybe [Int] -> Maybe [Int] findPathFor' _ node (Just p) = Just p findPathFor' path (Node wrap sub) Nothing = if dscName wrap == symbol@@ -447,15 +560,15 @@ treePathFromNameArray Nothing _ _ = Nothing treeViewSearch :: TreeView- -> TreeStore ModuleRecord+ -> ForestStore ModuleRecord -> Text -> TreeIter -> IO Bool-treeViewSearch treeView treeStore string iter = do+treeViewSearch treeView forestStore string iter = do liftIO $ debugM "leksah" "treeViewSearch"- path <- treeModelGetPath treeStore iter- val <- treeStoreGetValue treeStore path- mbTree <- treeStoreGetTreeSave treeStore path+ path <- treeModelGetPath forestStore iter+ val <- forestStoreGetValue forestStore path+ mbTree <- forestStoreGetTreeSave forestStore path exp <- treeViewRowExpanded treeView path when (isJust mbTree && not (null (subForest (fromJust mbTree))) && not exp) $ let found = searchInModSubnodes (fromJust mbTree) string@@ -480,15 +593,15 @@ (concatMap flatten (subForest tree)) descrViewSearch :: TreeView- -> TreeStore Descr+ -> ForestStore Descr -> Text -> TreeIter -> IO Bool descrViewSearch descrView descrStore string iter = do liftIO $ debugM "leksah" "descrViewSearch" path <- treeModelGetPath descrStore iter- val <- treeStoreGetValue descrStore path- tree <- treeStoreGetTree descrStore path+ val <- forestStoreGetValue descrStore path+ tree <- forestStoreGetTree descrStore path exp <- treeViewRowExpanded descrView path when (not (null (subForest tree)) && not exp) $ let found = searchInFacetSubnodes tree string@@ -504,73 +617,76 @@ (concatMap flatten (subForest tree)) -- | Fill facet view with descrs from selected module-fillFacets :: TreeView- -> TreeStore ModuleRecord- -> TreeView- -> TreeStore Descr- -> TypedTreeModelSort Descr- -> IO ()-fillFacets treeView treeStore descrView descrStore descrSortedStore = do+fillFacets :: (Applicative m, MonadIO m)+ => TreeView+ -> ForestStore ModuleRecord+ -> TreeView+ -> ForestStore Descr+ -> TypedTreeModelSort Descr+ -> m ()+fillFacets treeView forestStore descrView descrStore descrSortedStore = do liftIO $ debugM "leksah" "fillFacets"- sel <- getSelectionTree treeView treeStore- emptyModel <- treeStoreNew []- treeViewSetModel descrView emptyModel- treeStoreClear descrStore+ sel <- getSelectionTree treeView forestStore+ emptyModel <- forestStoreNew []+ treeViewSetModel descrView (Just emptyModel)+ forestStoreClear descrStore+ emptyPath <- treePathNewFromIndices' [] case sel of Just (_,Just (mod,package))- -> mapM_ (\(e,i) -> treeStoreInsertTree descrStore [] i e)+ -> mapM_ (\(e,i) -> forestStoreInsertTree descrStore emptyPath i e) $ zip (buildFacetForrest mod) [0 ..] _ -> return ()- treeViewSetModel descrView descrSortedStore+ treeViewSetModel descrView (Just descrSortedStore) treeViewSetEnableSearch descrView True- treeViewSetSearchEqualFunc descrView (Just (descrViewSearch descrView descrStore))+ treeViewSetSearchEqualFunc descrView+ (\_ _ key iter -> descrViewSearch descrView descrStore key iter) liftIO $ debugM "leksah" "fillFacets done" -getSelectionTree :: TreeView- -> TreeStore ModuleRecord- -> IO (Maybe ModuleRecord)-getSelectionTree treeView treeStore = do+getSelectionTree :: (Applicative m, MonadIO m)+ => TreeView+ -> ForestStore ModuleRecord+ -> m (Maybe ModuleRecord)+getSelectionTree treeView forestStore = do liftIO $ debugM "leksah" "getSelectionTree" treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of [] -> return Nothing- a:r -> do- val <- treeStoreGetValue treeStore a- return (Just val)+ a:r -> Just <$> forestStoreGetValue forestStore a -- | Get selected Descr, if any-getSelectionDescr :: TreeView- -> TreeStore Descr- -> TypedTreeModelSort Descr- -> IO (Maybe Descr)-getSelectionDescr treeView treeStore descrSortedStore = do+getSelectionDescr :: (Applicative m, MonadIO m)+ => TreeView+ -> ForestStore Descr+ -> TypedTreeModelSort Descr+ -> m (Maybe Descr)+getSelectionDescr treeView forestStore descrSortedStore = do liftIO $ debugM "leksah" "getSelectionDescr" treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of a:_ -> do- unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a- val <- treeStoreGetValue treeStore unsorteda- return (Just val)+ Just unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a+ Just <$> forestStoreGetValue forestStore unsorteda _ -> return Nothing -- | Fill info pane with selected Descr if any-fillInfo :: TreeView- -> TreeStore Descr- -> TypedTreeModelSort Descr- -> IDERef- -> IO ()+fillInfo :: (Applicative m, MonadIO m)+ => TreeView+ -> ForestStore Descr+ -> TypedTreeModelSort Descr+ -> IDERef+ -> m () fillInfo treeView lst descrSortedStore ideR = do liftIO $ debugM "leksah" "fillInfo" treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of [] -> return () [a] -> do- unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a- descr <- treeStoreGetValue lst unsorteda- reflectIDE (setInfo descr) ideR+ Just unsorteda <- treeModelSortConvertPathToChildPath descrSortedStore a+ descr <- forestStoreGetValue lst unsorteda+ liftIO $ reflectIDE (setInfo descr) ideR return () _ -> return () @@ -594,8 +710,8 @@ SystemScope -> do accessibleInfo' <- getSystemInfo case accessibleInfo' of- Nothing -> liftIO $ treeStoreClear (treeStore mods)- --treeStoreInsertTree (treeStore mods) [] 0 (Node ("",[]) [])+ Nothing -> forestStoreClear (forestStore mods)+ --forestStoreInsertTree (forestStore mods) [] 0 (Node ("",[]) []) Just (GenScopeC ai@(PackScope pm ps)) -> let p2 = if useBlacklist then PackScope (Map.filter (filterBlacklist@@ -633,16 +749,17 @@ (Node _ li) = buildModulesTree (l', p2) in insertIt li mods where- insertIt li mods = liftIO $ do- emptyModel <- treeStoreNew []- treeViewSetModel (treeView mods) emptyModel- treeStoreClear (treeStore mods)- mapM_ (\(e,i) -> treeStoreInsertTree (treeStore mods) [] i e)+ insertIt li mods = do+ emptyModel <- forestStoreNew []+ treeViewSetModel (treeView mods) (Just emptyModel)+ forestStoreClear (forestStore mods)+ emptyPath <- treePathNewFromIndices' []+ mapM_ (\(e,i) -> forestStoreInsertTree (forestStore mods) emptyPath i e) $ zip li [0 .. length li]- treeViewSetModel (treeView mods) (treeStore mods)+ treeViewSetModel (treeView mods) (Just $ forestStore mods) treeViewSetEnableSearch (treeView mods) True treeViewSetSearchEqualFunc (treeView mods)- (Just (treeViewSearch (treeView mods) (treeStore mods)))+ (\_ _ key iter -> treeViewSearch (treeView mods) (forestStore mods) key iter) filterBlacklist :: [Dependency] -> PackageDescr -> Bool@@ -846,71 +963,69 @@ (Just fp, Just pp) -> Just $ dropFileName pp </> fp (Just fp, Nothing) -> Just fp _ -> Nothing- otherwise -> Nothing+ _ -> Nothing modulesContextMenu :: IDERef- -> TreeStore ModuleRecord+ -> ForestStore ModuleRecord -> TreeView -> Menu -> IO () modulesContextMenu ideR store treeView theMenu = do liftIO $ debugM "leksah" "modulesContextMenu"- item1 <- menuItemNewWithLabel (__ "Edit source")- item1 `on` menuItemActivate $ do+ item1 <- menuItemNewWithLabel (__ "Edit source")+ onMenuItemActivate item1 $ do mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store case mbFile of Nothing -> return () Just fp -> void $ reflectIDE (selectSourceBuf fp) ideR- sep1 <- separatorMenuItemNew- item2 <- menuItemNewWithLabel (__ "Expand here")- item2 `on` menuItemActivate $ expandHere treeView- item3 <- menuItemNewWithLabel (__ "Collapse here")- item3 `on` menuItemActivate $ collapseHere treeView- item4 <- menuItemNewWithLabel (__ "Expand all")- item4 `on` menuItemActivate $ treeViewExpandAll treeView- item5 <- menuItemNewWithLabel (__ "Collapse all")- item5 `on` menuItemActivate $ treeViewCollapseAll treeView- sep2 <- separatorMenuItemNew- item6 <- menuItemNewWithLabel (__ "Add module")- item6 `on` menuItemActivate $ reflectIDE (packageTry $ addModule' treeView store) ideR- item7 <- menuItemNewWithLabel (__ "Delete module")- item7 `on` menuItemActivate $ do+ sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem+ item2 <- menuItemNewWithLabel (__ "Expand here")+ onMenuItemActivate item2 $ expandHere treeView+ item3 <- menuItemNewWithLabel (__ "Collapse here")+ onMenuItemActivate item3 $ collapseHere treeView+ item4 <- menuItemNewWithLabel (__ "Expand all")+ onMenuItemActivate item4 $ treeViewExpandAll treeView+ item5 <- menuItemNewWithLabel (__ "Collapse all")+ onMenuItemActivate item5 $ treeViewCollapseAll treeView+ sep2 <- separatorMenuItemNew >>= liftIO . toMenuItem+ item6 <- menuItemNewWithLabel (__ "Add module")+ onMenuItemActivate item6 $ reflectIDE (packageTry $ addModule' treeView store) ideR+ item7 <- menuItemNewWithLabel (__ "Delete module")+ onMenuItemActivate item7 $ do mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store case mbFile of Nothing -> return () Just fp -> do resp <- reflectIDE respDelModDialog ideR when resp $ do- exists <- doesFileExist fp- if exists- then do- reflectIDE (liftIO $ removeFile fp) ideR- reflectIDE (packageTry $ delModule treeView store)ideR- else- reflectIDE (packageTry $ delModule treeView store)ideR- reflectIDE (packageTry packageConfig) ideR- return ()- sel <- getSelectionTree treeView store+ exists <- doesFileExist fp+ if exists+ then do+ reflectIDE (liftIO $ removeFile fp) ideR+ reflectIDE (packageTry $ delModule treeView store)ideR+ else+ reflectIDE (packageTry $ delModule treeView store)ideR+ reflectIDE (packageTry packageConfig) ideR+ return ()+ sel <- getSelectionTree treeView store case sel of Just (s, Nothing) ->- mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1, castToMenuItem item2,- castToMenuItem item3, castToMenuItem item4, castToMenuItem item5, castToMenuItem sep2,- castToMenuItem item6]+ mapM_ (menuShellAppend theMenu) [item1, sep1, item2,+ item3, item4, item5, sep2, item6] Just (_,Just (m,_)) ->- mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1, castToMenuItem item2,- castToMenuItem item3, castToMenuItem item4, castToMenuItem item5, castToMenuItem sep2,- castToMenuItem item6, castToMenuItem item7]- otherwise -> return ()+ mapM_ (menuShellAppend theMenu) [item1, sep1, item2,+ item3, item4, item5, sep2, item6, item7]+ _ -> return () modulesSelect :: IDERef- -> TreeStore ModuleRecord+ -> ForestStore ModuleRecord -> TreeView -> TreePath -> TreeViewColumn -> IO () modulesSelect ideR store treeView path _ = do liftIO $ debugM "leksah" "modulesSelect"- treeViewExpandRow treeView path False+ treeViewToggleRow treeView path mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store case mbFile of Nothing -> return ()@@ -918,38 +1033,38 @@ -- | Build contextual menu on selected Descr descrViewContextMenu :: IDERef- -> TreeStore Descr+ -> ForestStore Descr -> TypedTreeModelSort Descr -> TreeView -> Menu -> IO () descrViewContextMenu ideR store descrSortedStore descrView theMenu = do liftIO $ debugM "leksah" "descrViewContextMenu"- item1 <- menuItemNewWithLabel (__ "Go to definition")- item1 `on` menuItemActivate $ do+ item1 <- menuItemNewWithLabel (__ "Go to definition")+ onMenuItemActivate item1 $ do sel <- getSelectionDescr descrView store descrSortedStore case sel of Just descr -> reflectIDE (goToDefinition descr) ideR- otherwise -> sysMessage Normal (__ "Modules>> descrViewPopup: no selection")- item2 <- menuItemNewWithLabel (__ "Insert in buffer")- item2 `on` menuItemActivate $ do+ _ -> sysMessage Normal (__ "Modules>> descrViewPopup: no selection")+ item2 <- menuItemNewWithLabel (__ "Insert in buffer")+ onMenuItemActivate item2 $ do sel <- getSelectionDescr descrView store descrSortedStore case sel of Just descr -> reflectIDE (insertInBuffer descr) ideR- otherwise -> sysMessage Normal (__ "Modules>> descrViewPopup: no selection")+ _ -> sysMessage Normal (__ "Modules>> descrViewPopup: no selection") mapM_ (menuShellAppend theMenu) [item1, item2] -- | Selects the Descr referenced by the path descrViewSelect :: IDERef- -> TreeStore Descr+ -> ForestStore Descr -> TypedTreeModelSort Descr -> TreePath -> TreeViewColumn -> IO () descrViewSelect ideR store descrSortedStore path _ = do liftIO $ debugM "leksah" "descrViewSelect"- unsortedp <- treeModelSortConvertPathToChildPath descrSortedStore path- descr <- treeStoreGetValue store unsortedp+ Just unsortedp <- treeModelSortConvertPathToChildPath descrSortedStore path+ descr <- forestStoreGetValue store unsortedp reflectIDE (goToDefinition descr) ideR setScope :: (Scope,Bool) -> IDEAction@@ -957,37 +1072,37 @@ liftIO $ debugM "leksah" "setScope" mods <- getModules Nothing case sc of- (PackageScope False) -> liftIO $ do+ (PackageScope False) -> do toggleButtonSetActive (packageScopeB mods) True widgetSetSensitive (dependsB mods) True toggleButtonSetActive (dependsB mods) False- (PackageScope True) -> liftIO $ do+ (PackageScope True) -> do toggleButtonSetActive (packageScopeB mods) True widgetSetSensitive (dependsB mods) True toggleButtonSetActive (dependsB mods) True- (WorkspaceScope False) -> liftIO $ do+ (WorkspaceScope False) -> do toggleButtonSetActive (workspaceScopeB mods) True widgetSetSensitive (dependsB mods) True toggleButtonSetActive (dependsB mods) False- (WorkspaceScope True) -> liftIO $ do+ (WorkspaceScope True) -> do toggleButtonSetActive (workspaceScopeB mods) True widgetSetSensitive (dependsB mods) True toggleButtonSetActive (dependsB mods) True- SystemScope -> liftIO $ do+ SystemScope -> do toggleButtonSetActive (systemScopeB mods) True widgetSetSensitive (dependsB mods) False- liftIO $ toggleButtonSetActive (blacklistB mods) bl+ toggleButtonSetActive (blacklistB mods) bl selectScope (sc,bl) getScope :: IDEM (Scope,Bool) getScope = do liftIO $ debugM "leksah" "getScope"- mods <- getModules Nothing- rb1s <- liftIO $ toggleButtonGetActive (packageScopeB mods)- rb2s <- liftIO $ toggleButtonGetActive (workspaceScopeB mods)- rb3s <- liftIO $ toggleButtonGetActive (systemScopeB mods)- cb1s <- liftIO $ toggleButtonGetActive (dependsB mods)- cbs <- liftIO $ toggleButtonGetActive (blacklistB mods)+ mods <- getModules Nothing+ rb1s <- toggleButtonGetActive (packageScopeB mods)+ rb2s <- toggleButtonGetActive (workspaceScopeB mods)+ rb3s <- toggleButtonGetActive (systemScopeB mods)+ cb1s <- toggleButtonGetActive (dependsB mods)+ cbs <- toggleButtonGetActive (blacklistB mods) let scope | rb1s = PackageScope cb1s | rb2s = WorkspaceScope cb1s@@ -1006,16 +1121,16 @@ liftIO $ debugM "leksah" "selectScope" recordExpanderState mods <- getModules Nothing- mbTreeSelection <- liftIO $ getSelectionTree (treeView mods) (treeStore mods)- mbDescrSelection <- liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)+ mbTreeSelection <- getSelectionTree (treeView mods) (forestStore mods)+ mbDescrSelection <- getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods) - ts <- liftIO $ treeViewGetSelection (treeView mods)+ ts <- treeViewGetSelection (treeView mods) withoutRecordingDo $ do- liftIO $ treeSelectionUnselectAll ts+ treeSelectionUnselectAll ts fillModulesList (sc,bl) let mbs = (case mbTreeSelection of Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)- otherwise -> Nothing,+ _ -> Nothing, case mbDescrSelection of Nothing -> Nothing Just fw -> Just (dscName fw))@@ -1023,14 +1138,14 @@ selectNames mbs recordScopeHistory applyExpanderState- liftIO $ bringPaneToFront mods+ bringPaneToFront mods selectNames :: (Maybe ModuleName, Maybe Text) -> IDEAction selectNames (mbModuleName, mbIdName) = do liftIO $ debugM "leksah" "selectIdentifier" mods <- getModules Nothing case mbModuleName of- Nothing -> liftIO $ do+ Nothing -> do sel <- treeViewGetSelection (treeView mods) treeSelectionUnselectAll sel selF <- treeViewGetSelection (descrView mods)@@ -1038,31 +1153,32 @@ Just moduleName -> let nameArray = map T.pack $ components moduleName in do- mbTree <- liftIO $ treeStoreGetTreeSave (treeStore mods) []+ mbTree <- forestStoreGetTreeSave (forestStore mods) =<< treePathNewFromIndices' [] case treePathFromNameArray mbTree nameArray [] of Nothing -> return ()- Just treePath -> liftIO $ do+ Just treePath' -> do+ treePath <- treePathNewFromIndices' (map fromIntegral treePath') treeViewExpandToPath (treeView mods) treePath sel <- treeViewGetSelection (treeView mods) treeSelectionSelectPath sel treePath- col <- treeViewGetColumn (treeView mods) 0- treeViewScrollToCell (treeView mods) (Just treePath) col- (Just (0.3,0.3))+ Just col <- treeViewGetColumn (treeView mods) 0+ treeViewScrollToCell (treeView mods) (Just treePath) (Just col)+ True 0.3 0.3 case mbIdName of Nothing -> do selF <- treeViewGetSelection (descrView mods) treeSelectionUnselectAll selF Just symbol -> do- mbDescrTree <- treeStoreGetTreeSave (descrStore mods) []+ mbDescrTree <- forestStoreGetTreeSave (descrStore mods) =<< treePathNewFromIndices' [] selF <- treeViewGetSelection (descrView mods) case findPathFor symbol mbDescrTree of Nothing -> sysMessage Normal (__ "no path found") Just childPath -> do- path <- treeModelSortConvertChildPathToPath (descrSortedStore mods) childPath+ Just path <- treeModelSortConvertChildPathToPath (descrSortedStore mods) =<< treePathNewFromIndices' (map fromIntegral childPath) treeSelectionSelectPath selF path- col <- treeViewGetColumn (descrView mods) 0- treeViewScrollToCell (descrView mods) (Just path) col- (Just (0.3,0.3))+ Just col <- treeViewGetColumn (descrView mods) 0+ treeViewScrollToCell (descrView mods) (Just path) (Just col)+ True 0.3 0.3 reloadKeepSelection :: Bool -> IDEAction reloadKeepSelection isInitial = do@@ -1074,15 +1190,15 @@ state <- readIDE currentState if not $ isStartingOrClosing state then do- mbTreeSelection <- liftIO $ getSelectionTree (treeView mods) (treeStore mods)- mbDescrSelection <- liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)+ mbTreeSelection <- getSelectionTree (treeView mods) (forestStore mods)+ mbDescrSelection <- getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods) sc <- getScope recordExpanderState fillModulesList sc- liftIO $ treeStoreClear (descrStore mods)+ forestStoreClear (descrStore mods) let mbs = (case mbTreeSelection of Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)- otherwise -> Nothing,+ _ -> Nothing, case mbDescrSelection of Nothing -> Nothing Just fw -> Just (dscName fw))@@ -1096,17 +1212,17 @@ selectNames (moduleS', facetS') applyExpanderState -treeStoreGetTreeSave :: TreeStore a -> TreePath -> IO (Maybe (Tree a))-treeStoreGetTreeSave treeStore treePath = catch (do- liftIO $ debugM "leksah" "treeStoreGetTreeSave"- res <- treeStoreGetTree treeStore treePath+forestStoreGetTreeSave :: MonadIO m => ForestStore a -> TreePath -> m (Maybe (Tree a))+forestStoreGetTreeSave forestStore treePath = liftIO $ catch (do+ debugM "leksah" "forestStoreGetTreeSave"+ res <- forestStoreGetTree forestStore treePath return (Just res)) (\ (_ :: SomeException) -> return Nothing) expandHere :: TreeView -> IO () expandHere treeView = do liftIO $ debugM "leksah" "expandHere" sel <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows sel+ paths <- treeSelectionGetSelectedRows' sel case paths of [] -> return () (hd:_) -> void (treeViewExpandRow treeView hd True)@@ -1115,20 +1231,24 @@ collapseHere treeView = do liftIO $ debugM "leksah" "collapseHere" sel <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows sel+ paths <- treeSelectionGetSelectedRows' sel case paths of [] -> return () (hd:_) -> void (treeViewCollapseRow treeView hd) -delModule :: TreeView -> TreeStore ModuleRecord -> PackageAction+delModule :: TreeView -> ForestStore ModuleRecord -> PackageAction delModule treeview store = do liftIO $ debugM "leksah" "delModule" window <- liftIDE getMainWindow- sel <- liftIO $ treeViewGetSelection treeview- paths <- liftIO $ treeSelectionGetSelectedRows sel+ sel <- treeViewGetSelection treeview+ paths <- treeSelectionGetSelectedRows' sel categories <- case paths of [] -> return []- (treePath:_) -> liftIO $ mapM (treeStoreGetValue store . (`take` treePath))+ (treePath':_) -> do+ treePath <- treePathGetIndices' treePath'+ mapM (\n ->+ treePathNewFromIndices' (take n treePath) >>=+ forestStoreGetValue store) [1 .. length treePath] liftIDE $ ideMessage Normal (T.pack $ printf (__ "categories: %s") (show categories))@@ -1145,24 +1265,31 @@ respDelModDialog = do liftIO $ debugM "leksah" "respDelModDialog" window <- getMainWindow- resp <- liftIO $ do- dia <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel (__ "Are you sure?")- dialogAddButton dia (__ "_Delete Module") (ResponseUser 1)- dialogSetDefaultResponse dia ResponseCancel- set dia [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun dia- widgetDestroy dia- return resp- return $ resp == ResponseUser 1+ dia <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType dia MessageTypeQuestion+ setMessageDialogText dia $ __ "Are you sure?"+ windowSetTransientFor dia (Just window)+ dialogAddButton' dia (__ "_Delete Module") (AnotherResponseType 1)+ dialogSetDefaultResponse' dia ResponseTypeCancel+ setWindowWindowPosition dia WindowPositionCenterOnParent+ resp <- dialogRun' dia+ widgetDestroy dia+ return $ resp == AnotherResponseType 1 -addModule' :: TreeView -> TreeStore ModuleRecord -> PackageAction+addModule' :: TreeView -> ForestStore ModuleRecord -> PackageAction addModule' treeView store = do liftIO $ debugM "leksah" "addModule'"- sel <- liftIO $ treeViewGetSelection treeView- paths <- liftIO $ treeSelectionGetSelectedRows sel+ sel <- treeViewGetSelection treeView+ paths <- treeSelectionGetSelectedRows' sel categories <- case paths of [] -> return []- (treePath:_) -> liftIO $ mapM (treeStoreGetValue store . (`take` treePath))+ (treePath':_) -> do+ treePath <- treePathGetIndices' treePath'+ mapM (\n ->+ treePathNewFromIndices' (take n treePath) >>=+ forestStoreGetValue store) [1 .. length treePath] addModule (map fst categories) @@ -1185,10 +1312,10 @@ modulePrefix in do window' <- liftIDE getMainWindow- mbResp <- liftIO $ addModuleDialog window' modPath srcPaths (hasLibs pd) $- map (T.pack . exeName) (executables pd)- ++ map (T.pack . testName) (testSuites pd)- ++ map (T.pack . benchmarkName) (benchmarks pd)+ mbResp <- addModuleDialog window' modPath srcPaths (hasLibs pd) $+ map (T.pack . unUnqualComponentName . exeName) (executables pd)+ ++ map (T.pack . unUnqualComponentName . testName) (testSuites pd)+ ++ map (T.pack . unUnqualComponentName . benchmarkName) (benchmarks pd) case mbResp of Nothing -> return () Just addMod@(AddModule modPath srcPath libExposed exesAndTests) ->@@ -1228,61 +1355,55 @@ lib Nothing = [] -- | Creates and runs a "new module" dialog-addModuleDialog :: Window -- ^ The parent window+addModuleDialog :: (Applicative m, MonadIO m)+ => Window -- ^ The parent window -> Text -- ^ Will be set as default value for the module name -> [FilePath] -- ^ Possible source directories to add it to -> Bool -- ^ Whether the active package has a library -> [Text] -- ^ The components of the active package- -> IO (Maybe AddModule)+ -> m (Maybe AddModule) addModuleDialog parent modString sourceRoots hasLib exesTests = do liftIO $ debugM "leksah" "addModuleDialog"- dia <- dialogNew- set dia [ windowTransientFor := parent- , windowTitle := __ "Construct new module" ]+ dia <- new' Dialog [constructDialogUseHeaderBar 1]+ setWindowTransientFor dia parent+ setWindowTitle dia $ __ "Construct new module" windowSetDefaultSize dia 400 100- upper <- dialogGetContentArea dia- lower <- dialogGetActionArea dia- (widget,inj,ext,_) <- buildEditor (moduleFields sourceRoots hasLib exesTests)+ upper <- dialogGetContentArea dia >>= liftIO . unsafeCastTo Box+ (widget,inj,ext,_) <- liftIO $ buildEditor (moduleFields sourceRoots hasLib exesTests) (AddModule modString (head sourceRoots) (Just False) Set.empty)- bb <- hButtonBoxNew- boxSetSpacing bb 6- buttonBoxSetLayout bb ButtonboxSpread- cancel <- buttonNewFromStock "gtk-cancel"- ok <- buttonNewFromStock "gtk-ok"- boxPackEnd bb cancel PackNatural 0- boxPackEnd bb ok PackNatural 0+ okButton <- dialogAddButton' dia (__"Add Module") ResponseTypeOk >>= liftIO . unsafeCastTo Button+ dialogSetDefaultResponse' dia ResponseTypeOk+ dialogAddButton' dia (__"Cancel") ResponseTypeCancel - errorLabel <- labelNew (Nothing :: Maybe String)+ errorLabel <- labelNew Nothing labelSetLineWrap errorLabel True- widgetSetName errorLabel ("errorLabel" :: String)+ widgetSetName errorLabel "errorLabel" - on ok buttonActivated $ do+ onButtonClicked okButton $ 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+ Just _ -> dialogResponse' dia ResponseTypeOk 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)+ boxPackStart' upper errorLabel PackNatural 0+ boxReorderChild upper errorLabel 0+ labelSetText errorLabel "Invalid module name, use uppercase identifiers seperated by dots. For example Some.New.Module" widgetShow errorLabel - on cancel buttonActivated (dialogResponse dia ResponseCancel)- boxPackStart (castToBox upper) widget PackGrow 0- boxPackEnd (castToBox lower) bb PackNatural 5- set ok [widgetCanDefault := True]- widgetGrabDefault ok+ boxPackStart' upper widget PackGrow 0+ setWidgetCanDefault okButton True+ widgetGrabDefault okButton widgetShowAll dia- resp <- dialogRun dia- value <- ext (AddModule modString (head sourceRoots) (Just False) Set.empty)+ resp <- dialogRun' dia+ value <- liftIO $ ext (AddModule modString (head sourceRoots) (Just False) Set.empty) widgetDestroy dia --find case resp of- ResponseOk -> return value+ ResponseTypeOk -> return value _ -> return Nothing moduleFields :: [FilePath] -> Bool -> [Text] -> FieldDescription AddModule@@ -1330,7 +1451,7 @@ liftIO $ do oldSel <- readIORef (oldSelection m) let (sc,bl) = (scope' oldSel, blacklist' oldSel)- paths1 <- getExpandedRows (treeView m) (treeStore m)+ paths1 <- getExpandedRows (treeView m) (forestStore m) paths2 <- getExpandedRows (descrView m) (descrStore m) modifyIORef (expanderState m) (\ es -> case (sc,bl) of@@ -1350,13 +1471,14 @@ return () -getExpandedRows :: TreeView -> TreeStore alpha -> IO [TreePath]+getExpandedRows :: TreeView -> ForestStore alpha -> IO [[Int]] getExpandedRows view store = do liftIO $ debugM "leksah" "getExpandedRows" mbIter <- treeModelGetIterFirst store case mbIter of- Nothing -> return []- Just iter -> expandedFor iter []+ (False, _) -> return []+ (True, iter) -> expandedFor iter [] >>=+ mapM (fmap (map fromIntegral) . treePathGetIndices') where expandedFor :: TreeIter -> [TreePath] -> IO [TreePath] expandedFor iter accu = do@@ -1365,15 +1487,14 @@ res <- if expanded then do- mbIter <- treeModelIterChildren store iter+ mbIter <- treeModelIterChildren store (Just iter) case mbIter of- Nothing -> return (path : accu)- Just iter -> expandedFor iter (path : accu)+ (False, _) -> return (path : accu)+ (True, iter) -> expandedFor iter (path : accu) else return accu- next <- treeModelIterNext store iter- case next of- Nothing -> return res- Just iter -> expandedFor iter res+ treeModelIterNext store iter >>= \case+ False -> return res+ True -> expandedFor iter res applyExpanderState :: IDEAction applyExpanderState = do@@ -1393,8 +1514,8 @@ (WorkspaceScope True,False) -> workspaceDExpNoBlack es (SystemScope,True) -> systemExp es (SystemScope,False) -> systemExpNoBlack es- mapM_ (treeViewExpandToPath (treeView m)) paths1- mapM_ (treeViewExpandToPath (descrView m)) paths2+ mapM_ (\p -> treePathNewFromIndices' (map fromIntegral p) >>= treeViewExpandToPath (treeView m)) paths1+ mapM_ (\p -> treePathNewFromIndices' (map fromIntegral p) >>= treeViewExpandToPath (descrView m)) paths2 -- * GUI History @@ -1403,11 +1524,11 @@ liftIO $ debugM "leksah" "selectIdentifier" mods <- getModules Nothing ideR <- ask- selTree <- liftIO $ getSelectionTree (treeView mods) (treeStore mods)- selDescr <- liftIO $ getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods)+ selTree <- getSelectionTree (treeView mods) (forestStore mods)+ selDescr <- getSelectionDescr (descrView mods) (descrStore mods) (descrSortedStore mods) let selMod = case selTree of Just (_,Just (md,_)) -> Just (modu $ mdModuleId md)- otherwise -> Nothing+ _ -> Nothing let selFacet = case selDescr of Nothing -> Nothing Just descr -> Just (dscName descr)
src/IDE/Pane/PackageEditor.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}@@ -25,6 +26,7 @@ packageNew' , packageClone , packageEdit+, projectEditText , packageEditText , choosePackageDir , choosePackageFile@@ -33,7 +35,7 @@ , standardSetup ) where -import Graphics.UI.Gtk+import Control.Applicative (Applicative, (<*>), (<$>)) import Distribution.Package import Distribution.PackageDescription import Distribution.Verbosity@@ -43,6 +45,7 @@ import IDE.Core.State import IDE.Utils.FileUtils+import IDE.Utils.CabalUtils (writeGenericPackageDescription') import Graphics.UI.Editor.MakeEditor import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.PackageDescription.Configuration (flattenPackageDescription)@@ -55,25 +58,15 @@ multisetEditor) import Distribution.Text (simpleParse, display) import Graphics.UI.Editor.Parameters- (paraInnerPadding,- paraInnerAlignment,- paraOuterPadding,- paraOuterAlignment,- Parameter(..),- paraPack,- Direction(..),- paraDirection,- paraMinSize,- paraShadow,- paraSynopsis,- (<<<-),- emptyParams,- paraName,- getParameterPrim)+ (paraMargin, paraVAlign, paraHAlign, boxPackEnd',+ dialogSetDefaultResponse', dialogRun', Packing(..), boxPackStart',+ dialogAddButton', Parameter(..), paraPack,+ paraOrientation, paraMinSize, paraShadow, paraSynopsis, (<<<-),+ emptyParams, paraName, getParameterPrim) import Graphics.UI.Editor.Simple- (stringEditor, comboEntryEditor,- staticListMultiEditor, intEditor, boolEditor, fileEditor,- comboSelectionEditor, multilineStringEditor, textEditor)+ (enumEditor, stringEditor, comboEntryEditor, staticListMultiEditor,+ intEditor, boolEditor, fileEditor, comboSelectionEditor,+ multilineStringEditor, textEditor) import Graphics.UI.Editor.Basics (Notifier, Editor(..), GUIEventSelector(..), GUIEvent(..)) import Distribution.Compiler@@ -84,25 +77,33 @@ import IDE.Pane.SourceBuffer (fileOpenThis) import Control.Event (EventSource(..)) -import qualified Graphics.UI.Gtk.Gdk.Events as GTK (Event(..)) import Data.List (isPrefixOf, sort, nub, sortBy)+import Data.List.Split (splitOn) import Data.Text (Text) import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import Control.Monad (void, when)-import Distribution.PackageDescription.PrettyPrint- (writeGenericPackageDescription)-import Distribution.Version (Version(..), orLaterVersion)+#if MIN_VERSION_Cabal(2,0,0)+import Distribution.Version+ (versionNumbers, Version(..), mkVersion, orLaterVersion)+import Distribution.Types.UnqualComponentName+ (UnqualComponentName(..), mkUnqualComponentName,+ unUnqualComponentName)+import Distribution.Types.ExecutableScope (ExecutableScope(..))+import Distribution.Types.ForeignLib (ForeignLib(..))+#else+import Distribution.Version+ (Version(..), orLaterVersion)+#endif -import Control.Applicative ((<*>), (<$>)) import IDE.Utils.Tool (ToolOutput(..)) import System.Exit (ExitCode(..)) import qualified Data.Conduit.List as CL (fold) import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink) import IDE.Utils.ExternalTool (runExternalTool') import qualified System.IO.Strict as S (readFile)-import Data.Char (toLower)+import Data.Char (isDigit, isAlphaNum, toLower) import qualified Data.Text as T (replace, span, splitAt, isPrefixOf, length, toLower, lines, unlines, pack, unpack, null)@@ -115,7 +116,41 @@ import Distribution.License (License(..)) import Control.Exception (SomeException(..)) import IDE.Metainfo.Provider (getAllPackageIds)+import GI.Gtk.Objects.Window+ (windowSetTransientFor, setWindowWindowPosition, setWindowTitle,+ setWindowTransientFor, Window(..))+import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..))+import GI.Gtk.Enums+ (Align(..), ShadowType(..), WindowPosition(..), ButtonsType(..),+ MessageType(..), ResponseType(..), FileChooserAction(..),+ Orientation(..))+import GI.Gtk.Objects.Dialog+ (Dialog(..), constructDialogUseHeaderBar, dialogGetActionArea, dialogGetContentArea)+import Data.GI.Base (on, unsafeCastTo, set, new')+import GI.Gtk.Objects.Box (boxNew, boxPackEnd, Box(..))+import GI.Gtk.Objects.Widget+ (widgetSetSensitive, toWidget, widgetDestroy, widgetShowAll,+ widgetGrabDefault, setWidgetCanDefault)+import GI.Gtk.Objects.MessageDialog+ (setMessageDialogText, constructMessageDialogButtons, setMessageDialogMessageType,+ MessageDialog(..))+import GI.Gtk.Objects.Notebook (Notebook(..))+import GI.Gtk.Objects.ButtonBox (buttonBoxNew)+import GI.Gtk.Objects.Button (onButtonClicked, buttonNewWithLabel)+import GI.Gtk.Objects.Label (labelSetMarkup, labelNew)+import GI.Gtk.Objects.CellRendererText (setCellRendererTextText) +#if !MIN_VERSION_Cabal(2,0,0)+versionNumbers :: Version -> [Int]+versionNumbers = versionBranch+mkPackageName :: String -> PackageName+mkPackageName = PackageName+mkVersion :: [Int] -> Version+mkVersion = (`Version` [])+mkUnqualComponentName :: String -> String+mkUnqualComponentName = id+#endif+ printf :: PrintfType r => Text -> r printf = S.printf . T.unpack @@ -127,20 +162,25 @@ toGenericPackageDescription :: PackageDescription -> GenericPackageDescription toGenericPackageDescription pd =- GenericPackageDescription {- packageDescription = pd{+ GenericPackageDescription+ { packageDescription = pd{ library = Nothing, executables = [], testSuites = [], benchmarks = [],- buildDepends = []},- genPackageFlags = [],- condLibrary = case library pd of+ buildDepends = []}+ , genPackageFlags = []+ , condLibrary = case library pd of Nothing -> Nothing- Just lib -> Just (buildCondTreeLibrary lib),- condExecutables = map buildCondTreeExe (executables pd),- condTestSuites = map buildCondTreeTest (testSuites pd),- condBenchmarks = map buildCondTreeBenchmark (benchmarks pd)}+ Just lib -> Just (buildCondTreeLibrary lib)+ , condExecutables = map buildCondTreeExe (executables pd)+ , condTestSuites = map buildCondTreeTest (testSuites pd)+ , condBenchmarks = map buildCondTreeBenchmark (benchmarks pd)+#if MIN_VERSION_Cabal(2,0,0)+ , condForeignLibs = map buildCondTreeForeignLib (foreignLibs pd)+ , condSubLibraries = concatMap buildCondTreeSubLibraries (subLibraries pd)+#endif+ } where buildCondTreeLibrary lib = CondNode {@@ -162,6 +202,19 @@ condTreeData = bm { benchmarkBuildInfo = (benchmarkBuildInfo bm) { targetBuildDepends = buildDepends pd } }, condTreeConstraints = buildDepends pd, condTreeComponents = []})+#if MIN_VERSION_Cabal(2,0,0)+ buildCondTreeForeignLib fl =+ (foreignLibName fl, CondNode {+ condTreeData = fl { foreignLibBuildInfo = (foreignLibBuildInfo fl) { targetBuildDepends = buildDepends pd } },+ condTreeConstraints = buildDepends pd,+ condTreeComponents = []})+ buildCondTreeSubLibraries sl@Library{libName = Nothing} = []+ buildCondTreeSubLibraries sl@Library{libName = Just ln} = [+ (ln, CondNode {+ condTreeData = sl { libBuildInfo = (libBuildInfo sl) { targetBuildDepends = buildDepends pd } },+ condTreeConstraints = buildDepends pd,+ condTreeComponents = []})]+#endif -- --------------------------------------------------------------------- -- The exported stuff goes here@@ -199,6 +252,12 @@ liftIDE $ editPackage flat dirName modules (\ _ -> return ()) return () +projectEditText :: ProjectAction+projectEditText = do+ project <- ask+ liftIDE $ fileOpenThis $ pjFile project+ return ()+ packageEditText :: PackageAction packageEditText = do idePackage <- ask@@ -222,23 +281,24 @@ hasUnknownTestTypes pd = any unknown $ testSuites pd where- unknown (TestSuite _ (TestSuiteExeV10 _ _) _ _) = False+ unknown TestSuite {testInterface = TestSuiteExeV10 _ _} = False unknown _ = True hasUnknownBenchmarkTypes :: PackageDescription -> Bool hasUnknownBenchmarkTypes pd = any unknown $ benchmarks pd where- unknown (Benchmark _ (BenchmarkExeV10 _ _) _ _) = False+ unknown Benchmark {benchmarkInterface = BenchmarkExeV10 _ _} = False unknown _ = True data NewPackage = NewPackage { newPackageName :: Text, newPackageParentDir :: FilePath,- templatePackage :: Maybe Text}+ templatePackage :: Maybe Text,+ newPackageProject :: Maybe FilePath } -packageFields :: FilePath -> FieldDescription NewPackage-packageFields workspaceDir = VFD emptyParams [+packageFields :: FilePath -> [Project] -> FieldDescription NewPackage+packageFields workspaceDir projects = VFD emptyParams [ mkField (paraName <<<- ParaName (__ "New package name") $ emptyParams)@@ -257,112 +317,139 @@ $ emptyParams) templatePackage (\ a b -> b{templatePackage = a})- (maybeEditor (comboEntryEditor examplePackages, emptyParams) True "")]+ (maybeEditor (comboEntryEditor examplePackages, emptyParams) True ""),+ mkField+ (paraName <<<- ParaName (__ "Add to existing project")+ $ emptyParams)+ (fmap T.pack . newPackageProject)+ (\ a b -> b{newPackageProject = T.unpack <$> a})+ (maybeEditor (comboEntryEditor (map (T.pack . pjFile) projects), emptyParams) True "")] examplePackages = [ "hello" , "gtk2hs-hello" , "ghcjs-dom-hello" , "jsaddle-hello"] -newPackageDialog :: Window -> FilePath -> IO (Maybe NewPackage)-newPackageDialog parent workspaceDir = do- dia <- dialogNew- set dia [ windowTransientFor := parent- , windowTitle := __ "Create New Package" ]- upper <- dialogGetContentArea dia- lower <- dialogGetActionArea dia- (widget,inj,ext,_) <- buildEditor (packageFields workspaceDir)- (NewPackage "" workspaceDir Nothing)- okButton <- dialogAddButton dia (__"Create Package") ResponseOk- dialogAddButton dia (__"Cancel") ResponseCancel- boxPackStart (castToBox upper) widget PackGrow 7- set okButton [widgetCanDefault := True]+newPackageDialog :: (Applicative m, MonadIO m) => Window -> FilePath -> [Project] -> m (Maybe NewPackage)+newPackageDialog parent workspaceDir projects = do+ let defaultParentDir = fromMaybe workspaceDir (dropFileName . pjFile <$> listToMaybe projects)+ dia <- new' Dialog [constructDialogUseHeaderBar 1]+ setWindowTransientFor dia parent+ setWindowTitle dia $ __ "Create New Package"+ upper <- dialogGetContentArea dia >>= liftIO . unsafeCastTo Box+ (widget,inj,ext,_) <- liftIO $ buildEditor (packageFields defaultParentDir projects)+ (NewPackage "" defaultParentDir Nothing (pjFile <$> listToMaybe projects))+ okButton <- dialogAddButton' dia (__"Create Package") ResponseTypeOk+ dialogSetDefaultResponse' dia ResponseTypeOk+ dialogAddButton' dia (__"Cancel") ResponseTypeCancel+ boxPackStart' upper widget PackGrow 7+ setWidgetCanDefault okButton True widgetGrabDefault okButton widgetShowAll dia- resp <- dialogRun dia- value <- ext (NewPackage "" workspaceDir Nothing)+ resp <- dialogRun' dia+ value <- liftIO $ ext (NewPackage "" defaultParentDir Nothing (pjFile <$> listToMaybe projects)) widgetDestroy dia --find- case resp of- ResponseOk -> return value- _ -> return Nothing+ case (resp, value) of+ (ResponseTypeOk, Just p)+ | validPackageName . T.unpack $ newPackageName p -> return value+ | otherwise -> do+ liftIO $ showErrorDialog (Just parent) "Invalid package name."+ newPackageDialog parent defaultParentDir projects+ _ -> return Nothing -packageNew' :: FilePath -> C.Sink ToolOutput IDEM () -> (Bool -> FilePath -> IDEAction) -> IDEAction-packageNew' workspaceDir log activateAction = do- windows <- getWindows- mbNewPackage <- liftIO $ newPackageDialog (head windows) workspaceDir+validPackageName :: String -> Bool+validPackageName = all valid . splitOn "-"+ where+ valid "" = False+ valid w = all isAlphaNum w && not (all isDigit w)++packageNew' :: FilePath -> [Project] -> C.Sink ToolOutput IDEM () -> (Bool -> Maybe Project -> FilePath -> IDEAction) -> IDEAction+packageNew' workspaceDir projects log activateAction = do+ windows <- getWindows+ mbNewPackage <- newPackageDialog (head windows) workspaceDir projects case mbNewPackage of Nothing -> return () Just NewPackage{..} | isNothing templatePackage -> do let dirName = newPackageParentDir </> T.unpack newPackageName+ mbProject = listToMaybe $ filter ((== newPackageProject) . Just . pjFile) projects mbCabalFile <- liftIO $ cabalFileName dirName window <- getMainWindow case mbCabalFile of Just cfn -> do- add <- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (T.pack $ printf (__- "There is already file %s in this directory. Would you like to add this package to the workspace?")- (takeFileName cfn))- dialogAddButton md (__ "_Add Package") (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- rid <- dialogRun md- widgetDestroy md- return $ rid == ResponseUser 1- when add $ activateAction False cfn+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ T.pack (printf (__+ "There is already file %s in this directory. Would you like to add this package to the project?")+ (takeFileName cfn))+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Add Package") (AnotherResponseType 1)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ rid <- dialogRun' md+ widgetDestroy md+ when (rid == AnotherResponseType 1) $+ activateAction False mbProject cfn Nothing -> do liftIO $ createDirectoryIfMissing True dirName isEmptyDir <- liftIO $ isEmptyDirectory dirName make <- if isEmptyDir then return True- else liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (T.pack $ printf (__- "The path you have choosen %s is not an empty directory. Are you sure you want to make a new package here?")- dirName)- dialogAddButton md (__ "_Make Package Here") (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- rid <- dialogRun md+ else do+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md . T.pack $ printf (__+ "The path you have choosen %s is not an empty directory. Are you sure you want to make a new package here?")+ dirName+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Make Package Here") (AnotherResponseType 1)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ rid <- dialogRun' md widgetDestroy md- return $ rid == ResponseUser 1+ return $ rid == AnotherResponseType 1 when make $ do modules <- liftIO $ allModules dirName let Just initialVersion = simpleParse "0.0.1" editPackage emptyPackageDescription {- package = PackageIdentifier (PackageName $ T.unpack newPackageName)+ package = PackageIdentifier (mkPackageName $ T.unpack newPackageName) initialVersion , buildType = Just Simple- , specVersionRaw = Right (orLaterVersion (Version [1,12] []))+ , specVersionRaw = Right (orLaterVersion (mkVersion [1,12])) , license = AllRightsReserved , buildDepends = [- Dependency (PackageName "base") anyVersion- , Dependency (PackageName "QuickCheck") anyVersion- , Dependency (PackageName "doctest") anyVersion]+ Dependency (mkPackageName "base") anyVersion+ , Dependency (mkPackageName "QuickCheck") anyVersion+ , Dependency (mkPackageName "doctest") anyVersion] , executables = [emptyExecutable {- exeName = T.unpack newPackageName+ exeName = mkUnqualComponentName $ T.unpack newPackageName , modulePath = "Main.hs" , buildInfo = emptyBuildInfo { hsSourceDirs = ["src"]- , targetBuildDepends = [Dependency (PackageName "base") anyVersion]+ , targetBuildDepends = [Dependency (mkPackageName "base") anyVersion] , options = [(GHC, ["-ferror-spans"])] , defaultLanguage = Just Haskell2010}}] , testSuites = [emptyTestSuite {- testName = "test-" ++ T.unpack newPackageName- , testInterface = TestSuiteExeV10 (Version [1,0] []) "Main.hs"+ testName = mkUnqualComponentName $ "test-" ++ T.unpack newPackageName+ , testInterface = TestSuiteExeV10 (mkVersion [1,0]) "Main.hs" , testBuildInfo = emptyBuildInfo { hsSourceDirs = ["test"] , targetBuildDepends = [- Dependency (PackageName "base") anyVersion- , Dependency (PackageName "QuickCheck") anyVersion- , Dependency (PackageName "doctest") anyVersion]+ Dependency (mkPackageName "base") anyVersion+ , Dependency (mkPackageName "QuickCheck") anyVersion+ , Dependency (mkPackageName "doctest") anyVersion] , options = [(GHC, ["-ferror-spans"])] , defaultLanguage = Just Haskell2010}}] , benchmarks = []- } dirName modules (activateAction True)+ } dirName modules (activateAction True mbProject) return ()- Just NewPackage{..} -> cabalUnpack newPackageParentDir (fromJust templatePackage) False (Just newPackageName) log (activateAction False)+ Just NewPackage{..} -> do+ let mbProject = listToMaybe $ filter ((== newPackageProject) . Just . pjFile) projects+ cabalUnpack newPackageParentDir (fromJust templatePackage) False (Just newPackageName) log (activateAction False mbProject) standardSetup :: Text standardSetup = "#!/usr/bin/runhaskell \n"@@ -393,27 +480,26 @@ clonePackageSourceDialog :: Window -> FilePath -> IDEM (Maybe ClonePackageSourceRepo) clonePackageSourceDialog parent workspaceDir = do- packages <- getAllPackageIds- liftIO $ do- dia <- dialogNew- set dia [ windowTransientFor := parent- , windowTitle := __ "Copy Installed Package" ]- upper <- dialogGetContentArea dia- lower <- dialogGetActionArea dia- (widget,inj,ext,_) <- buildEditor (cloneFields packages workspaceDir)+ packages <- getAllPackageIds+ dia <- new' Dialog [constructDialogUseHeaderBar 1]+ setWindowTransientFor dia parent+ setWindowTitle dia $ __ "Copy Installed Package"+ upper <- dialogGetContentArea dia >>= liftIO . unsafeCastTo Box+ (widget,inj,ext,_) <- liftIO $ buildEditor (cloneFields packages workspaceDir) (ClonePackageSourceRepo "" workspaceDir)- okButton <- dialogAddButton dia (__"Copy Package") ResponseOk- dialogAddButton dia (__"Cancel") ResponseCancel- boxPackStart (castToBox upper) widget PackGrow 7- set okButton [widgetCanDefault := True]+ okButton <- dialogAddButton' dia (__"Copy Package") ResponseTypeOk+ dialogSetDefaultResponse' dia ResponseTypeOk+ dialogAddButton' dia (__"Cancel") ResponseTypeCancel+ boxPackStart' upper widget PackGrow 7+ setWidgetCanDefault okButton True widgetGrabDefault okButton widgetShowAll dia- resp <- dialogRun dia- value <- ext (ClonePackageSourceRepo "" workspaceDir)+ resp <- dialogRun' dia+ value <- liftIO $ ext (ClonePackageSourceRepo "" workspaceDir) widgetDestroy dia --find case resp of- ResponseOk -> return value+ ResponseTypeOk -> return value _ -> return Nothing packageClone :: FilePath -> C.Sink ToolOutput IDEM () -> (FilePath -> IDEAction) -> IDEAction@@ -433,7 +519,7 @@ createDirectory tempDir runExternalTool' (__ "Unpacking") "cabal" (["unpack"] ++ ["--source-repository" | sourceRepo]- ++ ["--destdir=" <> T.pack tempDir, packageToUnpack]) tempDir $ do+ ++ ["--destdir=" <> T.pack tempDir, packageToUnpack]) tempDir Nothing $ do mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink log case mbLastOutput of Just (ToolExit ExitSuccess) -> do@@ -502,18 +588,22 @@ bis :: [BuildInfo]} deriving Eq -comparePDE a b = do- when (pd a /= pd b) $ putStrLn "pd"- when (exes a /= exes b) $ putStrLn "exes"- when (tests a /= tests b) $ putStrLn "tests"- when (mbLib a /= mbLib b) $ putStrLn "mbLib"- when (bis a /= bis b) $ putStrLn "bis"- fromEditor :: PackageDescriptionEd -> PackageDescription fromEditor (PDE pd exes' tests' benchmarks' mbLib' buildInfos) =+#if MIN_VERSION_Cabal(2,0,0)+ let exes = map (\ (Executable' s fb scope bii) -> if bii + 1 > length buildInfos+ then Executable (mkUnqualComponentName $ T.unpack s) fb scope (buildInfos !! (length buildInfos - 1))+ else Executable (mkUnqualComponentName $ T.unpack s) fb scope (buildInfos !! bii)) exes'+ tests = map (\ (Test' s fb bii) -> if bii + 1 > length buildInfos+ then TestSuite (mkUnqualComponentName $ T.unpack s) fb (buildInfos !! (length buildInfos - 1))+ else TestSuite (mkUnqualComponentName $ T.unpack s) fb (buildInfos !! bii)) tests'+ bms = map (\ (Benchmark' s fb bii) -> if bii + 1 > length buildInfos+ then Benchmark (mkUnqualComponentName $ T.unpack s) fb (buildInfos !! (length buildInfos - 1))+ else Benchmark (mkUnqualComponentName $ T.unpack s) fb (buildInfos !! bii)) benchmarks'+#else let exes = map (\ (Executable' s fb bii) -> if bii + 1 > length buildInfos then Executable (T.unpack s) fb (buildInfos !! (length buildInfos - 1)) else Executable (T.unpack s) fb (buildInfos !! bii)) exes'@@ -523,9 +613,14 @@ bms = map (\ (Benchmark' s fb bii) -> if bii + 1 > length buildInfos then Benchmark (T.unpack s) fb (buildInfos !! (length buildInfos - 1)) False else Benchmark (T.unpack s) fb (buildInfos !! bii) False) benchmarks'+#endif mbLib = case mbLib' of Nothing -> Nothing-#if MIN_VERSION_Cabal(1,22,0)+#if MIN_VERSION_Cabal(2,0,0)+ Just (Library' ln mn rmn s b bii) -> if bii + 1 > length buildInfos+ then Just (Library (mkUnqualComponentName . T.unpack <$> ln) mn rmn s b (buildInfos !! (length buildInfos - 1)))+ else Just (Library (mkUnqualComponentName . T.unpack <$> ln) mn rmn s b (buildInfos !! bii))+#elif MIN_VERSION_Cabal(1,22,0) Just (Library' mn rmn rs es b bii) -> if bii + 1 > length buildInfos then Just (Library mn rmn rs es b (buildInfos !! (length buildInfos - 1))) else Just (Library mn rmn rs es b (buildInfos !! bii))@@ -543,16 +638,27 @@ toEditor :: PackageDescription -> PackageDescriptionEd toEditor pd =+#if MIN_VERSION_Cabal(2,0,0)+ let (exes,exeBis) = unzip $ map (\(Executable s fb scope bi, i) -> (Executable' (T.pack $ unUnqualComponentName s) fb scope i, bi))+ (zip (executables pd) [0..])+ (tests,testBis) = unzip $ map (\(TestSuite s fb bi, i) -> (Test' (T.pack $ unUnqualComponentName s) fb i, bi))+ (zip (testSuites pd) [length exeBis..])+ (bms,benchmarkBis) = unzip $ map (\(Benchmark s fb bi, i) -> (Benchmark' (T.pack $ unUnqualComponentName s) fb i, bi))+ (zip (benchmarks pd) [length testBis..])+#else let (exes,exeBis) = unzip $ map (\(Executable s fb bi, i) -> (Executable' (T.pack s) fb i, bi)) (zip (executables pd) [0..]) (tests,testBis) = unzip $ map (\(TestSuite s fb bi _, i) -> (Test' (T.pack s) fb i, bi)) (zip (testSuites pd) [length exeBis..]) (bms,benchmarkBis) = unzip $ map (\(Benchmark s fb bi _, i) -> (Benchmark' (T.pack s) fb i, bi)) (zip (benchmarks pd) [length testBis..])+#endif bis = exeBis ++ testBis ++ benchmarkBis (mbLib,bis2) = case library pd of Nothing -> (Nothing,bis)-#if MIN_VERSION_Cabal(1,22,0)+#if MIN_VERSION_Cabal(2,0,0)+ Just (Library ln mn rmn s b bi) -> (Just (Library' (T.pack . unUnqualComponentName <$> ln) (sort mn) rmn s b (length bis)), bis ++ [bi])+#elif MIN_VERSION_Cabal(1,22,0) Just (Library mn rmn rs es b bi) -> (Just (Library' (sort mn) rmn rs es b (length bis)), bis ++ [bi]) #else Just (Library mn b bi) -> (Just (Library' (sort mn) b (length bis)), bis ++ [bi])@@ -572,7 +678,7 @@ -- data PackagePane = PackagePane {- packageBox :: VBox,+ packageBox :: Box, packageNotifer :: Notifier } deriving Typeable @@ -584,7 +690,7 @@ where primPaneName _ = __ "Package" getAddedIndex _ = 0- getTopWidget = castToWidget . packageBox+ getTopWidget = liftIO . toWidget . packageBox paneId b = "*Package" instance RecoverablePane PackagePane PackageState IDEM where@@ -611,7 +717,7 @@ (concatMap (buildInfoD (Just (takeDirectory packagePath)) modules) [0..length (bis packageEd) - 1])) pp nb modules afterSaveAction packageEd- Just p -> liftIO $ bringPaneToFront p+ Just p -> bringPaneToFront p initPackage :: FilePath -> PackageDescriptionEd@@ -651,26 +757,26 @@ IDEM (Maybe PackagePane,Connections) builder' packageDir packageD packageDescr afterSaveAction initialPackagePath modules packageInfos fields origPackageD panePath nb window = reifyIDE $ \ ideR -> do- vb <- vBoxNew False 0- bb <- hButtonBoxNew- save <- buttonNewFromStock "gtk-save"+ vb <- boxNew OrientationVertical 0+ bb <- buttonBoxNew OrientationHorizontal+ save <- buttonNewWithLabel "Save" widgetSetSensitive save False- closeB <- buttonNewFromStock "gtk-close"- addB <- buttonNewFromStock (__ "Add Build Info")- removeB <- buttonNewFromStock (__ "Remove Build Info")+ closeB <- buttonNewWithLabel "Close"+ addB <- buttonNewWithLabel (__ "Add Build Info")+ removeB <- buttonNewWithLabel (__ "Remove Build Info") label <- labelNew (Nothing :: Maybe Text)- boxPackStart bb addB PackNatural 0- boxPackStart bb removeB PackNatural 0- boxPackEnd bb closeB PackNatural 0- boxPackEnd bb save PackNatural 0+ boxPackStart' bb addB PackNatural 0+ boxPackStart' bb removeB PackNatural 0+ boxPackEnd' bb closeB PackNatural 0+ boxPackEnd' bb save PackNatural 0 (widget, setInj, getExt, notifier) <- buildEditor packageDescr packageD let packagePane = PackagePane vb notifier- boxPackStart vb widget PackGrow 7- boxPackStart vb label PackNatural 0- boxPackEnd vb bb PackNatural 7+ boxPackStart' vb widget PackGrow 7+ boxPackStart' vb label PackNatural 0+ boxPackEnd' vb bb PackNatural 7 let fieldNames = map (fromMaybe (__ "Unnamed") . getParameterPrim paraName . parameters) fields- on addB buttonActivated $ do+ onButtonClicked addB $ do mbNewPackage' <- extract packageD [getExt] case mbNewPackage' of Nothing -> sysMessage Normal (__ "Content doesn't validate")@@ -685,7 +791,7 @@ (concatMap (buildInfoD (Just packageDir) modules) [0..length (bis pde)])) panePath nb modules afterSaveAction origPackageD) ideR- on removeB buttonActivated $ do+ onButtonClicked removeB $ do mbNewPackage' <- extract packageD [getExt] case mbNewPackage' of Nothing -> sysMessage Normal (__ "Content doesn't validate")@@ -701,7 +807,7 @@ (concatMap (buildInfoD (Just packageDir) modules) [0..length (bis pde) - 2])) panePath nb modules afterSaveAction origPackageD) ideR- on closeB buttonActivated $ do+ onButtonClicked closeB $ do mbP <- extract packageD [getExt] let hasChanged = case mbP of Nothing -> False@@ -709,24 +815,26 @@ if not hasChanged then reflectIDE (void (closePane packagePane)) ideR else do- md <- messageDialogNew (Just window) []- MessageQuestion- ButtonsYesNo- (__ "Unsaved changes. Close anyway?")- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeYesNo]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "Unsaved changes. Close anyway?"+ windowSetTransientFor md (Just window)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md widgetDestroy md case resp of- ResponseYes -> reflectIDE (void (closePane packagePane)) ideR+ ResponseTypeYes -> reflectIDE (void (closePane packagePane)) ideR _ -> return ()- on save buttonActivated $ do+ onButtonClicked save $ do mbNewPackage' <- extract packageD [getExt] case mbNewPackage' of Nothing -> return () Just newPackage' -> let newPackage = fromEditor newPackage' in do let packagePath = packageDir </> (display . pkgName . package . pd) newPackage' ++ ".cabal"- writeGenericPackageDescription packagePath (toGenericPackageDescription newPackage)+ writeGenericPackageDescription' packagePath (toGenericPackageDescription newPackage) reflectIDE (do afterSaveAction packagePath closePane packagePane@@ -736,9 +844,9 @@ let hasChanged = case mbP of Nothing -> False Just p -> p /= origPackageD- when (isJust mbP) $ labelSetMarkup label ("" :: Text)- when (isJust mbP) $ comparePDE (fromJust mbP) packageD- markLabel nb (getTopWidget packagePane) hasChanged+ when (isJust mbP) $ labelSetMarkup label ""+ w <- reflectIDE (getTopWidget packagePane) ideR+ markLabel nb w hasChanged widgetSetSensitive save hasChanged return (e{gtkReturn=False})) registerEvent notifier ValidationError (\e -> do@@ -774,7 +882,7 @@ , mkField (paraName <<<- ParaName (__ "Description") $ paraSynopsis <<<- ParaSynopsis (__ "A more verbose description of this package")- $ paraShadow <<<- ParaShadow ShadowOut+ $ paraShadow <<<- ParaShadow ShadowTypeOut $ paraMinSize <<<- ParaMinSize (-1,210) $ emptyParams) (T.pack . description . pd)@@ -813,7 +921,7 @@ (paraName <<<- ParaName (__ "License Files") $ paraSynopsis <<<- ParaSynopsis (__ "A list of license files.")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,250) $ emptyParams) (licenseFiles . pd)@@ -856,7 +964,7 @@ mkField (paraName <<<- ParaName (__ "Build Dependencies") $ paraSynopsis <<<- ParaSynopsis (__ "Does this package depends on other packages?")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,250) $ emptyParams) (nub . buildDepends . pd)@@ -868,14 +976,14 @@ (paraName <<<- ParaName (__ "Cabal version") $ paraSynopsis <<<- ParaSynopsis (__ "Does this package depends on a specific version of Cabal?")- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) (specVersion . pd) (\ a b -> b{pd = (pd b){specVersionRaw = Left a}}) versionEditor , mkField (paraName <<<- ParaName (__ "Tested with compiler")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,150) $ emptyParams) (\a -> case (testedWith . pd) a of@@ -889,7 +997,7 @@ (paraName <<<- ParaName (__ "Data Files") $ paraSynopsis <<<- ParaSynopsis (__ "A list of files to be installed for run-time use by the package.")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,250) $ emptyParams) (dataFiles . pd)@@ -906,7 +1014,7 @@ (paraName <<<- ParaName (__ "Extra Source Files") $ paraSynopsis <<<- ParaSynopsis (__ "A list of additional files to be included in source distributions.")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,120) $ emptyParams) (extraSrcFiles . pd)@@ -916,7 +1024,7 @@ (paraName <<<- ParaName (__ "Extra Tmp Files") $ paraSynopsis <<<- ParaSynopsis (__ "A list of additional files or directories to be removed by setup clean.")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,120) $ emptyParams) (extraTmpFiles . pd)@@ -928,22 +1036,22 @@ (paraName <<<- ParaName (__ "Build Type") $ paraSynopsis <<<- ParaSynopsis (__ "Describe executable programs contained in the package")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (buildType . pd) (\ a b -> b{pd = (pd b){buildType = a}}) (maybeEditor (buildTypeEditor, emptyParams) True (__ "Specify?")) , mkField (paraName <<<- ParaName (__ "Custom Fields")- $ paraShadow <<<- ParaShadow ShadowIn+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (customFieldsPD . pd) (\ a b -> b{pd = (pd b){customFieldsPD = a}}) (multisetEditor- (ColumnDescr True [(__ "Name",\(n,_) -> [cellText := T.pack n])- ,(__ "Value",\(_,v) -> [cellText := T.pack v])])+ (ColumnDescr True [(__ "Name",\cell (n,_) -> setCellRendererTextText cell $ T.pack n)+ ,(__ "Value",\cell (_,v) -> setCellRendererTextText cell $ T.pack v)]) (pairEditor (stringxEditor (const True), emptyParams) (stringEditor (const True) True, emptyParams), emptyParams)@@ -955,7 +1063,7 @@ (paraName <<<- ParaName (__ "Executables") $ paraSynopsis <<<- ParaSynopsis (__ "Describe executable programs contained in the package")- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) exes (\ a b -> b{exes = a}) (executablesEditor (Just fp) modules numBuildInfos)@@ -965,7 +1073,7 @@ (paraName <<<- ParaName (__ "Tests") $ paraSynopsis <<<- ParaSynopsis (__ "Describe tests contained in the package")- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) tests (\ a b -> b{tests = a}) (testsEditor (Just fp) modules numBuildInfos)@@ -975,7 +1083,7 @@ (paraName <<<- ParaName (__ "Benchmarks") $ paraSynopsis <<<- ParaSynopsis (__ "Describe tests contained in the package")- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) bms (\ a b -> b{bms = a}) (benchmarksEditor (Just fp) modules numBuildInfos)@@ -985,8 +1093,8 @@ (paraName <<<- ParaName (__ "Library") $ paraSynopsis <<<- ParaSynopsis (__ "If the package contains a library, specify the exported modules here")- $ paraDirection <<<- ParaDirection Vertical- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) mbLib (\ a b -> b{mbLib = a}) (maybeEditor (libraryEditor (Just fp) modules numBuildInfos,@@ -1016,8 +1124,8 @@ (__ "Where to look for the source hierarchy") $ paraSynopsis <<<- ParaSynopsis (__ "Root directories for the source hierarchy.")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,150) $ emptyParams) (hsSourceDirs . (!! i) . bis)@@ -1027,8 +1135,8 @@ (paraName <<<- ParaName (__ "Non-exposed or non-main modules") $ paraSynopsis <<<- ParaSynopsis (__ "A list of modules used by the component but not exposed to users.")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,300) $ paraPack <<<- ParaPack PackGrow $ emptyParams)@@ -1041,19 +1149,19 @@ (T.pack $ printf (__ "%s Compiler ") (show (i + 1)), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for haskell compilers")- $ paraDirection <<<- ParaDirection Vertical- $ paraShadow <<<- ParaShadow ShadowIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ paraPack <<<- ParaPack PackGrow $ emptyParams) (options . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{options = a})}) (multisetEditor- (ColumnDescr True [( __ "Compiler Flavor",\(cv,_) -> [cellText := T.pack $ show cv])- ,(__ "Options",\(_,op) -> [cellText := T.pack $ concatMap (\s -> ' ' : s) op])])+ (ColumnDescr True [( __ "Compiler Flavor",\cell (cv,_) -> setCellRendererTextText cell . T.pack $ show cv)+ ,(__ "Options",\cell (_,op) -> setCellRendererTextText cell . T.pack $ concatMap (\s -> ' ' : s) op)]) (pairEditor (compilerFlavorEditor,emptyParams) (optsEditor,emptyParams),- paraDirection <<<- ParaDirection Vertical- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ paraOrientation <<<- ParaOrientation OrientationVertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) Nothing Nothing) #if MIN_VERSION_Cabal(1,22,0)@@ -1096,51 +1204,51 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{oldExtensions = a})}) extensionsEditor ]),- (T.pack $ printf (__ "%s Build Tools ") (show (i + 1)), VFD emptyParams [- mkField- (paraName <<<- ParaName (__ "Tools needed for a build")- $ paraDirection <<<- ParaDirection Vertical- $ paraMinSize <<<- ParaMinSize (-1,120)- $ emptyParams)- (buildTools . (!! i) . bis)- (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildTools = a})})- (dependenciesEditor [])- ]),- (T.pack $ printf (__ "%s Pkg Config ") (show (i + 1)), VFD emptyParams [- mkField- (paraName <<<- ParaName (__ "A list of pkg-config packages, needed to build this package")- $ paraDirection <<<- ParaDirection Vertical- $ paraMinSize <<<- ParaMinSize (-1,120)- $ emptyParams)- (pkgconfigDepends . (!! i) . bis)- (\ a b -> b{bis = update (bis b) i (\bi -> bi{pkgconfigDepends = a})})- (dependenciesEditor [])- ]),+-- (T.pack $ printf (__ "%s Build Tools ") (show (i + 1)), VFD emptyParams [+-- mkField+-- (paraName <<<- ParaName (__ "Tools needed for a build")+-- $ paraOrientation <<<- ParaOrientation OrientationVertical+-- $ paraMinSize <<<- ParaMinSize (-1,120)+-- $ emptyParams)+-- (map Dependency buildTools . (!! i) . bis)+-- (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildTools = a})})+-- (dependenciesEditor [])+-- ]),+-- (T.pack $ printf (__ "%s Pkg Config ") (show (i + 1)), VFD emptyParams [+-- mkField+-- (paraName <<<- ParaName (__ "A list of pkg-config packages, needed to build this package")+-- $ paraOrientation <<<- ParaOrientation OrientationVertical+-- $ paraMinSize <<<- ParaMinSize (-1,120)+-- $ emptyParams)+-- (pkgconfigDepends . (!! i) . bis)+-- (\ a b -> b{bis = update (bis b) i (\bi -> bi{pkgconfigDepends = a})})+-- (dependenciesEditor [])+-- ]), (T.pack $ printf (__ "%s Opts C -1-") (show (i + 1)), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for C compiler")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (ccOptions . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{ccOptions = a})}) optsEditor , mkField (paraName <<<- ParaName (__ "Options for linker")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (ldOptions . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{ldOptions = a})}) optsEditor , mkField (paraName <<<- ParaName (__ "A list of header files to use when compiling")- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (map T.pack . includes . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{includes = map T.unpack a})}) (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "A list of header files to install") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (installIncludes . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{installIncludes = a})}) (filesEditor fp FileChooserActionOpen (__ "Select File"))@@ -1149,7 +1257,7 @@ mkField (paraName <<<- ParaName (__ "A list of directories to search for header files") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (includeDirs . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{includeDirs = a})}) (filesEditor fp FileChooserActionSelectFolder (__ "Select Folder"))@@ -1157,7 +1265,7 @@ (paraName <<<- ParaName (__ "A list of C source files to be compiled,linked with the Haskell files.") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (cSources . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{cSources = a})}) (filesEditor fp FileChooserActionOpen (__ "Select file"))@@ -1166,14 +1274,14 @@ mkField (paraName <<<- ParaName (__ "A list of extra libraries to link with") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (map T.pack . extraLibs . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibs = map T.unpack a})}) (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "A list of directories to search for libraries.") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (extraLibDirs . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibDirs = a})}) (filesEditor fp FileChooserActionSelectFolder (__ "Select Folder"))@@ -1181,7 +1289,7 @@ (T.pack $ printf (__ "%s Other") (show (i + 1)), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for C preprocessor")- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (cppOptions . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{cppOptions = a})})@@ -1189,20 +1297,20 @@ , mkField (paraName <<<- ParaName (__ "Support frameworks for Mac OS X") $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (map T.pack . frameworks . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{frameworks = map T.unpack a})}) (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "Custom fields build info")- $ paraShadow <<<- ParaShadow ShadowIn+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ paraMinSize <<<- ParaMinSize (-1,150)- $ paraDirection <<<- ParaDirection Vertical $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (customFieldsBI . (!! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{customFieldsBI = a})}) (multisetEditor- (ColumnDescr True [(__ "Name",\(n,_) -> [cellText := T.pack n])- ,(__ "Value",\(_,v) -> [cellText := T.pack v])])+ (ColumnDescr True [(__ "Name",\cell (n,_) -> setCellRendererTextText cell $ T.pack n)+ ,(__ "Value",\cell (_,v) -> setCellRendererTextText cell $ T.pack v)]) (pairEditor (stringxEditor (const True),emptyParams) (stringEditor (const True) True,emptyParams),emptyParams)@@ -1242,23 +1350,23 @@ (compilerFlavorEditor , paraName <<<- ParaName "Compiler" $ emptyParams) (optsEditor,paraName <<<- ParaName "Options" $ emptyParams)- (paraDirection <<<- ParaDirection Vertical $ para)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ para) compilerOptsEditor :: Editor [(CompilerFlavor, [String])] compilerOptsEditor p = multisetEditor- (ColumnDescr True [("Compiler",\(compiler, _) -> [cellText := T.pack $ show compiler])- ,("Options",\(_, opts ) -> [cellText := T.pack $ unwords opts])])+ (ColumnDescr True [("Compiler",\cell (compiler, _) -> setCellRendererTextText cell . T.pack $ show compiler)+ ,("Options",\cell (_, opts ) -> setCellRendererTextText cell . T.pack $ unwords opts)]) (compilerOptRecordEditor,- paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0)- $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0)+ paraHAlign <<<- ParaHAlign AlignFill+ $ paraVAlign <<<- ParaVAlign AlignCenter $ emptyParams) (Just (sortBy (\ (f1, _) (f2, _) -> compare f1 f2))) (Just (\ (f1, _) (f2, _) -> f1 == f2))- (paraShadow <<<- ParaShadow ShadowIn- $ paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0)- $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0)- $ paraDirection <<<- ParaDirection Vertical+ (paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraHAlign <<<- ParaHAlign AlignFill+ $ paraVAlign <<<- ParaVAlign AlignCenter+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraPack <<<- ParaPack PackGrow $ p) @@ -1267,10 +1375,10 @@ (wid,inj,ext) <- pairEditor (stringEditor (not . null) True, paraName <<<- ParaName (__ "Name") $ emptyParams) (versionEditor, paraName <<<- ParaName (__ "Version") $ emptyParams)- (paraDirection <<<- ParaDirection Horizontal- $ paraShadow <<<- ParaShadow ShadowIn+ (paraOrientation <<<- ParaOrientation OrientationHorizontal+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ para) noti- let pinj (PackageIdentifier (PackageName n) v) = inj (n,v)+ let pinj (PackageIdentifier n v) = inj (unPackageName n,v) let pext = do mbp <- ext case mbp of@@ -1278,20 +1386,20 @@ Just (n,v) -> return $ if null n then Nothing- else Just $ PackageIdentifier (PackageName n) v+ else Just $ PackageIdentifier (mkPackageName n) v return (wid,pinj,pext) testedWithEditor :: Editor [(CompilerFlavor, VersionRange)] testedWithEditor = multisetEditor- (ColumnDescr True [(__ "Compiler Flavor",\(cv,_) -> [cellText := T.pack $ show cv])- ,(__ "Version Range",\(_,vr) -> [cellText := T.pack $ display vr])])+ (ColumnDescr True [(__ "Compiler Flavor",\cell (cv,_) -> setCellRendererTextText cell . T.pack $ show cv)+ ,(__ "Version Range",\cell (_,vr) -> setCellRendererTextText cell . T.pack $ display vr)]) (pairEditor (compilerFlavorEditor,- paraShadow <<<- ParaShadow ShadowNone $ emptyParams)+ paraShadow <<<- ParaShadow ShadowTypeNone $ emptyParams) (versionRangeEditor,- paraShadow <<<- ParaShadow ShadowNone $ emptyParams),- paraDirection <<<- ParaDirection Vertical $ emptyParams)+ paraShadow <<<- ParaShadow ShadowTypeNone $ emptyParams),+ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) Nothing (Just (==)) @@ -1348,17 +1456,17 @@ reposEditor :: Editor [SourceRepo] reposEditor p noti = multisetEditor- (ColumnDescr False [("",\repo -> [cellText := display repo])])+ (ColumnDescr False [("",\cell repo -> setCellRendererTextText cell display repo)]) (repoEditor, paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) $ emptyParams) Nothing Nothing- (paraShadow <<<- ParaShadow ShadowIn $+ (paraShadow <<<- ParaShadow ShadowTypeIn $ paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0)- $ paraDirection <<<- ParaDirection Vertical+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraPack <<<- ParaPack PackGrow $ p) noti@@ -1383,7 +1491,7 @@ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a branch", emptyParams) (maybeEditor (textEditor (const True) True,noBorder) True "Specify a tag", emptyParams) (maybeEditor (textEditor (const True) True,noBorder) True "Specify a subdir", emptyParams)- (paraDirection <<<- ParaDirection Vertical $ noBorder)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ noBorder) noti return (widg, (\ r -> inj (repoKind r,repoType r,repoLocation r,repoModule r,repoBranch r,repoTag r,repoSubdir r)),@@ -1442,12 +1550,19 @@ -- ------------------------------------------------------------ data Library' = Library'{+#if MIN_VERSION_Cabal(2,0,0)+ libName' :: Maybe Text,+#endif exposedModules' :: [ModuleName] #if MIN_VERSION_Cabal(1,22,0) , reexportedModules' :: [ModuleReexport]+#if MIN_VERSION_Cabal(2,0,0)+, signatures' :: [ModuleName]+#else , requiredSignatures':: [ModuleName] , exposedSignatures' :: [ModuleName] #endif+#endif , libExposed' :: Bool , libBuildInfoIdx :: Int} deriving (Show, Eq)@@ -1455,7 +1570,10 @@ data Executable' = Executable'{ exeName' :: Text , modulePath' :: FilePath-, buildInfoIdx :: Int}+#if MIN_VERSION_Cabal(2,0,0)+, exeScope' :: ExecutableScope+#endif+, exeBuildInfoIdx :: Int} deriving (Show, Eq) data Test' = Test'{@@ -1471,28 +1589,88 @@ deriving (Show, Eq) instance Default Library'-#if MIN_VERSION_Cabal(1,22,0)+#if MIN_VERSION_Cabal(2,0,0)+ where getDefault = Library' Nothing [] [] [] getDefault getDefault+#elif MIN_VERSION_Cabal(1,22,0) where getDefault = Library' [] [] [] [] getDefault getDefault #else where getDefault = Library' [] getDefault getDefault #endif instance Default Executable'+#if MIN_VERSION_Cabal(2,0,0)+ where getDefault = Executable' getDefault getDefault ExecutableScopeUnknown getDefault+#else where getDefault = Executable' getDefault getDefault getDefault+#endif instance Default Test'- where getDefault = Test' getDefault (TestSuiteExeV10 (Version [1,0] []) getDefault) getDefault+ where getDefault = Test' getDefault (TestSuiteExeV10 (mkVersion [1,0]) getDefault) getDefault instance Default Benchmark'- where getDefault = Benchmark' getDefault (BenchmarkExeV10 (Version [1,0] []) getDefault) getDefault+ where getDefault = Benchmark' getDefault (BenchmarkExeV10 (mkVersion [1,0]) getDefault) getDefault -#if MIN_VERSION_Cabal(1,22,0)+#if MIN_VERSION_Cabal(2,0,0) libraryEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Library' libraryEditor fp modules numBuildInfos para noti = do (wid,inj,ext) <- pairEditor (tupel3Editor (boolEditor,+ paraName <<<- ParaName (__ "Exposed")+ $ paraSynopsis <<<- ParaSynopsis (__ "Is the lib to be exposed by default?")+ $ emptyParams)+ (maybeEditor (textEditor (const True) True, paraName <<<- ParaName (__ "Name") $ emptyParams) True "Named?",+ paraSynopsis <<<- ParaSynopsis (__ "Is this a namesd library?")+ $ emptyParams)+ (modulesEditor (sort modules),+ paraName <<<- ParaName (__ "Exposed Modules")+ $ paraMinSize <<<- ParaMinSize (-1,300)+ $ para),+ paraOrientation <<<- ParaOrientation OrientationVertical+ $ emptyParams)+ (tupel3Editor+ (buildInfoEditorP numBuildInfos, paraName <<<- ParaName (__ "Build Info")+ $ paraPack <<<- ParaPack PackNatural+ $ para)+ (modulesEditor (sort modules),+ paraName <<<- ParaName (__ "Reexported Modules")+ $ paraMinSize <<<- ParaMinSize (-1,300)+ $ para)+ (modulesEditor (sort modules),+ paraName <<<- ParaName (__ "Signatures Needing Implementations")+ $ paraMinSize <<<- ParaMinSize (-1,300)+ $ para),+ paraOrientation <<<- ParaOrientation OrientationVertical+ $ emptyParams)+ (paraOrientation <<<- ParaOrientation OrientationVertical+ $ emptyParams)+ noti+ let pinj (Library' ln em rmn s exp bi) = inj (+ (exp, ln, map (T.pack . display) em)+ , (bi, map (T.pack . display) rmn, map (T.pack . display) s)+ )+ parseModuleNames = map (\s -> forceJust (simpleParse $ T.unpack s)+ "SpecialEditor >> libraryEditor: no parse for moduile name")+ parseRexportedModules = map (\s -> forceJust (simpleParse $ T.unpack s)+ "SpecialEditor >> libraryEditor: no parse for moduile name")+ pext = do+ mbp <- ext+ case mbp of+ Nothing -> return Nothing+ Just ((exp,ln,em), (bi, rmn, s)) -> return (Just $ Library'+ ln+ (parseModuleNames em)+ (parseRexportedModules rmn)+ (parseModuleNames s) exp bi)+ return (wid,pinj,pext)+#elif MIN_VERSION_Cabal(1,22,0)+libraryEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Library'+libraryEditor fp modules numBuildInfos para noti = do+ (wid,inj,ext) <-+ pairEditor+ (tupel3Editor+ (boolEditor, paraName <<<- ParaName (__ "Exposed") $ paraSynopsis <<<- ParaSynopsis (__ "Is the lib to be exposed by default?") $ emptyParams)@@ -1503,7 +1681,7 @@ (buildInfoEditorP numBuildInfos, paraName <<<- ParaName (__ "Build Info") $ paraPack <<<- ParaPack PackNatural $ para),- paraDirection <<<- ParaDirection Vertical+ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) (tupel3Editor (modulesEditor (sort modules),@@ -1518,9 +1696,9 @@ paraName <<<- ParaName (__ "Exposed Signatures") $ paraMinSize <<<- ParaMinSize (-1,300) $ para),- paraDirection <<<- ParaDirection Vertical+ paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams)- (paraDirection <<<- ParaDirection Vertical+ (paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) noti let pinj (Library' em rmn rs es exp bi) = inj ((exp, map (T.pack . display) em,bi), (map (T.pack . display) rmn, map (T.pack . display) rs, map (T.pack . display) es))@@ -1554,7 +1732,7 @@ (buildInfoEditorP numBuildInfos, paraName <<<- ParaName (__ "Build Info") $ paraPack <<<- ParaPack PackNatural $ para)- (paraDirection <<<- ParaDirection Vertical+ (paraOrientation <<<- ParaOrientation OrientationVertical $ emptyParams) noti let pinj (Library' em exp bi) = inj (exp, map (T.pack . display) em,bi)@@ -1573,32 +1751,67 @@ executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] executablesEditor fp modules countBuildInfo p = multisetEditor- (ColumnDescr True [(__ "Executable Name",\(Executable' exeName _ _) -> [cellText := exeName])- ,(__ "Module Path",\(Executable' _ mp _) -> [cellText := T.pack mp])- ,(__ "Build info index",\(Executable' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+ (ColumnDescr True [(__ "Executable Name",\cell Executable' {exeName' = exeName} -> setCellRendererTextText cell exeName)+ ,(__ "Module Path",\cell Executable' {modulePath' = mp} -> setCellRendererTextText cell $ T.pack mp)+ ,(__ "Build info index",\cell Executable' {exeBuildInfoIdx = bii} -> setCellRendererTextText cell . T.pack $ show (bii + 1))]) (executableEditor fp modules countBuildInfo,emptyParams) Nothing Nothing- (paraShadow <<<- ParaShadow ShadowIn+ (paraShadow <<<- ParaShadow ShadowTypeIn $ paraMinSize <<<- ParaMinSize (-1,200) $ p) +#if MIN_VERSION_Cabal(2,0,0) executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable' executableEditor fp modules countBuildInfo para noti = do+ (wid,inj,ext) <-+ pairEditor+ ( tupel3Editor+ (textEditor (not . T.null) True,+ paraName <<<- ParaName (__ "Executable Name")+ $ emptyParams)+ (stringEditor (not . null) True,+ paraOrientation <<<- ParaOrientation OrientationVertical+ $ paraName <<<- ParaName (__ "File with main function")+ $ emptyParams)+ (buildInfoEditorP countBuildInfo, paraName <<<- ParaName (__ "Build Info")+ $ paraHAlign <<<- ParaHAlign AlignStart+ $ paraVAlign <<<- ParaVAlign AlignStart+ $ paraMargin <<<- ParaMargin (0, 0, 0, 0)+ $ emptyParams)+ , paraOrientation <<<- ParaOrientation OrientationVertical+ $ emptyParams)+ (comboSelectionEditor [ExecutableScopeUnknown, ExecutablePublic, ExecutablePrivate] (\case+ ExecutableScopeUnknown -> "Scope Unknown"+ ExecutablePublic -> "Public"+ ExecutablePrivate -> "Private"),+ paraName <<<- ParaName (__ "Executable Name")+ $ emptyParams)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ para)+ noti+ let pinj (Executable' s f scope bi) = inj ((s,f,bi), scope)+ let pext = do+ mbp <- ext+ case mbp of+ Nothing -> return Nothing+ Just ((s,f,bi), scope) -> return (Just $Executable' s f scope bi)+ return (wid,pinj,pext)+#else+executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable'+executableEditor fp modules countBuildInfo para noti = do (wid,inj,ext) <- tupel3Editor (textEditor (not . T.null) True, paraName <<<- ParaName (__ "Executable Name") $ emptyParams) (stringEditor (not . null) True,- paraDirection <<<- ParaDirection Vertical+ paraOrientation <<<- ParaOrientation OrientationVertical $ paraName <<<- ParaName (__ "File with main function") $ emptyParams) (buildInfoEditorP countBuildInfo, paraName <<<- ParaName (__ "Build Info")- $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)- $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)- $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)- $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)- $ emptyParams)- (paraDirection <<<- ParaDirection Vertical $ para)+ $ paraHAlign <<<- ParaHAlign AlignStart+ $ paraVAlign <<<- ParaVAlign AlignStart+ $ paraMargin <<<- ParaMargin (0, 0, 0, 0)+ $ emptyParams)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ para) noti let pinj (Executable' s f bi) = inj (s,f,bi) let pext = do@@ -1607,17 +1820,18 @@ Nothing -> return Nothing Just (s,f,bi) -> return (Just $Executable' s f bi) return (wid,pinj,pext)+#endif testsEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Test'] testsEditor fp modules countBuildInfo p = multisetEditor- (ColumnDescr True [(__ "Test Name",\(Test' testName _ _) -> [cellText := testName])- ,(__ "Interface",\(Test' _ i _) -> [cellText := T.pack $ interfaceName i])- ,(__ "Build info index",\(Test' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+ (ColumnDescr True [(__ "Test Name",\cell (Test' testName _ _) -> setCellRendererTextText cell testName)+ ,(__ "Interface",\cell (Test' _ i _) -> setCellRendererTextText cell . T.pack $ interfaceName i)+ ,(__ "Build info index",\cell (Test' _ _ bii) -> setCellRendererTextText cell . T.pack $ show (bii + 1))]) (testEditor fp modules countBuildInfo,emptyParams) Nothing Nothing- (paraShadow <<<- ParaShadow ShadowIn+ (paraShadow <<<- ParaShadow ShadowTypeIn $ paraMinSize <<<- ParaMinSize (-1,200) $ p) where interfaceName (TestSuiteExeV10 _ f) = f@@ -1630,36 +1844,35 @@ paraName <<<- ParaName (__ "Test Name") $ emptyParams) (stringEditor (not . null) True,- paraDirection <<<- ParaDirection Vertical+ paraOrientation <<<- ParaOrientation OrientationVertical $ paraName <<<- ParaName (__ "File with main function") $ emptyParams) (buildInfoEditorP countBuildInfo, paraName <<<- ParaName (__ "Build Info")- $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)- $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)- $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)- $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)- $ emptyParams)- (paraDirection <<<- ParaDirection Vertical $ para)+ $ paraHAlign <<<- ParaHAlign AlignStart+ $ paraVAlign <<<- ParaVAlign AlignStart+ $ paraMargin <<<- ParaMargin (0, 0, 0, 0)+ $ emptyParams)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ para) noti- let pinj (Test' s (TestSuiteExeV10 (Version [1,0] []) f) bi) = inj (s,f,bi)+ let pinj (Test' s (TestSuiteExeV10 v f) bi) | versionNumbers v == [1,0] = inj (s,f,bi) pinj _ = error "Unexpected Test Interface" let pext = do mbp <- ext case mbp of Nothing -> return Nothing- Just (s,f,bi) -> return (Just $Test' s (TestSuiteExeV10 (Version [1,0] []) f) bi)+ Just (s,f,bi) -> return (Just $Test' s (TestSuiteExeV10 (mkVersion [1,0]) f) bi) return (wid,pinj,pext) benchmarksEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Benchmark'] benchmarksEditor fp modules countBuildInfo p = multisetEditor- (ColumnDescr True [(__ "Benchmark Name",\(Benchmark' benchmarkName _ _) -> [cellText := benchmarkName])- ,(__ "Interface",\(Benchmark' _ i _) -> [cellText := T.pack $ interfaceName i])- ,(__ "Build info index",\(Benchmark' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])])+ (ColumnDescr True [(__ "Benchmark Name",\cell (Benchmark' benchmarkName _ _) -> setCellRendererTextText cell benchmarkName)+ ,(__ "Interface",\cell (Benchmark' _ i _) -> setCellRendererTextText cell . T.pack $ interfaceName i)+ ,(__ "Build info index",\cell (Benchmark' _ _ bii) -> setCellRendererTextText cell . T.pack $ show (bii + 1))]) (benchmarkEditor fp modules countBuildInfo,emptyParams) Nothing Nothing- (paraShadow <<<- ParaShadow ShadowIn+ (paraShadow <<<- ParaShadow ShadowTypeIn $ paraMinSize <<<- ParaMinSize (-1,200) $ p) where interfaceName (BenchmarkExeV10 _ f) = f@@ -1672,24 +1885,23 @@ paraName <<<- ParaName (__ "Benchmark Name") $ emptyParams) (stringEditor (not . null) True,- paraDirection <<<- ParaDirection Vertical+ paraOrientation <<<- ParaOrientation OrientationVertical $ paraName <<<- ParaName (__ "File with main function") $ emptyParams) (buildInfoEditorP countBuildInfo, paraName <<<- ParaName (__ "Build Info")- $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)- $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)- $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)- $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)- $ emptyParams)- (paraDirection <<<- ParaDirection Vertical $ para)+ $ paraHAlign <<<- ParaHAlign AlignStart+ $ paraVAlign <<<- ParaVAlign AlignStart+ $ paraMargin <<<- ParaMargin (0, 0, 0, 0)+ $ emptyParams)+ (paraOrientation <<<- ParaOrientation OrientationVertical $ para) noti- let pinj (Benchmark' s (BenchmarkExeV10 (Version [1,0] []) f) bi) = inj (s,f,bi)+ let pinj (Benchmark' s (BenchmarkExeV10 v f) bi) | versionNumbers v == [1,0] = inj (s,f,bi) pinj _ = error "Unexpected Benchmark Interface" let pext = do mbp <- ext case mbp of Nothing -> return Nothing- Just (s,f,bi) -> return (Just $Benchmark' s (BenchmarkExeV10 (Version [1,0] []) f) bi)+ Just (s,f,bi) -> return (Just $Benchmark' s (BenchmarkExeV10 (mkVersion [1,0]) f) bi) return (wid,pinj,pext) buildInfoEditorP :: Int -> Editor Int@@ -1716,14 +1928,28 @@ where getDefault = emptyBuildInfo instance Default Library- where getDefault = Library []-#if MIN_VERSION_Cabal(1,22,0)- [] [] []+#if MIN_VERSION_Cabal(2,0,0)+ where getDefault = Library Nothing [] [] [] getDefault getDefault+#elif MIN_VERSION_Cabal(1,22,0)+ where getDefault = Library [] [] [] [] getDefault getDefault+#else+ where getDefault = Library [] getDefault getDefault #endif- getDefault getDefault +#if MIN_VERSION_Cabal(2,0,0)+instance Default ExecutableScope+ where getDefault = ExecutableScopeUnknown++instance Default UnqualComponentName+ where getDefault = mkUnqualComponentName ""+#endif+ instance Default Executable+#if MIN_VERSION_Cabal(2,0,0)+ where getDefault = Executable getDefault getDefault getDefault getDefault+#else where getDefault = Executable getDefault getDefault getDefault+#endif instance Default RepoType where getDefault = Darcs
src/IDE/Pane/PackageFlags.hs view
@@ -29,7 +29,6 @@ , getFlags ) where -import Graphics.UI.Gtk import qualified Text.PrettyPrint.HughesPJ as PP import Data.Typeable import System.FilePath.Posix@@ -52,9 +51,23 @@ import Data.Monoid ((<>)) import qualified Data.Text as T (unwords, unpack, pack) import Control.Applicative ((<$>))+import Control.Monad.IO.Class (MonadIO(..))+import Data.GI.Base.ManagedPtr (unsafeCastTo)+import GI.Gtk.Objects.Widget (widgetSetSensitive, Widget(..))+import GI.Gtk.Objects.Box (boxSetSpacing, Box(..), boxNew)+import GI.Gtk.Objects.ButtonBox (buttonBoxSetLayout, buttonBoxNew)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), ButtonBoxStyle(..),+ Orientation(..))+import GI.Gtk.Objects.Button (onButtonClicked, buttonNewWithLabel)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy,+ scrolledWindowSetShadowType, scrolledWindowNew)+import GI.Gtk (containerAdd) data IDEFlags = IDEFlags {- flagsBox :: VBox+ flagsBox :: Box } deriving Typeable data FlagsState = FlagsState@@ -64,7 +77,7 @@ where primPaneName _ = __ "Package Flags" getAddedIndex _ = 0- getTopWidget = castToWidget . flagsBox+ getTopWidget = liftIO . unsafeCastTo Widget . flagsBox paneId b = "*Flags" instance RecoverablePane IDEFlags FlagsState IDEM where@@ -79,9 +92,7 @@ Just pack -> do pp <- getBestPathForId "*Flags" nb <- getNotebook pp- case mbPack of- Nothing -> return Nothing- Just pack -> buildThisPane pp nb builder+ buildThisPane pp nb builder Nothing -> return Nothing builder pp nb w = let flagsDesc = extractFieldDescription flagsDescription@@ -95,23 +106,23 @@ -- | Builds the Flags pane builder' idePackage flagsDesc flatflagsDesc pp nb window ideR = do- vb <- vBoxNew False 0+ vb <- boxNew OrientationVertical 0 let flagsPane = IDEFlags vb- bb <- hButtonBoxNew+ bb <- buttonBoxNew OrientationHorizontal boxSetSpacing bb 6- buttonBoxSetLayout bb ButtonboxSpread- saveB <- buttonNewFromStock "gtk-save"+ buttonBoxSetLayout bb ButtonBoxStyleSpread+ saveB <- buttonNewWithLabel "Save" widgetSetSensitive saveB False- cancelB <- buttonNewFromStock "gtk-cancel"- boxPackStart bb cancelB PackNatural 0- boxPackStart bb saveB PackNatural 0+ cancelB <- buttonNewWithLabel "Cancel"+ boxPackStart' bb cancelB PackNatural 0+ boxPackStart' bb saveB PackNatural 0 (widget,injb,ext,notifier) <- buildEditor flagsDesc idePackage- sw <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType sw ShadowIn- scrolledWindowAddWithViewport sw widget- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic- on saveB buttonActivated (do+ sw <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType sw ShadowTypeIn+ containerAdd sw widget+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic+ onButtonClicked saveB (do mbPackWithNewFlags <- extract idePackage [ext] case mbPackWithNewFlags of Nothing -> return ()@@ -122,21 +133,22 @@ writeFields (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags flatFlagsDescription)- on cancelB buttonActivated (reflectIDE (void (closePane flagsPane)) ideR)+ onButtonClicked cancelB (reflectIDE (void (closePane flagsPane)) ideR) registerEvent notifier FocusIn (\e -> do reflectIDE (makeActive flagsPane) ideR return (e{gtkReturn=False}))- registerEvent notifier MayHaveChanged (\e -> do- mbP <- extract idePackage [ext]+ registerEvent notifier MayHaveChanged (\e -> (`reflectIDE` ideR) $ do+ mbP <- liftIO $ extract idePackage [ext] let hasChanged = case mbP of Nothing -> False Just p -> p /= idePackage- markLabel nb (getTopWidget flagsPane) hasChanged+ topWidget <- getTopWidget flagsPane+ markLabel nb topWidget hasChanged widgetSetSensitive saveB hasChanged return (e{gtkReturn=False})) - boxPackStart vb sw PackGrow 0- boxPackEnd vb bb PackNatural 6+ boxPackStart' vb sw PackGrow 0+ boxPackEnd' vb bb PackNatural 6 return (Just flagsPane,[]) @@ -229,6 +241,14 @@ readParser (unargs . ipdTestFlags) (\ b a -> a{ipdTestFlags = args b})+ (textEditor (const True) True)+ (\ _ -> return ())+ , mkFieldPP+ (paraName <<<- ParaName (__ "Benchmark flags") $ emptyParams)+ (PP.text . show)+ readParser+ (unargs . ipdBenchmarkFlags)+ (\ b a -> a{ipdBenchmarkFlags = args b}) (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP
src/IDE/Pane/Search.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Search@@ -25,33 +27,8 @@ , getSearch ) where -import Graphics.UI.Gtk- (scrolledWindowSetShadowType, rowActivated, Menu,- menuAttachToWidget, cellTextScaleSet, cellTextScale,- listStoreGetValue, treeSelectionGetSelectedRows, widgetShowAll,- menuPopup, menuShellAppend, menuItemActivate, menuItemNewWithLabel,- menuNew, listStoreAppend, listStoreClear, entrySetText,- toggleButtonGetActive, widgetSetSensitivity, vBoxNew, entryNew,- scrolledWindowSetPolicy, containerAdd, scrolledWindowNew,- treeSelectionSetMode, treeViewGetSelection,- treeViewSetHeadersVisible, cellPixbufStockId, cellText,- cellLayoutSetAttributes, cellLayoutPackStart, treeViewAppendColumn,- treeViewColumnSetReorderable, treeViewColumnSetResizable,- treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,- cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,- treeViewNew, listStoreNew, boxPackEnd, boxPackStart,- checkButtonNewWithLabel, toggleButtonSetActive, ResponseId(..),- dialogRun, radioButtonNewWithLabelFromWidget,- radioButtonNewWithLabel, buttonNewFromStock, windowTransientFor,- hButtonBoxNew, dialogGetActionArea, widgetGrabDefault, set, get,- dialogNew, dialogResponse, widgetHide, buttonSetLabel,- widgetCanDefault, hBoxNew, entryGetText, castToWidget, Entry, VBox,- ListStore, TreeView, ScrolledWindow, PolicyType(..),- SelectionMode(..), TreeViewColumnSizing(..), AttrOp(..),- Packing(..), focusInEvent, toggled, buttonPressEvent,- keyPressEvent, keyReleaseEvent)-import Graphics.UI.Gtk.Gdk.EventM-import System.Glib.Signals (on, after)+import Prelude ()+import Prelude.Compat import Data.IORef (newIORef, writeIORef, readIORef, IORef(..)) -- import IDE.Pane.SourceBuffer (goToDefinition) import IDE.Metainfo.Provider (searchMeta)@@ -63,13 +40,61 @@ import Control.Event (triggerEvent) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.ByteString.Char8 as BS (empty, unpack)-import System.Glib.Properties (newAttrFromMaybeStringProperty) import Control.Monad (void)-import Graphics.UI.Gtk.General.Enums (ShadowType(..)) import Data.Text (Text) import qualified Data.Text as T (unpack, pack, null) import System.Log.Logger (debugM) import Data.Monoid ((<>))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import Data.GI.Gtk.ModelView.SeqStore+ (seqStoreGetValue, seqStoreAppend, seqStoreClear, seqStoreNew,+ SeqStore(..))+import GI.Gtk.Objects.Entry+ (entrySetText, entryNew, entryGetText, Entry(..))+import GI.Gtk.Objects.TreeView+ (onTreeViewRowActivated, treeViewGetSelection,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..))+import Data.GI.Base.ManagedPtr (unsafeCastTo)+import GI.Gtk.Objects.Widget+ (toWidget, setWidgetSensitive, onWidgetKeyReleaseEvent,+ afterWidgetFocusInEvent, Widget(..))+import GI.Gtk.Objects.RadioButton+ (RadioButton(..), radioButtonNewWithLabelFromWidget,+ radioButtonNewWithLabel)+import GI.Gtk.Objects.ToggleButton+ (toggleButtonGetActive, toggleButtonSetActive)+import GI.Gtk.Objects.CheckButton (checkButtonNewWithLabel)+import GI.Gtk.Objects.Box (boxPackEnd, boxPackStart, Box(..), boxNew)+import Graphics.UI.Editor.Parameters+ (boxPackEnd', boxPackStart', Packing(..))+import GI.Gtk.Objects.CellRendererText (cellRendererTextNew)+import GI.Gtk.Objects.CellRendererPixbuf (cellRendererPixbufNew)+import GI.Gtk.Objects.TreeViewColumn+ (treeViewColumnSetReorderable, treeViewColumnSetResizable,+ treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (treeSelectionSetMode)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..), Orientation(..))+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gtk.Objects.ToggleButton (onToggleButtonToggled)+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.MenuItem+ (onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathGetIndices')+import GI.Gtk+ (setCellRendererTextScaleSet, setCellRendererTextScale,+ setCellRendererPixbufStockId, setCellRendererTextText) -- | A search pane description --@@ -77,10 +102,10 @@ data IDESearch = IDESearch { scrolledView :: ScrolledWindow , treeView :: TreeView-, searchStore :: ListStore Descr+, searchStore :: SeqStore Descr , searchScopeRef :: IORef Scope , searchModeRef :: IORef SearchMode-, topBox :: VBox+, topBox :: Box , entry :: Entry , scopeSelection :: Scope -> IDEAction , modeSelection :: SearchMode -> IDEAction@@ -98,12 +123,12 @@ where primPaneName _ = __ "Search" getAddedIndex _ = 0- getTopWidget = castToWidget . topBox+ getTopWidget = liftIO . toWidget . topBox paneId b = "*Search" instance RecoverablePane IDESearch SearchState IDEM where saveState p = do- str <- liftIO $ entryGetText (entry p)+ str <- entryGetText (entry p) mode <- liftIO $ readIORef (searchModeRef p) scope <- liftIO $ readIORef (searchScopeRef p) return (Just (SearchState str scope mode))@@ -123,22 +148,22 @@ mode = Prefix False in reifyIDE $ \ ideR -> do - scopebox <- hBoxNew True 2- rb1 <- radioButtonNewWithLabel (__ "Package")- rb2 <- radioButtonNewWithLabelFromWidget rb1 (__ "Workspace")- rb3 <- radioButtonNewWithLabelFromWidget rb1 (__ "System")+ scopebox <- boxNew OrientationHorizontal 2+ rb1 <- radioButtonNewWithLabel ([]::[RadioButton]) (__ "Package")+ rb2 <- radioButtonNewWithLabelFromWidget (Just rb1) (__ "Workspace")+ rb3 <- radioButtonNewWithLabelFromWidget (Just rb1) (__ "System") toggleButtonSetActive rb3 True cb2 <- checkButtonNewWithLabel (__ "Imports") - boxPackStart scopebox rb1 PackGrow 2- boxPackStart scopebox rb2 PackGrow 2- boxPackStart scopebox rb3 PackGrow 2- boxPackEnd scopebox cb2 PackNatural 2+ boxPackStart' scopebox rb1 PackGrow 2+ boxPackStart' scopebox rb2 PackGrow 2+ boxPackStart' scopebox rb3 PackGrow 2+ boxPackEnd' scopebox cb2 PackNatural 2 - modebox <- hBoxNew True 2- mb1 <- radioButtonNewWithLabel (__ "Exact")- mb2 <- radioButtonNewWithLabelFromWidget mb1 (__ "Prefix")- mb3 <- radioButtonNewWithLabelFromWidget mb1 (__ "Regex")+ modebox <- boxNew OrientationHorizontal 2+ mb1 <- radioButtonNewWithLabel ([]::[RadioButton]) (__ "Exact")+ mb2 <- radioButtonNewWithLabelFromWidget (Just mb1) (__ "Prefix")+ mb3 <- radioButtonNewWithLabelFromWidget (Just mb1) (__ "Regex") toggleButtonSetActive (case mode of Exact _ -> mb1@@ -146,100 +171,104 @@ Regex _ -> mb3) True mb4 <- checkButtonNewWithLabel (__ "Case sensitive") toggleButtonSetActive mb4 (caseSense mode)- boxPackStart modebox mb1 PackNatural 2- boxPackStart modebox mb2 PackNatural 2- boxPackStart modebox mb3 PackNatural 2- boxPackEnd modebox mb4 PackNatural 2+ boxPackStart' modebox mb1 PackNatural 2+ boxPackStart' modebox mb2 PackNatural 2+ boxPackStart' modebox mb3 PackNatural 2+ boxPackEnd' modebox mb4 PackNatural 2 - listStore <- listStoreNew []+ seqStore <- seqStoreNew [] treeView <- treeViewNew- treeViewSetModel treeView listStore+ treeViewSetModel treeView (Just seqStore) renderer3 <- cellRendererTextNew renderer30 <- cellRendererPixbufNew col3 <- treeViewColumnNew treeViewColumnSetTitle col3 (__ "Symbol")- treeViewColumnSetSizing col3 TreeViewColumnAutosize+ treeViewColumnSetSizing col3 TreeViewColumnSizingAutosize treeViewColumnSetResizable col3 True treeViewColumnSetReorderable col3 True treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer30 False cellLayoutPackStart col3 renderer3 True- cellLayoutSetAttributes col3 renderer3 listStore- $ \row -> [ cellText := dscName row]- cellLayoutSetAttributes col3 renderer30 listStore- $ \row -> [- cellPixbufStockId := stockIdFromType ((descrType . dscTypeHint) row)]+ cellLayoutSetDataFunction col3 renderer3 seqStore+ $ setCellRendererTextText renderer3 . dscName+ cellLayoutSetDataFunction col3 renderer30 seqStore+ $ setCellRendererPixbufStockId renderer30+ . stockIdFromType . descrType . dscTypeHint renderer1 <- cellRendererTextNew renderer10 <- cellRendererPixbufNew col1 <- treeViewColumnNew treeViewColumnSetTitle col1 (__ "Module")- treeViewColumnSetSizing col1 TreeViewColumnAutosize+ treeViewColumnSetSizing col1 TreeViewColumnSizingAutosize treeViewColumnSetResizable col1 True treeViewColumnSetReorderable col1 True treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer10 False cellLayoutPackStart col1 renderer1 True- cellLayoutSetAttributes col1 renderer1 listStore- $ \row -> [ cellText := case dsMbModu row of- Nothing -> ""- Just pm -> T.pack . display $ modu pm]- cellLayoutSetAttributes col1 renderer10 listStore- $ \row -> [newAttrFromMaybeStringProperty "stock-id"- := if isReexported row- then Just ("ide_reexported" :: Text)- else if isJust (dscMbLocation row)- then Just "ide_source"- else Nothing]+ cellLayoutSetDataFunction col1 renderer1 seqStore+ $ \row -> setCellRendererTextText renderer1 $+ case dsMbModu row of+ Nothing -> ""+ Just pm -> T.pack . display $ modu pm+ cellLayoutSetDataFunction col1 renderer10 seqStore+ $ \row -> setCellRendererPixbufStockId renderer10 $+ if isReexported row+ then "ide_reexported"+ else if isJust (dscMbLocation row)+ then "ide_source"+ else "" renderer2 <- cellRendererTextNew col2 <- treeViewColumnNew treeViewColumnSetTitle col2 (__ "Package")- treeViewColumnSetSizing col2 TreeViewColumnAutosize+ treeViewColumnSetSizing col2 TreeViewColumnSizingAutosize treeViewColumnSetResizable col2 True treeViewColumnSetReorderable col2 True treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 True- cellLayoutSetAttributes col2 renderer2 listStore- $ \row -> [ cellText := case dsMbModu row of- Nothing -> ""- Just pm -> T.pack . display $ pack pm]+ cellLayoutSetDataFunction col2 renderer2 seqStore+ $ \row -> setCellRendererTextText renderer2 $+ case dsMbModu row of+ Nothing -> ""+ Just pm -> T.pack . display $ pack pm renderer3 <- cellRendererTextNew col3 <- treeViewColumnNew treeViewColumnSetTitle col3 (__ "Type/Kind")- treeViewColumnSetSizing col3 TreeViewColumnAutosize+ treeViewColumnSetSizing col3 TreeViewColumnSizingAutosize treeViewColumnSetResizable col3 True treeViewColumnSetReorderable col3 True treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 True- cellLayoutSetAttributes col3 renderer3 listStore- $ \row -> [ cellText := T.pack . BS.unpack . fromMaybe BS.empty $- dscMbTypeStr row,- cellTextScale := 0.8, cellTextScaleSet := True ]+ cellLayoutSetDataFunction col3 renderer3 seqStore+ $ \row -> do+ setCellRendererTextText renderer3 $ T.pack . BS.unpack . fromMaybe BS.empty $+ dscMbTypeStr row+ setCellRendererTextScale renderer3 0.8+ setCellRendererTextScaleSet renderer3 True treeViewSetHeadersVisible treeView True sel <- treeViewGetSelection treeView- treeSelectionSetMode sel SelectionSingle+ treeSelectionSetMode sel SelectionModeSingle - sw <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType sw ShadowIn+ sw <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType sw ShadowTypeIn containerAdd sw treeView- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic entry <- entryNew - box <- vBoxNew False 2- boxPackStart box scopebox PackNatural 0- boxPackStart box sw PackGrow 0- boxPackStart box modebox PackNatural 0- boxPackEnd box entry PackNatural 0+ box <- boxNew OrientationVertical 2+ boxPackStart' box scopebox PackNatural 0+ boxPackStart' box sw PackGrow 0+ boxPackStart' box modebox PackNatural 0+ boxPackEnd' box entry PackNatural 0 scopeRef <- newIORef scope modeRef <- newIORef mode- let search = IDESearch sw treeView listStore scopeRef modeRef box entry scopeSelection_ modeSelection_ searchMetaGUI_ setChoices_+ let search = IDESearch sw treeView seqStore scopeRef modeRef box entry scopeSelection_ modeSelection_ searchMetaGUI_ setChoices_ scopeSelection_ :: Scope -> IDEAction scopeSelection_ scope = do liftIO $ writeIORef (searchScopeRef search) scope@@ -254,122 +283,123 @@ searchMetaGUI_ :: Text -> IDEAction searchMetaGUI_ str = do liftIO $ debugM "leksah" $ "searchMetGUI_ " <> T.unpack str- liftIO $ bringPaneToFront search- liftIO $ entrySetText entry str- scope <- liftIO $ getScope search- mode <- liftIO $ getMode search+ bringPaneToFront search+ entrySetText entry str+ scope <- getScope search+ mode <- getMode search -- let mode' = if length str > 2 then mode else Exact (caseSense mode) descrs <- if T.null str then return [] else searchMeta scope str mode- liftIO $ do- listStoreClear (searchStore search)- mapM_ (listStoreAppend (searchStore search)) (take 500 descrs)+ seqStoreClear (searchStore search)+ mapM_ (seqStoreAppend (searchStore search)) (take 500 descrs) modeSelectionCase :: Bool -> IDEAction modeSelectionCase caseSense = do oldMode <- liftIO $ readIORef (searchModeRef search) liftIO $ writeIORef (searchModeRef search) oldMode{caseSense = caseSense}- text <- liftIO $ entryGetText entry+ text <- entryGetText entry searchMetaGUI_ text setChoices_ :: [Descr] -> IDEAction- setChoices_ descrs =- liftIO $ do- listStoreClear (searchStore search)- mapM_ (listStoreAppend (searchStore search)) descrs+ setChoices_ descrs = do+ seqStoreClear (searchStore search)+ mapM_ (seqStoreAppend (searchStore search)) descrs bringPaneToFront search entrySetText entry (case descrs of [] -> "" hd: _ -> dscName hd) scopeSelection' rb1 rb2 rb3 cb2 = do- scope <- liftIO $ do- withImports <- toggleButtonGetActive cb2- s1 <- toggleButtonGetActive rb1- s2 <- toggleButtonGetActive rb2- s3 <- toggleButtonGetActive rb3- return $ if s1- then PackageScope withImports- else if s2- then WorkspaceScope withImports- else SystemScope- scopeSelection_ scope+ withImports <- toggleButtonGetActive cb2+ s1 <- toggleButtonGetActive rb1+ s2 <- toggleButtonGetActive rb2+ s3 <- toggleButtonGetActive rb3+ scopeSelection_ $+ if s1+ then PackageScope withImports+ else if s2+ then WorkspaceScope withImports+ else SystemScope - cid1 <- treeView `after` focusInEvent $ liftIO $ do+ cid1 <- ConnectC treeView <$> afterWidgetFocusInEvent treeView (\e -> do reflectIDE (makeActive search) ideR- return True- rb1 `on` toggled $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )- rb2 `on` toggled $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )- rb3 `on` toggled $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )- cb2 `on` toggled $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR)- mb1 `on` toggled $ liftIO $ do- widgetSetSensitivity mb4 False+ return True)+ onToggleButtonToggled rb1 $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )+ onToggleButtonToggled rb2 $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )+ onToggleButtonToggled rb3 $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR )+ onToggleButtonToggled cb2 $ liftIO (reflectIDE (scopeSelection' rb1 rb2 rb3 cb2) ideR)+ onToggleButtonToggled mb1 $ liftIO $ do+ setWidgetSensitive mb4 False active <- toggleButtonGetActive mb4 reflectIDE (modeSelection_ (Exact active)) ideR- mb2 `on` toggled $ liftIO $ do- widgetSetSensitivity mb4 True+ onToggleButtonToggled mb2 $ liftIO $ do+ setWidgetSensitive mb4 True active <- toggleButtonGetActive mb4 reflectIDE (modeSelection_ (Prefix active)) ideR- mb3 `on` toggled $ liftIO $ do- widgetSetSensitivity mb4 True+ onToggleButtonToggled mb3 $ liftIO $ do+ setWidgetSensitive mb4 True active <- toggleButtonGetActive mb4 reflectIDE (modeSelection_ (Regex active)) ideR- mb4 `on` toggled $ liftIO $ do+ onToggleButtonToggled mb4 $ liftIO $ do active <- toggleButtonGetActive mb4 reflectIDE (modeSelectionCase active) ideR- (cid2, cid3) <- treeViewContextMenu treeView $ searchContextMenu ideR listStore treeView- cid4 <- treeView `on` rowActivated $ selectDescr ideR listStore+ cids <- treeViewContextMenu treeView $ searchContextMenu ideR seqStore treeView+ cid4 <- ConnectC treeView <$> onTreeViewRowActivated treeView (\path col -> do+ p <- treePathGetIndices' path+ selectDescr ideR seqStore p col) -- sel `onSelectionChanged` do -- fillInfo search ideR- entry `on` keyReleaseEvent $ liftIO $ do+ onWidgetKeyReleaseEvent entry $ \e -> do text <- entryGetText entry reflectIDE (searchMetaGUI_ text) ideR return False- return (Just search, map ConnectC [cid1, cid2, cid3, cid4])+ return (Just search, cid1 : cid4 : cids) -getScope :: IDESearch -> IO Scope-getScope search = readIORef (searchScopeRef search)+getScope :: MonadIO m => IDESearch -> m Scope+getScope search = liftIO . readIORef $ searchScopeRef search -getMode :: IDESearch -> IO SearchMode-getMode search = readIORef (searchModeRef search)+getMode :: MonadIO m => IDESearch -> m SearchMode+getMode search = liftIO . readIORef $ searchModeRef search getSearch :: Maybe PanePath -> IDEM IDESearch getSearch Nothing = forceGetPane (Right "*Search") getSearch (Just pp) = forceGetPane (Left pp) -searchContextMenu :: IDERef- -> ListStore Descr+searchContextMenu :: MonadIO m+ => IDERef+ -> SeqStore Descr -> TreeView -> Menu- -> IO ()+ -> m () searchContextMenu ideR store descrView theMenu = do item1 <- menuItemNewWithLabel (__ "Go to definition")- item1 `on` menuItemActivate $ liftIO $ goToDef ideR store descrView+ onMenuItemActivate item1 $ liftIO $ goToDef ideR store descrView menuShellAppend theMenu item1 goToDef ideR store descrView = do sel <- getSelectionDescr descrView store case sel of- Just descr -> void (reflectIDE (triggerEvent ideR (GotoDefinition descr)) ideR)+ Just descr -> void (reflectIDE (triggerEvent ideR (GotoDefinition descr)) ideR) -- (goToDefinition descr) ideR- otherwise -> sysMessage Normal (__ "Search >> listViewPopup: no selection")+ _ -> sysMessage Normal (__ "Search >> listViewPopup: no selection") selectDescr ideR store [i] col = do- descr <- listStoreGetValue store i+ descr <- seqStoreGetValue store i liftIO $ reflectIDE (triggerEvent ideR (SelectIdent descr)) ideR return () selectDescr _ _ _ _ = liftIO $ sysMessage Normal (__ "Search >> selectDescr: invalid path") -getSelectionDescr :: TreeView- -> ListStore Descr- -> IO (Maybe Descr)-getSelectionDescr treeView listStore = do+getSelectionDescr :: (Applicative m, MonadIO m)+ => TreeView+ -> SeqStore Descr+ -> m (Maybe Descr)+getSelectionDescr treeView seqStore = do treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection- case paths of+ paths <- treeSelectionGetSelectedRows' treeSelection+ mapM treePathGetIndices' paths >>= \case [a]:r -> do- val <- listStoreGetValue listStore a+ val <- seqStoreGetValue seqStore a return (Just val) _ -> return Nothing @@ -394,25 +424,25 @@ windowSetTransientFor dia win upper <- dialogGetUpper dia lower <- dialogGetActionArea dia- boxPackStart upper (topBox searchPane) PackNatural 7+ boxPackStart' upper (topBox searchPane) PackNatural 7 bb <- hButtonBoxNew closeB <- buttonNewFromStock "gtk-cancel" okB <- buttonNewFromStock "gtk-ok" okB `onClicked` do- dialogResponse dia ResponseOk+ dialogResponse dia ResponseTypeOk widgetHideAll dia closeB `onClicked` do- dialogResponse dia ResponseCancel+ dialogResponse dia ResponseTypeCancel widgetHideAll dia- boxPackEnd bb closeB PackNatural 0- boxPackEnd bb okB PackNatural 0- boxPackStart lower bb PackNatural 7- set okB [widgetCanDefault := True]+ boxPackEnd' bb closeB PackNatural 0+ boxPackEnd' bb okB PackNatural 0+ boxPackStart' lower bb PackNatural 7+ setWidgetCanDefault okB True buttonSetLabel okB "Goto" widgetGrabDefault okB widgetShowAll dia- resp <- dialogRun dia+ resp <- dialogRun' dia return () return () --}
src/IDE/Pane/SourceBuffer.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} ----------------------------------------------------------------------------- --@@ -69,6 +70,7 @@ , addLogRef , removeLogRefs , removeBuildLogRefs+, removeFileExtLogRefs , removeTestLogRefs , removeLintLogRefs , markRefInSourceBuf@@ -113,30 +115,11 @@ import IDE.Utils.DirectoryUtils import IDE.SourceCandy import IDE.SymbolNavigation-import IDE.Completion as Completion (complete,cancel)+import IDE.Completion as Completion (complete,cancel, smartIndent) import IDE.TextEditor import Data.IORef (writeIORef,readIORef,newIORef) import Control.Event (triggerEvent) import IDE.Metainfo.Provider (getSystemInfo, getWorkspaceInfo)-import Graphics.UI.Gtk- (Notebook, clipboardGet, selectionClipboard, dialogAddButton, widgetDestroy,- fileChooserGetFilename, widgetShow, fileChooserDialogNew,- notebookGetNthPage, notebookPageNum, widgetHide, dialogRun,- messageDialogNew, scrolledWindowSetShadowType,- scrolledWindowSetPolicy, dialogSetDefaultResponse,- fileChooserSelectFilename,- TextSearchFlags(..))-import qualified Graphics.UI.Gtk as Gtk hiding (eventKeyName)-import Graphics.UI.Gtk.Windows.Window-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), PolicyType(..))-import Graphics.UI.Gtk.Windows.MessageDialog- (ButtonsType(..), MessageType(..))-import Graphics.UI.Gtk.Windows.Dialog (ResponseId(..))-import Graphics.UI.Gtk.Selectors.FileChooser- (FileChooserAction(..))-import System.Glib.Attributes (AttrOp(..), set)- import IDE.BufferMode import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))@@ -153,8 +136,6 @@ import Data.Monoid ((<>)) import qualified Data.Text.IO as T (writeFile, readFile) import Data.Time (UTCTime(..))-import Graphics.UI.Gtk.Gdk.EventM- (eventModifier, eventKeyName, eventKeyVal) import qualified Data.Foldable as F (Foldable(..), forM_, toList) import Data.Traversable (forM) import Language.Haskell.HLint3 (Idea(..))@@ -162,6 +143,47 @@ import qualified Data.Sequence as Seq import Data.Sequence (ViewR(..), (|>)) import Data.Time.Clock (addUTCTime, diffUTCTime)+import qualified GI.Gtk.Objects.Notebook as Gtk (Notebook(..))+import qualified GI.Gtk.Objects.Window as Gtk (Window(..))+import GI.Gtk.Objects.ScrolledWindow+ (setScrolledWindowShadowType, scrolledWindowSetPolicy)+import GI.Gtk.Enums+ (FileChooserAction(..), WindowPosition(..), ResponseType(..),+ ButtonsType(..), MessageType(..), ShadowType(..), PolicyType(..),+ Orientation(..))+import GI.Gdk.Structs.EventKey+ (getEventKeyState, getEventKeyKeyval)+import GI.Gdk.Functions (keyvalName)+import GI.Gdk.Flags (ModifierType(..))+import GI.Gtk.Flags (TextSearchFlags(..))+import GI.Gtk.Objects.MessageDialog+ (setMessageDialogText, constructMessageDialogButtons, setMessageDialogMessageType,+ MessageDialog(..))+import GI.Gtk.Objects.Dialog+ (dialogRun, constructDialogUseHeaderBar)+import GI.Gtk.Objects.Window+ (setWindowTitle, setWindowWindowPosition, windowSetTransientFor)+import Data.GI.Base (new')+import GI.Gtk.Objects.Widget+ (widgetHide, widgetShow, widgetDestroy)+import GI.Gtk.Objects.Notebook+ (notebookPageNum, notebookGetNthPage, Notebook(..))+import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..))+import GI.Gtk.Interfaces.FileChooser+ (fileChooserGetFilename, fileChooserSelectFilename,+ fileChooserSetAction)+import Graphics.UI.Editor.Parameters+ (dialogRun', dialogSetDefaultResponse', dialogAddButton')+import GI.Gtk.Objects.Clipboard (clipboardGet)+import GI.Gdk.Structs.Atom (atomIntern)+import GI.Gdk.Structs.EventButton (getEventButtonType)+import GI.Gdk.Enums (EventType(..))+import GI.Gtk+ (boxPackStart, boxNew, Container(..),+ containerAdd, infoBarGetContentArea,+ labelNew, infoBarNew)+import Data.GI.Base.ManagedPtr (unsafeCastTo)+import Control.Concurrent.MVar (tryPutMVar) --time :: MonadIO m => String -> m a -> m a --time name action = do@@ -228,7 +250,10 @@ ids2 <- sv `afterMoveCursor` writeCursorPositionInStatusbar sv -- ids3 <- sv `onLookupInfo` selectInfo sv -- obsolete by hyperlinks ids4 <- sv `afterToggleOverwrite` writeOverwriteInStatusbar sv- activateThisPane actbuf $ concat [ids1, ids2, ids4]+ ids5 <- eBuf `afterChanged` do+ tb <- readIDE triggerBuild+ void . liftIO $ tryPutMVar tb ()+ activateThisPane actbuf $ concat [ids1, ids2, ids4, ids5] triggerEventIDE (Sensitivity [(SensitivityEditor, True)]) grabFocus sv checkModTime actbuf@@ -371,30 +396,35 @@ F.forM_ (maybe [] (fromMaybe [] . (`Map.lookup` removeDetails)) fileName) $ removeTagByName buf . T.pack . show - triggerEventIDE (ErrorChanged False)+ triggerEventIDE (ErrorsRemoved False toRemove) return () where toRemove ref = toRemove' (logRefRootPath ref) (logRefFilePath ref) && logRefType ref `elem` types -removeFileLogRefs :: FilePath -> FilePath -> [LogRefType] -> IDEAction-removeFileLogRefs root file types = do- liftIO . debugM "leksah" $ "removeFileLogRefs " <> root <> " " <> file <> " " <> show types- removeLogRefs (\r f -> r == root && f == file) types+removeFileLogRefs :: FilePath -> [LogRefType] -> IDEAction+removeFileLogRefs file types = do+ liftIO . debugM "leksah" $ "removeFileLogRefs " <> file <> " " <> show types+ removeLogRefs (\r f -> r </> f == file) types +removeFileExtLogRefs :: FilePath -> String -> [LogRefType] -> IDEAction+removeFileExtLogRefs root fileExt types = do+ liftIO . debugM "leksah" $ "removeFileTypeLogRefs " <> root <> " " <> fileExt <> " " <> show types+ removeLogRefs (\r f -> r == root && takeExtension f == fileExt) types+ removePackageLogRefs :: FilePath -> [LogRefType] -> IDEAction removePackageLogRefs root types = do liftIO . debugM "leksah" $ "removePackageLogRefs " <> root <> " " <> show types removeLogRefs (\r _ -> r == root) types -removeBuildLogRefs :: FilePath -> FilePath -> IDEAction-removeBuildLogRefs root file = removeFileLogRefs root file [ErrorRef, WarningRef]+removeBuildLogRefs :: FilePath -> IDEAction+removeBuildLogRefs file = removeFileLogRefs file [ErrorRef, WarningRef] removeTestLogRefs :: FilePath -> IDEAction removeTestLogRefs root = removePackageLogRefs root [TestFailureRef] -removeLintLogRefs :: FilePath -> FilePath -> IDEAction-removeLintLogRefs root file = removeFileLogRefs root file [LintRef]+removeLintLogRefs :: FilePath -> IDEAction+removeLintLogRefs file = removeFileLogRefs file [LintRef] canResolve :: LogRef -> Bool canResolve LogRef { logRefIdea = Just (_, Idea{..}) }@@ -524,10 +554,10 @@ where buildPane contents mModTime = do nb <- getNotebook panePath prefs <- readIDE prefs- let bs = candyState prefs+ let useCandy = candyState prefs ct <- readIDE candy (ind,rbn) <- figureOutPaneName bn 0- buildThisPane panePath nb (builder' bs mbfn ind bn rbn ct prefs contents mModTime)+ buildThisPane panePath nb (builder' useCandy mbfn ind bn rbn ct prefs contents mModTime) data CharacterCategory = IdentifierCharacter | SpaceCharacter | SyntaxCharacter deriving (Eq)@@ -551,8 +581,7 @@ Gtk.Notebook -> Gtk.Window -> IDEM (Maybe IDEBuffer,Connections)-builder' bs mbfn ind bn rbn ct prefs fileContents modTime pp nb windows =- -- display a file+builder' useCandy mbfn ind bn rbn ct prefs fileContents modTime pp nb windows = case textEditorType prefs of "GtkSourceView" -> newGtkBuffer mbfn fileContents >>= makeBuffer modTime "Yi" -> newYiBuffer mbfn fileContents >>= makeBuffer modTime@@ -562,12 +591,13 @@ where makeBuffer :: TextEditor editor => Maybe UTCTime -> EditorBuffer editor -> IDEM (Maybe IDEBuffer,Connections) makeBuffer modTime buffer = do+ liftIO $ debugM "lekash" "makeBuffer" ideR <- ask beginNotUndoableAction buffer- let mod = modFromFileName mbfn- when (bs && isHaskellMode mod) $ modeTransformToCandy mod- (modeEditInCommentOrString mod) buffer+ let mode = modeFromFileName mbfn+ when (useCandy && isHaskellMode mode) $ modeTransformToCandy mode+ (modeEditInCommentOrString mode) buffer endNotUndoableAction buffer setModified buffer False siter <- getStartIter buffer@@ -575,7 +605,20 @@ iter <- getEndIter buffer -- create a new SourceView Widget- sv <- newView buffer (textviewFont prefs)+ (sv, sw) <- newView buffer (textviewFont prefs)++ -- Files opened from the unpackDirectory are meant for documentation+ -- and are not actually a source dependency, they should not be editable.+ homeDir <- liftIO getHomeDirectory+ let isEditable = fromMaybe True $ do+ dir <- unpackDirectory prefs+ let expandedDir = case dir of+ '~':rest -> homeDir ++ rest+ rest -> rest+ file <- mbfn+ return (not $ (splitDirectories expandedDir) `isPrefixOf` (splitDirectories file))++ setEditable sv isEditable setShowLineNumbers sv $ showLineNumbers prefs setRightMargin sv $ case rightMargin prefs of (False,_) -> Nothing@@ -585,29 +628,45 @@ drawTabs sv updateStyle buffer - -- put it in a scrolled window- sw <- getScrolledWindow sv if wrapLines prefs- then liftIO $ scrolledWindowSetPolicy sw PolicyNever PolicyAutomatic- else liftIO $ scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic- liftIO $ scrolledWindowSetShadowType sw ShadowIn+ then scrolledWindowSetPolicy sw PolicyTypeNever PolicyTypeAutomatic+ else scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic+ liftIO $ debugM "lekash" "makeBuffer setScrolledWindowShadowType"+ setScrolledWindowShadowType sw ShadowTypeIn+ liftIO $ debugM "lekash" "makeBuffer setScrolledWindowShadowType done"+++ box <- boxNew OrientationVertical 0+ when (not isEditable) $ liftIO $ do+ bar <- infoBarNew+ lab <- labelNew (Just "This file is opened in read-only mode because it comes from a non-local package")+ area <- infoBarGetContentArea bar >>= unsafeCastTo Container+ containerAdd area lab+ -- infoBarAddButton bar "Enable editing" (fromIntegral . fromEnum $ ResponseTypeReject)+ -- infoBarSetShowCloseButton bar True+ boxPackStart box bar False False 0+ widgetShow bar++ boxPackStart box sw True True 0+ modTimeRef <- liftIO $ newIORef modTime let buf = IDEBuffer { fileName = mbfn, bufferName = bn, addedIndex = ind, sourceView =sv,- scrolledWindow = sw,+ vBox = box, modTime = modTimeRef,- mode = mod}+ mode = mode} -- events- ids1 <- sv `afterFocusIn` makeActive buf+ ids1 <- afterFocusIn sv $ makeActive buf ids2 <- onCompletion sv (Completion.complete sv False) Completion.cancel ids3 <- onButtonPress sv $ do- click <- lift Gtk.eventClick+ e <- lift ask+ click <- getEventButtonType e liftIDE $ case click of- Gtk.DoubleClick -> do+ EventType2buttonPress -> do (start, end) <- getIdentifierUnderCursor buffer selectRange buffer start end return True@@ -632,7 +691,7 @@ Just fn -> Just (SrcSpan fn lStart cStart lEnd cEnd) Nothing -> Nothing - let tagName = "match"+ let tagName = "selection-match" hasSelection <- hasSelection buffer m <- liftIO $ readIORef hasMatch when m $ removeTagByName buffer tagName@@ -654,9 +713,10 @@ return () ids6 <- onKeyPress sv $ do- keyval <- lift eventKeyVal- name <- lift eventKeyName- modifier <- lift eventModifier+ e <- lift ask+ keyval <- getEventKeyKeyval e+ name <- keyvalName keyval+ modifier <- getEventKeyState e liftIDE $ do let moveToNextWord iterOp sel = do sel' <- iterOp sel@@ -672,34 +732,38 @@ placeCursor buffer nsel scrollToIter sv nsel 0 Nothing case (name, map mapControlCommand modifier, keyval) of- ("Left",[Gtk.Control],_) -> do+ (Just "Left",[ModifierTypeControlMask],_) -> do calculateNewPosition backwardCharC >>= continueSelection False return True- ("Left",[Gtk.Shift, Gtk.Control],_) -> do+ (Just "Left",[ModifierTypeShiftMask, ModifierTypeControlMask],_) -> do calculateNewPosition backwardCharC >>= continueSelection True return True- ("Right",[Gtk.Control],_) -> do+ (Just "Right",[ModifierTypeControlMask],_) -> do calculateNewPosition forwardCharC >>= continueSelection False --placeCursor buffer return True- ("Right",[Gtk.Shift, Gtk.Control],_) -> do+ (Just "Right",[ModifierTypeControlMask, ModifierTypeControlMask],_) -> do calculateNewPosition forwardCharC >>= continueSelection True return True- ("BackSpace",[Gtk.Control],_) -> do -- delete word+ (Just "BackSpace",[ModifierTypeControlMask],_) -> do -- delete word here <- getInsertIter buffer there <- calculateNewPosition backwardCharC delete buffer here there return True- ("underscore",[Gtk.Shift, Gtk.Control],_) -> do+ (Just "underscore",[ModifierTypeControlMask, ModifierTypeControlMask],_) -> do (start, end) <- getIdentifierUnderCursor buffer slice <- getSlice buffer start end True triggerEventIDE (SelectInfo slice False) return True -- Redundant should become a go to definition directly- ("minus",[Gtk.Control],_) -> do+ (Just "minus",[ModifierTypeControlMask],_) -> do (start, end) <- getIdentifierUnderCursor buffer slice <- getSlice buffer start end True triggerEventIDE (SelectInfo slice True) return True+ (Just "Return", [], _) ->+ readIDE currentState >>= \case+ IsCompleting _ -> return False+ _ -> smartIndent sv >> return True _ -> -- liftIO $ print ("sourcebuffer key:",name,modifier,keyval) return False@@ -724,7 +788,7 @@ -> EditorBuffer editor -> IDEM Bool forwardApplying tI txt mbTi tagName ebuf = do- mbFTxt <- forwardSearch tI txt [TextSearchVisibleOnly, TextSearchTextOnly] mbTi+ mbFTxt <- forwardSearch tI txt [TextSearchFlagsVisibleOnly, TextSearchFlagsTextOnly] mbTi case mbFTxt of Just (start, end) -> do startsWord <- startsWord start@@ -805,37 +869,40 @@ return (False, True) else do window <- liftIDE getMainWindow- resp <- liftIO $ do- md <- messageDialogNew- (Just window) []- MessageQuestion- ButtonsNone- (__ "File \"" <> name <> __ "\" has changed on disk.")- dialogAddButton md (__ "_Load From Disk") (ResponseUser 1)- dialogAddButton md (__ "_Always Load From Disk") (ResponseUser 2)- dialogAddButton md (__ "_Don't Load") (ResponseUser 3)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md (__ "File \"" <> name <> __ "\" has changed on disk.")+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Load From Disk") (AnotherResponseType 1)+ dialogAddButton' md (__ "_Always Load From Disk") (AnotherResponseType 2)+ dialogAddButton' md (__ "_Don't Load") (AnotherResponseType 3)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do revert buf return (False, True)- ResponseUser 2 -> do+ AnotherResponseType 2 -> do revert buf modifyIDE_ $ \ide -> ide{prefs = (prefs ide) {autoLoad = True}} return (False, True)- ResponseUser 3 -> do- nmt2 <- liftIO $ getModificationTime fn- liftIO $ writeIORef (modTime buf) (Just nmt2)- return (True, True)+ AnotherResponseType 3 -> dontLoad fn+ ResponseTypeDeleteEvent -> dontLoad fn _ -> return (False, False)+ else return (False, False) else return (False, False) Nothing -> return (False, False) + where+ dontLoad fn = do+ nmt2 <- liftIO $ getModificationTime fn+ liftIO $ writeIORef (modTime buf) (Just nmt2)+ return (True, True) setModTime :: IDEBuffer -> IDEAction setModTime buf = do let name = paneName buf@@ -912,9 +979,11 @@ markLabelAsChanged :: Notebook -> IDEBuffer -> IDEAction markLabelAsChanged nb (buf@IDEBuffer{sourceView = sv}) = do+ liftIO $ debugM "leksah" "markLabelAsChanged" ebuf <- getBuffer sv modified <- getModified ebuf- liftIO $ markLabel nb (getTopWidget buf) modified+ w <- getTopWidget buf+ markLabel nb w modified fileSaveBuffer :: MonadIDE m => TextEditor editor => Bool -> Notebook -> EditorView editor -> EditorBuffer editor -> IDEBuffer -> Int -> m Bool fileSaveBuffer query nb _ ebuf (ideBuf@IDEBuffer{sourceView = sv}) i = liftIDE $ do@@ -925,67 +994,64 @@ candy <- readIDE candy (panePath,connects) <- guiPropertiesFromName (paneName ideBuf) let mbfn = fileName ideBuf- mbpage <- liftIO $ notebookGetNthPage nb i- case mbpage of- Nothing -> throwIDE (__ "fileSave: Page not found")- Just page ->- if isJust mbfn && not query- then do (modifiedOnDiskNotLoaded, modifiedOnDisk) <- checkModTime ideBuf -- The user is given option to reload- modifiedInBuffer <- getModified ebuf- if modifiedOnDiskNotLoaded || modifiedInBuffer- then do- fileSave' (forceLineEnds prefs) (removeTBlanks prefs) nb ideBuf- useCandy candy $fromJust mbfn- setModTime ideBuf- return True- else return modifiedOnDisk- else reifyIDE $ \ideR -> do- dialog <- fileChooserDialogNew- (Just $ __ "Save File")- (Just window)- FileChooserActionSave- [("gtk-cancel" --buttons to display- ,ResponseCancel) --you can use stock buttons- ,("gtk-save"- , ResponseAccept)]- case mbfn of- Just fn -> void (fileChooserSelectFilename dialog fn)- Nothing -> return ()- widgetShow dialog- response <- dialogRun dialog- mbFileName <- case response of- ResponseAccept -> fileChooserGetFilename dialog- ResponseCancel -> return Nothing- ResponseDeleteEvent-> return Nothing- _ -> return Nothing- widgetDestroy dialog- case mbFileName of- Nothing -> return False- Just fn -> do- dfe <- doesFileExist fn- resp <- if dfe- then do md <- messageDialogNew (Just window) []- MessageQuestion- ButtonsCancel- (__ "File already exist.")- dialogAddButton md (__ "_Overwrite") ResponseYes- dialogSetDefaultResponse md ResponseCancel- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetHide md- return resp- else return ResponseYes- case resp of- ResponseYes -> do- reflectIDE (do- fileSave' (forceLineEnds prefs) (removeTBlanks prefs)- nb ideBuf useCandy candy fn- closePane ideBuf- cfn <- liftIO $ myCanonicalizePath fn- newTextBuffer panePath (T.pack $ takeFileName cfn) (Just cfn)- ) ideR- return True- _ -> return False+ page <- liftIO $ notebookGetNthPage nb (fromIntegral i)+ if isJust mbfn && not query+ then do (modifiedOnDiskNotLoaded, modifiedOnDisk) <- checkModTime ideBuf -- The user is given option to reload+ modifiedInBuffer <- getModified ebuf+ if modifiedOnDiskNotLoaded || modifiedInBuffer+ then do+ fileSave' (forceLineEnds prefs) (removeTBlanks prefs) nb ideBuf+ useCandy candy $fromJust mbfn+ setModTime ideBuf+ return True+ else return modifiedOnDisk+ else reifyIDE $ \ideR -> do+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog (__ "Save File")+ windowSetTransientFor dialog $ Just window+ fileChooserSetAction dialog FileChooserActionSave+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "gtk-save" ResponseTypeAccept+ case mbfn of+ Just fn -> void (fileChooserSelectFilename dialog fn)+ Nothing -> return ()+ widgetShow dialog+ response <- dialogRun' dialog+ mbFileName <- case response of+ ResponseTypeAccept -> fileChooserGetFilename dialog+ ResponseTypeCancel -> return Nothing+ ResponseTypeDeleteEvent -> return Nothing+ _ -> return Nothing+ widgetDestroy dialog+ case mbFileName of+ Nothing -> return False+ Just fn -> do+ dfe <- doesFileExist fn+ resp <- if dfe+ then do md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "File already exist."+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Overwrite") ResponseTypeYes+ dialogSetDefaultResponse' md ResponseTypeCancel+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- toEnum . fromIntegral <$> dialogRun md+ widgetHide md+ return resp+ else return ResponseTypeYes+ case resp of+ ResponseTypeYes -> do+ reflectIDE (do+ fileSave' (forceLineEnds prefs) (removeTBlanks prefs)+ nb ideBuf useCandy candy fn+ closePane ideBuf+ cfn <- liftIO $ myCanonicalizePath fn+ newTextBuffer panePath (T.pack $ takeFileName cfn) (Just cfn)+ ) ideR+ return True+ _ -> return False where fileSave' :: Bool -> Bool -> Notebook -> IDEBuffer -> Bool -> CandyTable -> FilePath -> IDEAction fileSave' forceLineEnds removeTBlanks nb ideBuf useCandy candyTable fn = do@@ -1095,24 +1161,27 @@ cancel <- reifyIDE $ \ideR -> if modified then do- md <- messageDialogNew (Just window) []- MessageQuestion- ButtonsCancel- (__ "Save changes to document: "+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "Save changes to document: " <> paneName currentBuffer- <> "?")- dialogAddButton md (__ "_Save") ResponseYes- dialogAddButton md (__ "_Don't Save") ResponseNo- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md+ <> "?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Save") ResponseTypeYes+ dialogAddButton' md (__ "_Don't Save") ResponseTypeNo+ dialogSetDefaultResponse' md ResponseTypeYes+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md widgetDestroy md case resp of- ResponseYes -> do+ ResponseTypeYes -> do reflectIDE (fileSave False) ideR return False- ResponseCancel -> return True- ResponseNo -> return False- _ -> return False+ ResponseTypeCancel -> return True+ ResponseTypeNo -> return False+ _ -> return False else return False if cancel then return False@@ -1145,15 +1214,15 @@ close' dir (buf@IDEBuffer {sourceView = sv}) = do (pane,_) <- guiPropertiesFromName (paneName buf) nb <- getNotebook pane- mbI <- liftIO $notebookPageNum nb (scrolledWindow buf)- case mbI of- Nothing -> throwIDE (__ "notebook page not found: unexpected")- Just i -> do+ i <- notebookPageNum nb (vBox buf)+ if i < 0+ then throwIDE (__ "notebook page not found: unexpected")+ else do ebuf <- getBuffer sv when (isJust (fileName buf)) $ do modified <- getModified ebuf when (not modified && not (isSubPath dir (fromJust (fileName buf))))- $ do fileClose' nb sv ebuf buf i; return ()+ $ do fileClose' nb sv ebuf buf (fromIntegral i); return () fileCloseAllButWorkspace :: IDEAction fileCloseAllButWorkspace = do@@ -1165,17 +1234,17 @@ close' workspace (buf@IDEBuffer {sourceView = sv}) = do (pane,_) <- guiPropertiesFromName (paneName buf) nb <- getNotebook pane- mbI <- liftIO $notebookPageNum nb (scrolledWindow buf)- case mbI of- Nothing -> throwIDE (__ "notebook page not found: unexpected")- Just i -> do+ i <- notebookPageNum nb (vBox buf)+ if i < 0+ then throwIDE (__ "notebook page not found: unexpected")+ else do ebuf <- getBuffer sv when (isJust (fileName buf)) $ do modified <- getModified ebuf when (not modified && not (isSubPathOfAny workspace (fromJust (fileName buf))))- $ do fileClose' nb sv ebuf buf i; return ()+ $ do fileClose' nb sv ebuf buf (fromIntegral i); return () isSubPathOfAny workspace fileName =- let paths = wsPackages workspace >>= ipdAllDirs+ let paths = ipdPackageDir <$> wsPackages workspace in any (`isSubPath` fileName) paths @@ -1189,24 +1258,23 @@ Just fn -> equalFilePath fn fpc Nothing -> False) buffers case buf of- hdb:tl -> do+ hdb:_ -> do window <- getMainWindow- resp <- liftIO $ do- md <- messageDialogNew- (Just window) []- MessageQuestion- ButtonsNone- (__ "Buffer already open.")- dialogAddButton md (__ "Make _Active") (ResponseUser 1)- dialogAddButton md (__ "_Open Second") (ResponseUser 2)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "Buffer already open."+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "Make _Active") (AnotherResponseType 1)+ dialogAddButton' md (__ "_Open Second") (AnotherResponseType 2)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 2 -> reallyOpen prefs fpc- _ -> makeActive hdb+ AnotherResponseType 2 -> reallyOpen prefs fpc+ _ -> makeActive hdb [] -> reallyOpen prefs fpc where reallyOpen prefs fpc = do@@ -1222,46 +1290,52 @@ let pName = paneName currentBuffer window <- getMainWindow print <- reifyIDE $ \ideR -> do- md <- messageDialogNew (Just window) []- MessageQuestion- ButtonsNone- (__"Print document: "- <> pName- <> "?")- dialogAddButton md (__"_Print") ResponseYes- dialogAddButton md (__"_Don't Print") ResponseNo- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __"Print document: "+ <> pName+ <> "?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__"_Print") ResponseTypeYes+ dialogSetDefaultResponse' md ResponseTypeYes+ dialogAddButton' md (__"_Don't Print") ResponseTypeNo+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md widgetDestroy md case resp of- ResponseYes -> return True- ResponseCancel -> return False- ResponseNo -> return False- _ -> return False+ ResponseTypeYes -> return True+ ResponseTypeCancel -> return False+ ResponseTypeNo -> return False+ _ -> return False when print $ do --real code modified <- getModified ebuf cancel <- reifyIDE $ \ideR -> if modified then do- md <- messageDialogNew (Just window) []- MessageQuestion- ButtonsNone- (__"Save changes to document: "+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __"Save changes to document: " <> pName- <> "?")- dialogAddButton md (__"_Save") ResponseYes- dialogAddButton md (__"_Don't Save") ResponseNo- dialogAddButton md (__"_Cancel Printing") ResponseCancel- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md+ <> "?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__"_Save") ResponseTypeYes+ dialogSetDefaultResponse' md ResponseTypeYes+ dialogAddButton' md (__"_Don't Save") ResponseTypeNo+ dialogAddButton' md (__"_Cancel Printing") ResponseTypeCancel+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md widgetDestroy md case resp of- ResponseYes -> do+ ResponseTypeYes -> do reflectIDE (fileSave False) ideR return False- ResponseCancel -> return True- ResponseNo -> return False+ ResponseTypeCancel -> return True+ ResponseTypeNo -> return False _ -> return False else return False@@ -1270,8 +1344,8 @@ Just name -> do status <- liftIO $ Print.print name case status of- Left error -> liftIO $ showDialog (T.pack $ show error) MessageError- Right _ -> liftIO $ showDialog "Print job has been sent successfully" MessageInfo+ Left error -> liftIO $ showErrorDialog (Just window) (T.pack $ show error)+ Right _ -> liftIO $ showDialog (Just window) "Print job has been sent successfully" MessageTypeInfo return () Nothing -> return () @@ -1301,12 +1375,12 @@ editCut :: IDEAction editCut = inActiveBufContext () $ \_ _ ebuf _ _ -> do- clip <- liftIO $ clipboardGet selectionClipboard+ clip <- clipboardGet =<< atomIntern "CLIPBOARD" False cutClipboard ebuf clip True editCopy :: IDEAction editCopy = inActiveBufContext () $ \_ view ebuf _ _ -> do- clip <- liftIO $ clipboardGet selectionClipboard+ clip <- clipboardGet =<< atomIntern "CLIPBOARD" False copyClipboard ebuf clip scrollToCursor view @@ -1314,7 +1388,7 @@ editPaste = inActiveBufContext () $ \_ _ ebuf _ _ -> do mark <- getInsertMark ebuf iter <- getIterAtMark ebuf mark- clip <- liftIO $ clipboardGet selectionClipboard+ clip <- clipboardGet =<< atomIntern "CLIPBOARD" False pasteClipboard ebuf clip iter True editShiftLeft :: IDEAction@@ -1493,11 +1567,11 @@ -- | Checks whether a file belongs to a package (includes files in -- sandbox source dirs) belongsToPackage :: FilePath -> IDEPackage -> Bool-belongsToPackage f = any (`isSubPath` f) . ipdAllDirs+belongsToPackage f = (`isSubPath` f) . ipdPackageDir -- | Checks whether a file belongs to the workspace belongsToWorkspace :: MonadIDE m => FilePath -> m Bool-belongsToWorkspace fp = liftM (not . null) (belongsToPackages fp)+belongsToWorkspace fp = not . null <$> belongsToPackages fp -- | Checks whether a file belongs to the workspace belongsToWorkspace' :: MonadIDE m => IDEBuffer -> m Bool
src/IDE/Pane/Trace.hs view
@@ -21,7 +21,6 @@ , fillTraceList ) where -import Graphics.UI.Gtk import Data.Typeable (Typeable(..)) import IDE.Core.State import IDE.Package (tryDebug)@@ -44,8 +43,6 @@ import qualified Text.ParserCombinators.Parsec.Token as P (integer, whiteSpace, colon, symbol, makeTokenParser) import Text.ParserCombinators.Parsec.Language (emptyDef)-import Graphics.UI.Gtk.Gdk.Events (Event(..))-import Graphics.UI.Gtk.General.Enums (MouseButton(..)) import System.Log.Logger (debugM) import IDE.Workspaces (packageTry) import qualified Data.Conduit.List as CL (consume)@@ -58,6 +55,43 @@ import qualified Data.Text as T (pack, unpack) import qualified Text.Printf as S (printf) import Text.Printf (PrintfType)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TreeView+ (treeViewGetSelection, treeViewSetHeadersVisible,+ treeViewAppendColumn, treeViewSetModel, treeViewNew, TreeView(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreGetValue, ForestStore(..),+ forestStoreInsert, forestStoreClear, forestStoreNew)+import GI.Gtk.Objects.Widget (afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.Notebook (Notebook(..))+import GI.Gtk.Objects.Window (Window(..))+import GI.Gtk.Objects.CellRendererToggle+ (setCellRendererToggleActive, cellRendererToggleNew)+import GI.Gtk.Objects.TreeViewColumn+ (treeViewColumnSetReorderable, treeViewColumnSetResizable,+ treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..))+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Objects.TreeSelection+ (onTreeSelectionChanged, treeSelectionSetMode)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.MenuItem+ (toMenuItem, onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import Control.Monad.Reader (MonadReader(..))+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices') printf :: PrintfType r => Text -> r printf = S.printf . T.unpack@@ -67,7 +101,7 @@ data IDETrace = IDETrace { scrolledView :: ScrolledWindow , treeView :: TreeView-, tracepoints :: TreeStore TraceHist+, tracepoints :: ForestStore TraceHist } deriving Typeable data TraceState = TraceState {@@ -84,7 +118,7 @@ where primPaneName _ = __ "Trace" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = liftIO . toWidget . scrolledView paneId b = "*Trace" instance RecoverablePane IDETrace TraceState IDEM where@@ -106,76 +140,77 @@ Notebook -> Window -> IDEM (Maybe IDETrace,Connections)-builder' pp nb windows = reifyIDE $ \ ideR -> do- tracepoints <- treeStoreNew []+builder' pp nb windows = do+ ideR <- ask+ tracepoints <- forestStoreNew [] treeView <- treeViewNew- treeViewSetModel treeView tracepoints+ treeViewSetModel treeView (Just tracepoints) renderer0 <- cellRendererToggleNew col0 <- treeViewColumnNew- treeViewColumnSetTitle col0 (""::Text)- treeViewColumnSetSizing col0 TreeViewColumnAutosize+ treeViewColumnSetTitle col0 ""+ treeViewColumnSetSizing col0 TreeViewColumnSizingAutosize treeViewColumnSetResizable col0 False treeViewColumnSetReorderable col0 True treeViewAppendColumn treeView col0 cellLayoutPackStart col0 renderer0 False- cellLayoutSetAttributes col0 renderer0 tracepoints- $ \row -> [ cellToggleActive := thSelected row]+ cellLayoutSetDataFunction col0 renderer0 tracepoints+ $ setCellRendererToggleActive renderer0 . thSelected renderer1 <- cellRendererTextNew col1 <- treeViewColumnNew treeViewColumnSetTitle col1 (__ "Index")- treeViewColumnSetSizing col1 TreeViewColumnAutosize+ treeViewColumnSetSizing col1 TreeViewColumnSizingAutosize treeViewColumnSetResizable col1 True treeViewColumnSetReorderable col1 True treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer1 False- cellLayoutSetAttributes col1 renderer1 tracepoints- $ \row -> [ cellText := T.pack $ show (thIndex row)]+ cellLayoutSetDataFunction col1 renderer1 tracepoints+ $ setCellRendererTextText renderer1 . T.pack . show . thIndex renderer2 <- cellRendererTextNew col2 <- treeViewColumnNew treeViewColumnSetTitle col2 (__ "Function")- treeViewColumnSetSizing col2 TreeViewColumnAutosize+ treeViewColumnSetSizing col2 TreeViewColumnSizingAutosize treeViewColumnSetResizable col2 True treeViewColumnSetReorderable col2 True treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 False- cellLayoutSetAttributes col2 renderer2 tracepoints- $ \row -> [ cellText := thFunction row]+ cellLayoutSetDataFunction col2 renderer2 tracepoints+ $ setCellRendererTextText renderer2 . thFunction renderer3 <- cellRendererTextNew col3 <- treeViewColumnNew treeViewColumnSetTitle col3 (__ "Position")- treeViewColumnSetSizing col3 TreeViewColumnAutosize+ treeViewColumnSetSizing col3 TreeViewColumnSizingAutosize treeViewColumnSetResizable col3 True treeViewColumnSetReorderable col3 True treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 False- cellLayoutSetAttributes col3 renderer3 tracepoints- $ \row -> [ cellText := T.pack $ displaySrcSpan (thPosition row)]+ cellLayoutSetDataFunction col3 renderer3 tracepoints+ $ setCellRendererTextText renderer3 . T.pack . displaySrcSpan . thPosition treeViewSetHeadersVisible treeView True sel <- treeViewGetSelection treeView- treeSelectionSetMode sel SelectionSingle+ treeSelectionSetMode sel SelectionModeSingle - scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic let pane = IDETrace scrolledView treeView tracepoints - cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive pane) ideR- return True- (cid2, cid3) <- treeViewContextMenu treeView $ traceContextMenu ideR tracepoints treeView- on sel treeSelectionSelectionChanged $ do+ cid1 <- onIDE afterWidgetFocusInEvent treeView (do+ liftIDE $ makeActive pane+ return True)+ cids2 <- treeViewContextMenu treeView $ traceContextMenu ideR tracepoints treeView+ onTreeSelectionChanged sel $ do sel <- getSelectedTracepoint treeView tracepoints case sel of Just ref -> return () -- TODO reflectIDE (selectRef (Just ref)) ideR Nothing -> return ()- return (Just pane, map ConnectC [cid1, cid2, cid3])+ return (Just pane, cid1 : cids2) fillTraceList :: IDEAction fillTraceList = packageTry $ do@@ -185,22 +220,24 @@ Nothing -> return () Just tracePane -> tryDebug $ debugCommand' ":history" $ do to <- CL.consume- liftIO $ postGUIAsync $ do+ lift $ postAsyncIDE $ do let parseRes = parse tracesParser "" . T.unpack $ selectString to r <- case parseRes of Left err -> do- debugM "leksah" (printf (__ "trace parse error %s\ninput: %s") (show err)+ liftIO $ debugM "leksah" (printf (__ "trace parse error %s\ninput: %s") (show err) (T.unpack $ selectString to)) return [] Right traces -> return traces- treeStoreClear (tracepoints tracePane)+ forestStoreClear (tracepoints tracePane) let r' = map (\h@(TraceHist _ i _ _) -> if i == currentHist' then h{thSelected = True} else h) r mapM_ (insertTrace (tracepoints tracePane)) (zip r' [0..length r']) where- insertTrace treeStore (tr,index) = treeStoreInsert treeStore [] index tr+ insertTrace forestStore (tr,index) = do+ emptyPath <- treePathNewFromIndices' []+ forestStoreInsert forestStore emptyPath index tr selectString :: [ToolOutput] -> Text selectString (ToolOutput str:r) = "\n" <> str <> selectString r@@ -208,14 +245,14 @@ selectString [] = "" getSelectedTracepoint :: TreeView- -> TreeStore TraceHist+ -> ForestStore TraceHist -> IO (Maybe TraceHist)-getSelectedTracepoint treeView treeStore = do+getSelectedTracepoint treeView forestStore = do treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of a:r -> do- val <- treeStoreGetValue treeStore a+ val <- forestStoreGetValue forestStore a return (Just val) _ -> return Nothing @@ -225,20 +262,19 @@ selectStrings [] = [] traceContextMenu :: IDERef- -> TreeStore TraceHist+ -> ForestStore TraceHist -> TreeView -> Menu -> IO () traceContextMenu ideR store treeView theMenu = do item1 <- menuItemNewWithLabel (__ "Back")- item1 `on` menuItemActivate $ reflectIDE debugBack ideR- sep1 <- separatorMenuItemNew+ onMenuItemActivate item1 $ reflectIDE debugBack ideR+ sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem item2 <- menuItemNewWithLabel (__ "Forward")- item2 `on` menuItemActivate $ reflectIDE debugForward ideR+ onMenuItemActivate item2 $ reflectIDE debugForward ideR item3 <- menuItemNewWithLabel (__ "Update")- item3 `on` menuItemActivate $ reflectIDE fillTraceList ideR- mapM_ (menuShellAppend theMenu) [castToMenuItem item1, castToMenuItem sep1,- castToMenuItem item2, castToMenuItem item3]+ onMenuItemActivate item3 $ reflectIDE fillTraceList ideR+ mapM_ (menuShellAppend theMenu) [item1, sep1, item2, item3] tracesParser :: CharParser () [TraceHist] tracesParser = try (do
src/IDE/Pane/Variables.hs view
@@ -22,7 +22,6 @@ , fillVariablesListQuiet ) where -import Graphics.UI.Gtk import Data.Typeable (Typeable(..)) import IDE.Core.State import IDE.Package (tryDebug, tryDebugQuiet)@@ -43,9 +42,6 @@ import qualified Text.ParserCombinators.Parsec.Token as P (whiteSpace, symbol, makeTokenParser) import Text.ParserCombinators.Parsec.Language (emptyDef)-import Graphics.UI.Gtk.Gdk.Events (Event(..))-import Graphics.UI.Gtk.General.Enums- (Click(..), MouseButton(..)) import IDE.Workspaces (packageTry, packageTryQuiet) import qualified Data.Conduit.List as CL (consume) import Control.Monad.Trans.Class (MonadTrans(..))@@ -55,12 +51,51 @@ import Data.Monoid ((<>)) import qualified Data.Text as T (pack, unpack) import Control.Applicative ((<$>))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TreeView+ (onTreeViewRowActivated, treeViewGetSelection,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreGetValue, ForestStore(..), forestStoreSetValue,+ forestStoreInsert, forestStoreClear, forestStoreNew)+import GI.Gtk.Objects.Widget (afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.Notebook (Notebook(..))+import GI.Gtk.Objects.Window (Window(..))+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextText, cellRendererTextNew)+import GI.Gtk.Objects.TreeViewColumn+ (TreeViewColumn(..), treeViewColumnSetReorderable,+ treeViewColumnSetResizable, treeViewColumnSetSizing,+ treeViewColumnSetTitle, treeViewColumnNew)+import GI.Gtk.Enums+ (PolicyType(..), ShadowType(..), SelectionMode(..),+ TreeViewColumnSizing(..))+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunction)+import GI.Gtk.Objects.TreeSelection+ (treeSelectionSetMode)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import Control.Monad.Reader (MonadReader(..))+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Objects.MenuItem+ (toMenuItem, onMenuItemActivate, menuItemNewWithLabel)+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices') -- | Represents the Variables pane data IDEVariables = IDEVariables { scrolledView :: ScrolledWindow , treeView :: TreeView-, variables :: TreeStore VarDescription+, variables :: ForestStore VarDescription } deriving Typeable @@ -80,7 +115,7 @@ where primPaneName _ = __ "Variables" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = liftIO . toWidget . scrolledView paneId b = "*Variables" @@ -110,60 +145,61 @@ Notebook -> Window -> IDEM (Maybe IDEVariables, Connections)-builder' pp nb windows = reifyIDE $ \ideR -> do- variables <- treeStoreNew []+builder' pp nb windows = do+ ideR <- ask+ variables <- forestStoreNew [] treeView <- treeViewNew- treeViewSetModel treeView variables+ treeViewSetModel treeView (Just variables) renderer1 <- cellRendererTextNew col1 <- treeViewColumnNew treeViewColumnSetTitle col1 (__ "Name")- treeViewColumnSetSizing col1 TreeViewColumnAutosize+ treeViewColumnSetSizing col1 TreeViewColumnSizingAutosize treeViewColumnSetResizable col1 True treeViewColumnSetReorderable col1 True treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer1 False- cellLayoutSetAttributes col1 renderer1 variables- $ \row -> [ cellText := varName row]+ cellLayoutSetDataFunction col1 renderer1 variables+ $ setCellRendererTextText renderer1 . varName renderer2 <- cellRendererTextNew col2 <- treeViewColumnNew treeViewColumnSetTitle col2 (__ "Type")- treeViewColumnSetSizing col2 TreeViewColumnAutosize+ treeViewColumnSetSizing col2 TreeViewColumnSizingAutosize treeViewColumnSetResizable col2 True treeViewColumnSetReorderable col2 True treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 False- cellLayoutSetAttributes col2 renderer2 variables- $ \row -> [ cellText := varType row]+ cellLayoutSetDataFunction col2 renderer2 variables+ $ setCellRendererTextText renderer2 . varType renderer3 <- cellRendererTextNew col3 <- treeViewColumnNew treeViewColumnSetTitle col3 (__ "Value")- treeViewColumnSetSizing col3 TreeViewColumnAutosize+ treeViewColumnSetSizing col3 TreeViewColumnSizingAutosize treeViewColumnSetResizable col3 True treeViewColumnSetReorderable col3 True treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 False- cellLayoutSetAttributes col3 renderer3 variables- $ \row -> [ cellText := varValue row]+ cellLayoutSetDataFunction col3 renderer3 variables+ $ setCellRendererTextText renderer3 . varValue treeViewSetHeadersVisible treeView True sel <- treeViewGetSelection treeView- treeSelectionSetMode sel SelectionSingle+ treeSelectionSetMode sel SelectionModeSingle - scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic let pane = IDEVariables scrolledView treeView variables- cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive pane) ideR- return True- (cid2, cid3) <- treeViewContextMenu treeView $ variablesContextMenu ideR variables treeView- cid4 <- on treeView rowActivated $ variablesSelect ideR variables- return (Just pane, map ConnectC [cid1, cid2, cid3, cid4])+ cid1 <- onIDE afterWidgetFocusInEvent treeView (do+ liftIDE $ makeActive pane+ return True)+ cids2 <- treeViewContextMenu treeView $ variablesContextMenu ideR variables treeView+ cid4 <- ConnectC treeView <$> onTreeViewRowActivated treeView (variablesSelect ideR variables)+ return (Just pane, [cid1, cid4] ++ cids2) -- | Quietly list the variable bindings of the current debug session@@ -174,17 +210,20 @@ Nothing -> return () Just var -> tryDebugQuiet $ debugCommand' ":show bindings" $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse variablesParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right triples -> do- treeStoreClear (variables var)- mapM_ (insertBreak (variables var))+ forestStoreClear (variables var)+ mapM_ (insertAtRoot (variables var)) (zip triples [0..length triples])- where- insertBreak treeStore (v,index) = treeStoreInsert treeStore [] index v +insertAtRoot :: MonadIO m => ForestStore a -> (a, Int) -> m ()+insertAtRoot forestStore (v,index) = do+ emptyPath <- treePathNewFromIndices' []+ forestStoreInsert forestStore emptyPath index v + -- | List the variable bindings of the current debug session fillVariablesList :: IDEAction fillVariablesList = packageTry $ do@@ -193,15 +232,13 @@ Nothing -> return () Just var -> tryDebug $ debugCommand' ":show bindings" $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse variablesParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right triples -> do- treeStoreClear (variables var)- mapM_ (insertBreak (variables var))+ forestStoreClear (variables var)+ mapM_ (insertAtRoot (variables var)) (zip triples [0..length triples])- where- insertBreak treeStore (v,index) = treeStoreInsert treeStore [] index v -- | Concatenates the tool output lines with newlines@@ -214,14 +251,14 @@ -- | Tries to get the selected variable in the Pane, -- together with the 'TreePath' getSelectedVariable :: TreeView- -> TreeStore VarDescription+ -> ForestStore VarDescription -> IO (Maybe (VarDescription,TreePath))-getSelectedVariable treeView treeStore = do+getSelectedVariable treeView forestStore = do treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection+ paths <- treeSelectionGetSelectedRows' treeSelection case paths of a:r -> do- val <- treeStoreGetValue treeStore a+ val <- forestStoreGetValue forestStore a return (Just (val,a)) _ -> return Nothing @@ -282,82 +319,81 @@ -- | Constructs the context menu of the Variables pane variablesContextMenu :: IDERef- -> TreeStore VarDescription+ -> ForestStore VarDescription -> TreeView -> Menu -> IO () variablesContextMenu ideR store treeView theMenu = do item1 <- menuItemNewWithLabel (__ "Force")- item1 `on` menuItemActivate $ do+ onMenuItemActivate item1 $ do mbSel <- getSelectedVariable treeView store case mbSel of Just (varDescr,path) -> reflectIDE (forceVariable varDescr path store) ideR otherwise -> return ()- sep1 <- separatorMenuItemNew+ sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem item2 <- menuItemNewWithLabel (__ "Print")- item2 `on` menuItemActivate $ do+ onMenuItemActivate item2 $ do mbSel <- getSelectedVariable treeView store case mbSel of Just (varDescr,path) -> reflectIDE (printVariable varDescr path store) ideR otherwise -> return () item3 <- menuItemNewWithLabel (__ "Update")- item3 `on` menuItemActivate $ postGUIAsync (reflectIDE fillVariablesList ideR)- mapM_ (menuShellAppend theMenu) [castToMenuItem item1,- castToMenuItem item2, castToMenuItem sep1, castToMenuItem item3]+ onMenuItemActivate item3 $ reflectIDE (postAsyncIDE fillVariablesList) ideR+ mapM_ (menuShellAppend theMenu) [item1, item2, sep1, item3] -- | Called when a variable is selected in the Variables pane. -- Forces the variable and updates the entry in the pane, variablesSelect :: IDERef- -> TreeStore VarDescription+ -> ForestStore VarDescription -> TreePath -> TreeViewColumn -> IO () variablesSelect ideR store path _ = do- varDescr <- treeStoreGetValue store path+ varDescr <- forestStoreGetValue store path reflectIDE (forceVariable varDescr path store) ideR -- | Force the value of the given 'VarDescription', retrieve its type -- and update the appropriate entry in the Variables pane-forceVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction-forceVariable varDescr path treeStore = packageTry $ tryDebug $ do+forceVariable :: VarDescription -> TreePath -> ForestStore VarDescription -> IDEAction+forceVariable varDescr path forestStore = packageTry $ tryDebug $ do debugCommand' (":force " <> varName varDescr) $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse valueParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right value -> do- var <- treeStoreGetValue treeStore path- treeStoreSetValue treeStore path var{varValue = value}+ var <- forestStoreGetValue forestStore path+ forestStoreSetValue forestStore path var{varValue = value} debugCommand' (":type " <> varName varDescr) $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse typeParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right typ -> do- var <- treeStoreGetValue treeStore path- treeStoreSetValue treeStore path var{varType = typ}+ var <- forestStoreGetValue forestStore path+ forestStoreSetValue forestStore path var{varType = typ} -- | Print the value of the given 'VarDescription', retrieve its type -- and update the appropriate entry in the Variables pane-printVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction-printVariable varDescr path treeStore = packageTry $ tryDebug $ do+printVariable :: VarDescription -> TreePath -> ForestStore VarDescription -> IDEAction+printVariable varDescr path forestStore = packageTry $ tryDebug $ do debugCommand' (":print " <> varName varDescr) $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse valueParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right value -> do- var <- treeStoreGetValue treeStore path- treeStoreSetValue treeStore path var{varValue = value}+ var <- forestStoreGetValue forestStore path+ forestStoreSetValue forestStore path var{varValue = value} debugCommand' (":type " <> varName varDescr) $ do to <- CL.consume- liftIO $ postGUIAsync $+ lift $ postAsyncIDE $ case parse typeParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (T.pack $ show e)+ Left e -> liftIO $ sysMessage Normal (T.pack $ show e) Right typ -> do- var <- treeStoreGetValue treeStore path- treeStoreSetValue treeStore path var{varType = typ}+ var <- forestStoreGetValue forestStore path+ forestStoreSetValue forestStore path var{varType = typ}
src/IDE/Pane/WebKit/Documentation.hs view
@@ -27,48 +27,48 @@ , reloadDoc ) where +import Prelude ()+import Prelude.Compat import Graphics.UI.Frame.Panes (RecoverablePane(..), PanePath, RecoverablePane, Pane(..))-import Graphics.UI.Gtk- (scrolledWindowSetShadowType, scrolledWindowSetPolicy,- scrolledWindowNew, castToWidget, ScrolledWindow) import Data.Typeable (Typeable) import Data.Text (Text) import IDE.Core.Types (IDEAction, IDEM) import Control.Monad.IO.Class (MonadIO(..)) import Graphics.UI.Frame.ViewFrame (getNotebook) import IDE.Core.State (reifyIDE)-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), PolicyType(..))--#ifdef WEBKITGTK-import Graphics.UI.Gtk- (eventModifier, eventKeyName, keyPressEvent, focusInEvent,- containerAdd, Modifier(..), after)-import Graphics.UI.Gtk.WebKit.Types (WebView(..))-import Graphics.UI.Gtk.WebKit.WebView- (webViewUri, webViewGoBack, webViewZoomOut, webViewZoomIn,- webViewZoomLevel, webViewReload, webViewLoadUri, webViewNew)-import System.Glib.Attributes (AttrOp(..), set, get)-import System.Glib.Signals (on) import IDE.Core.State (reflectIDE) import Graphics.UI.Editor.Basics (Connection(..))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+#ifdef MIN_VERSION_gi_webkit2+import GI.WebKit2.Objects.WebView+ (webViewReload, webViewGoBack,+ webViewNew, webViewLoadUri, setWebViewZoomLevel, webViewGetUri,+ getWebViewZoomLevel, WebView(..)) #else-import Data.IORef (writeIORef, newIORef, readIORef, IORef)-import Control.Applicative ((<$>))+import GI.WebKit.Objects.WebView+ (webViewReload, webViewGoBack, webViewZoomOut, webViewZoomIn,+ webViewNew, webViewLoadUri, setWebViewZoomLevel, webViewGetUri,+ getWebViewZoomLevel, WebView(..)) #endif+import GI.Gtk.Objects.Widget+ (onWidgetKeyPressEvent, afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Enums (PolicyType(..), ShadowType(..))+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gdk (getEventKeyState, keyvalName, getEventKeyKeyval)+import GI.Gdk.Flags (ModifierType(..))+import System.Log.Logger (debugM) data IDEDocumentation = IDEDocumentation { scrolledView :: ScrolledWindow-#ifdef WEBKITGTK , webView :: WebView-#else- , docState :: IORef DocumentationState-#endif } deriving Typeable data DocumentationState = DocumentationState {- zoom :: Float+ zoom :: Double , uri :: Maybe Text } deriving(Eq,Ord,Read,Show,Typeable) @@ -76,62 +76,52 @@ where primPaneName _ = "Doc" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = liftIO . toWidget . scrolledView paneId b = "*Doc" instance RecoverablePane IDEDocumentation DocumentationState IDEM where- saveState p = liftIO $-#ifdef WEBKITGTK- do zoom <- webView p `get` webViewZoomLevel- uri <- webView p `get` webViewUri- return (Just DocumentationState{..})-#else- Just <$> readIORef (docState p)-#endif- recoverState pp DocumentationState {..} = do- nb <- getNotebook pp+ saveState p = do+ zoom <- fmap realToFrac <$> getWebViewZoomLevel $ webView p+ uri <- webViewGetUri $ webView p+ return (Just DocumentationState{..})+ recoverState pp DocumentationState {..} = do+ nb <- getNotebook pp mbPane <- buildPane pp nb builder case mbPane of Nothing -> return ()- Just p -> liftIO $-#ifdef WEBKITGTK- do webView p `set` [webViewZoomLevel := zoom]- maybe (return ()) (webViewLoadUri (webView p)) uri-#else- writeIORef (docState p) DocumentationState {..}-#endif+ Just p -> do+ setWebViewZoomLevel (webView p) (realToFrac zoom)+ maybe (return ()) (webViewLoadUri (webView p)) uri return mbPane builder pp nb windows = reifyIDE $ \ ideR -> do- scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn -#ifdef WEBKITGTK webView <- webViewNew containerAdd scrolledView webView-#else- docState <- newIORef DocumentationState {zoom = 1.0, uri = Nothing}-#endif - scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic let docs = IDEDocumentation {..} -#ifdef WEBKITGTK- cid1 <- after webView focusInEvent $ do+ cid1 <- ConnectC webView <$> afterWidgetFocusInEvent webView (\e -> do liftIO $ reflectIDE (makeActive docs) ideR- return True+ return True) - cid2 <- webView `on` keyPressEvent $ do- key <- eventKeyName- mod <- eventModifier- liftIO $ case (key, mod) of- ("plus", [Shift,Control]) -> webViewZoomIn webView >> return True- ("minus",[Control]) -> webViewZoomOut webView >> return True- ("BackSpace", []) -> webViewGoBack webView >> return True- _ -> return False- return (Just docs, map ConnectC [cid1, cid2])-#else- return (Just docs, [])-#endif+ cid2 <- ConnectC webView <$> onWidgetKeyPressEvent webView (\e -> do+ key <- getEventKeyKeyval e >>= keyvalName+ mod <- getEventKeyState e+ case (key, mod) of+ (Just "plus", [ModifierTypeShiftMask,ModifierTypeControlMask]) -> do+ zoom <- getWebViewZoomLevel webView+ setWebViewZoomLevel webView (zoom * 1.25)+ return True+ (Just "minus",[ModifierTypeControlMask]) -> do+ zoom <- getWebViewZoomLevel webView+ setWebViewZoomLevel webView (zoom * 0.8)+ return True+ (Just "BackSpace", []) -> webViewGoBack webView >> return True+ _ -> return False)+ return (Just docs, [cid1, cid2]) getDocumentation :: Maybe PanePath -> IDEM IDEDocumentation@@ -140,21 +130,13 @@ loadDoc :: Text -> IDEAction loadDoc uri =-#ifdef WEBKITGTK do doc <- getDocumentation Nothing let view = webView doc- liftIO $ webViewLoadUri view uri-#else- return ()-#endif+ webViewLoadUri view uri reloadDoc :: IDEAction reloadDoc =-#ifdef WEBKITGTK do doc <- getDocumentation Nothing let view = webView doc- liftIO $ webViewReload view-#else- return ()-#endif+ webViewReload view
src/IDE/Pane/WebKit/Inspect.hs view
@@ -27,11 +27,6 @@ import Graphics.UI.Frame.Panes (RecoverablePane(..), PanePath, RecoverablePane, Pane(..))-import Graphics.UI.Gtk- (scrolledWindowSetShadowType, entryGetText, entryActivated,- boxPackStart, entrySetText, Entry, VBox, entryNew, vBoxNew,- postGUISync, scrolledWindowSetPolicy, scrolledWindowNew,- castToWidget, ScrolledWindow) import IDE.Utils.GUIUtils import Data.Typeable (Typeable) import IDE.Core.Types (IDEAction, IDEM, IDE(..))@@ -39,48 +34,38 @@ import Graphics.UI.Frame.ViewFrame (getNotebook) import IDE.Core.State (modifyIDE_, postSyncIDE, reifyIDE, leksahOrPackageDir)-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), Packing(..), PolicyType(..))--#ifdef WEBKITGTK-import Graphics.UI.Gtk- (toggleActionActive, castToMenuItem, actionCreateMenuItem,- toggleActionNew, menuShellAppend, toggleActionSetActive,- menuItemActivate, menuItemNewWithLabel, eventModifier,- eventKeyName, keyPressEvent, focusInEvent, containerAdd,- Modifier(..), after)-import Graphics.UI.Gtk.WebKit.Types (WebView(..))-import Graphics.UI.Gtk.WebKit.WebView- (populatePopup, webViewGoBack, webViewZoomOut, webViewZoomIn,- webViewLoadString, webViewZoomLevel, webViewReload, webViewNew,- webViewLoadUri)-import System.Glib.Attributes (AttrOp(..), set, get)-import System.Glib.Signals (on) import IDE.Core.State (reflectIDE) import Graphics.UI.Editor.Basics (Connection(..)) import Text.Show.Pretty (HtmlOpts(..), defaultHtmlOpts, valToHtmlPage, parseValue, getDataDir) import System.FilePath ((</>))-#endif import Data.IORef (writeIORef, newIORef, readIORef, IORef) import Control.Applicative ((<$>)) import System.Log.Logger (debugM)-import Graphics.UI.Gtk.WebKit.WebView- (webViewSetWebSettings, webViewGetWebSettings, loadCommitted,- webViewGetUri)-import Graphics.UI.Gtk.WebKit.WebFrame (webFrameGetUri) import Data.Text (Text) import qualified Data.Text as T (unpack, pack)-import Graphics.UI.Gtk.WebKit.WebSettings- (webSettingsMonospaceFontFamily)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+#ifdef MIN_VERSION_gi_webkit2+import GI.WebKit2.Objects.WebView+ (setWebViewSettings, webViewGetSettings, webViewNew, WebView(..))+import GI.WebKit2.Objects.Settings+ (settingsSetMonospaceFontFamily)+#else+import GI.WebKit.Objects.WebView+ (setWebViewSettings, getWebViewSettings, webViewNew, WebView(..))+import GI.WebKit.Objects.WebSettings+ (setWebSettingsMonospaceFontFamily)+#endif+import GI.Gtk.Objects.Widget (afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Enums (PolicyType(..), ShadowType(..))+import GI.Gtk.Objects.Container (containerAdd) data IDEInspect = IDEInspect { scrollWin :: ScrolledWindow-#ifdef WEBKITGTK , inspectView :: WebView-#else- , inspectState :: IORef InspectState-#endif } deriving Typeable data InspectState = InspectState {@@ -90,55 +75,38 @@ where primPaneName _ = "Inspect" getAddedIndex _ = 0- getTopWidget = castToWidget . scrollWin+ getTopWidget = liftIO . toWidget . scrollWin paneId b = "*Inspect" instance RecoverablePane IDEInspect InspectState IDEM where- saveState p = liftIO $-#ifdef WEBKITGTK- return (Just InspectState{})-#else- Just <$> readIORef (inspectState p)-#endif+ saveState p = return (Just InspectState{}) recoverState pp InspectState {} = do- nb <- getNotebook pp- mbPane <- buildPane pp nb builder- case mbPane of- Nothing -> return ()- Just p -> liftIO $-#ifdef WEBKITGTK- return ()-#else- writeIORef (inspectState p) InspectState {..}-#endif- return mbPane+ nb <- getNotebook pp+ buildPane pp nb builder builder pp nb windows = reifyIDE $ \ ideR -> do- scrollWin <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrollWin ShadowIn+ scrollWin <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrollWin ShadowTypeIn -#ifdef WEBKITGTK inspectView <- webViewNew- settings <- webViewGetWebSettings inspectView- settings `set` [webSettingsMonospaceFontFamily := ("Consolas" :: Text)]- webViewSetWebSettings inspectView settings- alwaysHtmlRef <- newIORef False- containerAdd scrollWin inspectView+#ifdef MIN_VERSION_gi_webkit2+ settings <- webViewGetSettings inspectView+ settingsSetMonospaceFontFamily settings "Consolas" #else- inspectState <- newIORef InspectState {}+ settings <- getWebViewSettings inspectView+ setWebSettingsMonospaceFontFamily settings "Consolas" #endif+ setWebViewSettings inspectView settings+ alwaysHtmlRef <- newIORef False+ containerAdd scrollWin inspectView - scrolledWindowSetPolicy scrollWin PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrollWin PolicyTypeAutomatic PolicyTypeAutomatic let inspect = IDEInspect {..} -#ifdef WEBKITGTK- cid1 <- after inspectView focusInEvent $ do+ cid1 <- ConnectC inspectView <$> afterWidgetFocusInEvent inspectView ( \e -> do liftIO $ reflectIDE (makeActive inspect) ideR- return True+ return True) - return (Just inspect, [ConnectC cid1])-#else- return (Just inspect, [])-#endif+ return (Just inspect, [cid1]) getInspectPane :: Maybe PanePath -> IDEM IDEInspect
src/IDE/Pane/WebKit/Output.hs view
@@ -29,11 +29,6 @@ import Graphics.UI.Frame.Panes (RecoverablePane(..), PanePath, RecoverablePane, Pane(..))-import Graphics.UI.Gtk- (scrolledWindowSetShadowType, entryGetText, entryActivated,- boxPackStart, entrySetText, Entry, VBox, entryNew, vBoxNew,- postGUISync, scrolledWindowSetPolicy, scrolledWindowNew,- castToWidget, ScrolledWindow) import IDE.Utils.GUIUtils import Data.Typeable (Typeable) import IDE.Core.Types (IDEAction, IDEM, IDE(..))@@ -41,56 +36,71 @@ import Graphics.UI.Frame.ViewFrame (getNotebook) import IDE.Core.State (modifyIDE_, postSyncIDE, reifyIDE, leksahOrPackageDir)-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), Packing(..), PolicyType(..))--#ifdef WEBKITGTK-import Graphics.UI.Gtk- (toggleActionActive, castToMenuItem, actionCreateMenuItem,- toggleActionNew, menuShellAppend, toggleActionSetActive,- menuItemActivate, menuItemNewWithLabel, eventModifier,- eventKeyName, keyPressEvent, focusInEvent, containerAdd,- Modifier(..), after)-import Graphics.UI.Gtk.WebKit.Types (WebView(..))-import Graphics.UI.Gtk.WebKit.WebView- (populatePopup, webViewGoBack, webViewZoomOut, webViewZoomIn,- webViewLoadString, webViewZoomLevel, webViewReload, webViewNew,- webViewLoadUri)-import System.Glib.Attributes (AttrOp(..), set, get)-import System.Glib.Signals (on) import IDE.Core.State (reflectIDE) import Graphics.UI.Editor.Basics (Connection(..)) import Text.Show.Pretty (HtmlOpts(..), defaultHtmlOpts, valToHtmlPage, parseValue, getDataDir) import System.FilePath ((</>)) import IDE.Pane.WebKit.Inspect (getInspectPane, IDEInspect(..))-import Graphics.UI.Gtk.WebKit.WebSettings- (webSettingsEnableDeveloperExtras)-import Graphics.UI.Gtk.WebKit.WebInspector (inspectWebView)-#endif import Data.IORef (writeIORef, newIORef, readIORef, IORef) import Control.Applicative ((<$>)) import System.Log.Logger (debugM)-import Graphics.UI.Gtk.WebKit.WebView- (webViewSetWebSettings, webViewGetWebSettings, webViewGetInspector,- loadCommitted, webViewGetUri)-import Graphics.UI.Gtk.WebKit.WebFrame (webFrameGetUri) import Data.Text (Text) import qualified Data.Text as T (unpack, pack)+import GI.Gtk.Objects.Box (boxNew, Box(..))+import GI.Gtk.Objects.Entry+ (entryGetText, onEntryActivate, entrySetText, entryNew, Entry(..))+#ifdef MIN_VERSION_gi_webkit2+import GI.WebKit2.Objects.WebView+ (webViewReload, webViewGetUri, webViewLoadHtml,+ webViewGetInspector, setWebViewSettings, webViewGetSettings,+ onWebViewLoadChanged, webViewLoadUri, onWebViewContextMenu,+ webViewGoBack, webViewNew,+ setWebViewZoomLevel, getWebViewZoomLevel, WebView(..))+import GI.WebKit2.Objects.Settings+ (settingsSetEnableDeveloperExtras)+#else+import GI.WebKit.Objects.WebView+ (webViewReload, webViewGetUri, webViewLoadString,+ webViewGetInspector, setWebViewSettings, getWebViewSettings,+ onWebViewLoadCommitted, webViewLoadUri, onWebViewPopulatePopup,+ webViewGoBack, webViewZoomOut, webViewZoomIn, webViewNew,+ setWebViewZoomLevel, getWebViewZoomLevel, WebView(..))+import GI.WebKit.Objects.WebFrame (webFrameGetUri)+import GI.WebKit.Objects.WebSettings+ (setWebSettingsEnableDeveloperExtras)+import GI.WebKit.Objects.WebInspector+ (onWebInspectorInspectWebView)+#endif+import GI.Gtk.Objects.Widget+ (onWidgetKeyPressEvent, afterWidgetFocusInEvent, toWidget)+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Enums (PolicyType(..), ShadowType(..), Orientation(..))+import Graphics.UI.Editor.Parameters (Packing(..), boxPackStart')+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gdk (getEventKeyState, getEventKeyKeyval, keyvalName)+import GI.Gdk.Flags (ModifierType(..))+import GI.Gtk.Objects.ToggleAction+ (setToggleActionActive, toggleActionNew)+import GI.Gtk.Objects.Action (actionCreateMenuItem)+import GI.Gtk.Objects.MenuItem+ (MenuItem(..), onMenuItemActivate, toMenuItem)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import Data.GI.Base.ManagedPtr (unsafeCastTo) data IDEOutput = IDEOutput {- vbox :: VBox+ vbox :: Box , uriEntry :: Entry-#ifdef WEBKITGTK , webView :: WebView , alwaysHtmlRef :: IORef Bool-#else- , outState :: IORef OutputState-#endif+-- , outState :: IORef OutputState } deriving Typeable data OutputState = OutputState {- zoom :: Float+ zoom :: Double , alwaysHtml :: Bool } deriving(Eq,Ord,Read,Show,Typeable) @@ -98,107 +108,113 @@ where primPaneName _ = "Out" getAddedIndex _ = 0- getTopWidget = castToWidget . vbox+ getTopWidget = liftIO . toWidget . vbox paneId b = "*Out" instance RecoverablePane IDEOutput OutputState IDEM where- saveState p = liftIO $-#ifdef WEBKITGTK- do zoom <- webView p `get` webViewZoomLevel- alwaysHtml <- readIORef $ alwaysHtmlRef p- return (Just OutputState{..})-#else- Just <$> readIORef (outState p)-#endif- recoverState pp OutputState {..} = do- nb <- getNotebook pp+ saveState p = do+ zoom <- fmap realToFrac <$> getWebViewZoomLevel $ webView p+ alwaysHtml <- liftIO . readIORef $ alwaysHtmlRef p+ return (Just OutputState{..})+ recoverState pp OutputState {..} = do+ nb <- getNotebook pp mbPane <- buildPane pp nb builder case mbPane of Nothing -> return ()- Just p -> liftIO $-#ifdef WEBKITGTK- do webView p `set` [webViewZoomLevel := zoom]- writeIORef (alwaysHtmlRef p) alwaysHtml-#else- writeIORef (outState p) OutputState {..}-#endif+ Just p -> do+ setWebViewZoomLevel (webView p) (realToFrac zoom)+ liftIO $ writeIORef (alwaysHtmlRef p) alwaysHtml return mbPane builder pp nb windows = reifyIDE $ \ ideR -> do- vbox <- vBoxNew False 0+ vbox <- boxNew OrientationVertical 0 uriEntry <- entryNew- entrySetText uriEntry ("http://" :: Text)- scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn- boxPackStart vbox uriEntry PackNatural 0- boxPackStart vbox scrolledView PackGrow 0+ entrySetText uriEntry "http://"+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn+ boxPackStart' vbox uriEntry PackNatural 0+ boxPackStart' vbox scrolledView PackGrow 0 -#ifdef WEBKITGTK webView <- webViewNew alwaysHtmlRef <- newIORef False containerAdd scrolledView webView-#else- outState <- newIORef OutputState {zoom = 1.0}-#endif - scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic let out = IDEOutput {..} -#ifdef WEBKITGTK- cid1 <- after webView focusInEvent $ do+ cid1 <- ConnectC webView <$> afterWidgetFocusInEvent webView (\e -> do liftIO $ reflectIDE (makeActive out) ideR- return True+ return True) -- webView `set` [webViewZoomLevel := 2.0]- cid2 <- on webView keyPressEvent $ do- key <- eventKeyName- mod <- eventModifier- liftIO $ case (key, mod) of- ("plus", [Shift,Control]) -> webViewZoomIn webView >> return True- ("minus",[Control]) -> webViewZoomOut webView >> return True- ("BackSpace", [Shift]) -> webViewGoBack webView >> return True- _ -> return False+ cid2 <- ConnectC webView <$> onWidgetKeyPressEvent webView (\e -> do+ key <- getEventKeyKeyval e >>= keyvalName+ mod <- getEventKeyState e+ case (key, mod) of+ (Just "plus", [ModifierTypeShiftMask,ModifierTypeControlMask]) -> do+ zoom <- getWebViewZoomLevel webView+ setWebViewZoomLevel webView (zoom * 1.25)+ return True+ (Just "minus",[ModifierTypeControlMask]) -> do+ zoom <- getWebViewZoomLevel webView+ setWebViewZoomLevel webView (zoom * 0.8)+ return True+ (Just "BackSpace", [ModifierTypeShiftMask]) -> webViewGoBack webView >> return True+ _ -> return False) - cid3 <- on webView populatePopup $ \ menu -> do+ -- TODO+#ifndef MIN_VERSION_gi_webkit2+ cid3 <- ConnectC webView <$> onWebViewPopulatePopup webView (\ menu -> do alwaysHtml <- readIORef alwaysHtmlRef- action <- toggleActionNew "AlwaysHTML" (__"Always HTML") Nothing Nothing- item <- castToMenuItem <$> actionCreateMenuItem action- item `on` menuItemActivate $ writeIORef alwaysHtmlRef $ not alwaysHtml- toggleActionSetActive action alwaysHtml+ action <- toggleActionNew "AlwaysHTML" (Just $ __"Always HTML") Nothing Nothing+ item <- actionCreateMenuItem action >>= unsafeCastTo MenuItem+ onMenuItemActivate item $ writeIORef alwaysHtmlRef $ not alwaysHtml+ setToggleActionActive action alwaysHtml menuShellAppend menu item- return ()+ return ())+#endif - cid4 <- on uriEntry entryActivated $ do+ cid4 <- ConnectC uriEntry <$> onEntryActivate uriEntry (do uri <- entryGetText uriEntry webViewLoadUri webView uri- (`reflectIDE` ideR) $ modifyIDE_ (\ide -> ide {autoURI = Just uri})+ (`reflectIDE` ideR) $ modifyIDE_ (\ide -> ide {autoURI = Just uri})) - cid5 <- on webView loadCommitted $ \ frame -> do- mbUri <- webFrameGetUri frame+#ifndef MIN_VERSION_gi_webkit2+ cid5 <- ConnectC webView <$> onWebViewLoadCommitted webView (\ frame -> do+ uri <- webFrameGetUri frame valueUri <- getValueUri- case mbUri of- Just uri | uri /= valueUri -> do+ if uri /= valueUri+ then do entrySetText uriEntry uri (`reflectIDE` ideR) $ modifyIDE_ (\ide -> ide {autoURI = Just uri})- Just _ -> do- (`reflectIDE` ideR) $ modifyIDE_ (\ide -> ide {autoURI = Nothing})- Nothing -> return ()+ else+ (`reflectIDE` ideR) $ modifyIDE_ (\ide -> ide {autoURI = Nothing}))+#endif - cid6 <- uriEntry `after` focusInEvent $ do+ cid6 <- ConnectC uriEntry <$> afterWidgetFocusInEvent uriEntry (\e -> do liftIO $ reflectIDE (makeActive out) ideR- return True+ return True) - settings <- webViewGetWebSettings webView- settings `set` [webSettingsEnableDeveloperExtras := True]- webViewSetWebSettings webView settings+#ifdef MIN_VERSION_gi_webkit2+ settings <- webViewGetSettings webView+ settingsSetEnableDeveloperExtras settings True+#else+ settings <- getWebViewSettings webView+ setWebSettingsEnableDeveloperExtras settings True+#endif+ setWebViewSettings webView settings inspector <- webViewGetInspector webView- cid7 <- on inspector inspectWebView $ \view -> (`reflectIDE` ideR) $ do++#ifndef MIN_VERSION_gi_webkit2+ cid7 <- ConnectC inspector <$> onWebInspectorInspectWebView inspector (\view -> (`reflectIDE` ideR) $ do inspectPane <- getInspectPane Nothing displayPane inspectPane False- return $ inspectView inspectPane+ return $ inspectView inspectPane)+#endif - return (Just out, [ConnectC cid1, ConnectC cid2, ConnectC cid3, ConnectC cid4, ConnectC cid5, ConnectC cid6])+#ifdef MIN_VERSION_gi_webkit2+ return (Just out, [cid1, cid2, cid4, cid6]) #else- return (Just out, [])+ return (Just out, [cid1, cid2, cid3, cid4, cid5, cid6, cid7]) #endif @@ -206,9 +222,9 @@ getOutputPane Nothing = forceGetPane (Right "*Out") getOutputPane (Just pp) = forceGetPane (Left pp) -getValueUri :: IO Text+getValueUri :: MonadIO m => m Text getValueUri = do- dataDir <- map fixSep <$> leksahOrPackageDir "pretty-show" getDataDir+ dataDir <- liftIO $ map fixSep <$> leksahOrPackageDir "pretty-show" getDataDir return . T.pack $ "file://" ++ (case dataDir of ('/':_) -> dataDir@@ -220,33 +236,27 @@ setOutput :: Text -> Text -> IDEAction setOutput command str =-#ifdef WEBKITGTK do out <- getOutputPane Nothing- liftIO $ do- entrySetText (uriEntry out) (T.pack $ show command)- uri <- getValueUri- alwaysHtml <- readIORef $ alwaysHtmlRef out- let view = webView out- html = case (alwaysHtml, parseValue $ T.unpack str) of- (False, Just value) -> T.pack $ valToHtmlPage defaultHtmlOpts value- _ -> str- webViewLoadString view html Nothing uri+ entrySetText (uriEntry out) (T.pack $ show command)+ uri <- getValueUri+ alwaysHtml <- liftIO . readIORef $ alwaysHtmlRef out+ let view = webView out+ html = case (alwaysHtml, parseValue $ T.unpack str) of+ (False, Just value) -> T.pack $ valToHtmlPage defaultHtmlOpts value+ _ -> str+#ifdef MIN_VERSION_gi_webkit2+ webViewLoadHtml view html (Just uri) #else- return ()+ webViewLoadString view html "text/html" "UTF-8" uri #endif loadOutputUri :: FilePath -> IDEAction loadOutputUri uri =-#ifdef WEBKITGTK do out <- getOutputPane Nothing let view = webView out- liftIO $ do- entrySetText (uriEntry out) (T.pack uri)- currentUri <- webViewGetUri view- if Just (T.pack uri) == currentUri- then webViewReload view- else webViewLoadUri view (T.pack uri)-#else- return ()-#endif+ entrySetText (uriEntry out) (T.pack uri)+ currentUri <- webViewGetUri view+ if Just (T.pack uri) == currentUri+ then webViewReload view+ else webViewLoadUri view (T.pack uri)
src/IDE/Pane/Workspace.hs view
@@ -5,6 +5,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Workspace@@ -22,7 +24,7 @@ module IDE.Pane.Workspace ( WorkspaceState(..)-, WorkspacePane+, WorkspacePane(..) , getWorkspacePane , showWorkspacePane , refreshWorkspacePane@@ -30,40 +32,22 @@ ) where import Prelude hiding (catch)-import Graphics.UI.Gtk- (treeSelectionSelectIter, treeStoreLookup,- cellLayoutSetAttributeFunc, treeViewRowActivated, treeStoreClear,- treeModelGetIterFirst, treeViewLevelIndentation,- treeViewShowExpanders, treeViewCollapseRow, treeViewExpandRow,- treeSelectionUnselectAll, cellLayoutPackEnd, cellTextMarkup,- cellPixbufStockId, scrolledWindowSetShadowType,- treeSelectionSelectionChanged, treeStoreRemove, treeModelIterNext,- treeModelGetRow, treeStoreInsert, treeModelIterNthChild,- treeModelGetPath, TreeIter, treeModelGetIter, TreePath,- treeSelectionGetSelectedRows, rowActivated, treeStoreGetValue,- rowExpanded, on, after, focusInEvent, scrolledWindowSetPolicy,- containerAdd, scrolledWindowNew, treeSelectionSetMode,- treeViewGetSelection, treeViewSetHeadersVisible, cellText,- cellLayoutSetAttributes, cellLayoutPackStart, treeViewAppendColumn,- treeViewColumnSetReorderable, treeViewColumnSetResizable,- treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,- cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,- treeViewNew, treeStoreNew, castToWidget, TreeStore, TreeView,- ScrolledWindow, treeViewRowExpanded, treeStoreGetTree, Menu(..),- MenuItem(..), treeStoreSetValue) import Data.Maybe- (fromJust, fromMaybe, maybeToList, listToMaybe, isJust)+ (fromJust, fromMaybe, maybeToList, listToMaybe, isJust, isNothing) import Control.Monad (forM, void, when)-import Data.Foldable (forM_)+import Data.Foldable (forM_, for_) import Data.Typeable (Typeable) import IDE.Core.State- (catchIDE, window, getIDE, MessageLevel(..), ipdPackageId,+ (onIDE, catchIDE, window, getIDE, MessageLevel(..), ipdPackageId, wsPackages, workspace, readIDE, IDEAction, ideMessage, reflectIDE,- reifyIDE, IDEM, IDEPackage, ipdSandboxSources)-import IDE.Pane.SourceBuffer (fileNew, goToSourceDefinition')-import IDE.Sandbox+ reifyIDE, IDEM, IDEPackage)+import IDE.Pane.SourceBuffer+ (selectSourceBuf, fileNew, goToSourceDefinition') import Control.Applicative ((<$>))-import System.FilePath ((</>), takeFileName, dropFileName)+import System.FilePath+ ((</>), takeFileName, dropFileName,+ addTrailingPathSeparator, takeDirectory, takeExtension,+ makeRelative, splitDirectories) import Distribution.Package (PackageIdentifier(..)) import System.Directory (removeDirectoryRecursive, removeDirectory, createDirectory,@@ -72,13 +56,10 @@ import IDE.Core.CTypes (Location(..), packageIdentifierToString) import Graphics.UI.Frame.Panes- (RecoverablePane(..), PanePath, RecoverablePane, Pane(..))+ (PaneMonad(..), RecoverablePane(..), PanePath, RecoverablePane,+ Pane(..)) import Graphics.UI.Frame.ViewFrame (getMainWindow, getNotebook) import Graphics.UI.Editor.Basics (Connection(..))-import Graphics.UI.Gtk.General.Enums- (ShadowType(..), PolicyType(..), SelectionMode(..),- TreeViewColumnSizing(..))-import System.Glib.Attributes (set, AttrOp(..)) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (showErrorDialog, showInputDialog, treeViewContextMenu', __,@@ -89,35 +70,84 @@ (isPrefixOf, words, isSuffixOf, unpack, pack) import Data.Monoid ((<>)) import IDE.Core.Types- (ipdLib, WorkspaceAction, Workspace(..), wsAllPackages, WorkspaceM,- runPackage, runWorkspace, PackageAction, PackageM, IDEPackage(..),- IDE(..), Prefs(..), MonadIDE(..), ipdPackageDir)-import System.Glib.Properties (newAttrFromMaybeStringProperty)-import System.FilePath- (addTrailingPathSeparator, takeDirectory, takeExtension,- makeRelative, splitDirectories)+ (pjLookupPackage, wsLookupProject, pjPackages, activeComponent,+ activePack, activeProject, Project(..), ipdLib, WorkspaceAction,+ Workspace(..), wsAllPackages, WorkspaceM, runPackage, runProject,+ runWorkspace, PackageAction, PackageM, ProjectAction, ProjectM,+ IDEPackage(..), IDE(..), Prefs(..), MonadIDE(..), ipdPackageDir) import Control.Monad.Reader.Class (MonadReader(..)) import IDE.Workspaces- (makePackage, workspaceAddPackage', workspaceRemovePackage,- workspaceActivatePackage, workspaceTry, workspaceTryQuiet,- packageTry)+ (workspaceOpen, makePackage, projectAddPackage', workspaceRemoveProject,+ projectRemovePackage, workspaceActivatePackage, workspaceTry,+ workspaceTryQuiet, packageTry) import Data.List- (isSuffixOf, find, stripPrefix, isPrefixOf, sortBy, sort)+ (sortOn, isSuffixOf, find, stripPrefix, isPrefixOf, sortBy, sort) import Data.Ord (comparing) import Data.Char (toUpper, toLower)-import System.Log.Logger (debugM)+import System.Log.Logger (errorM, debugM) import Data.Tree (Forest, Tree(..))-import Graphics.UI.Gtk.MenuComboToolbar.MenuItem- (menuItemActivate, menuItemNewWithLabel) import IDE.Pane.Modules (addModule)-import Graphics.UI.Gtk.Windows.MessageDialog- (ButtonsType(..), MessageType(..), messageDialogNew)-import Graphics.UI.Gtk.ModelView.CellRenderer- (CellRendererMode(..), cellMode)-import IDE.Pane.PackageEditor (packageEditText)-import IDE.Utils.GtkBindings (treeViewSetActiveOnSingleClick)-import IDE.Package (packageTest, packageRun, packageClean)+import IDE.Pane.PackageEditor (packageEditText, projectEditText)+import IDE.Package (packageTest, packageRun, packageClean,packageBench) import Control.Monad.Trans.Class (MonadTrans(..))+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreGetTree, forestStoreGetValue, ForestStore(..),+ forestStoreRemove, forestStoreInsert, forestStoreSetValue,+ forestStoreClear, forestStoreNew)+import GI.Gtk.Structs.TreeIter (treeIterCopy, TreeIter(..))+import Data.GI.Gtk.ModelView.TreeModel+ (treeModelIterNext, treeModelIterNthChild, treeModelGetIter,+ treeModelGetPath)+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import GI.Gtk.Objects.ScrolledWindow+ (scrolledWindowSetPolicy, scrolledWindowSetShadowType,+ scrolledWindowNew, ScrolledWindow(..))+import GI.Gtk.Objects.TextView+ (textViewSetEditable, textViewNew, TextView(..))+import GI.Pango.Structs.FontDescription+ (fontDescriptionSetFamily, fontDescriptionNew,+ fontDescriptionFromString)+import GI.Gtk.Objects.TreeView+ (treeViewRowExpanded, onTreeViewRowActivated,+ onTreeViewRowExpanded, treeViewGetSelection,+ treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,+ treeViewNew, TreeView(..))+import GI.Gtk.Objects.Widget+ (widgetHide, widgetShowAll, afterWidgetFocusInEvent, toWidget,+ widgetOverrideFont)+import GI.Gtk.Objects.TreeViewColumn+ (treeViewColumnSetReorderable, treeViewColumnSetResizable,+ treeViewColumnSetSizing, treeViewColumnNew)+import GI.Gtk.Enums+ (PackType(..), PackType, Orientation(..), MessageType(..),+ PolicyType(..), ShadowType(..), TreeViewColumnSizing(..))+import GI.Gtk.Objects.CellRendererPixbuf+ (setCellRendererPixbufStockId, cellRendererPixbufNew)+import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)+import Data.GI.Base (set)+import Data.GI.Gtk.ModelView.CellLayout+ (cellLayoutSetDataFunc', cellLayoutSetDataFunction)+import GI.Gtk.Objects.CellRendererText+ (setCellRendererTextMarkup, cellRendererTextNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerRemove, containerAdd)+import Data.GI.Gtk.ModelView.CustomStore+ (customStoreGetRow)+import Data.Int (Int32)+import Data.GI.Gtk.ModelView.Types+ (treePathGetIndices', treePathNewFromIndices')+import VCSWrapper.Git.Safe as Git+import GI.Gtk.Objects.Box+ (boxSetChildPacking, boxPackStart, boxNew, Box(..))+import Data.GI.Base.GObject (new')+import GI.Gtk.Objects.Label (Label(..), labelNew)+import Graphics.UI.Editor.Parameters (Packing(..), boxPackStart')+import GI.Gtk.Objects.LinkButton+ (onLinkButtonActivateLink, linkButtonNewWithLabel, LinkButton(..),+ linkButtonNew)+import Data.GI.Base.Signals (SignalHandlerId)+import GI.Gtk (treeViewExpandRow) -- | The data for a single record in the Workspace Pane@@ -125,12 +155,12 @@ FileRecord FilePath | DirRecord FilePath Bool -- Whether it is a source directory- | PackageRecord IDEPackage- | AddSourcesRecord- | AddSourceRecord IDEPackage+ | ProjectRecord FilePath+ | PackageRecord FilePath | ComponentsRecord | ComponentRecord Text- deriving (Eq)+ | GitRecord+ deriving (Eq, Show) instance Ord WorkspaceRecord where -- | The ordering used for displaying the records@@ -138,114 +168,166 @@ compare (FileRecord _) (DirRecord _ _) = GT compare (FileRecord p1) (FileRecord p2) = comparing (map toLower) p1 p2 compare (DirRecord p1 _) (DirRecord p2 _) = comparing (map toLower) p1 p2- compare (PackageRecord p1) (PackageRecord p2) = comparing (map toLower . ipdPackageDir) p1 p2- compare (AddSourceRecord p1) (AddSourceRecord p2) = comparing (map toLower . ipdPackageDir) p1 p2+ compare (ProjectRecord p1) (ProjectRecord p2) = comparing (map toLower) p1 p2+ compare (PackageRecord p1) (PackageRecord p2) = comparing (map toLower) p1 p2 compare (ComponentRecord t1) (ComponentRecord t2) = comparing (map toLower . T.unpack) t1 t2 compare _ _ = LT -- | The markup to show for a record toMarkup :: WorkspaceRecord- -> IDEPackage+ -> (Maybe Project, Maybe IDEPackage) -> IDEM Text-toMarkup record pkg = do- mbActivePackage <- readIDE activePack- mbActiveComponent <- readIDE activeExe+toMarkup record (mbProject, mbPackage) =+ readIDE workspace >>= \case+ Nothing -> return "Error Workspace Closed"+ Just ws -> do+ mbActiveProject <- readIDE activeProject+ mbActivePackage <- readIDE activePack+ mbActiveComponent <- readIDE activeComponent - return . size $ case record of- (PackageRecord p) ->- let active = Just pkg == mbActivePackage- pkgText = (if active then bold else id)- (packageIdentifierToString (ipdPackageId p))- mbLib = ipdLib p- componentText = if active- then maybe (if isJust mbLib then "(library)" else "")- (\comp -> "(" <> comp <> ")") mbActiveComponent- else ""- pkgDir = gray . T.pack $ ipdPackageDir p- in (pkgText <> " " <> componentText <> " " <> pkgDir)- (FileRecord f) -> T.pack $ takeFileName f- (DirRecord f _) | ipdPackageDir pkg == f -> "Files"- | otherwise -> T.pack $ last (splitDirectories f)- AddSourcesRecord -> "Source Dependencies"- (AddSourceRecord p) -> do- let pkgText = packageIdentifierToString (ipdPackageId p)- dirText = gray (T.pack (ipdPackageDir p))- pkgText <> " " <> dirText- ComponentsRecord -> "Components"- (ComponentRecord comp) -> do- let active = Just pkg == mbActivePackage &&- (mbActiveComponent == Nothing && comp == "library"- ||- Just comp == mbActiveComponent)- (if active then bold else id) comp- where- bold str = "<b>" <> str <> "</b>"- italic str = "<i>" <> str <> "</i>"- gray str = "<span foreground=\"#999999\">" <> str <> "</span>"- size str = "<span font=\"9\">" <> str <> "</span>"+ let worspaceRelative = makeRelative (dropFileName (wsFile ws))+ projectRelative =+ case mbProject of+ Just p -> makeRelative (dropFileName (pjFile p))+ Nothing -> id+ activeProject = (pjFile <$> mbProject) == (pjFile <$> mbActiveProject)+ activePackage = activeProject && (ipdCabalFile <$> mbPackage) == (ipdCabalFile <$> mbActivePackage) + case record of+ (ProjectRecord p) -> return $ (if activeProject then bold else id)+ (T.pack $ worspaceRelative p)+ (PackageRecord pFile) -> return $ case mbPackage of+ Nothing -> "Error package not found " <> T.pack pFile+ Just p ->+ let pkgText = (if activePackage then bold else id)+ (packageIdentifierToString (ipdPackageId p))+ mbLib = ipdLib p+ componentText = if activePackage+ then maybe (if isJust mbLib then "(library)" else "")+ (\comp -> "(" <> comp <> ")") mbActiveComponent+ else ""+ pkgDir = gray . T.pack . projectRelative $ ipdPackageDir p+ in (pkgText <> " " <> componentText <> " " <> pkgDir)+ (FileRecord f) -> return $ T.pack $ takeFileName f+ (DirRecord f _)+ | (ipdPackageDir <$> mbPackage) == Just f -> return "Files"+ | otherwise -> return $ T.pack $ last (splitDirectories f)+ ComponentsRecord -> return "Components"+ (ComponentRecord comp) -> do+ let active = activePackage &&+ (isNothing mbActiveComponent && comp == "library"+ ||+ Just comp == mbActiveComponent)+ return $ (if active then bold else id) comp+ GitRecord ->+ case ipdPackageDir <$> mbPackage of+ Nothing -> return "No Git project"+ Just dir -> do+ let conf = Git.makeConfig (Just dir) Nothing Nothing+ liftIO $ Git.runVcs conf $ do+ branch <- Git.localBranches+ case branch of+ (Right (branch,_)) -> return branch+ (Left _) -> return "No Git project"+ where+ bold str = "<b>" <> str <> "</b>"+ italic str = "<i>" <> str <> "</i>"+ gray str = "<span foreground=\"#999999\">" <> str <> "</span>" + -- | The icon to show for a record-toIcon :: WorkspaceRecord -> Maybe Text+toIcon :: WorkspaceRecord -> Text toIcon record = case record of FileRecord path- | takeExtension path == ".hs" -> Just "ide_source"- | takeExtension path == ".cabal" -> Just "ide_cabal_file"+ | takeExtension path == ".hs" -> "ide_source"+ | takeExtension path == ".cabal" -> "ide_cabal_file" DirRecord p isSrc- | isSrc -> Just "ide_source_folder"- | otherwise -> Just "ide_folder"- PackageRecord _ -> Just "ide_package"- ComponentsRecord -> Just "ide_component"- AddSourcesRecord -> Just "ide_source_dependency"- AddSourceRecord _ -> Just "ide_package"- _ -> Nothing+ | isSrc -> "ide_source_folder"+ | otherwise -> "ide_folder"+ ProjectRecord _ -> "ide_source_dependency"+ PackageRecord _ -> "ide_package"+ ComponentsRecord -> "ide_component"+ GitRecord -> "ide_git"+ _ -> "" -- | Gets the package to which a node in the tree belongs-iterToPackage :: TreeStore WorkspaceRecord -> TreeIter -> IDEM (Maybe IDEPackage)+iterToPackage :: ForestStore WorkspaceRecord -> TreeIter -> IDEM (Maybe Project, Maybe IDEPackage) iterToPackage store iter = do- path <- liftIO $ treeModelGetPath store iter+ path <- treeModelGetPath store iter treePathToPackage store path -- | Gets the package to which a node in the tree belongs-treePathToPackage :: TreeStore WorkspaceRecord -> TreePath -> IDEM (Maybe IDEPackage)-treePathToPackage store (n:_) = do- record <- liftIO $ treeStoreGetValue store [n]- case record of- (PackageRecord pkg) -> return (Just pkg)+treePathToPackage :: ForestStore WorkspaceRecord -> TreePath -> IDEM (Maybe Project, Maybe IDEPackage)+treePathToPackage store p = treePathGetIndices' p >>= treePathToPackage' store++treePathToPackage' :: ForestStore WorkspaceRecord -> [Int32] -> IDEM (Maybe Project, Maybe IDEPackage)+treePathToPackage' store (n1:n2:_) = do+ projectRecord <- forestStoreGetValue store =<< treePathNewFromIndices' [n1]+ packageRecord <- forestStoreGetValue store =<< treePathNewFromIndices' [n1,n2]+ case (projectRecord, packageRecord) of+ (ProjectRecord pjFile, PackageRecord pkgFile) -> readIDE workspace >>= \case+ Just ws -> case wsLookupProject pjFile ws of+ Just pj -> case pjLookupPackage pkgFile pj of+ Just pkg -> return (Just pj, Just pkg)+ _ -> do+ liftIO . errorM "leksah" $ "treePathToPackage: could not find pakcage " <> pkgFile+ return (Nothing, Nothing)+ _ -> do+ liftIO . errorM "leksah" $ "treePathToPackage: Could not find project " <> pjFile+ return (Nothing, Nothing)+ _ -> do+ liftIO $ errorM "leksah" "treePathToPackage: No workspace"+ return (Nothing, Nothing)+ _ -> do+ liftIO $ errorM "leksah" "treePathToPackage: Unexpected entry in forest"+ return (Nothing, Nothing)+treePathToPackage' store (n:_) =+ treePathNewFromIndices' [n] >>= forestStoreGetValue store >>= \case+ ProjectRecord pjFile -> readIDE workspace >>= \case+ Just ws -> case wsLookupProject pjFile ws of+ Just pj -> return (Just pj, Nothing)+ _ -> do+ liftIO . errorM "leksah" $ "treePathToPackage: Could not find project " <> pjFile+ return (Nothing, Nothing)+ _ -> do+ liftIO $ errorM "leksah" "treePathToPackage: No workspace"+ return (Nothing, Nothing) _ -> do liftIO $ debugM "leksah" "treePathToPackage: Unexpected entry at root forest"- return Nothing-treePathToPackage _ _ = do+ return (Nothing, Nothing)+treePathToPackage' _ _ = do liftIO $ debugM "leksah" "treePathToPackage is called with empty path"- return Nothing+ return (Nothing, Nothing) -- | Determines whether the 'WorkspaceRecord' can expand, i.e. whether -- it should get an expander.-canExpand :: WorkspaceRecord -> IDEPackage -> IDEM Bool-canExpand record pkg = case record of+canExpand :: WorkspaceRecord -> Project -> Maybe IDEPackage -> IDEM Bool+canExpand record pj mbPkg = case record of+ (ProjectRecord _) -> return False (PackageRecord _) -> return True (DirRecord fp _) -> do mbWs <- readIDE workspace case mbWs of- Just ws -> not . null <$> (flip runWorkspace ws . flip runPackage pkg $ dirRecords fp)+ Just ws -> not . null <$> ((`runWorkspace` ws) . (`runProject` pj) . (`runPackage` pkg) $ dirRecords fp) Nothing -> return False ComponentsRecord -> return . not . null $ components- AddSourcesRecord -> return . not . null $ ipdSandboxSources pkg- (AddSourceRecord _) -> return True _ -> return False where components = maybeToList (ipdLib pkg) ++ ipdExes pkg ++ ipdTests pkg ++ ipdBenchmarks pkg+ pkg = fromJust mbPkg -- Only for record trypes that should have a package (not ProjectRecord) -- * The Workspace pane -- | The representation of the Workspace pane data WorkspacePane = WorkspacePane {- scrolledView :: ScrolledWindow+ box :: Box+, scrolledView :: ScrolledWindow+, noWsText :: LinkButton , treeView :: TreeView-, recordStore :: TreeStore WorkspaceRecord+, recordStore :: ForestStore WorkspaceRecord } deriving Typeable @@ -257,87 +339,126 @@ instance Pane WorkspacePane IDEM where primPaneName _ = __ "Workspace" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = liftIO . toWidget . box paneId b = "*Workspace" instance RecoverablePane WorkspacePane WorkspaceState IDEM where saveState p = return (Just WorkspaceState)+ recoverState pp WorkspaceState = do nb <- getNotebook pp buildPane pp nb builder- builder pp nb windows = reifyIDE $ \ ideR -> do- recordStore <- treeStoreNew []- treeView <- treeViewNew- treeViewSetModel treeView recordStore + builder pp nb windows = do+ ideR <- ask+ recordStore <- forestStoreNew [] + -- Treeview+ treeView <- buildTreeView recordStore+ sigIds <- treeViewEvents recordStore treeView - col1 <- treeViewColumnNew- treeViewColumnSetSizing col1 TreeViewColumnAutosize+ -- Scrolled view+ scrolledView <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledView ShadowTypeIn+ scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic+ containerAdd scrolledView treeView++ -- "Open workspace" link+ noWsText <- linkButtonNewWithLabel "Open a workspace" (Just "Open a workspace")+ onLinkButtonActivateLink noWsText $ do+ reflectIDE workspaceOpen ideR+ return False++ -- Box, top-level widget of the pane+ box <- boxNew OrientationVertical 0+ boxPackStart box scrolledView False True 0+ boxPackStart box noWsText True True 0+ -- Calling refreshWorkspacePane here does not work+ -- since the GUI is not yet running. This created strange behaviour+ -- where the workspace was split evenly while only one of the+ -- widgets (ScrolledView/TreeView and Openworkspace link).+ -- Instead we initialize the packing of the TreeView to not expand+ -- and rely on the fact that refreshWorkspacePane is called+ -- by the WorkspaceChanged event, and the packing of the two+ -- widgets is changed there when swapping.+++ let wsPane = WorkspacePane {..}++ return (Just wsPane, sigIds)+++buildTreeView :: ForestStore WorkspaceRecord -> IDEM TreeView+buildTreeView recordStore = do+ treeView <- treeViewNew+ treeViewSetModel treeView (Just recordStore)++ col1 <- treeViewColumnNew+ treeViewColumnSetSizing col1 TreeViewColumnSizingAutosize treeViewColumnSetResizable col1 True treeViewColumnSetReorderable col1 True treeViewAppendColumn treeView col1 -- prefs <- reflectIDE (readIDE prefs) ideR+ prefs <- readIDE prefs when (showWorkspaceIcons prefs) $ do renderer2 <- cellRendererPixbufNew cellLayoutPackStart col1 renderer2 False- set renderer2 [ newAttrFromMaybeStringProperty "stock-id" := (Nothing :: Maybe Text) ]- cellLayoutSetAttributes col1 renderer2 recordStore- $ \record -> [ newAttrFromMaybeStringProperty "stock-id" := toIcon record]+ setCellRendererPixbufStockId renderer2 ""+ cellLayoutSetDataFunction col1 renderer2 recordStore+ $ setCellRendererPixbufStockId renderer2 . toIcon renderer1 <- cellRendererTextNew+ ideR <- ask cellLayoutPackStart col1 renderer1 True- cellLayoutSetAttributeFunc col1 renderer1 recordStore $ \iter -> do- record <- treeModelGetRow recordStore iter- mbPkg <- flip reflectIDE ideR $ iterToPackage recordStore iter- forM_ mbPkg $ \pkg -> do- -- The cellrenderer is stateful, so it knows which cell this markup will be for (the cell at iter)- markup <- flip reflectIDE ideR $ toMarkup record pkg- forM_ mbPkg $ \pkg -> set renderer1 [ cellTextMarkup := Just markup]+ cellLayoutSetDataFunc' col1 renderer1 recordStore $ \iter -> do+ record <- customStoreGetRow recordStore iter+ projAndPkg <- (`reflectIDE` ideR) $ iterToPackage recordStore iter+ -- The cellrenderer is stateful, so it knows which cell this markup will be for (the cell at iter)+ markup <- (`reflectIDE` ideR) $ toMarkup record projAndPkg+ setCellRendererTextMarkup renderer1 markup - -- treeViewSetActiveOnSingleClick treeView True+ -- set workspace font+ mbFd <- case workspaceFont prefs of+ (True, Just str) -> Just <$> fontDescriptionFromString str+ _ -> return Nothing+ widgetOverrideFont treeView mbFd++ -- treeViewSetActiveOnSingleClick treeView True treeViewSetHeadersVisible treeView False sel <- treeViewGetSelection treeView- -- treeSelectionSetMode sel SelectionSingle+ -- treeSelectionSetMode sel SelectionModeSingle - scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn- containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic+ return treeView - let wsPane = WorkspacePane {..} - cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive wsPane) ideR- return True-- on treeView rowExpanded $ \iter path -> do- record <- treeStoreGetValue recordStore path- mbPkg <- flip reflectIDE ideR $ iterToPackage recordStore iter- forM_ mbPkg $ \pkg -> do- flip reflectIDE ideR $ do- workspaceTryQuiet $ do- runPackage (refreshPackageTreeFrom recordStore treeView path) pkg+treeViewEvents :: ForestStore WorkspaceRecord -> TreeView -> IDEM [Connection]+treeViewEvents recordStore treeView = do+ ideR <- ask+ cid1 <- onTreeViewRowExpanded treeView $ \iter path -> do+ record <- forestStoreGetValue recordStore path+ (`reflectIDE` ideR) $ iterToPackage recordStore iter >>= \case+ (Just project, Just pkg) ->+ workspaceTryQuiet . (`runProject` project) $+ refreshPackageTreeFrom recordStore treeView path+ _ -> return () - on treeView rowActivated $ \path col -> do- record <- treeStoreGetValue recordStore path- mbPkg <- flip reflectIDE ideR $ treePathToPackage recordStore path- forM_ mbPkg $ \pkg -> do- expandable <- flip reflectIDE ideR $ canExpand record pkg+ cid2 <- onTreeViewRowActivated treeView $ \path col -> do+ record <- forestStoreGetValue recordStore path+ (`reflectIDE` ideR) $ treePathToPackage recordStore path >>= \case+ (Just project, mbPkg) -> do+ expandable <- canExpand record project mbPkg case record of- FileRecord f -> void . flip reflectIDE ideR $- goToSourceDefinition' f (Location "" 1 0 1 0)- ComponentRecord name -> flip reflectIDE ideR $ workspaceTryQuiet $- workspaceActivatePackage pkg (Just name)- _ -> when expandable $ do+ ProjectRecord project -> void $ selectSourceBuf project+ FileRecord f -> void $ goToSourceDefinition' f (Location "" 1 0 1 0)+ ComponentRecord name -> workspaceTryQuiet $+ workspaceActivatePackage project mbPkg (Just name)+ _ -> when expandable $ void $ treeViewToggleRow treeView path+ _ -> return () - (cid3, cid4) <- reflectIDE (treeViewContextMenu' treeView recordStore contextMenuItems) ideR- reflectIDE (refresh wsPane) ideR+ sigIds <- treeViewContextMenu' treeView recordStore contextMenuItems+ return $ sigIds <> map (ConnectC treeView) [cid1, cid2] - return (Just wsPane, map ConnectC [cid1, cid3, cid4]) -- | Get the Workspace pane getWorkspacePane :: IDEM WorkspacePane@@ -382,50 +503,72 @@ workspace <- getWorkspacePane refresh workspace --- | Needed when building the pane, since getWorkspacePane does not++-- | Seperately defined from refreshWorkspacePane, since getWorkspacePane does not -- work before the building is finished refresh :: WorkspacePane -> IDEAction-refresh pane = do- let store = recordStore pane- let view = treeView pane+refresh WorkspacePane{..} = do+ mbWs <- readIDE workspace - workspaceTryQuiet $ do- packages <- sort . wsPackages <$> ask- setChildren Nothing store view [] (map PackageRecord packages)+ -- Depending on if there is a workspace, show the tree or a message to open one+ case mbWs of+ Nothing -> do+ widgetHide scrolledView+ boxSetChildPacking box scrolledView False False 0 PackTypeStart+ widgetShowAll noWsText+ boxSetChildPacking box noWsText True True 0 PackTypeStart + Just ws -> do+ widgetHide noWsText+ boxSetChildPacking box noWsText False False 0 PackTypeStart+ widgetShowAll scrolledView+ boxSetChildPacking box scrolledView True True 0 PackTypeStart+ let projects = wsProjects ws+ forestStoreClear recordStore+ (`runWorkspace` ws) $ do+ path <- liftIO $ treePathNewFromIndices' []+ for_ (zip [0..] projects) $ \(n, project) -> do+ liftIO $ forestStoreInsert recordStore path n (ProjectRecord $ pjFile project)+ let packages = pjPackages project+ (`runProject` project) $ do+ path <- liftIO $ treePathNewFromIndices' [fromIntegral n]+ for_ (zip [0..] packages) $ \(nPkg, pkg) -> do+ liftIO $ forestStoreInsert recordStore path nPkg (PackageRecord $ ipdCabalFile pkg)+ children <- children (PackageRecord $ ipdCabalFile pkg) (Just pkg)+ lift $ setChildren (Just project) (Just pkg) recordStore treeView [fromIntegral n, fromIntegral nPkg] children+ treeViewExpandRow treeView path False --- | Mutates the 'TreeStore' with the given TreePath as root to attach new++-- | Mutates the 'ForestStore' with the given TreePath as root to attach new -- entries to. Walks the directory tree recursively when refreshing directories.-refreshPackageTreeFrom :: TreeStore WorkspaceRecord -> TreeView -> TreePath -> PackageAction+refreshPackageTreeFrom :: ForestStore WorkspaceRecord -> TreeView -> TreePath -> ProjectAction refreshPackageTreeFrom store view path = do- record <- liftIO $ treeStoreGetValue store path- Just pkg <- liftIDE $ treePathToPackage store path- expandable <- liftIDE $ canExpand record pkg+ record <- liftIO $ forestStoreGetValue store path+ (Just project, mbPkg) <- liftIDE $ treePathToPackage store path+ expandable <- liftIDE $ canExpand record project mbPkg - kids <- children record- lift $ setChildren (Just pkg) store view path kids+ kids <- children record mbPkg+ path' <- treePathGetIndices' path+ lift $ setChildren (Just project) mbPkg store view path' kids -- | Returns the children of the 'WorkspaceRecord'.-children :: WorkspaceRecord -> PackageM [WorkspaceRecord]-children record = case record of- DirRecord dir _ -> dirRecords dir- ComponentsRecord -> componentsRecords- AddSourcesRecord -> addSourcesRecords- AddSourceRecord pkg -> return []+children :: WorkspaceRecord -> Maybe IDEPackage -> ProjectM [WorkspaceRecord]+children record mbPkg = case record of+ DirRecord dir _ -> runPkg $ dirRecords dir+ ComponentsRecord -> runPkg componentsRecords+ ProjectRecord project ->+ readIDE workspace >>= \case+ Nothing -> return []+ Just ws -> return $ maybe [] (map (PackageRecord . ipdCabalFile) . pjPackages)+ $ wsLookupProject project ws PackageRecord pkg -> do- p <- ask+ p <- runPkg ask return [ ComponentsRecord- , AddSourcesRecord+ , GitRecord , DirRecord (ipdPackageDir p) False] _ -> return []----- | Gets the direct children, the add source dependencies-addSourcesRecords :: PackageM [WorkspaceRecord]-addSourcesRecords = do- pkg <- ask- return $ sort $ map AddSourceRecord (ipdSandboxSources pkg)-+ where+ runPkg = (`runPackage` fromJust mbPkg) -- | Returns the contents at the given 'FilePath' as 'WorkspaceRecord's. -- Runs in the PackageM monad to determine if directories are@@ -449,7 +592,7 @@ Just relativeToPackage -> do srcDirs <- ipdSrcDirs <$> ask return $ DirRecord full (relativeToPackage `elem` srcDirs)- Nothing -> do+ Nothing -> -- It's not a descendant of the package directory (e.g. in a source dependency) return $ DirRecord full False else return $ FileRecord full@@ -461,74 +604,88 @@ componentsRecords = do package <- ask mbActivePackage <- readIDE activePack- activeComponent <- readIDE activeExe+ activeComponent <- readIDE activeComponent - return $ sort $ map (\comp -> ComponentRecord comp) (components package)+ return $ sort $ map ComponentRecord (components package) where- components package = maybeToList (ipdLib package)- ++ ipdExes package- ++ ipdTests package- ++ ipdBenchmarks package-+ components package = map ("lib:"<>) (maybeToList (ipdLib package))+ ++ map ("exe:"<>) (ipdExes package)+ ++ map ("test:"<>) (ipdTests package)+ ++ map ("bench:"<>) (ipdBenchmarks package) -- | Recursively sets the children of the given 'TreePath' to the provided tree of 'WorkspaceRecord's. If a record -- is already present, it is kept in the same (expanded) state. -- If a the parent record is not expanded just makes sure at least one of--- the chldren is added.-setChildren :: Maybe IDEPackage -> TreeStore WorkspaceRecord -> TreeView -> TreePath -> [WorkspaceRecord] -> WorkspaceAction-setChildren _ store _ [] [] = liftIO $ treeStoreClear store-setChildren mbPkg store view parentPath kids = do+-- the children is added.+setChildren :: Maybe Project+ -> Maybe IDEPackage+ -> ForestStore WorkspaceRecord+ -> TreeView+ -> [Int32]+ -> [WorkspaceRecord] -> WorkspaceAction+setChildren _ _ store _ [] [] = liftIO $ forestStoreClear store+setChildren mbProject mbPkg store view parentPath kids = do+ ws <- ask -- We only need to get all the children right when they are visible expanded <- if null parentPath then return True- else liftIO $ treeViewRowExpanded view parentPath-+ else liftIO $ treeViewRowExpanded view =<< treePathNewFromIndices' parentPath let kidsToAdd = (if expanded then id else take 1) kids forM_ (zip [0..] kidsToAdd) $ \(n, record) -> do liftIO $ do- mbParentIter <- treeModelGetIter store parentPath- mbChildIter <- treeModelIterNthChild store mbParentIter n+ mbChildIter <- (treeModelGetIter store =<< treePathNewFromIndices' parentPath) >>= \case+ Just parentIter ->+ treeModelIterNthChild store (Just parentIter) n >>= \case+ (True, childIter) -> return (Just childIter)+ (False, _) -> return Nothing+ Nothing -> return Nothing let compare rec1 rec2 = case (rec1, rec2) of- (PackageRecord p1, PackageRecord p2) -> ipdCabalFile p1 == ipdCabalFile p2+ (ProjectRecord p1, ProjectRecord p2) -> p1 == p2+ (PackageRecord p1, PackageRecord p2) -> p1 == p2 _ -> rec1 == rec2 findResult <- searchToRight compare record store mbChildIter case (mbChildIter, findResult) of (_, WhereExpected iter) -> do -- it's already there path <- treeModelGetPath store iter- treeStoreSetValue store path record+ forestStoreSetValue store path record (Just iter, Found _) -> do -- it's already there at a later sibling path <- treeModelGetPath store iter removeUntil record store path _ -> do- treeStoreInsert store parentPath n record-- let pkg = case record of- PackageRecord p -> p- _ -> fromJust mbPkg+ parentPath' <- treePathNewFromIndices' parentPath+ forestStoreInsert store parentPath' (fromIntegral n) record+ let project = case record of+ ProjectRecord p -> fromJust $ wsLookupProject p ws+ _ -> fromJust mbProject+ mbPkg' = case record of+ PackageRecord p -> pjLookupPackage p project+ _ -> mbPkg -- Only update the grand kids if they are visible when expanded $ do- grandKids <- (`runPackage` pkg) $ children record- setChildren (Just pkg) store view (parentPath ++ [n]) grandKids+ grandKids <- (`runProject` project) $ children record mbPkg'+ setChildren (Just project) mbPkg' store view (parentPath ++ [n]) grandKids liftIO $ if null kids- then treeStoreRemoveChildren store parentPath- else when expanded . void $ removeRemaining store (parentPath++[length kids])+ then forestStoreRemoveChildren store parentPath+ else when expanded . void $ removeRemaining store =<< treePathNewFromIndices' (parentPath++[fromIntegral $ length kids]) -- * Context menu -contextMenuItems :: WorkspaceRecord -> TreePath -> TreeStore WorkspaceRecord -> IDEM [[(Text, IDEAction)]]+contextMenuItems :: WorkspaceRecord -> TreePath -> ForestStore WorkspaceRecord -> IDEM [[(Text, IDEAction)]] contextMenuItems record path store = do+ mainWindow <- getMainWindow case record of (FileRecord fp) -> do- let onDeleteFile = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> do+ let onDeleteFile = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> showDialogOptions+ (Just mainWindow) ("Are you sure you want to delete " <> T.pack (takeFileName fp) <> "?")- MessageQuestion+ MessageTypeQuestion [ ("Delete File", removeFile fp >> reflectIDE refreshWorkspacePane ideRef) , ("Cancel", return ()) ]@@ -538,46 +695,49 @@ DirRecord fp _ -> do - let onNewModule = flip catchIDE (\(e :: SomeException) -> print e) $ do- mbPkg <- treePathToPackage store path- forM_ mbPkg $ \pkg -> do- mbWs <- readIDE workspace- forM_ mbWs $ \ws -> do- mbModulePath <- flip runWorkspace ws $ runPackage (dirToModulePath fp) pkg- let modulePrefix = fromMaybe [] mbModulePath- packageTry $ addModule modulePrefix- refreshWorkspacePane+ let onNewModule = flip catchIDE (\(e :: SomeException) -> print e) $+ treePathToPackage store path >>= \case+ (Just project, Just pkg) -> do+ mbWs <- readIDE workspace+ forM_ mbWs $ \ws -> do+ (`runWorkspace` ws) . (`runProject` project) . (`runPackage` pkg) $ do+ mbModulePath <- dirToModulePath fp+ let modulePrefix = fromMaybe [] mbModulePath+ addModule modulePrefix+ refreshWorkspacePane+ _ -> return () let onNewTextFile = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> do- mbText <- showInputDialog "File name:" ""+ mbText <- showInputDialog (Just mainWindow) "File name:" "" case mbText of Just t -> do let path = fp </> T.unpack t exists <- doesFileExist path if exists- then showErrorDialog "File already exists"+ then showErrorDialog (Just mainWindow) "File already exists" else do writeFile path "" void $ reflectIDE (refreshWorkspacePane >> goToSourceDefinition' path (Location "" 1 0 1 0)) ideRef Nothing -> return () let onNewDir = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> do- mbText <- showInputDialog "Directory name:" ""+ mbText <- showInputDialog (Just mainWindow) "Directory name:" "" case mbText of Just t -> do let path = fp </> T.unpack t exists <- doesDirectoryExist path if exists- then showErrorDialog "Directory already exists"+ then showErrorDialog (Just mainWindow) "Directory already exists" else do createDirectory path void $ reflectIDE refreshWorkspacePane ideRef Nothing -> return () - let onDeleteDir = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> do+ let onDeleteDir = flip catchIDE (\(e :: SomeException) -> print e) $ reifyIDE $ \ideRef -> showDialogOptions+ (Just mainWindow) ("Are you sure you want to delete " <> T.pack (takeFileName fp) <> "?")- MessageQuestion+ MessageTypeQuestion [ ("Delete directory", removeDirectoryRecursive fp >> reflectIDE refreshWorkspacePane ideRef) , ("Cancel", return ()) ]@@ -591,57 +751,60 @@ ] ] - PackageRecord p -> do-- let onSetActive = workspaceTryQuiet $ workspaceActivatePackage p Nothing- onAddModule = workspaceTryQuiet $ runPackage (addModule []) p- onOpenCabalFile = workspaceTryQuiet $ runPackage packageEditText p+ ProjectRecord projectFile -> do+ let onSetActive = workspaceTryQuiet $ do+ ws <- ask+ case wsLookupProject projectFile ws of+ Just project -> workspaceActivatePackage project Nothing Nothing+ Nothing -> liftIO . errorM "leksah" $ "onSetActive: Project not found " <> projectFile+ onOpenProjectFile = void $ selectSourceBuf projectFile onRemoveFromWs = workspaceTryQuiet $ do- workspaceRemovePackage p+ workspaceRemoveProject projectFile liftIDE refreshWorkspacePane - return [ [ ("New Module...", onAddModule)- , ("Set As Active Package", onSetActive)-- ]- , [ ("Build", workspaceTryQuiet $ runPackage makePackage p)- , ("Run", workspaceTryQuiet $ runPackage packageRun p)- , ("Test", workspaceTryQuiet $ runPackage packageTest p)- , ("Clean", workspaceTryQuiet $ runPackage packageClean p)- , ("Open Package File", onOpenCabalFile)+ return [ [ ("Set As Active Project", onSetActive)+ , ("Open Project File", onOpenProjectFile) ] , [ ("Remove From Workspace", onRemoveFromWs) ] ] - ComponentRecord comp -> do- Just pkg <- treePathToPackage store path- let onSetActive = workspaceTryQuiet $- workspaceActivatePackage pkg (Just comp)- return [[ ("Activate component", onSetActive) ]]+ PackageRecord _ ->+ treePathToPackage store path >>= \case+ (Just project, Just p) -> do - AddSourcesRecord -> do- Just pkg <- treePathToPackage store path- let onAddSource snapshot = workspaceTryQuiet $ flip runPackage pkg (sandboxAddSource snapshot)- return [ [ ("Add Source Dependency...", onAddSource False >> refreshWorkspacePane)- , ("Add Source Dependency Snapshot...", onAddSource True >> refreshWorkspacePane)- ]- ]+ let runPkg = (`runProject` project) . (`runPackage` p)+ onSetActive = workspaceTryQuiet $ workspaceActivatePackage project (Just p) Nothing+ onAddModule = workspaceTryQuiet $ runPkg $ addModule []+ onOpenCabalFile = void . selectSourceBuf $ ipdCabalFile p+ onRemoveFromProject = workspaceTryQuiet . (`runProject` project) $ do+ projectRemovePackage p+ liftIDE refreshWorkspacePane + return [ [ ("New Module...", onAddModule)+ , ("Set As Active Package", onSetActive) - AddSourceRecord p -> do- Just pkg <- treePathToPackage store path- let onRemoveSourceDependency = do- workspaceTryQuiet $ flip runPackage pkg (sandboxDeleteSource (ipdPackageDir p))- onAddSourceDependencyToWs = workspaceTryQuiet . void $- workspaceAddPackage' (ipdCabalFile p)+ ]+ , [ ("Build", workspaceTryQuiet $ runPkg makePackage)+ , ("Run", workspaceTryQuiet $ runPkg packageRun)+ , ("Test", workspaceTryQuiet $ runPkg packageTest)+ , ("Benchmark", workspaceTryQuiet $ runPkg packageBench)+ , ("Clean", workspaceTryQuiet $ runPkg packageClean)+ , ("Open Package File", onOpenCabalFile)+ ]+ , [+ ("Remove From Project", onRemoveFromProject)+ ]+ ]+ _ -> return [] - return [ [ ("Add Package To Workspace", onAddSourceDependencyToWs >> refreshWorkspacePane)- ]- , [ ("Delete Source Dependency", onRemoveSourceDependency >> refreshWorkspacePane)- ]- ]+ ComponentRecord comp -> do+ (Just project, Just pkg) <- treePathToPackage store path+ let onSetActive = workspaceTryQuiet $+ workspaceActivatePackage project (Just pkg) (Just comp)+ return [[ ("Activate component", onSetActive) ]]+ _ -> return [] @@ -661,55 +824,59 @@ capitalize [] = [] --- * Utility functions for operating on 'TreeStore'+-- * Utility functions for operating on 'ForestStore' leaf :: a -> Tree a leaf x = Node x [] -treeStoreRemoveChildren :: TreeStore a -> TreePath -> IO ()-treeStoreRemoveChildren store path = do- Node record children <- treeStoreGetTree store path- forM_ (zip [0..] children) $ \_ -> do- treeStoreRemove store (path ++ [0]) -- this works because mutation ...+forestStoreRemoveChildren :: ForestStore a -> [Int32] -> IO ()+forestStoreRemoveChildren store path = do+ Node record children <- forestStoreGetTree store =<< treePathNewFromIndices' path+ forM_ (zip [0..] children) $ \_ ->+ forestStoreRemove store =<< treePathNewFromIndices' (path ++ [0]) -- this works because mutation ... data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound --- | Tries to find the given value in the 'TreeStore'. Only looks at the given 'TreeIter' and its+-- | Tries to find the given value in the 'ForestStore'. 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-searchToRight :: (a -> a -> Bool) -> a -> TreeStore a -> Maybe TreeIter -> IO FindResult+searchToRight :: (a -> a -> Bool) -> a -> ForestStore a -> Maybe TreeIter -> IO FindResult searchToRight compare _ _ Nothing = return NotFound searchToRight compare a store (Just iter) = do- row <- treeModelGetRow store iter+ row <- customStoreGetRow store iter if compare row a then return $ WhereExpected iter- else treeModelIterNext store iter >>= find'+ else do+ next <- treeIterCopy iter+ treeModelIterNext store next >>= find' next where- find' :: Maybe TreeIter -> IO FindResult- find' Nothing = return NotFound- find' (Just iter) = do- row <- treeModelGetRow store iter+ find' :: TreeIter -> Bool -> IO FindResult+ find' _ False = return NotFound+ find' iter True = do+ row <- customStoreGetRow store iter if compare row a then return $ Found iter- else treeModelIterNext store iter >>= find'+ else do+ next <- treeIterCopy iter+ treeModelIterNext store next >>= find' next -- | 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 :: Eq a => a -> ForestStore a -> TreePath -> IO () removeUntil a store path = do- row <- treeStoreGetValue store path+ row <- forestStoreGetValue store path when (row /= a) $ do- found <- treeStoreRemove store path+ found <- forestStoreRemove 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 :: ForestStore a -> TreePath -> IO () removeRemaining store path = do- found <- treeStoreRemove store path+ found <- forestStoreRemove store path when found $ removeRemaining store path
src/IDE/PaneGroups.hs view
@@ -32,10 +32,6 @@ newGroupOrBringToFront) import Control.Monad (void, unless, when, liftM) import IDE.Core.Types (frameState)-import Graphics.UI.Editor.Parameters (Direction(..))-import Graphics.UI.Gtk- (widgetSetSensitive, notebookSetShowTabs, notebookSetTabPos)-import Graphics.UI.Gtk.General.Enums (PositionType(..)) import IDE.Pane.Modules (IDEModules(..)) import IDE.Pane.Info (IDEInfo(..)) import IDE.Pane.SourceBuffer@@ -46,6 +42,10 @@ import IDE.Pane.Workspace (WorkspacePane(..)) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Pane.WebKit.Output (IDEOutput(..))+import GI.Gtk.Objects.Notebook+ (notebookSetShowTabs, notebookSetTabPos)+import GI.Gtk.Enums (Orientation(..), PositionType(..))+import GI.Gtk.Objects.Widget (widgetSetSensitive) moveOrBuildPane :: RecoverablePane alpha beta delta => PanePath -> delta (Maybe alpha) moveOrBuildPane path = do@@ -62,21 +62,20 @@ layout' <- liftM layout (readIDE frameState) case ret of (Just rpp, True) -> do- viewSplit' rpp Horizontal- viewSplit' (rpp ++ [SplitP BottomP]) Horizontal+ viewSplit' rpp OrientationHorizontal+ viewSplit' (rpp ++ [SplitP BottomP]) OrientationHorizontal let lowerP = rpp ++ [SplitP BottomP, SplitP BottomP] let upperP = rpp ++ [SplitP BottomP, SplitP TopP] let topP = rpp ++ [SplitP TopP] lower <- getNotebook lowerP upper <- getNotebook upperP top <- getNotebook topP- liftIO $ do- notebookSetTabPos lower PosBottom- notebookSetTabPos upper PosTop- notebookSetTabPos top PosTop- notebookSetShowTabs upper False- notebookSetShowTabs lower False- notebookSetShowTabs top False+ notebookSetTabPos lower PositionTypeBottom+ notebookSetTabPos upper PositionTypeTop+ notebookSetTabPos top PositionTypeTop+ notebookSetShowTabs upper False+ notebookSetShowTabs lower False+ notebookSetShowTabs top False getOrBuildBrowserPanes upperP lowerP topP (Just rpp, False) -> do let lowerP = getBestPanePath (rpp ++ [SplitP BottomP, SplitP BottomP]) layout'@@ -96,16 +95,15 @@ mbBreakpoints :: Maybe IDEBreakpoints <- getPane mbVariables :: Maybe IDEVariables <- getPane mbTrace :: Maybe IDETrace <- getPane- liftIO $ do- case mbBreakpoints of- Nothing -> return ()- Just idePane -> widgetSetSensitive (getTopWidget idePane) sens- case mbVariables of- Nothing -> return ()- Just idePane -> widgetSetSensitive (getTopWidget idePane) sens- case mbTrace of- Nothing -> return ()- Just idePane -> widgetSetSensitive (getTopWidget idePane) sens+ case mbBreakpoints of+ Nothing -> return ()+ Just idePane -> getTopWidget idePane >>= (`widgetSetSensitive` sens)+ case mbVariables of+ Nothing -> return ()+ Just idePane -> getTopWidget idePane >>= (`widgetSetSensitive` sens)+ case mbTrace of+ Nothing -> return ()+ Just idePane -> getTopWidget idePane >>= (`widgetSetSensitive` sens) showDebugger :: IDEAction showDebugger = do@@ -115,15 +113,14 @@ bufs <- allBuffers case ret of (Just rpp, True) -> do- viewSplit' rpp Horizontal+ viewSplit' rpp OrientationHorizontal let lowerP = rpp ++ [SplitP BottomP] let upperP = rpp ++ [SplitP TopP] lower <- getNotebook lowerP upper <- getNotebook upperP- liftIO $ do- notebookSetTabPos lower PosTop- notebookSetTabPos upper PosTop- notebookSetShowTabs upper False+ notebookSetTabPos lower PositionTypeTop+ notebookSetTabPos upper PositionTypeTop+ notebookSetShowTabs upper False getOrBuildDebugPanes upperP lowerP bufs (Just rpp, False) -> do let lowerP = getBestPanePath (rpp ++ [SplitP BottomP]) layout'
src/IDE/Preferences.hs view
@@ -4,6 +4,9 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Preferences@@ -27,8 +30,6 @@ , defaultPrefs ) where -import Graphics.UI.Gtk-import Graphics.UI.Gtk.General.Settings import qualified Text.PrettyPrint.HughesPJ as PP import Distribution.Package import Data.IORef@@ -55,20 +56,12 @@ debugSetBreakOnError, debugSetBreakOnException, debugSetPrintEvldWithShow)-import Graphics.UI.Gtk.SourceView- (sourceStyleSchemeManagerAppendSearchPath,- sourceStyleSchemeManagerGetSchemeIds, sourceStyleSchemeManagerNew) import System.Time (getClockTime) import qualified IDE.StrippedPrefs as SP import Control.Exception(SomeException,catch) import Prelude hiding(catch) import Data.List (isSuffixOf, sortBy) import Data.Maybe (mapMaybe, catMaybes, fromMaybe, isJust)-import Graphics.UI.Gtk.Windows.MessageDialog- (ButtonsType(..), MessageType(..))-import System.Glib.Attributes (set)-import Graphics.UI.Gtk.General.Enums- (ButtonBoxStyle(..), WindowPosition(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (void, when) import System.FilePath ((</>))@@ -81,45 +74,66 @@ import IDE.Pane.Errors (fillErrorList) import GHC.IO (evaluate) import IDE.Metainfo.Provider (getAllPackageIds)+import GI.Gtk.Objects.Dialog+ (Dialog(..), onDialogResponse, dialogResponse, dialogGetHeaderBar,+ dialogGetContentArea, dialogAddActionWidget)+import Data.GI.Base (new', unsafeCastTo, set)+import GI.Gtk.Objects.Window+ (windowSetDefaultSize, setWindowTitle, setWindowTransientFor)+import GI.Gtk.Objects.HButtonBox (hButtonBoxNew)+import GI.Gtk.Objects.Box (Box(..), boxSetSpacing)+import GI.Gtk.Objects.ButtonBox (buttonBoxSetLayout)+import GI.Gtk.Enums+ (Orientation(..), FileChooserAction(..), ShadowType(..),+ ResponseType(..), ButtonBoxStyle(..))+import GI.Gtk.Objects.Button+ (onButtonClicked, buttonNewWithLabel, Button (..))+import GI.Gtk.Objects.Label (labelSetMarkup, labelNew)+import GI.Gtk.Objects.Widget+ (widgetModifyFont, widgetDestroy, widgetShowAll, widgetGrabDefault,+ setWidgetCanDefault, widgetSetSensitive, widgetShow)+import GI.Gtk.Objects.VBox (VBox(..))+import GI.Pango.Structs.FontDescription (fontDescriptionFromString)+import GI.Gtk.Objects.CellRendererText (setCellRendererTextText)+import GI.Gtk.Objects.Settings+ (settingsSetLongProperty, settingsGetForScreen, Settings(..))+import GI.GtkSource+ (styleSchemeManagerGetSchemeIds,+ styleSchemeManagerAppendSearchPath, styleSchemeManagerNew)+import GI.Gtk+ (widgetOverrideFont, constructDialogUseHeaderBar, Container(..),+ containerAdd) -- | This needs to be incremented when the preferences format changes prefsVersion :: Int-prefsVersion = 7+prefsVersion = 12 runPreferencesDialog :: IDEAction runPreferencesDialog = do packageInfos <- getAllPackageIds+ liftIO $ print packageInfos initialPrefs <- readIDE prefs parent <- getMainWindow reifyIDE $ \ideR -> do- dialog <- dialogNew- set dialog [ windowTransientFor := parent- , windowTitle := __ "Preferences" ]+ dialog <- new' Dialog [constructDialogUseHeaderBar 1]+ setWindowTransientFor dialog parent+ setWindowTitle dialog $ __ "Preferences" windowSetDefaultSize dialog 800 500 configDir <- getConfigDir (widget, inj, ext, notifier) <- buildEditor (extractFieldDescription $ prefsDescription configDir packageInfos) initialPrefs - bb <- hButtonBoxNew- boxSetSpacing bb 6- buttonBoxSetLayout bb ButtonboxSpread- load <- buttonNewWithLabel (__ "Load")- save <- buttonNewWithLabel (__ "Save")- preview <- buttonNewWithLabel (__ "Preview")- cancel <- buttonNewFromStock "gtk-cancel"- apply <- buttonNewFromStock "gtk-apply"- forM_ [preview, cancel, apply] $ \but ->- boxPackEnd bb but PackNatural 0--+ actionArea <- dialogGetHeaderBar dialog >>= unsafeCastTo Container+ preview <- buttonNewWithLabel (__ "Preview")+ containerAdd actionArea preview+ apply <- dialogAddButton' dialog "gtk-apply" ResponseTypeOk >>= unsafeCastTo Button+ dialogSetDefaultResponse' dialog ResponseTypeOk - upper <- dialogGetContentArea dialog- boxPackStart (castToBox upper) widget PackGrow 0- errorLabel <- labelNew (Nothing :: Maybe Text)- boxPackStart (castToBox upper) errorLabel PackNatural 0- lower <- dialogGetActionArea dialog- boxPackEnd (castToBox lower) bb PackNatural 5+ upper <- dialogGetContentArea dialog >>= unsafeCastTo Box+ boxPackStart' upper widget PackGrow 0+ errorLabel <- labelNew Nothing+ boxPackStart' upper errorLabel PackNatural 0 -- Keep an IO ref to the last applied preferences -- so it can be restored@@ -132,12 +146,12 @@ writeIORef lastAppliedPrefsRef newPrefs - on preview buttonActivated $ do+ onButtonClicked preview $ do mbNewPrefs <- extract initialPrefs [ext] forM_ mbNewPrefs applyPrefs - on apply buttonActivated $ do+ onButtonClicked apply $ do mbNewPrefs <- extract initialPrefs [ext] forM_ mbNewPrefs $ \newPrefs -> do applyPrefs newPrefs@@ -154,7 +168,7 @@ SP.serverPort = serverPort newPrefs, SP.endWithLastConn = endWithLastConn newPrefs} - dialogResponse dialog ResponseOk+ dialogResponse' dialog ResponseTypeOk let onClose = do mbP <- extract initialPrefs [ext]@@ -163,12 +177,12 @@ Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /= initialPrefs{prefsFormat = 0, prefsSaveTime = ""} when hasChanged (applyPrefs initialPrefs)- dialogResponse dialog ResponseCancel+ dialogResponse' dialog ResponseTypeCancel - on cancel buttonActivated onClose- on dialog response $ \resp -> do- case resp of- ResponseDeleteEvent -> onClose+-- onButtonClicked cancel onClose+ onDialogResponse dialog $ \resp ->+ case toEnum $ fromIntegral resp of+ ResponseTypeDeleteEvent -> onClose _ -> return () registerEvent notifier MayHaveChanged (\ e -> do@@ -177,20 +191,22 @@ Nothing -> False Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /= initialPrefs{prefsFormat = 0, prefsSaveTime = ""}- when (isJust mbP) $ labelSetMarkup errorLabel ("" :: Text)+ when (isJust mbP) $ do+ labelSetMarkup errorLabel ""+ widgetSetSensitive apply True return (e{gtkReturn=False})) registerEvent notifier ValidationError $ \e -> do- labelSetMarkup errorLabel $ "<span foreground=\"red\" size=\"x-large\">The following fields have invalid values: "+ labelSetMarkup errorLabel $ "<span foreground=\"red\">The following fields have invalid values: " <> eventText e <> "</span>" widgetSetSensitive apply False return e - set apply [widgetCanDefault := True]+ setWidgetCanDefault apply True widgetGrabDefault apply widgetShowAll dialog- resp <- dialogRun dialog+ resp <- dialogRun' dialog widgetDestroy dialog return () @@ -254,7 +270,7 @@ , mkFieldPP (paraName <<<- ParaName (__ "Right margin") $ paraSynopsis <<<- ParaSynopsis (__ "Size or 0 for no right margin")- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) (PP.text . show) readParser rightMargin@@ -308,7 +324,7 @@ (paraName <<<- ParaName (__ "Source candy") $ paraSynopsis <<<- ParaSynopsis (__ "Empty for do not use or the name of a candy file in a config dir")- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) (PP.text . show) readParser sourceCandy (\b a -> a{sourceCandy = b})@@ -443,7 +459,15 @@ stringParser textEditorType (\b a -> a{textEditorType = b})- (comboSelectionEditor ["GtkSourceView", "Yi", "CodeMirror"] id)+ (comboSelectionEditor+ ["GtkSourceView"]+#ifdef LEKSAH_WITH_YI+ ++ ["Yi"]+#endif+#ifdef LEKSAH_WITH_CODE_MIRROR+ ++ ["CodeMirror"]+#endif+ id) (\i -> return ()) ]), (__ "User Interface", VFDPP emptyParams [@@ -458,21 +482,39 @@ (\_ -> applyInterfaceTheme) , mkFieldPP (paraName <<<- ParaName (__ "LogView Font") $ emptyParams)- (\a -> PP.text (case a of Nothing -> show ""; Just s -> show s))+ (\(b, a) -> PP.text (if b then case a of Nothing -> show ""; Just s -> show s else show "")) (do str <- stringParser- return (if T.null str then Nothing else Just str))+ return (if T.null str then (False, Nothing) else (True, Just str))) logviewFont- (\ b a -> a{logviewFont = b})- fontEditor- (\mbs -> do+ (\b a -> a{logviewFont = b})+ (disableEditor (fontEditor, emptyParams) True "Use custom font")+ (\(b, mbFont) -> do log <- getLog- fdesc <- liftIO $fontDescriptionFromString (fromMaybe "" mbs)- liftIO $widgetModifyFont (castToWidget $ logLaunchTextView log) (Just fdesc))+ fdesc <- fontDescriptionFromString (if b then fromMaybe "" mbFont else "Monospace")+ widgetOverrideFont (logLaunchTextView log) (Just fdesc)+ ) , mkFieldPP+ (paraName <<<- ParaName (__ "Workspace Font") $ emptyParams)+ (\(b, a) -> PP.text (if b then case a of Nothing -> show ""; Just s -> show s else show ""))+ (do str <- stringParser+ return (if T.null str then (False, Nothing) else (True, Just str)))+ workspaceFont+ (\b a -> a{workspaceFont = b})+ (disableEditor (fontEditor, emptyParams) True "Use custom font")+ (\(b, mbFont) -> do+ wp <- getWorkspacePane+ case (b, mbFont) of+ (True, Just font) -> do+ fdesc <- fontDescriptionFromString (if b then fromMaybe "" mbFont else "")+ widgetOverrideFont (treeView wp) (Just fdesc)+ _ -> do+ widgetOverrideFont (treeView wp) Nothing+ )+ , mkFieldPP (paraName <<<- ParaName (__ "Window default size") $ paraSynopsis <<<- ParaSynopsis (__ "Default size of the main ide window specified as pair")- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) (PP.text.show) (pairParser intParser) defaultSize (\(c,d) a -> a{defaultSize = (c,d)})@@ -498,6 +540,14 @@ boolEditor (\_ -> rebuildWorkspacePane) , mkFieldPP+ (paraName <<<- ParaName (__ "Collapse errors in Errors pane by default") $ emptyParams)+ (PP.text . show)+ boolParser+ collapseErrors+ (\b a -> a {collapseErrors = b})+ boolEditor+ (\_ -> return ())+ , mkFieldPP (paraName <<<- ParaName (__ "Use ctrl Tab for Notebook flipper") $ emptyParams) (PP.text . show) boolParser@@ -517,7 +567,7 @@ (paraName <<<- ParaName (__ "Name of the keymap") $ paraSynopsis <<<- ParaSynopsis (__ "The name of a keymap file in a config dir")- $ paraDirection <<<- ParaDirection Horizontal $ emptyParams)+ $ paraOrientation <<<- ParaOrientation OrientationHorizontal $ emptyParams) (PP.text . T.unpack) identifier keymapName@@ -530,7 +580,7 @@ (paraName <<<- ParaName (__ "Save the session (open files, pane positioning and sizing, etc) before closing a workspace") $ paraSynopsis <<<- ParaSynopsis (__ "Save the session (open files, pane positioning and sizing, etc) before closing a workspace")- $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)+ $ paraShadow <<<- ParaShadow ShadowTypeIn $ emptyParams) (PP.text . show) boolParser saveSessionOnClose@@ -542,8 +592,8 @@ mkFieldPP (paraName <<<- ParaName (__ "Categories for panes")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,130) $ emptyParams) (PP.text . show)@@ -551,8 +601,8 @@ categoryForPane (\b a -> a{categoryForPane = b}) (multisetEditor- (ColumnDescr True [(__ "Pane Id", \ (n, _) -> [cellText := n])- ,(__ "Pane Category", \ (_, v) -> [cellText := v])])+ (ColumnDescr True [(__ "Pane Id", \cell (n, _) -> setCellRendererTextText cell n)+ ,(__ "Pane Category", \cell (_, v) -> setCellRendererTextText cell v)]) (pairEditor (textEditor (not . T.null) True, emptyParams) (textEditor (not . T.null) True, emptyParams), emptyParams)@@ -562,8 +612,8 @@ ,mkFieldPP (paraName <<<- ParaName (__ "Pane path for category")- $ paraShadow <<<- ParaShadow ShadowIn- $ paraDirection <<<- ParaDirection Vertical+ $ paraShadow <<<- ParaShadow ShadowTypeIn+ $ paraOrientation <<<- ParaOrientation OrientationVertical $ paraMinSize <<<- ParaMinSize (-1,130) $ emptyParams) (PP.text . show)@@ -571,8 +621,8 @@ pathForCategory (\b a -> a{pathForCategory = b}) (multisetEditor- (ColumnDescr True [(__ "Pane category", \ (n, _) -> [cellText := n])- ,(__ "Pane path", \ (_, v) -> [cellText := T.pack $ show v])])+ (ColumnDescr True [(__ "Pane category", \cell (n, _) -> setCellRendererTextText cell n)+ ,(__ "Pane path", \cell (_, v) -> setCellRendererTextText cell . T.pack $ show v)]) (pairEditor (textEditor (not . T.null) True, emptyParams) (genericEditor, emptyParams), emptyParams)@@ -706,6 +756,14 @@ boolEditor (\i -> return ()) , mkFieldPP+ (paraName <<<- ParaName (__ "Make documentation when building") $ emptyParams)+ (PP.text . show)+ boolParser+ makeDocs+ (\b a -> a{makeDocs = b})+ boolEditor+ (\i -> return ())+ , mkFieldPP (paraName <<<- ParaName (__ "Run unit tests when building") $ emptyParams) (PP.text . show) boolParser@@ -714,6 +772,14 @@ boolEditor (\i -> return ()) , mkFieldPP+ (paraName <<<- ParaName (__ "Run benchmarks when building") $ emptyParams)+ (PP.text . show)+ boolParser+ runBenchmarks+ (\b a -> a{runBenchmarks = b})+ boolEditor+ (\i -> return ())+ , mkFieldPP (paraName <<<- ParaName (__ "Make mode") $ emptyParams) (PP.text . show) boolParser@@ -747,15 +813,6 @@ (\b a -> a{useVado = b}) boolEditor (\i -> return ())-- , mkFieldPP- (paraName <<<- ParaName (__ "Use cabal-dev") $ emptyParams)- (PP.text . show)- boolParser- useCabalDev- (\b a -> a{useCabalDev = b})- boolEditor- (\i -> return ()) ]), (__ "Debug", VFDPP emptyParams [ mkFieldPP@@ -819,7 +876,7 @@ mbScreen <- getActiveScreen case mbScreen of Nothing -> return Nothing- Just screen -> liftIO $ Just <$> settingsGetForScreen screen+ Just screen -> Just <$> settingsGetForScreen screen applyInterfaceTheme :: IDEAction applyInterfaceTheme = do@@ -830,9 +887,9 @@ mapM_ updateStyle' buffers mbSettings <- getActiveSettings case mbSettings of- Just settings -> liftIO $ settingsSetLongProperty+ Just settings -> settingsSetLongProperty settings- ("gtk-application-prefer-dark-theme" :: Text)+ "gtk-application-prefer-dark-theme" (if darkUserInterface prefs then 1 else 0) "Leksah" Nothing -> return ()@@ -843,10 +900,10 @@ -- | Editor for enabling a different syntax stylesheet styleEditor :: Editor (Bool, Text) styleEditor p n = do- styleManager <- sourceStyleSchemeManagerNew+ styleManager <- styleSchemeManagerNew dataDir <- getDataDir- sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles"- ids <- sourceStyleSchemeManagerGetSchemeIds styleManager+ styleSchemeManagerAppendSearchPath styleManager . T.pack $ dataDir </> "data/styles"+ ids <- fromMaybe [] <$> styleSchemeManagerGetSchemeIds styleManager let notDarkIds = filter (not . T.isSuffixOf "-dark") ids disableEditor (comboSelectionEditor notDarkIds id, p) True (__ "Select a special style?") p n @@ -860,12 +917,12 @@ , tabWidth = 4 , wrapLines = False , sourceCandy = (False,"candy")- , darkUserInterface = False+ , darkUserInterface = True , saveSessionOnClose = True , keymapName = "keymap" , forceLineEnds = True , removeTBlanks = True- , textviewFont = Nothing+ , textviewFont = Just "Monospace 10" , sourceStyle = (True,"leksah") , foundBackgroundLight = Color 65535 65535 32768 , matchBackgroundLight = Color 42064 55923 28520@@ -879,24 +936,25 @@ , lintBackgroundDark = Color 0 15000 0 , textEditorType = "GtkSourceView" , autoLoad = False- , logviewFont = Nothing+ , logviewFont = (False, Nothing)+ , workspaceFont = (False, Nothing) , defaultSize = (1024,800) , browser = "firefox" , sourceDirectories = [] , packageBlacklist = []- , pathForCategory = [ ("EditorCategory",[SplitP LeftP])- , ("LogCategory",[SplitP RightP, SplitP BottomP])- , ("ToolCategory",[SplitP RightP, SplitP TopP])+ , pathForCategory = [ ("ExplorerCategory",[SplitP LeftP])+ , ("EditorCategory",[SplitP RightP])+ , ("ToolCategory",[SplitP RightP,SplitP TopP])+ , ("LogCategory",[SplitP RightP,SplitP BottomP]) ]- , defaultPath = [SplitP LeftP]- , categoryForPane = [ ("*ClassHierarchy","ToolCategory")- , ("*Breakpoints","LogCategory")+ , defaultPath = [SplitP RightP]+ , categoryForPane = [ ("*Breakpoints","LogCategory") , ("*Browser","ToolCategory") , ("*Debug","ToolCategory")- , ("*Errors","ToolCategory")+ , ("*Errors","LogCategory") , ("*Files","ToolCategory") , ("*Flags","ToolCategory")- , ("*Grep","ToolCategory")+ , ("*Grep","LogCategory") , ("*HLint","ToolCategory") , ("*Doc","ToolCategory") , ("*Info","LogCategory")@@ -909,10 +967,10 @@ , ("*Search","ToolCategory") , ("*Trace","LogCategory") , ("*Variables","LogCategory")- , ("*Workspace","LogCategory")]+ , ("*Workspace","ExplorerCategory")] , collectAtStart = True , unpackDirectory = Just ("~" </> configDirName </> "packageSources")- , retrieveURL = "http://www.leksah.org"+ , retrieveURL = "http://leksah.github.io" , retrieveStrategy = SP.RetrieveThenBuild , useCtrlTabFlipping = True , docuSearchURL = "https://www.haskell.org/hoogle/?q="@@ -920,9 +978,10 @@ , saveAllBeforeBuild = True , jumpToWarnings = True , useVado = False- , useCabalDev = False , backgroundBuild = True+ , makeDocs = False , runUnitTests = False+ , runBenchmarks = False , makeMode = True , singleBuildWithoutLinking = False , dontInstallLast = False@@ -934,8 +993,9 @@ , serverIP = "127.0.0.1" , endWithLastConn = True , showHiddenFiles = False- , showWorkspaceIcons = True+ , showWorkspaceIcons = True , hlintOnSave = True+ , collapseErrors = True } -- ------------------------------------------------------------
− src/IDE/Sandbox.hs
@@ -1,142 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}------------------------------------------------------------------------------------ Module : IDE.Sandbox--- Copyright : 2007-2014 Juergen Nicklisch-Franken, Hamish Mackenzie--- License : GPL------ Maintainer : Juergen Nicklisch-Franken <info@leksah.org>--- Stability : provisional--- Portability :------ |-----------------------------------------------------------------------------------module IDE.Sandbox (- sandboxInit-, sandboxInitShared-, sandboxDelete-, sandboxAddSource-, sandboxDeleteSource-) where--import Graphics.UI.Gtk (Window)-import Control.Applicative ((<$>), (<*>))-import Control.Monad (when, void)-import Control.Monad.Trans.Class (lift)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Reader (ask)-import System.Exit (ExitCode(..))-import System.FilePath (dropFileName)-import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink)-import qualified Data.Conduit.List as CL (fold)-import IDE.Utils.Tool (ToolOutput(..))-import IDE.Utils.GUIUtils (showDialogOptions, __, chooseDir)-import IDE.Core.State- (reflectIDE, reifyIDE, PackageAction, readIDE, prefs,- ipdPackageDir, getMainWindow, Workspace, wsFile, liftIDE,- IDEPackage, IDEM, runPackage, LogLaunch)-import IDE.Pane.Log (getDefaultLogLaunch)-import IDE.Utils.ExternalTool (runExternalTool')-import IDE.LogRef (logOutput)-import IDE.Pane.PackageEditor (choosePackageFile)-import IDE.Workspaces (workspaceTryQuiet)-import IDE.Package (refreshPackage)-import Data.Monoid ((<>))-import qualified Data.Text as T (pack)-import IDE.Core.Types (runWorkspace, IDE(..), PackageM)-import System.Directory (doesFileExist)-import System.FilePath.Windows ((</>))-import Graphics.UI.Gtk.Windows.MessageDialog (MessageType(..))---- | Get the last item-sinkLast = CL.fold (\_ a -> Just a) Nothing--sandboxTry :: PackageAction -> PackageAction-sandboxTry action = do- sandbox <- hasSandbox- pkg <- ask- if sandbox then action else do- reifyIDE $ \ideRef -> do- Just ws <- reflectIDE (readIDE workspace) ideRef- let packageToIO = flip reflectIDE ideRef . flip runWorkspace ws . flip runPackage pkg- showDialogOptions- "This action requires a sandboxed package database. Would you like to initialize a sandbox for this package?"- MessageQuestion- [ ("Initialize New Sandbox", packageToIO $ sandboxInit >> action)- , ("Use Existing Sandbox", packageToIO $ sandboxInitShared >> action)- , ("Cancel", return ())]- (Just 0)--hasSandbox :: PackageM Bool-hasSandbox = do- pkg <- ask- liftIO $ doesFileExist (ipdPackageDir pkg </> "cabal.sandbox.config")--logSandbox :: IDEPackage -> LogLaunch -> C.Sink ToolOutput IDEM ()-logSandbox package logLaunch = do- let log = logOutput logLaunch- mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink log- when (mbLastOutput == Just (ToolExit ExitSuccess)) .- lift $ workspaceTryQuiet (runPackage (void $ refreshPackage log) package)--sandboxInit :: PackageAction-sandboxInit = do- package <- ask- logLaunch <- getDefaultLogLaunch- runExternalTool' (__ "Sandbox Init")- "cabal" ["sandbox", "init"]- (ipdPackageDir package) (logSandbox package logLaunch)--chooseSandboxDir :: Window -> Maybe FilePath -> IO (Maybe FilePath)-chooseSandboxDir window = chooseDir window (__ "Select sandbox folder")--sandboxInitShared :: PackageAction-sandboxInitShared = do- package <- ask- ws <- lift ask- window <- liftIDE getMainWindow- mbDir <- liftIO $ chooseSandboxDir window Nothing- case mbDir of- Nothing -> return ()- Just dir -> do- logLaunch <- getDefaultLogLaunch- runExternalTool' (__ "Sandbox Init")- "cabal" ["sandbox", "init", "--sandbox=" <> T.pack dir]- (ipdPackageDir package) (logSandbox package logLaunch)--sandboxDelete :: PackageAction-sandboxDelete = sandboxTry $ do- package <- ask- logLaunch <- getDefaultLogLaunch- runExternalTool' (__ "Sandbox Delete")- "cabal" ["sandbox", "delete"]- (ipdPackageDir package) (logSandbox package logLaunch)--chooseSandboxSourceDir :: Window -> Maybe FilePath -> IO (Maybe FilePath)-chooseSandboxSourceDir window = chooseDir window (__ "Select source folder")--sandboxAddSource :: Bool -> PackageAction-sandboxAddSource snapshot = sandboxTry $ do- package <- ask- ws <- lift ask- let path = dropFileName (wsFile ws)- window <- liftIDE getMainWindow- mbFilePath <- liftIO $ chooseSandboxSourceDir window (Just path)- case mbFilePath of- Nothing -> return ()- Just fp -> do- logLaunch <- getDefaultLogLaunch- runExternalTool' (__ "Sandbox Add Source")- "cabal" (["sandbox", "add-source", T.pack fp] ++ ["--snapshot" | snapshot])- (ipdPackageDir package) (logSandbox package logLaunch)--sandboxDeleteSource :: FilePath -> PackageAction-sandboxDeleteSource dir = sandboxTry $ do- package <- ask- logLaunch <- getDefaultLogLaunch- runExternalTool' (__ "Sandbox Delete Source")- "cabal" ["sandbox", "delete-source", T.pack dir]- (ipdPackageDir package) (logSandbox package logLaunch)-
src/IDE/Session.hs view
@@ -26,11 +26,8 @@ , viewFullScreen ) where -import Prelude hiding (catch)-import Graphics.UI.Gtk hiding (showLayout)-import Graphics.UI.Gtk.General.CssProvider (cssProviderNew, cssProviderLoadFromString)-import Graphics.UI.Gtk.General.StyleContext (styleContextAddProvider)-import Control.Applicative ((<$>))+import Prelude ()+import Prelude.Compat import System.FilePath import qualified Data.Map as Map import Data.Maybe@@ -71,10 +68,30 @@ import Control.Monad (void, when) import System.Log.Logger (debugM) import Data.Text (Text)-import qualified Data.Text as T (pack) import Data.Traversable (forM) import Data.Foldable (forM_) import IDE.Preferences (applyInterfaceTheme)+import GI.Gtk.Objects.Window+ (windowUnfullscreen, windowFullscreen, windowSetDefaultSize,+ Window(..), windowSetTransientFor, setWindowTitle, windowGetSize)+import GI.Gtk.Enums+ (Orientation(..), ResponseType(..), FileChooserAction(..))+import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..))+import GI.Gtk.Interfaces.FileChooser+ (fileChooserGetFilename, fileChooserSetCurrentFolder,+ fileChooserSetAction)+import GI.Gtk.Objects.Widget+ (widgetShowAll, widgetGetParent, widgetDestroy, widgetHide,+ widgetShow)+import GI.Gtk.Objects.Paned (panedSetPosition, panedGetPosition)+import GI.Gtk.Objects.Notebook+ (notebookSetCurrentPage, notebookSetTabPos, notebookSetShowTabs,+ notebookGetCurrentPage, notebookGetTabPos, notebookGetShowTabs)+import Data.GI.Base (unsafeCastTo, new')+import Control.Arrow (Arrow(..))+import qualified Data.Text as T (unpack, pack)+import Data.Monoid ((<>))+import GI.Gtk (constructDialogUseHeaderBar) -- --------------------------------------------------------------------- -- This needs to be incremented, when the session format changes@@ -188,46 +205,22 @@ , detachedSize = Nothing} (HorizontalP TerminalP {- paneGroups = Map.fromList [- ("Debug",HorizontalP- TerminalP {- paneGroups = Map.fromList []- , paneTabs = Nothing- , currentPage = -1- , detachedId = Nothing- , detachedSize = Nothing}- TerminalP {- paneGroups = Map.fromList []- , paneTabs = Just TopP- , currentPage = -1- , detachedId = Nothing- , detachedSize = Nothing} 167)]+ paneGroups = Map.fromList [] , paneTabs = Just TopP- , currentPage = 2+ , currentPage = -1 , detachedId = Nothing , detachedSize = Nothing} TerminalP { paneGroups = Map.fromList [] , paneTabs = Just TopP- , currentPage = 1+ , currentPage = -1 , detachedId = Nothing- , detachedSize = Nothing} 456) 693- , population = [ (Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP BottomP])- , (Just (LogSt LogState),[SplitP RightP,SplitP BottomP])- , (Just (ModulesSt- (ModulesState 200 (SystemScope,False) (Nothing,Nothing)- ExpanderState {- packageExp = ([],[])- , packageExpNoBlack = ([],[])- , packageDExp = ([],[])- , packageDExpNoBlack = ([],[])- , workspaceExp = ([],[])- , workspaceExpNoBlack = ([],[])- , workspaceDExp = ([],[])- , workspaceDExpNoBlack = ([],[])- , systemExp = ([],[])- , systemExpNoBlack = ([],[])})),[SplitP RightP,SplitP TopP])- , (Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP])]+ , detachedSize = Nothing}+ 456)+ 250+ , population = [ (Just (WorkspaceSt WorkspaceState),[SplitP LeftP])++ ] , windowSize = (1024,768) , fullScreen = False , completionSize = (750,400)@@ -334,13 +327,13 @@ -- saveSession :: IDEAction saveSession = do- sessionPath <- liftIO $ getConfigFilePathForSave standardSessionFilename- mbSessionPath2 <- do- ws <- readIDE workspace- case ws of- Nothing -> return Nothing- Just ws -> return $ Just (dropExtension (wsFile ws) ++- leksahSessionFileExtension)+ sessionPath <- liftIO $ getConfigFilePathForSave standardSessionFilename+ mbSessionPath2 <- do+ ws <- readIDE workspace+ case ws of+ Nothing -> return Nothing+ Just ws -> return $ Just (dropExtension (wsFile ws) +++ leksahSessionFileExtension) saveSessionAs sessionPath mbSessionPath2 saveSessionAs :: FilePath -> Maybe FilePath -> IDEAction@@ -355,7 +348,7 @@ wdw <- getMainWindow layout <- mkLayout population <- getPopulation- size <- liftIO $ windowGetSize wdw+ size <- windowGetSize wdw fullScreen <- getFullScreenState (completionSize,_) <- readIDE completion mbWs <- readIDE workspace@@ -374,7 +367,7 @@ , saveTime = T.pack $ show timeNow , layoutS = layout , population = population- , windowSize = size+ , windowSize = (fromIntegral *** fromIntegral) size , fullScreen = fullScreen , completionSize = completionSize , workspacePath = case mbWs of@@ -405,30 +398,22 @@ loadSessionPrompt :: IDEAction loadSessionPrompt = do window' <- getMainWindow- response <- liftIO $ do- configFolder <- getConfigDir- dialog <- fileChooserDialogNew- (Just $ __ "Select session file")- (Just window')- FileChooserActionOpen- [("gtk-cancel"- ,ResponseCancel)- ,("gtk-open"- , ResponseAccept)]- fileChooserSetCurrentFolder dialog configFolder- widgetShow dialog- res <- dialogRun dialog- case res of- ResponseAccept -> do- fileName <- fileChooserGetFilename dialog- widgetHide dialog- return fileName- _ -> do- widgetHide dialog- return Nothing- case response of- Just fn -> loadSession fn- Nothing -> return ()+ configFolder <- liftIO getConfigDir+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog (__ "Select session file")+ windowSetTransientFor dialog $ Just window'+ fileChooserSetAction dialog FileChooserActionOpen+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "Load Session" ResponseTypeAccept+ fileChooserSetCurrentFolder dialog configFolder+ widgetShow dialog+ res <- dialogRun' dialog+ case res of+ ResponseTypeAccept -> do+ fileName <- fileChooserGetFilename dialog+ widgetHide dialog+ mapM_ loadSession fileName+ _ -> widgetHide dialog loadSession :: FilePath -> IDEAction loadSession sessionPath = do@@ -437,21 +422,20 @@ deactivatePackage recentFiles' <- readIDE recentFiles recentWorkspaces' <- readIDE recentWorkspaces- b <- fileCloseAll (\_ -> return True)- when b $ do- detachedCloseAll- paneCloseAll- groupsCloseAll- viewCollapseAll- recoverSession sessionPath- modifyIDE_ (\ ide -> ide{ recentFiles = recentFiles'- , recentWorkspaces = recentWorkspaces'})- return ()+ fileCloseAll (\_ -> return True)+ detachedCloseAll+ paneCloseAll+ groupsCloseAll+ viewCollapseAll+ recoverSession sessionPath+ modifyIDE_ (\ ide -> ide{ recentFiles = recentFiles'+ , recentWorkspaces = recentWorkspaces'})+ return () detachedCloseAll :: IDEAction detachedCloseAll = do windows <- getWindows- liftIO $ mapM_ widgetDestroy (tail windows)+ mapM_ widgetDestroy (tail windows) paneCloseAll :: IDEAction paneCloseAll = do@@ -480,26 +464,26 @@ l2 <- getLayout' l (pp ++ [SplitP TopP]) r2 <- getLayout' r (pp ++ [SplitP BottomP]) pane <- getPaned pp- pos <- liftIO $ panedGetPosition pane+ pos <- fromIntegral <$> panedGetPosition pane return (HorizontalP l2 r2 pos) getLayout' (VerticalP l r _) pp = do l2 <- getLayout' l (pp ++ [SplitP LeftP]) r2 <- getLayout' r (pp ++ [SplitP RightP]) pane <- getPaned pp- pos <- liftIO $ panedGetPosition pane+ pos <- fromIntegral <$> panedGetPosition pane return (VerticalP l2 r2 pos) getLayout' raw@(TerminalP {paneGroups = groups}) pp = do groups2 <- forM (Map.toAscList groups) $ \(group, g) -> do l <- getLayout' g (pp ++ [GroupP group]) return (group, l) nb <- getNotebook pp- showTabs <- liftIO $ notebookGetShowTabs nb- pos <- liftIO $ notebookGetTabPos nb- current <- liftIO $ notebookGetCurrentPage nb+ showTabs <- notebookGetShowTabs nb+ pos <- notebookGetTabPos nb+ current <- fromIntegral <$> notebookGetCurrentPage nb size <- case detachedId raw of Just _ -> do- Just parent <- liftIO $ widgetGetParent nb- liftIO (Just <$> windowGetSize (castToWindow parent))+ parent <- widgetGetParent nb >>= liftIO . unsafeCastTo Window . fromJust+ Just . (fromIntegral *** fromIntegral) <$> windowGetSize parent Nothing -> return $ detachedSize raw return raw { paneGroups = Map.fromAscList groups2@@ -511,6 +495,7 @@ getPopulation = do paneMap <- getPaneMapSt mapM (\ (pn,v) -> do+ liftIO $ debugM "leksah" $ "getPopulation calling saveState for " <> T.unpack pn (PaneC p) <- paneFromName pn mbSt <- saveState p case mbSt of@@ -540,9 +525,9 @@ sessionSt <- liftIO $ catch (readFields sessionPath sessionDescr defaultSession) (\(_ :: SomeException) -> return defaultSession)- liftIO $ uncurry (windowSetDefaultSize wdw) (windowSize sessionSt)+ uncurry (windowSetDefaultSize wdw) . (fromIntegral *** fromIntegral) $ windowSize sessionSt applyLayout (layoutS sessionSt)- workspaceOpenThis False (workspacePath sessionSt)+ forM_ (workspacePath sessionSt) (workspaceOpenThis False) liftIO $ debugM "leksah" "recoverSession calling populate" populate (population sessionSt) liftIO $ debugM "leksah" "recoverSession calling setCurrentPages"@@ -560,7 +545,7 @@ if (fst . findbarState) sessionSt then showFindbar else hideFindbar- setCompletionSize (completionSize sessionSt)+ uncurry setCompletionSize (completionSize sessionSt) modifyIDE_ (\ide -> ide{recentFiles = recentOpenedFiles sessionSt, recentWorkspaces = recentOpenedWorksp sessionSt}) setFullScreenState (fullScreen sessionSt)@@ -588,25 +573,25 @@ case mbPair of Nothing -> return () Just (win,wid) -> do- liftIO $ widgetShowAll win- liftIO $ windowSetDefaultSize win width height+ widgetShowAll win+ windowSetDefaultSize win (fromIntegral width) (fromIntegral height) _ -> return ()- liftIO $notebookSetShowTabs nb (isJust mbTabPos)+ notebookSetShowTabs nb (isJust mbTabPos) case mbTabPos of- Just p -> liftIO $notebookSetTabPos nb (paneDirectionToPosType p)+ Just p -> notebookSetTabPos nb (paneDirectionToPosType p) _ -> return () forM_ (Map.toAscList groups) $ \(group, g) -> applyLayout' g (pp ++ [GroupP group]) applyLayout' (VerticalP l r pos) pp = do- viewSplit' pp Vertical+ viewSplit' pp OrientationVertical pane <- getPaned pp- liftIO $panedSetPosition pane pos+ panedSetPosition pane (fromIntegral pos) applyLayout' l (pp ++ [SplitP LeftP]) applyLayout' r (pp ++ [SplitP RightP]) applyLayout' (HorizontalP t b pos) pp = do- viewSplit' pp Horizontal+ viewSplit' pp OrientationHorizontal pane <- getPaned pp- liftIO $panedSetPosition pane pos+ panedSetPosition pane (fromIntegral pos) applyLayout' t (pp ++ [SplitP TopP]) applyLayout' b (pp ++ [SplitP BottomP]) @@ -625,7 +610,7 @@ setCurrentPages' g (GroupP group : p) when (ind >= 0) $ do nb <- getNotebook (reverse p)- liftIO $ notebookSetCurrentPage nb ind+ notebookSetCurrentPage nb (fromIntegral ind) viewFullScreen :: IDEAction viewFullScreen = do@@ -633,6 +618,6 @@ mbWindow <- getActiveWindow case (mbWindow, isFullScreen) of (Nothing, _) -> return ()- (Just window, True) -> liftIO $ windowFullscreen window- (Just window, False) -> liftIO $ windowUnfullscreen window+ (Just window, True) -> windowFullscreen window+ (Just window, False) -> windowUnfullscreen window
src/IDE/SourceCandy.hs view
@@ -46,9 +46,10 @@ index) import Data.Monoid ((<>)) import Control.Monad.IO.Class (MonadIO(..))-import Graphics.UI.Gtk.SourceView (sourceBufferNew)-import Graphics.UI.Gtk.Multiline.TextBuffer+import GI.Gtk.Objects.TextBuffer (textBufferGetIterAtMark, textBufferCreateMark, textBufferSetText)+import GI.GtkSource (bufferNew)+import GI.Gtk.Objects.TextTagTable (noTextTagTable) --------------------------------------------------------------------------------- -- * Implementation@@ -58,8 +59,8 @@ notBeforeOp = Set.fromList "!#$%&*+./<=>?@\\^|-~'\"" notAfterOp = notBeforeOp -keystrokeCandy :: TextEditor editor => CandyTable -> Maybe Char -> EditorBuffer editor -> (Text -> Bool) -> IDEM ()-keystrokeCandy (CT(transformTable,_)) mbc ebuf editInCommentOrString = do+keystrokeCandy :: TextEditor editor => CandyTable -> Char -> EditorBuffer editor -> (Text -> Bool) -> IDEM ()+keystrokeCandy (CT(transformTable,_)) c ebuf editInCommentOrString = do cursorMark <- getInsertMark ebuf endIter <- getIterAtMark ebuf cursorMark lineNr <- getLine endIter@@ -67,9 +68,9 @@ offset <- getOffset endIter startIter <- backwardToLineStartC endIter slice <- getSlice ebuf startIter endIter True- mbc2 <- case mbc of- Just c -> return (Just c)- Nothing -> getChar endIter+ mbc2 <- if c /= '\0'+ then return (Just c)+ else getChar endIter let block = editInCommentOrString slice unless block $ replace mbc2 cursorMark slice offset transformTable@@ -161,9 +162,9 @@ setModified ebuf modified simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView)-simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do- buffer <- sourceBufferNew Nothing- textBufferSetText buffer contents+simpleGtkBuffer contents = GtkBuffer <$> do+ buffer <- bufferNew noTextTagTable+ textBufferSetText buffer contents (-1) return buffer getCandylessText :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM Text@@ -195,8 +196,8 @@ getText workBuffer i1 i2 True -- 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+createTextMark (GtkBuffer sb) (GtkIter i) = textBufferCreateMark sb Nothing i+getIterAtTextMark (GtkBuffer sb) m = GtkIter <$> textBufferGetIterAtMark sb m positionFromCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> (Int,Int) -> IDEM (Int,Int) positionFromCandy candyTable ebuf (line,column) = do
src/IDE/Statusbar.hs view
@@ -20,155 +20,144 @@ import IDE.Core.State (postAsyncIDE, getMainWindow, widgetGet, PaneMonad(..), IDEAction(..), StatusbarCompartment(..))-import Graphics.UI.Gtk- (windowTitle,- castToStatusbar,- Statusbar(..),- boxPackStart,- hBoxNew,- widgetSetSizeRequest,- widgetSetName,- statusbarNew,- HBox(..),- statusbarPush,- statusbarPop,- Packing(..),- boxPackEnd,- imageSetPixelSize,- imageNewFromStock,- IconSize(..),- Image,- castToImage,- imageSetFromStock,- set,- AttrOp(..)- ) import Graphics.UI.Frame.Panes (IDEPane(..), paneName) import Text.Printf (printf) import Control.Monad.IO.Class (MonadIO(..)) import Data.Text (Text) import qualified Data.Text as T (pack, lines, unpack) import Data.Monoid ((<>))+import GI.Gtk.Objects.Statusbar+ (Statusbar(..), statusbarNew, statusbarPush, statusbarPop)+import GI.Gtk.Objects.Window (setWindowTitle)+import GI.Gtk.Objects.Image+ (Image(..), imageSetPixelSize, imageNewFromIconName,+ imageSetFromIconName)+import GI.Gtk.Enums (IconSize(..), Orientation(..))+import GI.Gtk.Objects.Box (boxNew, Box(..))+import GI.Gtk.Objects.Widget (widgetSetSizeRequest, widgetSetName)+import Graphics.UI.Editor.Parameters+ (Packing(..), boxPackEnd', boxPackStart')+import Data.GI.Base.ManagedPtr (unsafeCastTo) changeStatusbar :: [StatusbarCompartment] -> IDEAction changeStatusbar = postAsyncIDE . mapM_ changeStatusbar' where changeStatusbar' (CompartmentCommand accStr) = do sb <- getSBSpecialKeys- liftIO $statusbarPop sb 1- liftIO $statusbarPush sb 1 accStr+ statusbarPop sb 1+ statusbarPush sb 1 accStr return () changeStatusbar' (CompartmentPane (Just (PaneC pane))) = do sb <- getSBActivePane- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 (paneName pane)+ statusbarPop sb 1+ statusbarPush sb 1 (paneName pane) return () changeStatusbar' (CompartmentPane Nothing) = do sb <- getSBActivePane- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 ("" :: Text)+ statusbarPop sb 1+ statusbarPush sb 1 "" return () changeStatusbar' (CompartmentState string) = do let realStr = if '\n' `elem` T.unpack string then head (T.lines string) <> " ..." else string sb <- getSBErrors- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 realStr+ statusbarPop sb 1+ statusbarPush sb 1 realStr return () changeStatusbar' (CompartmentPackage string) = do sb <- getSBActivePackage window <- getMainWindow- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 string- liftIO $ set window [ windowTitle := "Leksah: " <> string ]+ statusbarPop sb 1+ statusbarPush sb 1 string+ setWindowTitle window $ "Leksah: " <> string return () changeStatusbar' (CompartmentBufferPos (line,col)) = do sb <- getStatusbarLC- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 (T.pack $ printf "Ln %4d, Col %3d" (line + 1) (col + 1))+ statusbarPop sb 1+ statusbarPush sb 1 (T.pack $ printf "Ln %4d, Col %3d" (line + 1) (col + 1)) return () changeStatusbar' (CompartmentOverlay modi) = do sb <- getStatusbarIO- liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 $ if modi then "OVR" else ("INS" :: Text)+ statusbarPop sb 1+ statusbarPush sb 1 $ if modi then "OVR" else "INS" return () changeStatusbar' (CompartmentBuild bool) = do im <- getImBuild- liftIO $ imageSetFromStock im (if bool then "ide_build" else "ide_empty") IconSizeMenu+ imageSetFromIconName im (Just $ if bool then "ide_build" else "ide_empty") (fromIntegral . fromEnum $ IconSizeMenu) return () changeStatusbar' (CompartmentCollect bool) = do im <- getImCollect- liftIO $ imageSetFromStock im (if bool then "ide_rebuild_meta" else "ide_empty") IconSizeMenu+ imageSetFromIconName im (Just $ if bool then "ide_rebuild_meta" else "ide_empty") (fromIntegral . fromEnum $ IconSizeMenu) return () -buildStatusbar :: IO HBox+buildStatusbar :: MonadIO m => m Box buildStatusbar = do sblk <- statusbarNew- widgetSetName sblk ("statusBarSpecialKeys" :: Text)+ widgetSetName sblk "statusBarSpecialKeys" widgetSetSizeRequest sblk 150 (-1) sbap <- statusbarNew- widgetSetName sbap ("statusBarActivePane" :: Text)+ widgetSetName sbap "statusBarActivePane" widgetSetSizeRequest sbap 150 (-1) sbapr <- statusbarNew- widgetSetName sbapr ("statusBarActiveProject" :: Text)+ widgetSetName sbapr "statusBarActiveProject" widgetSetSizeRequest sbapr 150 (-1) sbe <- statusbarNew- widgetSetName sbe ("statusBarErrors" :: Text)+ widgetSetName sbe "statusBarErrors" widgetSetSizeRequest sbe 150 (-1) sblc <- statusbarNew- widgetSetName sblc ("statusBarLineColumn" :: Text)+ widgetSetName sblc "statusBarLineColumn" widgetSetSizeRequest sblc 150 (-1) sbio <- statusbarNew- widgetSetName sbio ("statusBarInsertOverwrite" :: Text)+ widgetSetName sbio "statusBarInsertOverwrite" widgetSetSizeRequest sbio 60 (-1) - buildImage <- imageNewFromStock "ide_empty" IconSizeMenu- widgetSetName buildImage ("buildImage" :: Text)+ buildImage <- imageNewFromIconName (Just "ide_empty") (fromIntegral $ fromEnum IconSizeMenu)+ widgetSetName buildImage "buildImage" imageSetPixelSize buildImage 16 - collectImage <- imageNewFromStock "ide_empty" IconSizeMenu- widgetSetName collectImage ("collectImage" :: Text)+ collectImage <- imageNewFromIconName (Just "ide_empty") (fromIntegral $ fromEnum IconSizeMenu)+ widgetSetName collectImage "collectImage" imageSetPixelSize collectImage 16 - hb <- hBoxNew False 1- widgetSetName hb ("statusBox" :: Text)- boxPackStart hb sblk PackGrow 0- boxPackStart hb sbap PackGrow 0- boxPackStart hb sbapr PackGrow 0- --boxPackStart hb dummy PackGrow 0- boxPackEnd hb sblc PackNatural 0- boxPackEnd hb sbio PackNatural 0- boxPackEnd hb collectImage PackNatural 0- boxPackEnd hb buildImage PackNatural 0- boxPackEnd hb sbe PackNatural 0+ hb <- boxNew OrientationHorizontal 1+ widgetSetName hb "statusBox"+ boxPackStart' hb sblk PackGrow 0+ boxPackStart' hb sbap PackGrow 0+ boxPackStart' hb sbapr PackGrow 0+ --boxPackStart' hb dummy PackGrow 0+ boxPackEnd' hb sblc PackNatural 0+ boxPackEnd' hb sbio PackNatural 0+ boxPackEnd' hb collectImage PackNatural 0+ boxPackEnd' hb buildImage PackNatural 0+ boxPackEnd' hb sbe PackNatural 0 return hb getSBSpecialKeys :: PaneMonad alpha => alpha Statusbar-getSBSpecialKeys = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarSpecialKeys"] castToStatusbar+getSBSpecialKeys = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarSpecialKeys"] (unsafeCastTo Statusbar) getSBActivePane :: PaneMonad alpha => alpha Statusbar-getSBActivePane = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActivePane"] castToStatusbar+getSBActivePane = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActivePane"] (unsafeCastTo Statusbar) getSBActivePackage :: PaneMonad alpha => alpha Statusbar-getSBActivePackage = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActiveProject"] castToStatusbar+getSBActivePackage = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarActiveProject"] (unsafeCastTo Statusbar) getSBErrors :: PaneMonad alpha => alpha Statusbar-getSBErrors = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarErrors"] castToStatusbar+getSBErrors = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarErrors"] (unsafeCastTo Statusbar) getStatusbarIO :: PaneMonad alpha => alpha Statusbar-getStatusbarIO = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarInsertOverwrite"] castToStatusbar+getStatusbarIO = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarInsertOverwrite"] (unsafeCastTo Statusbar) getStatusbarLC :: PaneMonad alpha => alpha Statusbar-getStatusbarLC = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarLineColumn"] castToStatusbar+getStatusbarLC = widgetGet ["Leksah Main Window", "topBox","statusBox","statusBarLineColumn"] (unsafeCastTo Statusbar) getImBuild :: PaneMonad alpha => alpha Image-getImBuild = widgetGet ["Leksah Main Window", "topBox","statusBox","buildImage"] castToImage+getImBuild = widgetGet ["Leksah Main Window", "topBox","statusBox","buildImage"] (unsafeCastTo Image) getImCollect :: PaneMonad alpha => alpha Image-getImCollect = widgetGet ["Leksah Main Window", "topBox","statusBox","collectImage"] castToImage+getImCollect = widgetGet ["Leksah Main Window", "topBox","statusBox","collectImage"] (unsafeCastTo Image)
@@ -1,5 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.SymbolNavigation@@ -19,32 +22,58 @@ mapControlCommand ) where -import Graphics.UI.Gtk- (cursorNew, eventRootCoordinates, widgetAddEvents,- buttonPressEvent, eventIsHint, motionNotifyEvent, eventModifier,- drawWindowGetPointer, eventCoordinates, EventM, DrawWindow,- pointerGrab, screenGetDefault,- widgetGetAllocation, scrolledWindowGetVAdjustment,- adjustmentGetValue, scrolledWindowGetHAdjustment, pointerUngrab,- eventTime, leaveNotifyEvent, ScrolledWindow, Modifier(..),- Rectangle(..), EventMask(..), Underline(..),- widgetGetWindow- )-import System.Glib.Signals (on) import IDE.TextEditor (TextEditor(..), EditorView(..), EditorIter(..)) import IDE.Core.Types (IDEM)-import Graphics.UI.Editor.Basics (Connection(..), Connection) import Control.Monad.IO.Class (MonadIO(..))-import Graphics.UI.Gtk.Gdk.Cursor (CursorType(..)) import IDE.Utils.GUIUtils (mapControlCommand) import Data.IORef (writeIORef, readIORef, newIORef)-import Control.Monad (when)+import Control.Monad (join, when) import Data.Maybe (fromJust, isJust) import Control.Monad.Reader.Class (MonadReader(..)) import IDE.Core.State (reflectIDE) import Control.Applicative ((<$>)) import Data.Text (Text) import qualified Data.Text as T (length)+import GI.Gtk.Objects.ScrolledWindow+ (getScrolledWindowVadjustment, getScrolledWindowHadjustment,+ ScrolledWindow(..))+import Graphics.UI.Editor.Basics (Connection(..), Connection)+import GI.Pango.Enums (Underline(..))+import GI.Gdk.Objects.Cursor (cursorNew)+import GI.Gdk.Enums (GrabOwnership(..), CursorType(..))+import GI.Gtk.Objects.Widget+ (onWidgetButtonPressEvent, onWidgetMotionNotifyEvent,+ widgetGetWindow, widgetGetAllocation, onWidgetLeaveNotifyEvent)+import GI.Gdk.Structs.EventCrossing (getEventCrossingTime)+import GI.Gdk.Functions (pointerGrab, pointerUngrab)+import GI.Gtk.Objects.Adjustment (adjustmentGetValue)+import Graphics.UI.Frame.Rectangle+ (getRectangleHeight, getRectangleWidth)+import GI.Gdk.Objects.Screen (screenGetDefault)+import qualified GI.Gdk.Objects.Window as Gdk (noWindow)+import GI.Gdk.Structs.EventMotion+ (getEventMotionXRoot, getEventMotionY, getEventMotionX,+ getEventMotionState, getEventMotionTime, getEventMotionIsHint)+import GI.Gdk.Structs.EventButton+ (getEventButtonXRoot, getEventButtonY, getEventButtonX,+ getEventButtonState, getEventButtonTime)+import GI.Gdk.Objects.Window (windowGetOrigin)+import GI.Gdk+ (getEventButtonDevice, getEventMotionDevice,+ deviceGetDisplay, cursorNewForDisplay, displayGetDefault)+import Data.Foldable (forM_)+-- TODO fix seat code+#undef MIN_VERSION_GTK_3_20+#ifdef MIN_VERSION_GTK_3_20+import GI.Gdk.Flags+ (SeatCapabilities(..), EventMask(..), ModifierType(..))+import GI.Gdk.Objects.Device (deviceGetSeat)+import GI.Gdk.Objects.Seat (seatGrab, seatUngrab)+#else+import GI.Gdk.Flags+ (EventMask(..), ModifierType(..))+import GI.Gdk.Objects.Device (deviceGrab, deviceUngrab)+#endif data Locality = LocalityPackage | LocalityWorkspace | LocalitySystem -- in which category symbol is located deriving (Ord,Eq,Show)@@ -62,26 +91,35 @@ tvb <- getBuffer sv ttt <- getTagTable tvb linkTag <- newTag ttt "link"- underline linkTag UnderlineSingle- cursor <- liftIO $ cursorNew Hand2+ underline linkTag UnderlineSingle Nothing - id1 <- liftIO (sw `on` leaveNotifyEvent $ do- eventTime >>= (liftIO . pointerUngrab)- return True)+-- id1 <- ConnectC sw <$> onWidgetLeaveNotifyEvent sw (\e -> do+-- getEventCrossingTime e >>= pointerUngrab+-- return True) - let moveOrClick eventX eventY mods eventTime click = do- sx <- liftIO $ scrolledWindowGetHAdjustment sw >>= adjustmentGetValue- sy <- liftIO $ scrolledWindowGetVAdjustment sw >>= adjustmentGetValue+ let moveOrClick mbDevice eventX eventY mods eventTime mbMotion = do+#ifdef MIN_VERSION_GTK_3_20+ mbSeat <- mapM deviceGetSeat mbDevice+ let ungrab = mapM_ seatUngrab mbSeat+#else+ let ungrab = mapM_ (`deviceUngrab` eventTime) mbDevice+#endif+ mbHand <- mapM deviceGetDisplay mbDevice+ >>= mapM (`cursorNewForDisplay` CursorTypeHand2)+ sx <- getScrolledWindowHadjustment sw >>= adjustmentGetValue+ sy <- getScrolledWindowVadjustment sw >>= adjustmentGetValue let ex = eventX + sx ey = eventY + sy- ctrlPressed = mapControlCommand Control `elem` mods- shiftPressed = Shift `elem` mods+ ctrlPressed = mapControlCommand ModifierTypeControlMask `elem` mods+ shiftPressed = ModifierTypeShiftMask `elem` mods iter <- getIterAtLocation sv (round ex) (round ey)- (Rectangle _ _ szx szy) <- liftIO $ widgetGetAllocation sw+ rect <- widgetGetAllocation sw+ szx <- getRectangleWidth rect+ szy <- getRectangleHeight rect if eventX < 0 || eventY < 0 || round eventX > szx || round eventY > szy then do- liftIO $ pointerUngrab eventTime+ ungrab return True else do (beg, en) <- identifierMapper ctrlPressed shiftPressed iter@@ -90,29 +128,41 @@ offs <- getLineOffset beg offsc <- getLineOffset iter if T.length slice > 1 then- if click then do- liftIO $ pointerUngrab eventTime+ case mbMotion of+ Nothing -> do+ ungrab clickHandler ctrlPressed shiftPressed slice- else do+#ifdef MIN_VERSION_GTK_3_20+ Just motion -> do+#else+ Just _ -> do+#endif applyTagByName tvb "link" beg en- Just screen <- liftIO screenGetDefault- mbDW <- liftIO $ widgetGetWindow tv- case mbDW of+ screen <- screenGetDefault+ widgetGetWindow tv >>= \case Nothing -> return ()- Just dw -> do- liftIO $ pointerGrab dw False [PointerMotionMask,ButtonPressMask,LeaveNotifyMask] (Nothing :: Maybe DrawWindow) (Just cursor) eventTime- return ()- else do- liftIO $ pointerUngrab eventTime- return ()+ Just dw ->+#ifdef MIN_VERSION_GTK_3_20+ forM_ mbSeat $ \seat ->+ seatGrab seat dw [SeatCapabilitiesPointer] False mbHand (_convertToEvent <$> motion) Nothing+#else+ forM_ mbDevice $ \device ->+ deviceGrab device dw GrabOwnershipNone False+ [EventMaskPointerMotionMask,EventMaskButtonPressMask,EventMaskLeaveNotifyMask]+ mbHand eventTime+#endif+ else ungrab return True lineNumberBugFix <- liftIO $ newIORef Nothing- let fixBugWithX mods isHint (eventX, eventY) ptrx = do- let hasNoControlModifier = mapControlCommand Control `notElem` mods+ let fixBugWithX mods isHint (eventX, eventY) ptrx' = do+ Just window <- widgetGetWindow sw+ (_, ox, _) <- windowGetOrigin window+ let ptrx = ptrx' - (fromIntegral ox)+ let hasNoControlModifier = mapControlCommand ModifierTypeControlMask `notElem` mods lnbf <- readIORef lineNumberBugFix- -- print ("ishint?, adjusted, event.x, ptr.x, adjustment,hasControl?",isHint,ptrx - fromMaybe (-1000) lnbf , eventX, ptrx, lnbf, hasNoControlModifier)+ -- print ("ishint?, adjusted, event.x, ptr.x, adjustment,hasControl?",isHint, eventX, ptrx, lnbf, ox, hasNoControlModifier) -- when (isHint && hasNoControlModifier) $- when (abs (ptrx - eventX) > 1) $+ when (abs (ptrx - eventX) > 2) $ -- get difference between event X and pointer x -- event X is in coordinates of sourceView text -- pointer X is in coordinates of window (remember "show line numbers" ?)@@ -124,28 +174,30 @@ else eventX return (nx, eventY) ideR <- ask- liftIO $ do- id2 <- sw `on` motionNotifyEvent $ do- isHint <- eventIsHint- eventTime <- eventTime- mods <- eventModifier- (oldX, oldY) <- eventCoordinates- (rootX, _) <- eventRootCoordinates- (eventX, eventY) <- liftIO $ fixBugWithX mods isHint (oldX, oldY) rootX- liftIO $- -- print ("move adjustment: isHint, old, new root", isHint, eventX, oldX, rootX)- (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime False- return True- id3 <- sw `on` buttonPressEvent $ do- eventTime <- eventTime- mods <- eventModifier- -- liftIO $ print ("button press")- (oldX, oldY) <- eventCoordinates- (rootX, _) <- eventRootCoordinates- (eventX, eventY) <- liftIO $ fixBugWithX mods False (oldX, oldY) rootX- -- liftIO $ print ("click adjustment: old, new", eventX, oldX)- liftIO $ (`reflectIDE` ideR) $ moveOrClick eventX eventY mods eventTime True+ id2 <- ConnectC sw <$> onWidgetMotionNotifyEvent sw (\e -> do+ isHint <- (/=0) <$> getEventMotionIsHint e+ eventTime <- getEventMotionTime e+ mods <- getEventMotionState e+ oldX <- getEventMotionX e+ oldY <- getEventMotionY e+ rootX <- getEventMotionXRoot e+ device <- getEventMotionDevice e+ (eventX, eventY) <- liftIO $ fixBugWithX mods isHint (oldX, oldY) rootX+ -- print ("move adjustment: isHint, old, new root", isHint, eventX, oldX, rootX)+ (`reflectIDE` ideR) $ moveOrClick device eventX eventY mods eventTime (Just e)+ return True)+ id3 <- ConnectC sw <$> onWidgetButtonPressEvent sw (\e -> do+ eventTime <- getEventButtonTime e+ mods <- getEventButtonState e+ -- liftIO $ print ("button press")+ oldX <- getEventButtonX e+ oldY <- getEventButtonY e+ rootX <- getEventButtonXRoot e+ device <- getEventButtonDevice e+ (eventX, eventY) <- liftIO $ fixBugWithX mods False (oldX, oldY) rootX+ -- liftIO $ print ("click adjustment: old, new", eventX, oldX)+ (`reflectIDE` ideR) $ moveOrClick device eventX eventY mods eventTime Nothing) - return [ConnectC id1, ConnectC id2, ConnectC id3]+ return [{-id1,-} id2, id3]
src/IDE/TextEditor/Class.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor.Class@@ -20,22 +21,33 @@ , scrollToCursor ) where +import qualified IDE.Core.Types as Core (IDEM) import IDE.Core.Types- (LogRefType, IDE(..), IDERef, IDEM, IDEEventM, EditorStyle(..),- IDEAction(..), Prefs (..), editorStyle)+ (LogRefType, IDE(..), IDERef, IDEEventM, EditorStyle(..),+ Prefs (..), editorStyle) import Graphics.UI.Editor.Basics (Connection) import Control.Monad.Reader (ReaderT(..))-import Graphics.UI.Gtk- (Widget, ECrossing, ScrolledWindow, DrawWindow, Clipboard,- TextSearchFlags, Menu, EMotion, EKey, EButton, EventM, Rectangle,- Color, Underline) import Foreign (Ptr) import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.IO.Class (MonadIO(..))-import System.Glib.Signals (on) import Data.Text (Text) import IDE.Core.State (readIDE)+import GI.Gtk.Objects.Clipboard (Clipboard(..))+import qualified GI.Gdk as Gdk (Window)+import GI.Gdk+ (EventCrossing, EventMotion, EventKey, EventButton)+import Graphics.UI.Frame.Rectangle (Rectangle)+import GI.Gtk.Objects.ScrolledWindow (ScrolledWindow(..))+import GI.Gtk.Objects.Widget (Widget(..))+import GI.Gtk.Objects.Menu (Menu(..))+import GI.Gtk.Flags (TextSearchFlags)+import Text.PrinterParser (Color(..))+import GI.Pango (Underline)+import GHC.Stack (HasCallStack) +type IDEM a = HasCallStack => Core.IDEM a+type IDEAction = IDEM ()+ updateStyle :: TextEditor editor => EditorBuffer editor -> IDEAction updateStyle ebuf = do prefs <- readIDE prefs@@ -101,7 +113,7 @@ -> IDEM Text hasSelection :: EditorBuffer editor -> IDEM Bool insert :: EditorBuffer editor -> EditorIter editor -> Text -> IDEM ()- newView :: EditorBuffer editor -> Maybe Text -> IDEM (EditorView editor)+ newView :: EditorBuffer editor -> Maybe Text -> IDEM (EditorView editor, ScrolledWindow) pasteClipboard :: EditorBuffer editor -> Clipboard -> EditorIter editor@@ -119,13 +131,14 @@ undo :: EditorBuffer editor -> IDEM () -- Events+ afterChanged :: EditorBuffer editor -> IDEM () -> IDEM [Connection] afterModifiedChanged :: EditorBuffer editor -> IDEM () -> IDEM [Connection] -- View bufferToWindowCoords :: EditorView editor -> (Int, Int) -> IDEM (Int, Int) drawTabs :: EditorView editor -> IDEM () getBuffer :: EditorView editor -> IDEM (EditorBuffer editor)- getWindow :: EditorView editor -> IDEM (Maybe DrawWindow)+ getWindow :: EditorView editor -> IDEM (Maybe Gdk.Window) getIterAtLocation :: EditorView editor -> Int -> Int -> IDEM (EditorIter editor) getIterLocation :: EditorView editor -> EditorIter editor -> IDEM Rectangle getOverwrite :: EditorView editor -> IDEM Bool@@ -149,32 +162,33 @@ setRightMargin :: EditorView editor -> Maybe Int -> IDEM () setShowLineNumbers :: EditorView editor -> Bool -> IDEM () setTabWidth :: EditorView editor -> Int -> IDEM ()+ setEditable :: EditorView editor -> Bool -> IDEM () -- Events afterFocusIn :: EditorView editor -> IDEM () -> IDEM [Connection] afterMoveCursor :: EditorView editor -> IDEM () -> IDEM [Connection] afterToggleOverwrite :: EditorView editor -> IDEM () -> IDEM [Connection] onButtonPress :: EditorView editor- -> IDEEventM EButton Bool+ -> IDEEventM EventButton Bool -> IDEM [Connection] onButtonRelease :: EditorView editor- -> IDEEventM EButton Bool+ -> IDEEventM EventButton Bool -> IDEM [Connection] onCompletion :: EditorView editor -> IDEM () -> IDEM () -> IDEM [Connection] onKeyPress :: EditorView editor- -> IDEEventM EKey Bool+ -> IDEEventM EventKey Bool -> IDEM [Connection] onMotionNotify :: EditorView editor- -> IDEEventM EMotion Bool+ -> IDEEventM EventMotion Bool -> IDEM [Connection] onLeaveNotify :: EditorView editor- -> IDEEventM ECrossing Bool+ -> IDEEventM EventCrossing Bool -> IDEM [Connection] onKeyRelease :: EditorView editor- -> IDEEventM EKey Bool+ -> IDEEventM EventKey Bool -> IDEM [Connection]- onLookupInfo :: EditorView editor -> IDEEventM EButton Bool -> IDEM [Connection]- onMotionNotifyEvent :: EditorView editor -> IDEEventM EMotion Bool -> IDEM [Connection]+ onLookupInfo :: EditorView editor -> IDEEventM EventButton Bool -> IDEM [Connection]+ onMotionNotifyEvent :: EditorView editor -> IDEEventM EventMotion Bool -> IDEM [Connection] onPopulatePopup :: EditorView editor -> (Menu -> IDEM ()) -> IDEM [Connection] onSelectionChanged :: EditorBuffer editor -> IDEM () -> IDEM [Connection] @@ -222,5 +236,5 @@ -- Tag background :: EditorTag editor -> Color -> IDEM ()- underline :: EditorTag editor -> Underline -> IDEM ()+ underline :: EditorTag editor -> Underline -> Maybe Color -> IDEM ()
src/IDE/TextEditor/CodeMirror.hs view
@@ -38,10 +38,9 @@ ) where import Data.Typeable (Typeable)-import Graphics.UI.Gtk (scrolledWindowSetShadowType)-import Graphics.UI.Gtk.General.Enums (ShadowType(..)) import Data.Text (Text) import Text.Show (Show)+#ifdef LEKSAH_WITH_CODE_MIRROR import Data.Tuple (snd, fst) import Data.Function (($), (.)) import Data.Maybe (Maybe, Maybe(..))@@ -57,12 +56,35 @@ import qualified Data.Text as T (pack) import Control.Lens.Getter (to) import Control.Monad (liftM, (=<<))--#ifdef LEKSAH_WITH_CODE_MIRROR+import GI.WebKit.Objects.WebView+ (onWebViewPopulatePopup, webViewLoadString, webViewGetMainFrame,+ onWebViewLoadFinished, webViewNew, WebView(..))+import GI.Gtk.Functions (mainIteration)+import GI.Gtk.Objects.ScrolledWindow+ (ScrolledWindow(..), scrolledWindowSetShadowType,+ scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Enums (ShadowType(..))+import GI.Gtk.Objects.Container (containerAdd)+import GI.WebKit.Objects.WebFrame (webFrameGetGlobalContext)+import GI.Gtk.Objects.Widget+ (widgetAddEvents, onWidgetKeyReleaseEvent,+ onWidgetLeaveNotifyEvent, onWidgetMotionNotifyEvent,+ onWidgetKeyPressEvent, onWidgetButtonReleaseEvent,+ onWidgetButtonPressEvent, afterWidgetFocusInEvent, widgetGrabFocus,+ toWidget, widgetGetParent, widgetGetWindow)+import Graphics.UI.Frame.Rectangle+ (newRectangle)+import Data.GI.Base.ManagedPtr (withManagedPtr, unsafeCastTo)+import GI.Gdk.Flags (ModifierType(..), EventMask(..))+import GI.Gdk.Structs.EventButton (getEventButtonState)+import GI.JavaScriptCore.Structs.GlobalContext (GlobalContext(..))+import Foreign.Ptr (castPtr)+import Data.GI.Base.BasicConversions (gflagsToWord)+import Data.GI.Base.Attributes (AttrOp(..)) import Control.Monad (unless) import Data.Text (pack, unpack) import IDE.TextEditor.Class (TextEditor(..))-import Graphics.UI.Gtk.WebKit.Types (WebView(..)) import Control.Monad.Reader (ReaderT(..)) import Language.Javascript.JSaddle (valToObject, (#), JSContextRef, Object, jsg, jsg2, (<#), obj, js2, jss,@@ -75,26 +97,9 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Lens ((^.), IndexPreservingGetter)-import Graphics.UI.Gtk.WebKit.WebView- (webViewLoadUri, webViewLoadString, webViewGetMainFrame,- loadFinished, webViewNew) import qualified GHCJS.CodeMirror as CM (getDataDir)-import System.Glib.Signals (after, on)-import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame- (webFrameGetGlobalContext) import Text.Blaze.Html.Renderer.Text (renderHtml) import Text.Hamlet (shamlet)-import Graphics.UI.Gtk- (ScrolledWindow, menuPopup, menuAttachToWidget, menuNew,- popupMenuSignal, eventModifier, widgetAddEvents, keyReleaseEvent,- leaveNotifyEvent, motionNotifyEvent, keyPressEvent,- buttonReleaseEvent, buttonPressEvent, focusInEvent,- widgetGrabFocus, widgetGetParent, castToScrolledWindow,- containerAdd, scrolledWindowNew, Rectangle(..),- EventMask(..), Modifier(..), ContainerClass, mainIteration,- castToWidget,- widgetGetWindow- ) import Data.Maybe (fromJust) import IDE.Core.State (onIDE, reflectIDE, leksahOrPackageDir) import Graphics.UI.Editor.Basics (Connection(..))@@ -106,7 +111,7 @@ #ifdef LEKSAH_WITH_CODE_MIRROR data CodeMirrorState = CodeMirrorState {- cmContext :: JSContextRef+ cmContext :: GlobalContext , cmObject :: Object } type CM = ReaderT (WebView, CodeMirrorState) JSM webView :: CM WebView@@ -116,7 +121,7 @@ runCM :: CodeMirrorRef -> CM a -> IDEM a runCM (v, mvar) f = liftIO $ do s <- guiTakeMVar mvar- runReaderT (runReaderT f (v, s)) (cmContext s)+ withManagedPtr (cmContext s) (runReaderT (runReaderT f (v, s)) . castPtr) where guiTakeMVar mvar = do maybeValue <- tryTakeMVar mvar@@ -202,19 +207,19 @@ ideR <- ask liftIO $ do debugM "leksah" "newCMBuffer"- scrolledWindow <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledWindow ShadowIn+ scrolledWindow <- scrolledWindowNew noAdjustment noAdjustment+ scrolledWindowSetShadowType scrolledWindow ShadowTypeIn cmWebView <- webViewNew containerAdd scrolledWindow cmWebView dataDir <- liftIO $ leksahOrPackageDir "ghcjs-codemirror" CM.getDataDir s <- newEmptyMVar- cmWebView `on` loadFinished $ \ _ -> do+ onWebViewLoadFinished cmWebView $ \ _ -> do debugM "leksah" "newCMBuffer loadFinished" cmContext <- webViewGetMainFrame cmWebView >>= webFrameGetGlobalContext- let runjs f = f `runReaderT` cmContext+ let runjs f = withManagedPtr cmContext (runReaderT f . castPtr) runjs $ do- document <- jsg "document"+ document <- jsg "document" code <- obj code ^. setValue contents code ^. setMode "haskell"@@ -233,7 +238,7 @@ ++ "</head>" ++ "<body style=\"margin:0;padding:0 auto;\">" ++ "</body></html>"- ) Nothing (T.pack $ "file://" ++ dataDir ++ "/codemirror.html")+ ) (T.pack "text/html") (T.pack "UTF-8") (T.pack $ "file://" ++ dataDir ++ "/codemirror.html") debugM "leksah" "newCMBuffer loading" return $ CMBuffer (cmWebView, s) @@ -365,7 +370,7 @@ getBuffer (CMView cm) = return $ CMBuffer cm getWindow (CMView cm) = runCM cm $ do v <- webView- liftIO $ widgetGetWindow v+ widgetGetWindow v getIterAtLocation (CMView cm) x y = runCM cm $ do m <- codeMirror lift $ do@@ -381,13 +386,13 @@ r <- rect ^. right t <- rect ^. top b <- rect ^. bottom- return $ Rectangle (round l) (round t) (round $ r - l) (round $ b - t)+ newRectangle (round l) (round t) (round $ r - l) (round $ b - t) getOverwrite (CMView cm) = return False -- TODO- getScrolledWindow (CMView (v,_)) = liftIO . fmap (castToScrolledWindow . fromJust) $ widgetGetParent v- getEditorWidget (CMView (v,_)) = return $ castToWidget v+ getScrolledWindow (CMView (v,_)) = widgetGetParent v >>= (liftIO . unsafeCastTo ScrolledWindow . fromJust)+ getEditorWidget (CMView (v,_)) = liftIO $ toWidget v grabFocus (CMView cm) = runCM cm $ do v <- webView- liftIO $ widgetGrabFocus v+ widgetGrabFocus v scrollToMark (CMView cm) m withMargin mbAlign = do i <- getIterAtMark (CMBuffer cm) m scrollToIter (CMView cm) i withMargin mbAlign@@ -493,51 +498,47 @@ afterFocusIn (CMView (v, _)) f = do ideR <- ask liftIO $ do- id1 <- v `after` focusInEvent $ lift $ reflectIDE f ideR >> return False- return [ConnectC id1]+ id1 <- afterWidgetFocusInEvent v $ \e -> reflectIDE f ideR >> return False+ return [ConnectC v id1] afterModifiedChanged (CMBuffer cm) f = return [] -- TODO afterMoveCursor (CMView cm) f = return [] -- TODO afterToggleOverwrite (CMView cm) f = return [] -- TODO onButtonPress (CMView (v, _)) f = do- id1 <- v `onIDE` buttonPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonPressEvent v f+ return [id1] onButtonRelease (CMView (v, _)) f = do- id1 <- v `onIDE` buttonReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonReleaseEvent v f+ return [id1] onCompletion (CMView cm) start cancel = return [] -- TODO onKeyPress (CMView (v, _)) f = do- id1 <- v `onIDE` keyPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyPressEvent v f+ return [id1] onMotionNotify (CMView (v, _)) f = do- id1 <- v `onIDE` motionNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetMotionNotifyEvent v f+ return [id1] onLeaveNotify (CMView (v, _)) f = do- id1 <- v `onIDE` leaveNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetLeaveNotifyEvent v f+ return [id1] onKeyRelease (CMView (v, _)) f = do- id1 <- v `onIDE` keyReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyReleaseEvent v f+ return [id1] onLookupInfo (CMView (v, _)) f = do ideR <- ask- liftIO $ do- v `widgetAddEvents` [ButtonReleaseMask]- id1 <- (`reflectIDE` ideR) $ v `onIDE` buttonReleaseEvent $ do- mod <- lift eventModifier- case mod of- [Control] -> f >> return True- _ -> return False- return [ConnectC id1]+ widgetAddEvents v (gflagsToWord [EventMaskButtonReleaseMask])+ id1 <- onIDE onWidgetButtonReleaseEvent v $ do+ e <- lift ask+ mod <- liftIO $ getEventButtonState e+ case mod of+ [ModifierTypeControlMask] -> f >> return True+ _ -> return False+ return [id1] onMotionNotifyEvent (CMView cm) f = return [] -- TODO onPopulatePopup (CMView (v, _)) f = do ideR <- ask- liftIO $ do- id1 <- on v popupMenuSignal $ do- menu <- menuNew- menuAttachToWidget menu v- reflectIDE (f menu) ideR- menuPopup menu Nothing- return True- return [ConnectC id1]+ id1 <- onWebViewPopulatePopup v $ \menu -> do+ reflectIDE (f menu) ideR+ return [ConnectC v id1] onSelectionChanged (CMBuffer cm) f = return [] -- TODO+ setEditable _ _ = return () #endif
src/IDE/TextEditor/GtkSourceView.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor.GtkSourceView@@ -36,120 +38,135 @@ (LogRefType(..), LogRef(..), LogRefType, colorHexString, Prefs(..), IDE(..), IDEM) import Control.Monad.IO.Class (MonadIO(..))-import Graphics.UI.Gtk- (castToWidget, textViewGetIterAtLocation, focusOutEvent,- focusInEvent, modifiedChanged, textTagUnderline, textTagBackground,- textTagTableLookup, textTagTableAdd, textTagNew, textIterSetOffset,- textIterSetLineOffset, textIterSetLine, textIterGetBuffer,- textIterStartsWord, textIterStartsLine, textIterIsEnd,- textIterIsStart, textIterGetOffset, textIterGetLine,- textIterGetCharsInLine, textIterGetChar, textIterForwardWordEnd,- textIterForwardToLineEnd, textIterForwardSearch,- textIterForwardFindChar, textIterForwardChars, textIterForwardChar,- textIterEndsWord, textIterBackwardChars, textIterGetLineOffset,- textIterBackwardWordStart, textIterBackwardFindChar,- textIterBackwardChar, populatePopup, eventModifier,- keyReleaseEvent, leaveNotifyEvent, motionNotifyEvent,- keyPressEvent, focusOutEvent, textIterEqual, idleAdd,- bufferInsertText, buttonReleaseEvent, buttonPressEvent,- toggleOverwrite, endUserAction, widgetAddEvents, moveCursor,- scrolledWindowSetPolicy, textViewScrollToIter,- textViewScrollToMark, widgetGrabFocus, widgetGetParent,- castToScrolledWindow, textViewGetOverwrite,- textViewGetIterLocation, textViewBuffer,- textViewBufferToWindowCoords, textBufferSetModified,- textBufferSelectRange, textBufferRemoveTagByName,- textBufferPlaceCursor, textBufferPasteClipboard, widgetModifyFont,- containerAdd, scrolledWindowNew, textViewSetWrapMode,- textBufferMoveMark, textBufferInsert, textBufferHasSelection,- textBufferGetText, textBufferGetTagTable, textBufferGetStartIter,- textBufferGetSlice, textBufferGetSelectionBounds,- textBufferGetSelectionBound, textBufferGetModified,- textBufferGetLineCount, textBufferGetIterAtOffset,- textBufferGetIterAtMark, textBufferGetIterAtLine,- textBufferGetInsert, textBufferGetEndIter, textBufferEndUserAction,- textBufferDeleteSelection, textBufferDelete,- textBufferCutClipboard, textBufferCreateMark,- textBufferCopyClipboard, textBufferBeginUserAction,- textBufferApplyTagByName, TextTag, TextTagTable, TextMark,- textBufferSetText, textIterCopy, TextIter, Modifier(..),- FontDescription, fontDescriptionFromString, fontDescriptionNew,- fontDescriptionSetFamily, EventMask(..), after, Underline(..),- Color(..),- widgetGetWindow- ) import Data.Typeable (Typeable) import Control.Applicative ((<$>))-import Graphics.UI.Gtk.SourceView- (sourceBufferRemoveSourceMarks, sourceViewGetMarkAttributes,- sourceBufferCreateSourceMark, SourceMark,- sourceViewSetShowLineMarks,- sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,- sourceViewSetShowLineNumbers, sourceViewSetRightMarginPosition,- sourceViewSetShowRightMargin, sourceViewSetIndentWidth,- castToSourceBuffer, sourceViewSetDrawSpaces, sourceBufferUndo,- sourceBufferSetStyleScheme, sourceStyleSchemeManagerGetScheme,- sourceStyleSchemeManagerGetSchemeIds, sourceStyleSchemeManagerNew,- sourceBufferRedo, sourceViewSetSmartHomeEnd,- sourceViewSetAutoIndent, sourceViewSetIndentOnTab,- sourceViewSetInsertSpacesInsteadOfTabs,- sourceViewSetHighlightCurrentLine, sourceViewNewWithBuffer,- sourceBufferGetCanUndo, sourceBufferGetCanRedo, SourceView,- SourceBuffer, sourceBufferEndNotUndoableAction,- sourceBufferBeginNotUndoableAction, sourceBufferSetMaxUndoLevels,- sourceBufferNew, sourceBufferNewWithLanguage,- sourceLanguageManagerGuessLanguage,- sourceLanguageManagerSetSearchPath, gTypeSourceBuffer,- sourceLanguageManagerGetSearchPath, sourceLanguageManagerNew) import System.FilePath ((</>))-import System.GIO (contentTypeGuess) import IDE.Core.State (onIDE, reflectIDE, readIDE, getDataDir)-import Graphics.UI.Gtk.SourceView.Enums- (SourceDrawSpacesFlags(..), SourceSmartHomeEndType(..))-import Graphics.UI.Gtk.General.Enums- (PolicyType(..), TextWindowType(..), WrapMode(..)) import Control.Monad (void, when, forM_) import Control.Monad.Reader.Class (MonadReader(..)) import Graphics.UI.Editor.Basics (Connection(..))-import Data.Maybe (isNothing, maybeToList, fromJust)+import Data.Maybe+ (isJust, fromMaybe, isNothing, maybeToList, fromJust) import Data.IORef (writeIORef, readIORef, newIORef)-import System.Glib.MainLoop (priorityDefault, idleRemove) import Data.Char (isDigit, isSymbol, isAlphaNum)-import System.Glib.Signals- (GSignalMatchType(..), signalBlockMatched, after, on) import Control.Monad.Trans.Class (MonadTrans(..))-import System.Glib.Attributes (get, AttrOp(..), set)-import qualified Graphics.UI.Gtk as Gtk (endUserAction) import IDE.Utils.GUIUtils (fontDescription) import Data.Text (Text) import qualified Data.Text as T (drop, dropWhile, all, length, pack) import Data.Monoid ((<>))-import Graphics.UI.Gtk.Multiline.TextBuffer- (markSet, textBufferDeleteMarkByName, textBufferDeleteMark,- textBufferGetMark)-import Graphics.UI.Gtk.SourceView.SourceMarkAttributes- (queryTooltipText, sourceMarkAttributesSetIconName,- sourceMarkAttributesNew)-import Graphics.UI.Gtk.SourceView.SourceView- (sourceViewSetMarkAttributes)-import Graphics.UI.Gtk.Multiline.TextMark- (textMarkGetName, toTextMark) import Control.Arrow (Arrow(..)) import System.Log.Logger (debugM) import Foreign.ForeignPtr (withForeignPtr)-import System.Glib.GObject (GObjectClass(..), unGObject)-import Foreign.Ptr (castPtr)+import Foreign.Ptr (nullPtr, castPtr)+import qualified GI.GtkSource as Source+import GI.GtkSource+ (viewSetDrawSpaces, setViewTabWidth, setViewShowLineNumbers,+ setViewRightMarginPosition, setViewShowRightMargin,+ setViewIndentWidth, setViewDrawSpaces, bufferUndo,+ bufferSetStyleScheme, styleSchemeManagerGetScheme,+ styleSchemeManagerGetSchemeIds, styleSchemeManagerAppendSearchPath,+ styleSchemeManagerNew, bufferRemoveSourceMarks, bufferRedo,+ viewSetMarkAttributes, onMarkAttributesQueryTooltipText,+ markAttributesSetIconName, markAttributesNew, setViewShowLineMarks,+ setViewSmartHomeEnd, setViewAutoIndent, setViewIndentOnTab,+ setViewInsertSpacesInsteadOfTabs, setViewHighlightCurrentLine,+ viewNewWithBuffer, bufferCreateSourceMark, getBufferCanUndo,+ getBufferCanRedo, bufferEndNotUndoableAction,+ bufferBeginNotUndoableAction, bufferSetMaxUndoLevels, bufferNew,+ bufferNewWithLanguage, languageManagerGuessLanguage,+ languageManagerSetSearchPath, languageManagerGetSearchPath,+ languageManagerNew)+import GI.Gio (contentTypeGuess)+import GI.Gtk.Objects.TextBuffer+ (afterTextBufferChanged, setTextBufferText, onTextBufferMarkSet,+ afterTextBufferInsertText, afterTextBufferEndUserAction,+ afterTextBufferModifiedChanged, textBufferSetModified,+ textBufferSelectRange, textBufferRemoveTagByName,+ textBufferPlaceCursor, textBufferPasteClipboard, textBufferInsert,+ textBufferGetText, textBufferGetStartIter, textBufferGetSlice,+ textBufferGetSelectionBounds, textBufferGetSelectionBound,+ textBufferGetModified, textBufferGetLineCount,+ textBufferGetIterAtOffset, textBufferGetIterAtMark,+ textBufferGetIterAtLine, textBufferGetInsert, textBufferGetEndIter,+ textBufferEndUserAction, textBufferDeleteSelection,+ textBufferDelete, textBufferCutClipboard, textBufferGetMark,+ textBufferCopyClipboard, textBufferBeginUserAction,+ textBufferApplyTagByName, textBufferGetTagTable, textBufferSetText)+import GI.Gtk.Objects.TextTag+import GI.Gtk.Objects.TextTagTable+ (noTextTagTable, textTagTableLookup, TextTagTable(..),+ textTagTableAdd)+import GI.Gtk.Objects.TextMark (textMarkGetName, TextMark(..))+import GI.Gtk.Objects.TextView+ (textViewSetEditable, onTextViewPopulatePopup,+ onTextViewMoveCursor, afterTextViewToggleOverwrite,+ afterTextViewMoveCursor, textViewScrollToIter,+ textViewScrollToMark, textViewGetOverwrite,+ textViewGetIterLocation, textViewGetIterAtLocation,+ textViewBufferToWindowCoords, textViewSetWrapMode,+ getTextViewBuffer)+import Data.GI.Base.ManagedPtr+ (castTo, withManagedPtr, unsafeCastTo)+import GI.GObject.Functions+ (signalHandlersBlockMatched, signalLookup)+import Data.GI.Base.BasicTypes (GObject(..))+import GI.GObject.Flags (SignalMatchType(..))+import GI.GtkSource.Enums (SmartHomeEndType(..))+import GI.Gtk.Enums+ (PolicyType(..), TextWindowType(..), WrapMode(..))+import GI.Gtk.Objects.ScrolledWindow+ (ScrolledWindow(..), scrolledWindowSetPolicy, scrolledWindowNew)+import GI.Gtk.Objects.Adjustment (noAdjustment)+import GI.Gtk.Objects.Container (containerAdd)+import GI.Gtk.Objects.Widget+ (onWidgetKeyReleaseEvent, onWidgetLeaveNotifyEvent,+ onWidgetMotionNotifyEvent, onWidgetKeyPressEvent,+ onWidgetFocusOutEvent, onWidgetButtonPressEvent,+ onWidgetButtonReleaseEvent, widgetAddEvents,+ afterWidgetFocusInEvent, widgetGrabFocus, toWidget,+ widgetGetParent, widgetGetWindow, widgetModifyFont)+import GI.Pango.Enums (Underline(..))+import GI.GtkSource.Flags (DrawSpacesFlags(..))+import Data.GI.Base.BasicConversions (gflagsToWord)+import GI.Gdk.Flags (ModifierType(..), EventMask(..))+import GI.GLib (pattern PRIORITY_DEFAULT, idleAdd, sourceRemove)+import GI.Gdk+ (setRGBAAlpha, setRGBABlue, setRGBAGreen, setRGBARed, newZeroRGBA,+ RGBA, getEventButtonState)+import GI.Gtk.Structs.TextIter+ (textIterSetOffset, textIterSetLineOffset, textIterSetLine,+ textIterGetBuffer, textIterStartsWord, textIterStartsLine,+ textIterIsEnd, textIterIsStart, textIterGetOffset,+ textIterGetCharsInLine, textIterGetChar, textIterForwardWordEnd,+ textIterForwardToLineEnd, textIterForwardSearch,+ textIterForwardFindChar, textIterForwardChars, textIterForwardChar,+ textIterEndsWord, textIterBackwardChars, textIterGetLineOffset,+ textIterBackwardWordStart, textIterBackwardFindChar,+ textIterBackwardChar, textIterEqual, textIterGetLine, textIterCopy,+ TextIter(..))+import Data.Text.Encoding (encodeUtf8)+import qualified GI.Gdk as Gdk (Window(..))+import Control.Monad.Trans.Reader (ReaderT(..))+import GI.Gtk.Objects.Menu (Menu(..))+import Data.GI.Base.Constructible (Constructible(..))+import Data.GI.Base.Attributes (AttrOp(..))+import Text.PrinterParser (Color(..))+import GI.Gtk (widgetOverrideFont, setTextTagUnderlineRgba)+import GI.GtkSource.Objects.StyleScheme+ (styleSchemeGetStyle, StyleScheme(..))+import GI.GtkSource.Objects.Style+import GI.Pango.Enums (Weight (..), Style (..)) transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView) transformGtkIter (GtkIter i) f = do- new <- liftIO $ textIterCopy i+ new <- textIterCopy i liftIO $ f new return (GtkIter new) transformGtkIterMaybe :: EditorIter GtkSourceView -> (TextIter -> IO Bool) -> IDEM (Maybe (EditorIter GtkSourceView)) transformGtkIterMaybe (GtkIter i) f = do- new <- liftIO $ textIterCopy i+ new <- textIterCopy i found <- liftIO $ f new return $ if found then Just (GtkIter new)@@ -158,316 +175,367 @@ data GtkSourceView = GtkSourceView deriving( Typeable, Show ) newGtkBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer GtkSourceView)-newGtkBuffer mbFilename contents = liftIO $ do- lm <- sourceLanguageManagerNew+newGtkBuffer mbFilename contents = do+ liftIO $ debugM "lekash" "newGtkBuffer"+ lm <- languageManagerNew dataDir <- getDataDir- oldPath <- sourceLanguageManagerGetSearchPath lm- sourceLanguageManagerSetSearchPath lm (Just $ (dataDir </> "language-specs") : oldPath)+ oldPath <- languageManagerGetSearchPath lm+ languageManagerSetSearchPath lm (Just $ T.pack (dataDir </> "language-specs") : oldPath) mbLang <- case mbFilename of Just filename -> do- guess <- contentTypeGuess filename contents (T.length contents)- sourceLanguageManagerGuessLanguage lm (Just filename) $+ guess <- contentTypeGuess (Just $ T.pack filename) (Just $ encodeUtf8 contents)+ languageManagerGuessLanguage lm (Just $ T.pack filename) $ case guess of- (True, _) -> Just "text/x-haskell"- (False, t) -> Just t- Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just ("text/x-haskell" :: Text))+ (_, True) -> Just "text/x-haskell"+ (t, False) -> Just t+ Nothing -> languageManagerGuessLanguage lm Nothing (Just "text/x-haskell") mbLang2 <- case mbLang of- Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just ("text/x-haskell" :: Text))+ Nothing -> languageManagerGuessLanguage lm Nothing (Just "text/x-haskell") _ -> return mbLang buffer <- case mbLang2 of- Just sLang -> sourceBufferNewWithLanguage sLang- Nothing -> sourceBufferNew Nothing- sourceBufferSetMaxUndoLevels buffer (-1)- sourceBufferBeginNotUndoableAction buffer- textBufferSetText buffer contents- sourceBufferEndNotUndoableAction buffer+ Just sLang -> bufferNewWithLanguage sLang+ Nothing -> bufferNew noTextTagTable+ bufferSetMaxUndoLevels buffer (-1)+ bufferBeginNotUndoableAction buffer+ liftIO $ debugM "lekash" "newGtkBuffer setTextBufferText"+ setTextBufferText buffer contents+ bufferEndNotUndoableAction buffer+ liftIO $ debugM "lekash" "newGtkBuffer setup tag table" tagTable <- textBufferGetTagTable buffer- textTagNew (Just "found") >>= textTagTableAdd tagTable- textTagNew (Just "match") >>= textTagTableAdd tagTable+ textTagNew (Just "search-match") >>= textTagTableAdd tagTable+ textTagNew (Just "selection-match") >>= textTagTableAdd tagTable textTagNew (Just "context") >>= textTagTableAdd tagTable textTagNew (Just "breakpoint") >>= textTagTableAdd tagTable forM_ [minBound .. maxBound :: LogRefType] $ \ refType -> textTagNew (Just . T.pack $ show refType) >>= textTagTableAdd tagTable return $ GtkBuffer buffer ++-- | Sets the style for a type of tag in the buffer by looking in the stylescheme+-- for a style with the given name, otherwise use the provided action+-- that sets some style on the TextTag (for standard sourceview styleschemes we can't+-- edit the stylescheme files)+setTagStyle :: Source.Buffer -> Text -> StyleScheme -> (Text -> IDEM ()) -> IDEM ()+setTagStyle sb tagName scheme applyDefaultStyle = do+ tagTable <- textBufferGetTagTable sb+ mbTag <- textTagTableLookup tagTable tagName+ forM_ mbTag $ \tag -> do+ mbStyle <- styleSchemeGetStyle scheme tagName+ case mbStyle of+ Just style -> applyStyle tag style+ Nothing -> applyDefaultStyle tagName+ where+ applyStyle :: TextTag -> Source.Style -> IDEM ()+ applyStyle tag style = do+ mbBg <- getStyleBackground style+ forM_ mbBg (setTextTagBackground tag)+ mbFg <- getStyleForeground style+ forM_ mbFg (setTextTagForeground tag)+ bold <- getStyleBold style+ when bold (setTextTagWeight tag (fromIntegral . fromEnum $ WeightBold))+ italic <- getStyleItalic style+ when italic (setTextTagStyle tag StyleItalic)+ instance TextEditor GtkSourceView where- data EditorBuffer GtkSourceView = GtkBuffer SourceBuffer- data EditorView GtkSourceView = GtkView SourceView+ data EditorBuffer GtkSourceView = GtkBuffer Source.Buffer+ data EditorView GtkSourceView = GtkView Source.View data EditorMark GtkSourceView = GtkMark TextMark data EditorIter GtkSourceView = GtkIter TextIter data EditorTagTable GtkSourceView = GtkTagTable TextTagTable data EditorTag GtkSourceView = GtkTag TextTag newBuffer = newGtkBuffer- applyTagByName (GtkBuffer sb) name (GtkIter first) (GtkIter last) = liftIO $+ applyTagByName (GtkBuffer sb) name (GtkIter first) (GtkIter last) = textBufferApplyTagByName sb name first last- beginNotUndoableAction (GtkBuffer sb) = liftIO $ sourceBufferBeginNotUndoableAction sb- beginUserAction (GtkBuffer sb) = liftIO $ textBufferBeginUserAction sb- canRedo (GtkBuffer sb) = liftIO $ sourceBufferGetCanRedo sb- canUndo (GtkBuffer sb) = liftIO $ sourceBufferGetCanUndo sb- copyClipboard (GtkBuffer sb) clipboard = liftIO $ textBufferCopyClipboard sb clipboard- createMark (GtkView sv) refType (GtkIter i) tooltip = liftIO $ do- sb <- castToSourceBuffer <$> get sv textViewBuffer+ beginNotUndoableAction (GtkBuffer sb) = bufferBeginNotUndoableAction sb+ beginUserAction (GtkBuffer sb) = textBufferBeginUserAction sb+ canRedo (GtkBuffer sb) = getBufferCanRedo sb+ canUndo (GtkBuffer sb) = getBufferCanUndo sb+ copyClipboard (GtkBuffer sb) = textBufferCopyClipboard sb+ createMark (GtkView sv) refType (GtkIter i) tooltip = do+ sb <- getTextViewBuffer sv >>= liftIO . unsafeCastTo Source.Buffer n <- textIterGetLine i let cat = T.pack $ show refType name = T.pack (show n) <> " " <> tooltip mark <- textBufferGetMark sb name when (isNothing mark) . void $- sourceBufferCreateSourceMark sb (Just name) cat i- cutClipboard (GtkBuffer sb) clipboard defaultEditable = liftIO $ textBufferCutClipboard sb clipboard defaultEditable- delete (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $+ bufferCreateSourceMark sb (Just name) cat i+ cutClipboard (GtkBuffer sb) = textBufferCutClipboard sb+ delete (GtkBuffer sb) (GtkIter first) (GtkIter last) = textBufferDelete sb first last- deleteSelection (GtkBuffer sb) = liftIO . void $ textBufferDeleteSelection sb True True- endNotUndoableAction (GtkBuffer sb) = liftIO $ sourceBufferEndNotUndoableAction sb- endUserAction (GtkBuffer sb) = liftIO $ textBufferEndUserAction sb- getEndIter (GtkBuffer sb) = liftIO $ GtkIter <$> textBufferGetEndIter sb- getInsertMark (GtkBuffer sb) = liftIO $ GtkMark <$> textBufferGetInsert sb- getIterAtLine (GtkBuffer sb) line = liftIO $ GtkIter <$> textBufferGetIterAtLine sb line- getIterAtMark (GtkBuffer sb) (GtkMark m) = liftIO $ GtkIter <$> textBufferGetIterAtMark sb m- getIterAtOffset (GtkBuffer sb) offset = liftIO $ GtkIter <$> textBufferGetIterAtOffset sb offset- getLineCount (GtkBuffer sb) = liftIO $ textBufferGetLineCount sb- getModified (GtkBuffer sb) = liftIO $ textBufferGetModified sb- getSelectionBoundMark (GtkBuffer sb) = liftIO $ GtkMark <$> textBufferGetSelectionBound sb- getSelectionBounds (GtkBuffer sb) = liftIO $ (GtkIter *** GtkIter) <$>+ deleteSelection (GtkBuffer sb) = void $ textBufferDeleteSelection sb True True+ endNotUndoableAction (GtkBuffer sb) = bufferEndNotUndoableAction sb+ endUserAction (GtkBuffer sb) = textBufferEndUserAction sb+ getEndIter (GtkBuffer sb) = GtkIter <$> textBufferGetEndIter sb+ getInsertMark (GtkBuffer sb) = GtkMark <$> textBufferGetInsert sb+ getIterAtLine (GtkBuffer sb) line = GtkIter <$> textBufferGetIterAtLine sb (fromIntegral line)+ getIterAtMark (GtkBuffer sb) (GtkMark m) = GtkIter <$> textBufferGetIterAtMark sb m+ getIterAtOffset (GtkBuffer sb) offset = GtkIter <$> textBufferGetIterAtOffset sb (fromIntegral offset)+ getLineCount (GtkBuffer sb) = fromIntegral <$> textBufferGetLineCount sb+ getModified (GtkBuffer sb) = textBufferGetModified sb+ getSelectionBoundMark (GtkBuffer sb) = GtkMark <$> textBufferGetSelectionBound sb+ getSelectionBounds (GtkBuffer sb) = (\(_, a, b) -> (GtkIter a, GtkIter b)) <$> textBufferGetSelectionBounds sb- getInsertIter (GtkBuffer sb) = liftIO $ GtkIter <$> do+ getInsertIter (GtkBuffer sb) = GtkIter <$> do insertMark <- textBufferGetInsert sb textBufferGetIterAtMark sb insertMark- getSlice (GtkBuffer sb) (GtkIter first) (GtkIter last) includeHidenChars = liftIO $+ getSlice (GtkBuffer sb) (GtkIter first) (GtkIter last) includeHidenChars = textBufferGetSlice sb first last includeHidenChars- getStartIter (GtkBuffer sb) = liftIO $ GtkIter <$> textBufferGetStartIter sb- getTagTable (GtkBuffer sb) = liftIO $ GtkTagTable <$> textBufferGetTagTable sb- getText (GtkBuffer sb) (GtkIter first) (GtkIter last) includeHidenChars = liftIO $+ getStartIter (GtkBuffer sb) = GtkIter <$> textBufferGetStartIter sb+ getTagTable (GtkBuffer sb) = GtkTagTable <$> textBufferGetTagTable sb+ getText (GtkBuffer sb) (GtkIter first) (GtkIter last) includeHidenChars = textBufferGetText sb first last includeHidenChars- hasSelection (GtkBuffer sb) = liftIO $ textBufferHasSelection sb- insert (GtkBuffer sb) (GtkIter i) text = liftIO $ textBufferInsert sb i text+ hasSelection (GtkBuffer sb) = (\(b, _, _) -> b) <$> textBufferGetSelectionBounds sb+ insert (GtkBuffer sb) (GtkIter i) text = textBufferInsert sb i text (-1) newView (GtkBuffer sb) mbFontString = do+ liftIO $ debugM "lekash" "newView (GtkSourceView)" prefs <- readIDE prefs fd <- fontDescription mbFontString- liftIO $ GtkView <$> do- sv <- sourceViewNewWithBuffer sb+ sv <- viewNewWithBuffer sb - -- Disable source_mark_updated handler in sv because it schedules a full redraw- -- that turns out to be unnecessary and very costly in Leksah- withForeignPtr (unGObject $ toGObject sv) $ \svPtr -> void $- signalBlockMatched sb [SignalMatchId, SignalMatchData]- "source_mark_updated" gTypeSourceBuffer 0 Nothing Nothing (Just (castPtr svPtr))+ -- Disable source_mark_updated handler in sv because it schedules a full redraw+ -- that turns out to be unnecessary and very costly in Leksah+ signal <- signalLookup "source_mark_updated" =<< liftIO (gobjectType (undefined :: Source.Buffer))+ liftIO $ withManagedPtr sv $ \svPtr ->+ signalHandlersBlockMatched sb [SignalMatchTypeId, SignalMatchTypeData]+ signal 0 Nothing nullPtr (castPtr svPtr) - sourceViewSetHighlightCurrentLine sv True- sourceViewSetInsertSpacesInsteadOfTabs sv True- sourceViewSetIndentOnTab sv True- sourceViewSetAutoIndent sv True- sourceViewSetSmartHomeEnd sv SourceSmartHomeEndBefore- sourceViewSetShowLineMarks sv True- forM_ [minBound..maxBound] $ \ refType -> do- let cat = T.pack $ show refType- icon = case refType of- ErrorRef -> "ide_error"- WarningRef -> "ide_warning"- TestFailureRef -> "software-update-urgent"- LintRef -> "ide_suggestion"- BreakpointRef -> "media-playback-pause"- ContextRef -> "media-playback-start"- attributes <- sourceMarkAttributesNew- sourceMarkAttributesSetIconName attributes (Just (icon :: Text))- on attributes queryTooltipText $ \ mark -> maybe "" (T.drop 1 . T.dropWhile isDigit) <$> textMarkGetName mark- sourceViewSetMarkAttributes sv cat (Just attributes) (1 + fromEnum(maxBound :: LogRefType) - fromEnum refType)- if wrapLines prefs- then textViewSetWrapMode sv WrapWord- else textViewSetWrapMode sv WrapNone- sw <- scrolledWindowNew Nothing Nothing- containerAdd sw sv- widgetModifyFont sv (Just fd)- return sv- pasteClipboard (GtkBuffer sb) clipboard (GtkIter i) defaultEditable = liftIO $- textBufferPasteClipboard sb clipboard i defaultEditable- placeCursor (GtkBuffer sb) (GtkIter i) = liftIO $ textBufferPlaceCursor sb i- redo (GtkBuffer sb) = liftIO $ sourceBufferRedo sb- removeTagByName (GtkBuffer sb) name = liftIO $ do+ liftIO $ debugM "lekash" "newView set attirbutes"+ setViewHighlightCurrentLine sv True+ setViewInsertSpacesInsteadOfTabs sv True+ setViewIndentOnTab sv True+ setViewAutoIndent sv True+ setViewSmartHomeEnd sv SmartHomeEndTypeBefore+ setViewShowLineMarks sv True++ liftIO $ debugM "lekash" "newView set up mark attributes"+ forM_ [minBound..maxBound] $ \ refType -> do+ let cat = T.pack $ show refType+ icon = case refType of+ ErrorRef -> "ide_error"+ WarningRef -> "ide_warning"+ TestFailureRef -> "software-update-urgent"+ LintRef -> "ide_suggestion"+ BreakpointRef -> "media-playback-pause"+ ContextRef -> "media-playback-start"+ attributes <- markAttributesNew+ markAttributesSetIconName attributes icon+ onMarkAttributesQueryTooltipText attributes $ \ mark ->+ maybe "" (T.drop 1 . T.dropWhile isDigit) <$> textMarkGetName mark+ viewSetMarkAttributes sv cat attributes (fromIntegral $ 1 + fromEnum(maxBound :: LogRefType) - fromEnum refType)+ textViewSetWrapMode sv (if wrapLines prefs+ then WrapModeWord+ else WrapModeNone)+ sw <- scrolledWindowNew noAdjustment noAdjustment+ containerAdd sw sv+ widgetOverrideFont sv (Just fd)+ return (GtkView sv, sw)+ pasteClipboard (GtkBuffer sb) clipboard (GtkIter i) defaultEditable =+ textBufferPasteClipboard sb clipboard (Just i) defaultEditable+ placeCursor (GtkBuffer sb) (GtkIter i) = textBufferPlaceCursor sb i+ redo (GtkBuffer sb) = bufferRedo sb+ removeTagByName (GtkBuffer sb) name = do first <- textBufferGetStartIter sb last <- textBufferGetEndIter sb textBufferRemoveTagByName sb name first last- sourceBufferRemoveSourceMarks sb first last name- selectRange (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $+ bufferRemoveSourceMarks sb first last (Just name)+ selectRange (GtkBuffer sb) (GtkIter first) (GtkIter last) = textBufferSelectRange sb first last- setModified (GtkBuffer sb) modified = liftIO . void $ textBufferSetModified sb modified- setStyle (GtkBuffer sb) EditorStyle {..} =+ setModified (GtkBuffer sb) modified = void $ textBufferSetModified sb modified+ setStyle (GtkBuffer sb) EditorStyle {..} = do+ liftIO $ debugM "lekash" "setStyle (GtkSourceView)" case styleName of Nothing -> return () Just str -> do- styleManager <- liftIO sourceStyleSchemeManagerNew+ styleManager <- liftIO styleSchemeManagerNew dataDir <- liftIO getDataDir- liftIO $ sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles"- ids <- liftIO $ sourceStyleSchemeManagerGetSchemeIds styleManager+ styleSchemeManagerAppendSearchPath styleManager . T.pack $ dataDir </> "data/styles"+ ids <- fromMaybe [] <$> styleSchemeManagerGetSchemeIds styleManager let preferedNames = if preferDark then [str<>"-dark", str] else [str] forM_ (take 1 $ filter (`elem` ids) preferedNames) $ \ name -> do- liftIO $ do- scheme <- sourceStyleSchemeManagerGetScheme styleManager name- sourceBufferSetStyleScheme sb (Just scheme)+ scheme <- styleSchemeManagerGetScheme styleManager name+ bufferSetStyleScheme sb (Just scheme) tagTable <- getTagTable (GtkBuffer sb)- let isDark = name `elem` ["leksah-dark", "oblivion", "cobalt"]+ let isDark = name `elem` ["leksah-dark", "oblivion", "cobalt", "industrial"] setBG (dark, light) (Just tag) = background tag (if isDark then dark else light) setBG _ Nothing = return ()- setUnderline = maybe (return ()) (`underline` UnderlineError)- lookupTag tagTable "match" >>= setBG matchBG- lookupTag tagTable "found" >>= setBG foundBG- lookupTag tagTable (T.pack $ show ErrorRef ) >>= setUnderline- lookupTag tagTable (T.pack $ show WarningRef ) >>= setUnderline- lookupTag tagTable (T.pack $ show TestFailureRef) >>= setUnderline- lookupTag tagTable (T.pack $ show LintRef ) >>= setBG lintBG- lookupTag tagTable (T.pack $ show BreakpointRef ) >>= setBG breakpointBG- lookupTag tagTable (T.pack $ show ContextRef ) >>= setBG contextBG- setText (GtkBuffer sb) text = liftIO $ textBufferSetText sb text- undo (GtkBuffer sb) = liftIO $ sourceBufferUndo sb+ setUnderline mbCol = maybe (return ()) (\tag -> underline tag UnderlineError mbCol)+ -- This is ugly, we just have to make sure we only provide+ -- styleschemes that include styles for these tags+ let applyDefaultStyling tagName = do+ mbTag <- lookupTag tagTable tagName+ case tagName of+ "selection-match" -> setBG matchBG mbTag+ "search-match" -> setBG foundBG mbTag+ "BreakpointRef" -> setBG breakpointBG mbTag+ "ContextRef" -> setBG contextBG mbTag+ "ErrorRef" -> setUnderline Nothing mbTag+ "WarningRef" -> setUnderline (Just $ Color 214 176 4) mbTag+ "TestFailureRef" -> setUnderline (Just $ Color 207 18 241) mbTag+ "LintRef" -> setUnderline (Just $ Color 21 110 209) mbTag+ _ -> return ()+ let tagNames = ["selection-match", "search-match"]+ ++ map (T.pack . show)+ [ErrorRef, WarningRef, TestFailureRef, LintRef, BreakpointRef, ContextRef]+ forM_ tagNames $ \tagName -> do+ setTagStyle sb tagName scheme applyDefaultStyling + setText (GtkBuffer sb) text = setTextBufferText sb text+ undo (GtkBuffer sb) = bufferUndo sb++ afterChanged (GtkBuffer sb) f = do+ ideR <- ask+ id1 <- ConnectC sb <$> afterTextBufferChanged sb (reflectIDE f ideR)+ return [id1]+ afterModifiedChanged (GtkBuffer sb) f = do ideR <- ask- liftIO $ do- id1 <- sb `after` modifiedChanged $ reflectIDE f ideR- return [ConnectC id1]+ id1 <- ConnectC sb <$> afterTextBufferModifiedChanged sb (reflectIDE f ideR)+ return [id1] -- View- bufferToWindowCoords (GtkView sv) point = liftIO $ textViewBufferToWindowCoords sv TextWindowWidget point- drawTabs (GtkView sv) = liftIO $ sourceViewSetDrawSpaces sv [SourceDrawSpacesTab, SourceDrawSpacesSpace, SourceDrawSpacesTrailing]- getBuffer (GtkView sv) = liftIO $ (GtkBuffer . castToSourceBuffer) <$> sv `get` textViewBuffer- getWindow (GtkView sv) = liftIO $ widgetGetWindow sv- getIterAtLocation (GtkView sv) x y = liftIO $ GtkIter <$> textViewGetIterAtLocation sv x y- getIterLocation (GtkView sv) (GtkIter i) = liftIO $ textViewGetIterLocation sv i- getOverwrite (GtkView sv) = liftIO $ textViewGetOverwrite sv- getScrolledWindow (GtkView sv) = liftIO $ (castToScrolledWindow . fromJust) <$> widgetGetParent sv- getEditorWidget (GtkView sv) = return $ castToWidget sv- grabFocus (GtkView sv) = liftIO $ widgetGrabFocus sv- scrollToMark (GtkView sv) (GtkMark m) withMargin mbAlign = liftIO $ textViewScrollToMark sv m withMargin mbAlign- scrollToIter (GtkView sv) (GtkIter i) withMargin mbAlign = liftIO . void $ textViewScrollToIter sv i withMargin mbAlign+ bufferToWindowCoords (GtkView sv) (x, y) = (fromIntegral *** fromIntegral) <$>+ textViewBufferToWindowCoords sv TextWindowTypeWidget (fromIntegral x) (fromIntegral y)+ drawTabs (GtkView sv) = viewSetDrawSpaces sv [DrawSpacesFlagsTab, DrawSpacesFlagsSpace, DrawSpacesFlagsTrailing]+ getBuffer (GtkView sv) = GtkBuffer <$> (getTextViewBuffer sv >>= (liftIO . unsafeCastTo Source.Buffer))+ getWindow (GtkView sv) = widgetGetWindow sv+ getIterAtLocation (GtkView sv) x y = GtkIter+#ifdef MIN_VERSION_GTK_3_20+ . snd+#endif+ <$> textViewGetIterAtLocation sv (fromIntegral x) (fromIntegral y)+ getIterLocation (GtkView sv) (GtkIter i) = textViewGetIterLocation sv i+ getOverwrite (GtkView sv) = textViewGetOverwrite sv+ getScrolledWindow (GtkView sv) = widgetGetParent sv >>= \case+ Just v -> liftIO $ unsafeCastTo ScrolledWindow v+ Nothing -> error "getScrolledWindow failed"+ getEditorWidget (GtkView sv) = liftIO $ toWidget sv+ grabFocus (GtkView sv) = widgetGrabFocus sv+ scrollToMark (GtkView sv) (GtkMark m) withMargin mbAlign = uncurry (textViewScrollToMark sv m withMargin (isJust mbAlign)) $ fromMaybe (0,0) mbAlign+ scrollToIter (GtkView sv) (GtkIter i) withMargin mbAlign = void $ uncurry (textViewScrollToIter sv i withMargin (isJust mbAlign)) $ fromMaybe (0,0) mbAlign setFont (GtkView sv) mbFontString = do fd <- fontDescription mbFontString- liftIO $ widgetModifyFont sv (Just fd)- setIndentWidth (GtkView sv) width = liftIO $ sourceViewSetIndentWidth sv width+ widgetModifyFont sv (Just fd)+ setIndentWidth (GtkView sv) width = setViewIndentWidth sv (fromIntegral width) setWrapMode v@(GtkView sv) wrapLines = do sw <- getScrolledWindow v if wrapLines- then liftIO $ do- textViewSetWrapMode sv WrapWord- scrolledWindowSetPolicy sw PolicyNever PolicyAutomatic- else liftIO $ do- textViewSetWrapMode sv WrapNone- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic- setRightMargin (GtkView sv) mbRightMargin = liftIO $+ then do+ textViewSetWrapMode sv WrapModeWord+ scrolledWindowSetPolicy sw PolicyTypeNever PolicyTypeAutomatic+ else do+ textViewSetWrapMode sv WrapModeNone+ scrolledWindowSetPolicy sw PolicyTypeAutomatic PolicyTypeAutomatic+ setRightMargin (GtkView sv) mbRightMargin = case mbRightMargin of Just n -> do- sourceViewSetShowRightMargin sv True- sourceViewSetRightMarginPosition sv (fromIntegral n)- Nothing -> sourceViewSetShowRightMargin sv False- setShowLineNumbers (GtkView sv) show = liftIO $ sourceViewSetShowLineNumbers sv show- setTabWidth (GtkView sv) width = liftIO $ sourceViewSetTabWidth sv width+ setViewShowRightMargin sv True+ setViewRightMarginPosition sv (fromIntegral n)+ Nothing -> setViewShowRightMargin sv False+ setShowLineNumbers (GtkView sv) show = setViewShowLineNumbers sv show+ setTabWidth (GtkView sv) width = setViewTabWidth sv (fromIntegral width) -- Events afterFocusIn (GtkView sv) f = do ideR <- ask- liftIO $ do- id1 <- sv `after` focusInEvent $ lift $ reflectIDE f ideR >> return False- return [ConnectC id1]+ id1 <- ConnectC sv <$> afterWidgetFocusInEvent sv (\e -> reflectIDE f ideR >> return False)+ return [id1] afterMoveCursor v@(GtkView sv) f = do ideR <- ask (GtkBuffer sb) <- getBuffer v- liftIO $ do- id1 <- sv `after` moveCursor $ \_ _ _ -> reflectIDE f ideR- sv `widgetAddEvents` [ButtonReleaseMask]- id2 <- sv `on` buttonReleaseEvent $ lift $ reflectIDE f ideR >> return False- id3 <- sb `after` Gtk.endUserAction $ reflectIDE f ideR- return [ConnectC id1, ConnectC id2, ConnectC id3]+ id1 <- ConnectC sv <$> afterTextViewMoveCursor sv (\_ _ _ -> reflectIDE f ideR)+ widgetAddEvents sv (gflagsToWord [EventMaskButtonReleaseMask])+ id2 <- ConnectC sv <$> onWidgetButtonReleaseEvent sv (\e -> reflectIDE f ideR >> return False)+ id3 <- ConnectC sb <$> afterTextBufferEndUserAction sb (reflectIDE f ideR)+ return [id1, id2, id3] afterToggleOverwrite (GtkView sv) f = do ideR <- ask- liftIO $ do- id1 <- sv `after` toggleOverwrite $ reflectIDE f ideR- return [ConnectC id1]+ id1 <- ConnectC sv <$> afterTextViewToggleOverwrite sv (reflectIDE f ideR)+ return [id1] onButtonPress (GtkView sv) f = do- id1 <- sv `onIDE` buttonPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonPressEvent sv f+ return [id1] onButtonRelease (GtkView sv) f = do- id1 <- sv `onIDE` buttonReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonReleaseEvent sv f+ return [id1] onCompletion v@(GtkView sv) start cancel = do ideR <- ask (GtkBuffer sb) <- getBuffer v- liftIO $ do- -- when multiple afterBufferInsertText are called quickly,- -- we cancel previous idle action which was not processed,- -- its handler is stored here.- -- Paste operation is example of such sequential events (each word!).- lastHandler <- newIORef Nothing- id1 <- after sb bufferInsertText $ \iter text -> do- lh <- readIORef lastHandler- debugM "leksah" $ "Removing " <> show lh- mapM_ idleRemove $ maybeToList lh- h <- flip idleAdd priorityDefault $ do- writeIORef lastHandler Nothing- let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.'- let isOp a = isSymbol a || a == ':' || a == '\\' || a == '*' || a == '/' || a == '-'- || a == '!' || a == '@' || a == '%' || a == '&' || a == '?'- if T.all isIdent text || T.all isOp text- then do- hasSel <- textBufferHasSelection sb- if not hasSel- then do- (iterC, _) <- textBufferGetSelectionBounds sb- atC <- textIterEqual iter iterC- when atC $ reflectIDE start ideR- return False- else do- reflectIDE cancel ideR- return False- else do- reflectIDE cancel ideR- return False- writeIORef lastHandler (Just h)- return ()- id2 <- sv `on` moveCursor $ \_ _ _ -> reflectIDE cancel ideR- id3 <- sv `on` buttonPressEvent $ lift $ reflectIDE cancel ideR >> return False- id4 <- sv `on` focusOutEvent $ lift $ reflectIDE cancel ideR >> return False- return [ConnectC id1, ConnectC id2, ConnectC id3, ConnectC id4]+ -- when multiple afterBufferInsertText are called quickly,+ -- we cancel previous idle action which was not processed,+ -- its handler is stored here.+ -- Paste operation is example of such sequential events (each word!).+ lastHandler <- liftIO $ newIORef Nothing+ id1 <- ConnectC sb <$> afterTextBufferInsertText sb (\iter text _ -> do+ lh <- readIORef lastHandler+ debugM "leksah" $ "Removing " <> show lh+ mapM_ sourceRemove $ maybeToList lh+ h <- idleAdd PRIORITY_DEFAULT $ do+ writeIORef lastHandler Nothing+ let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.'+ let isOp a = isSymbol a || a == ':' || a == '\\' || a == '*' || a == '/' || a == '-'+ || a == '!' || a == '@' || a == '%' || a == '&' || a == '?'+ if T.all isIdent text || T.all isOp text+ then do+ (hasSel, iterC, _) <- textBufferGetSelectionBounds sb+ if not hasSel+ then do+ atC <- textIterEqual iter iterC+ when atC $ reflectIDE start ideR+ return False+ else do+ reflectIDE cancel ideR+ return False+ else do+ reflectIDE cancel ideR+ return False+ writeIORef lastHandler (Just h)+ return ())+ id2 <- ConnectC sv <$> onTextViewMoveCursor sv (\_ _ _ -> reflectIDE cancel ideR)+ id3 <- ConnectC sv <$> onWidgetButtonPressEvent sv (\e -> reflectIDE cancel ideR >> return False)+ id4 <- ConnectC sv <$> onWidgetFocusOutEvent sv (\e -> reflectIDE cancel ideR >> return False)+ return [id1, id2, id3, id4] onKeyPress (GtkView sv) f = do- id1 <- sv `onIDE` keyPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyPressEvent sv f+ return [id1] onMotionNotify (GtkView sv) f = do- id1 <- sv `onIDE` motionNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetMotionNotifyEvent sv f+ return [id1] onLeaveNotify (GtkView sv) f = do- id1 <- sv `onIDE` leaveNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetLeaveNotifyEvent sv f+ return [id1] onKeyRelease (GtkView sv) f = do- id1 <- sv `onIDE` keyReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyReleaseEvent sv f+ return [id1] onLookupInfo (GtkView sv) f = do- liftIO $ sv `widgetAddEvents` [ButtonReleaseMask]- id1 <- sv `onIDE` buttonReleaseEvent $ do- mod <- lift eventModifier+ widgetAddEvents sv $ gflagsToWord [EventMaskButtonReleaseMask]+ id1 <- onIDE onWidgetButtonReleaseEvent sv $ do+ e <- lift ask+ mod <- getEventButtonState e case mod of- [Control] -> f >> return True+ [ModifierTypeControlMask] -> f >> return True _ -> return False- return [ConnectC id1]+ return [id1] onMotionNotifyEvent (GtkView sv) handler = do- liftIO $ widgetAddEvents sv [ButtonMotionMask, Button1MotionMask] -- TODO: this doesn't work yet event gets fired anyways: restrict event to being fired when left mouse button is pressed down- id1 <- sv `onIDE` motionNotifyEvent $ handler --TODO this is potentially slowing leksah, a better event (if there was any) could be more efficient here- liftIO $ widgetAddEvents sv [ButtonMotionMask, Button1MotionMask] -- TODO: this doesn't work yet event gets fired anyways: restrict event to being fired when left mouse button is pressed down- return [ConnectC id1]+ widgetAddEvents sv $ gflagsToWord [EventMaskButtonMotionMask, EventMaskButton1MotionMask] -- TODO: this doesn't work yet event gets fired anyways: restrict event to being fired when left mouse button is pressed down+ id1 <- onIDE onWidgetMotionNotifyEvent sv handler --TODO this is potentially slowing leksah, a better event (if there was any) could be more efficient here+ widgetAddEvents sv $ gflagsToWord [EventMaskButtonMotionMask, EventMaskButton1MotionMask] -- TODO: this doesn't work yet event gets fired anyways: restrict event to being fired when left mouse button is pressed down+ return [id1] onPopulatePopup (GtkView sv) f = do ideR <- ask- liftIO $ do- id1 <- sv `on` populatePopup $ \menu -> reflectIDE (f menu) ideR- return [ConnectC id1]+ id1 <- ConnectC sv <$> onTextViewPopulatePopup sv (\menu -> reflectIDE (f =<< liftIO (unsafeCastTo Menu menu)) ideR)+ return [id1] onSelectionChanged (GtkBuffer sb) handler = do ideR <- ask- liftIO $ do- id1 <- sb `on` markSet $ \ _ mark -> do- name <- textMarkGetName mark- when (name == Just "insert") $ reflectIDE handler ideR- return [ConnectC id1]+ id1 <- ConnectC sb <$> onTextBufferMarkSet sb (\ _ mark -> do+ name <- textMarkGetName mark+ when (name == Just "insert") $ reflectIDE handler ideR)+ return [id1] -- Iter backwardCharC i = transformGtkIter i textIterBackwardChar backwardFindCharC i pred mbLimit = transformGtkIterMaybe i $ \x ->- textIterBackwardFindChar x pred $+ textIterBackwardFindChar x (return . pred) $ case mbLimit of Just (GtkIter limit) -> Just limit Nothing -> Nothing@@ -476,49 +544,60 @@ n <- textIterGetLineOffset new textIterBackwardChars new n return ()- endsWord (GtkIter i) = liftIO $ textIterEndsWord i+ endsWord (GtkIter i) = textIterEndsWord i forwardCharC i = transformGtkIter i textIterForwardChar- forwardCharsC i n = transformGtkIter i $ flip textIterForwardChars n+ forwardCharsC i n = transformGtkIter i $ flip textIterForwardChars (fromIntegral n) forwardFindCharC i pred mbLimit = transformGtkIterMaybe i $ \x ->- textIterForwardFindChar x pred $+ textIterForwardFindChar x (return . pred) $ case mbLimit of Just (GtkIter limit) -> Just limit Nothing -> Nothing- forwardSearch (GtkIter i) str flags mbLimit = liftIO $ fmap (fmap (GtkIter *** GtkIter)) $- textIterForwardSearch i str flags $+ forwardSearch (GtkIter i) str flags mbLimit =+ textIterForwardSearch i str flags ( case mbLimit of Just (GtkIter limit) -> Just limit- Nothing -> Nothing+ Nothing -> Nothing) >>= \case+ (False, _, _) -> return Nothing+ (True, a, b) -> return $ Just (GtkIter a, GtkIter b) forwardToLineEndC i = transformGtkIter i textIterForwardToLineEnd forwardWordEndC i = transformGtkIterMaybe i textIterForwardWordEnd- getChar (GtkIter i) = liftIO $ textIterGetChar i- getCharsInLine (GtkIter i) = liftIO $ textIterGetCharsInLine i- getLine (GtkIter i) = liftIO $ textIterGetLine i- getLineOffset (GtkIter i) = liftIO $ textIterGetLineOffset i- getOffset (GtkIter i) = liftIO $ textIterGetOffset i- isStart (GtkIter i) = liftIO $ textIterIsStart i- isEnd (GtkIter i) = liftIO $ textIterIsEnd i- iterEqual (GtkIter i1) (GtkIter i2) = liftIO $ textIterEqual i1 i2- startsLine (GtkIter i) = liftIO $ textIterStartsLine i- startsWord (GtkIter i) = liftIO $ textIterStartsWord i- atEnd (GtkIter i) = liftIO $ GtkIter <$> do+ getChar (GtkIter i) = textIterGetChar i >>= \case '\0' -> return Nothing+ c -> return $ Just c+ getCharsInLine (GtkIter i) = fromIntegral <$> textIterGetCharsInLine i+ getLine (GtkIter i) = fromIntegral <$> textIterGetLine i+ getLineOffset (GtkIter i) = fromIntegral <$> textIterGetLineOffset i+ getOffset (GtkIter i) = fromIntegral <$> textIterGetOffset i+ isStart (GtkIter i) = textIterIsStart i+ isEnd (GtkIter i) = textIterIsEnd i+ iterEqual (GtkIter i1) (GtkIter i2) = textIterEqual i1 i2+ startsLine (GtkIter i) = textIterStartsLine i+ startsWord (GtkIter i) = textIterStartsWord i+ atEnd (GtkIter i) = GtkIter <$> do buffer <- textIterGetBuffer i textBufferGetEndIter buffer- atLine i line = transformGtkIter i $ flip textIterSetLine line- atLineOffset i column = transformGtkIter i $ flip textIterSetLineOffset column- atOffset i offset = transformGtkIter i $ flip textIterSetOffset offset- atStart (GtkIter i) = liftIO $ GtkIter <$> do+ atLine i line = transformGtkIter i $ flip textIterSetLine (fromIntegral line)+ atLineOffset i column = transformGtkIter i $ flip textIterSetLineOffset (fromIntegral column)+ atOffset i offset = transformGtkIter i $ flip textIterSetOffset (fromIntegral offset)+ atStart (GtkIter i) = GtkIter <$> do buffer <- textIterGetBuffer i textBufferGetEndIter buffer -- Tag Table- newTag (GtkTagTable tt) name = liftIO $ GtkTag <$> do+ newTag (GtkTagTable tt) name = GtkTag <$> do t <- textTagNew (Just name) textTagTableAdd tt t return t- lookupTag (GtkTagTable tt) name = liftIO $ fmap GtkTag <$> textTagTableLookup tt name+ lookupTag (GtkTagTable tt) name = fmap GtkTag <$> textTagTableLookup tt name -- Tag- background (GtkTag t) color = liftIO $ set t [textTagBackground := T.pack $ colorHexString color]- underline (GtkTag t) value = liftIO $ set t [textTagUnderline := value]-+ background (GtkTag t) color = setTextTagBackground t . T.pack $ colorHexString color+ underline (GtkTag t) value Nothing = setTextTagUnderline t value+ underline (GtkTag t) value (Just (Color r g b)) = do+ col <- newZeroRGBA+ setRGBARed col (fromIntegral r / 255)+ setRGBAGreen col (fromIntegral g / 255)+ setRGBABlue col (fromIntegral b / 255)+ setRGBAAlpha col 1+ setTextTagUnderline t value+ setTextTagUnderlineRgba t col+ setEditable (GtkView view) b = textViewSetEditable view b
src/IDE/TextEditor/Yi.hs view
@@ -33,11 +33,31 @@ ) where import Data.Typeable (Typeable)-import Graphics.UI.Gtk (castToWidget)++#ifdef LEKSAH_WITH_YI import Data.Text (Text) import qualified Data.Text as T (pack, unpack)+import GI.Gtk+ (noWidget, getCurrentEventTime, menuPopup, menuAttachToWidget,+ menuNew, onWidgetPopupMenu, onWidgetKeyReleaseEvent,+ onWidgetLeaveNotifyEvent, onWidgetMotionNotifyEvent,+ onWidgetKeyPressEvent, onWidgetButtonReleaseEvent,+ onWidgetButtonPressEvent, widgetAddEvents, afterWidgetFocusInEvent,+ widgetGrabFocus, toWidget, widgetGetWindow)+import GI.Gdk+ (getEventButtonState)+import Graphics.UI.Frame.Rectangle+ (Rectangle(..), newRectangle)+import Data.GI.Base.Attributes (AttrOp(..))+import GI.Pango (layoutSetFontDescription)+import Yi (nelemsB, readAtB, moveB)+import Yi.Buffer.TextUnit (TextUnit(..))+import GI.Gdk.Flags (ModifierType(..), EventMask(..))+import Control.Monad (void)+import qualified Yi.Rope as R (head)+import IDE.Core.Types (MonadIDE(..))+import Data.GI.Base.BasicConversions (gflagsToWord) -#ifdef LEKSAH_WITH_YI import IDE.TextEditor.Class (TextEditor(..)) import IDE.Core.Types (IDEM) import IDE.Core.State (liftYi, onIDE, reflectIDE, liftYiControl)@@ -48,7 +68,7 @@ setBufferMode) import Yi (moveToColB, gotoLn, atSol, atEof, atSof, curCol, curLn, readLnB,- readCharB, nextWordB, moveToEol, rightB, rightN, nextPointB,+ nextWordB, moveToEol, rightB, rightN, unitWord, atBoundaryB, moveToSol, prevWordB, leftB, readB, doUntilB_, prevPointB, Mode, modifyMode, insertingA, undoB, markSavedB, setSelectRegionB, redoB, markPointA, insertNAt,@@ -66,20 +86,10 @@ import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO(..)) import Data.Time (getCurrentTime)-import qualified Graphics.UI.Gtk as Gtk (Modifier(..)) import IDE.Utils.GUIUtils (fontDescription)-import Graphics.UI.Gtk- (popupMenuSignal, focusInEvent, menuPopup, menuAttachToWidget,- menuNew, eventModifier, widgetAddEvents, keyReleaseEvent,- leaveNotifyEvent, motionNotifyEvent, keyPressEvent,- buttonReleaseEvent, buttonPressEvent, widgetGrabFocus,- Rectangle(..), layoutSetFontDescription, EventMask(..),- widgetGetWindow- ) import Control.Monad.Reader.Class (MonadReader(..)) import Graphics.UI.Editor.Basics (Connection(..)) import Control.Monad.Trans.Class (MonadTrans(..))-import System.Glib.Signals (on, after) import Control.Lens (use) #endif @@ -151,7 +161,7 @@ canRedo (YiBuffer fb) = return True -- TODO canUndo (YiBuffer fb) = return True -- TODO copyClipboard (YiBuffer fb) _ = liftYi $ withEditor $ copy- createMark (YiView b) _name (YiIter (Iter _ p)) _icon _description = withYiBuffer b $+ createMark (YiView b) _name (YiIter (Iter _ p)) _toolTip = void . withYiBuffer (Yi.getBuffer b) $ YiMark <$> newMarkB (MarkValue p Backward) cutClipboard (YiBuffer fb) clipboard defaultEditable = liftYi $ withEditor $ cut delete (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) =@@ -188,7 +198,8 @@ insert (YiBuffer b) (YiIter (Iter _ p)) text = withYiBuffer b $ insertNAt (Yi.fromText text) p newView (YiBuffer b) mbFontString = do fd <- fontDescription mbFontString- liftYiControl $ fmap YiView $ Yi.newView b fd+ v <- liftYiControl $ Yi.newView b fd+ return (YiView v, scrollWin v) pasteClipboard (YiBuffer b) clipboard (YiIter (Iter _ p)) defaultEditable = liftYi $ withEditor $ paste placeCursor (YiBuffer b) (YiIter (Iter _ p)) = withYiBuffer b $ moveTo p redo (YiBuffer b) = withYiBuffer b redoB@@ -198,24 +209,24 @@ setModified (YiBuffer b) modified = unless modified $ do now <- liftIO $ getCurrentTime withYiBuffer b $ markSavedB now- setStyle preferDark (YiBuffer b) mbStyle = return () -- TODO+ setStyle (YiBuffer b) mbStyle = return () -- TODO setText (YiBuffer b) text = liftYiControl $ Yi.setText b (Yi.fromText text) undo (YiBuffer b) = withYiBuffer b undoB bufferToWindowCoords (YiView v) point = return point -- TODO drawTabs (YiView _) = return () -- TODO getBuffer (YiView v) = return $ YiBuffer $ Yi.getBuffer v- getWindow (YiView v) = liftIO $ widgetGetWindow (drawArea v)+ getWindow (YiView v) = widgetGetWindow (drawArea v) getIterAtLocation (YiView View{viewFBufRef = b}) x y = return $ mkYiIter' b $ Point 0 -- TODO- getIterLocation (YiView v) (YiIter i) = return $ Rectangle 0 0 0 0 -- TODO+ getIterLocation (YiView v) (YiIter i) = newRectangle 0 0 0 0 -- TODO getOverwrite (YiView View{viewFBufRef = b}) = withYiBuffer' b $ not <$> use insertingA getScrolledWindow (YiView v) = return $ scrollWin v- getEditorWidget (YiView v) = return $ castToWidget $ drawArea v- grabFocus (YiView View{drawArea = da}) = liftIO $ widgetGrabFocus da+ getEditorWidget (YiView v) = liftIO . toWidget $ drawArea v+ grabFocus (YiView View{drawArea = da}) = widgetGrabFocus da scrollToMark (YiView v) (YiMark m) withMargin mbAlign = return () -- TODO scrollToIter (YiView v) (YiIter i) withMargin mbAlign = return () -- TODO setFont (YiView v) mbFontString = do fd <- fontDescription mbFontString- liftIO $ layoutSetFontDescription (layout v) (Just fd)+ layoutSetFontDescription (layout v) (Just fd) setIndentWidth (YiView View{viewFBufRef = b}) width = withYiBuffer' b $ modifyMode $ \ (mode@Mode{modeIndentSettings = mis}) ->@@ -240,7 +251,7 @@ backwardToLineStartC (YiIter i) = transformYiIter i moveToSol endsWord (YiIter i) = withYiIter i $ do atBoundaryB unitWord Forward- forwardCharC (YiIter i) = transformYiIter' i nextPointB+ forwardCharC i = forwardCharsC i 1 forwardCharsC (YiIter i) n = transformYiIter i $ rightN n forwardFindCharC (YiIter i) pred mbLimit = tryTransformYiIter i $ doUntilB_ (pred <$> readB) rightB@@ -252,7 +263,7 @@ if p == newPoint then return Nothing else return . Just $ mkYiIter' b newPoint- getChar (YiIter i) = withYiIter i readCharB+ getChar (YiIter (Iter b p)) = withYiBuffer' b $ R.head <$> nelemsB 1 p getCharsInLine (YiIter i) = withYiIter i $ Yi.length <$> readLnB getLine (YiIter i) = withYiIter i curLn getLineOffset (YiIter i) = withYiIter i curCol@@ -273,50 +284,51 @@ underline (YiTag) value = return () -- TODO afterFocusIn (YiView v) f = do ideR <- ask- liftIO $ do- id1 <- (drawArea v) `after` focusInEvent $ lift $ reflectIDE f ideR >> return False- return [ConnectC id1]+ id1 <- onIDE afterWidgetFocusInEvent (drawArea v) $ liftIDE f >> return True+ return [id1] afterModifiedChanged (YiBuffer b) f = return [] -- TODO afterMoveCursor (YiView v) f = return [] -- TODO afterToggleOverwrite (YiView v) f = return [] -- TODO onButtonPress (YiView v) f = do- id1 <- (drawArea v) `onIDE` buttonPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonPressEvent (drawArea v) f+ return [id1] onButtonRelease (YiView v) f = do- id1 <- (drawArea v) `onIDE` buttonReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) f+ return [id1] onCompletion (YiView v) start cancel = return [] -- TODO onKeyPress (YiView v) f = do- id1 <- (drawArea v) `onIDE` keyPressEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyPressEvent (drawArea v) f+ return [id1] onMotionNotify (YiView v) f = do- id1 <- (drawArea v) `onIDE` motionNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetMotionNotifyEvent (drawArea v) f+ return [id1] onLeaveNotify (YiView v) f = do- id1 <- (drawArea v) `onIDE` leaveNotifyEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetLeaveNotifyEvent (drawArea v) f+ return [id1] onKeyRelease (YiView v) f = do- id1 <- (drawArea v) `onIDE` keyReleaseEvent $ f- return [ConnectC id1]+ id1 <- onIDE onWidgetKeyReleaseEvent (drawArea v) f+ return [id1] onLookupInfo (YiView v) f = do- liftIO $ (drawArea v) `widgetAddEvents` [ButtonReleaseMask]- id1 <- (drawArea v) `onIDE` buttonReleaseEvent $ do- mod <- lift $ eventModifier+ widgetAddEvents (drawArea v) (gflagsToWord [EventMaskButtonReleaseMask])+ id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) $ do+ e <- lift ask+ mod <- getEventButtonState e case mod of- [Gtk.Control] -> f >> return True- _ -> return False- return [ConnectC id1]+ [ModifierTypeControlMask] -> f >> return True+ _ -> return False+ return [id1] onMotionNotifyEvent (YiView v) f = return [] -- TODO onPopulatePopup (YiView v) f = do ideR <- ask liftIO $ do- id1 <- (drawArea v) `on` popupMenuSignal $ do+ id1 <- ConnectC (drawArea v) <$> onWidgetPopupMenu (drawArea v) (do menu <- menuNew- menuAttachToWidget menu (drawArea v)+ menuAttachToWidget menu (drawArea v) Nothing reflectIDE (f menu) ideR- menuPopup menu Nothing- return True- return [ConnectC id1]-+ menuPopup menu noWidget noWidget Nothing 0 =<< getCurrentEventTime+ return True)+ return [id1]+ onSelectionChanged (YiBuffer b) handler = return [] -- TODO+ setEditable _ _ = return () -- TODO #endif
+ src/IDE/TextEditor/Yi/Config.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{- Based on example config yi example-configs/yi-vim.hs -}++module IDE.TextEditor.Yi.Config (+ defaultYiConfig+, Config+, Control+, ControlM+, YiM+, start+, runControl+, liftYi+) where++#ifdef LEKSAH_WITH_YI++import Data.List (reverse, isPrefixOf)++import Yi+import qualified Yi.Keymap.Vim as V2+import qualified Yi.Keymap.Vim.Common as V2+import qualified Yi.Keymap.Vim.Utils as V2++import qualified Yi.Mode.Haskell as Haskell++import qualified Yi.UI.Pango+import Yi.UI.Pango.Control++import Control.Monad (replicateM_)+import Control.Applicative (Alternative(..))+import qualified Data.Text as T (singleton)+import Data.Monoid ((<>))+import qualified Yi.Rope as R (toText)++start yiConfig f =+ startControl yiConfig $ do+ yiControl <- getControl+ controlIO (f yiControl)++-- Set soft tabs of 4 spaces in width.+prefIndent :: Mode s -> Mode s+prefIndent m = m {+ modeIndentSettings = IndentSettings+ {+ expandTabs = True,+ shiftWidth = 4,+ tabSize = 4+ }}++defaultYiConfig = defaultVimConfig {+ modeTable = myModes ++ modeTable defaultVimConfig,+ defaultKm = myKeymapSet,+ configCheckExternalChangesObsessively = False+}++defaultSearchKeymap :: Keymap+defaultSearchKeymap = do+ Event (KASCII c) [] <- anyEvent+ write (isearchAddE $ T.singleton c)++myKeymapSet :: KeymapSet+myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this ->+ let eval = V2.pureEval this+ in super {+ -- Here we can add custom bindings.+ -- See Yi.Keymap.Vim.Common for datatypes and+ -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE++ -- In case of conflict, that is if there exist multiple bindings+ -- whose prereq function returns WholeMatch,+ -- the first such binding is used.+ -- So it's important to have custom bindings first.+ V2.vimBindings = myBindings eval <> V2.vimBindings super+ }++myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding]+myBindings eval =+ let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)+ imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of+ V2.Insert _ ->+ fmap (const (y >> return V2.Continue))+ (evs `V2.matchesString` x)+ _ -> V2.NoMatch)+ in [ nmap "<C-h>" previousTabE+ , nmap "<C-l>" nextTabE+ , nmap "<C-l>" nextTabE++ -- Press space to clear incremental search highlight+ , nmap " " (eval ":nohlsearch<CR>")++ -- for times when you don't press shift hard enough+ , nmap ";" (eval ":")++ , nmap "<F3>" (withCurrentBuffer deleteTrailingSpaceB)+ , nmap "<F4>" (withCurrentBuffer moveToSol)+ , nmap "<F1>" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText)+ , imap "<Home>" (withCurrentBuffer moveToSol)+ , imap "<End>" (withCurrentBuffer moveToEol)+ ]++myModes :: [AnyMode]+myModes = [+ AnyMode Haskell.fastMode {+ -- Disable beautification+ modePrettify = const $ return ()+ }+ ]++#else++data Config = Config+data Control = Control+data ControlM a = ControlM+data YiM a = YiM++defaultYiConfig :: Config+defaultYiConfig = Config+start :: Config -> (Control -> IO a) -> IO a+start yiConfig f = f Control+runControl :: ControlM a -> Control -> IO a+runControl = undefined+liftYi :: YiM a -> ControlM a+liftYi = undefined++#endif+
+ src/IDE/Utils/CabalUtils.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+--+-- Module : IDE.Utils.CabalUtils+-- Copyright : 2007-2016 Juergen Nicklisch-Franken, Hamish Mackenzie, Jacco Krijnen, JP Moresmau+-- License : GPL+--+-- Maintainer : maintainer@leksah.org+-- Stability : provisional+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module IDE.Utils.CabalUtils (+ writeGenericPackageDescription'+) where++import Distribution.PackageDescription+ (GenericPackageDescription(..))+import Distribution.Simple.Utils (writeUTF8File)+import Distribution.PackageDescription.PrettyPrint+ (showGenericPackageDescription)++-- | Version of writeGenericPackageDescription that drops trailing spaces+writeGenericPackageDescription' :: FilePath -> GenericPackageDescription -> IO ()+writeGenericPackageDescription' f = writeUTF8File f . dropTrailingSpaces . showGenericPackageDescription+ where+ dropTrailingSpaces = unlines . map (reverse . dropWhile (==' ') . reverse) . lines++
src/IDE/Utils/ExternalTool.hs view
@@ -83,9 +83,10 @@ -> FilePath -> [Text] -> FilePath+ -> Maybe [(String,String)] -> C.Sink ToolOutput IDEM () -> m ()-runExternalTool' description executable args dir handleOutput = do+runExternalTool' description executable args dir mbEnv handleOutput = do runExternalTool (do run <- isRunning return (not run))@@ -94,6 +95,7 @@ executable args dir+ mbEnv handleOutput return() @@ -104,9 +106,10 @@ -> FilePath -> [Text] -> FilePath+ -> Maybe [(String,String)] -> C.Sink ToolOutput IDEM () -> m ()-runExternalTool runGuard pidHandler description executable args dir handleOutput = do+runExternalTool runGuard pidHandler description executable args dir mbEnv handleOutput = do prefs <- readIDE prefs run <- runGuard when run $ do@@ -122,7 +125,7 @@ return ("ssh", map T.pack a) _ -> return (executable, args) -- Run the tool- (output, pid) <- liftIO $ runTool executable' args' (Just dir)+ (output, pid) <- liftIO $ runTool executable' args' (Just dir) mbEnv modifyIDE_ (\ide -> ide{runningTool = Just pid}) reifyIDE $ \ideR -> forkIO $ reflectIDE (do@@ -141,11 +144,10 @@ isRunning :: MonadIDE m => m Bool isRunning = do maybeProcess <- readIDE runningTool- liftIO $- case maybeProcess of- Just process ->- isNothing <$> getProcessExitCode process- Nothing -> return False+ case maybeProcess of+ Just process ->+ liftIO $ isNothing <$> getProcessExitCode process+ Nothing -> return False interruptBuild :: MonadIDE m => m () interruptBuild = do
src/IDE/Utils/GUIUtils.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, DataKinds, PatternSynonyms #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.GUIUtils@@ -29,8 +30,12 @@ , getBackgroundBuildToggled , setBackgroundBuildToggled+, getMakeDocs+, setMakeDocs , getRunUnitTests , setRunUnitTests+, getRunBenchmarks+, setRunBenchmarks , getMakeModeToggled , setMakeModeToggled , getDebugToggled@@ -45,36 +50,89 @@ , treeViewToggleRow , treeViewContextMenu , treeViewContextMenu'-, treeStoreGetForest , __ , fontDescription ) where -import Graphics.UI.Gtk import IDE.Utils.Tool (runProcess) import Data.Maybe (listToMaybe, fromMaybe, catMaybes, fromJust, isJust) import Control.Monad (void, when, unless) import IDE.Core.State---import Graphics.UI.Gtk.Selectors.FileChooser--- (FileChooserAction(..))---import Graphics.UI.Gtk.General.Structs--- (ResponseId(..))-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Exception as E import Data.Text (Text) import Data.Monoid ((<>))-import qualified Data.Text as T (unpack-#ifdef LOCALIZATION- , pack-#endif- )+import qualified Data.Text as T (unpack, pack) import Control.Applicative ((<$>)) import Data.List (intercalate) import Data.Foldable (forM_) import Data.Tree (Tree(..), Forest)+import GI.Gtk.Objects.Window+ (setWindowWindowPosition, windowSetTransientFor, setWindowTitle,+ Window(..))+import GI.Gtk.Enums+ (WindowPosition(..), MessageType(..), ButtonsType(..), MessageType,+ ResponseType(..), FileChooserAction(..))+import Data.GI.Base (new')+import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..))+import GI.Gtk.Interfaces.FileChooser+ (fileChooserAddFilter, fileChooserGetFilename,+ fileChooserSetCurrentFolder, fileChooserSetAction)+import GI.Gtk.Objects.Dialog+ (Dialog(..), constructDialogUseHeaderBar, dialogGetContentArea,+ dialogSetDefaultResponse, dialogRun, dialogAddButton)+import GI.Gtk.Objects.FileFilter+ (fileFilterAddPattern, fileFilterSetName, fileFilterNew)+import GI.Gtk.Objects.MessageDialog+ (constructMessageDialogText, constructMessageDialogButtons,+ constructMessageDialogMessageType, MessageDialog(..))+import Data.GI.Base.ManagedPtr (unsafeCastTo)+import GI.Gtk.Objects.Box (boxPackStart, Box(..))+import GI.Gtk.Objects.Label (labelNew)+import GI.Gtk.Objects.Entry (getEntryText, setEntryText, entryNew, onEntryActivate)+import Graphics.UI.Editor.Parameters+ (dialogSetDefaultResponse', dialogRun', dialogAddButton',+ boxPackStart', Packing(..))+import GI.Gtk.Objects.ToggleAction+ (toggleActionSetActive, toggleActionGetActive, ToggleAction(..))+import GI.Gtk.Objects.MenuItem+ (toMenuItem, onMenuItemActivate, menuItemNewWithLabel,+ MenuItem(..))+import GI.Gtk.Objects.UIManager (uIManagerGetWidget)+import GI.Gtk.Objects.TreeView+ (toTreeView, TreeView(..), treeViewGetPathAtPos,+ treeViewGetSelection, treeViewExpandRow,+ treeViewCollapseRow, treeViewRowExpanded)+import GI.Gdk.Flags (ModifierType(..))+import GI.Gtk.Structs.TreePath+ (TreePath(..))+import GI.Gtk.Objects.Widget+ (Widget(..), toWidget, noWidget, onWidgetButtonPressEvent, onWidgetPopupMenu,+ widgetShowAll, widgetHide, widgetDestroy, widgetShow, widgetActivate)+import GI.Gdk+ (pattern BUTTON_SECONDARY, getEventButtonType, getEventButtonY,+ getEventButtonX, getEventButtonTime, getEventButtonButton)+import GI.Gdk.Enums (EventType(..))+import GI.Gtk.Objects.TreeSelection+ (treeSelectionSelectPath, treeSelectionUnselectAll, treeSelectionCountSelectedRows)+import Graphics.UI.Editor.Basics (Connection, Connection)+import Data.GI.Gtk.ModelView.ForestStore+ (forestStoreGetValue, forestStoreGetTree, ForestStore(..))+import GI.Gtk.Objects.Menu+ (Menu(..), menuPopup, menuAttachToWidget, menuNew)+import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew)+import GI.Gtk.Objects.MenuShell (menuShellAppend)+import GI.Pango.Structs.FontDescription+ (fontDescriptionSetFamily, fontDescriptionNew, FontDescription(..))+import GI.Pango (fontDescriptionFromString)+import Data.GI.Base.BasicTypes (UnexpectedNullPointerReturn(..))+import GI.Gtk.Functions (getCurrentEventTime)+import Data.Word (Word32)+import Data.GI.Gtk.ModelView.Types+ (treeSelectionGetSelectedRows', treePathNewFromIndices') #ifdef LOCALIZATION @@ -85,26 +143,24 @@ chooseDir :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseDir window prompt mbFolder = do- dialog <- fileChooserDialogNew- (Just prompt)- (Just window)- FileChooserActionSelectFolder- [("gtk-cancel"- ,ResponseCancel)- ,("gtk-open"- ,ResponseAccept)]- when (isJust mbFolder) . void $ fileChooserSetCurrentFolder dialog (fromJust mbFolder)+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog prompt+ windowSetTransientFor dialog $ Just window+ fileChooserSetAction dialog FileChooserActionSelectFolder+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "gtk-open" ResponseTypeAccept+ mapM_ (fileChooserSetCurrentFolder dialog) mbFolder widgetShow dialog- response <- dialogRun dialog+ response <- dialogRun' dialog case response of- ResponseAccept -> do+ ResponseTypeAccept -> do fn <- fileChooserGetFilename dialog widgetDestroy dialog return fn- ResponseCancel -> do+ ResponseTypeCancel -> do widgetDestroy dialog return Nothing- ResponseDeleteEvent -> do+ ResponseTypeDeleteEvent -> do widgetDestroy dialog return Nothing _ -> return Nothing@@ -116,28 +172,25 @@ -> [(String, [String])] -- ^ File filters, e.g. [("Music Files", ["*.mp3", "*.wav"])] -> IO (Maybe FilePath) chooseFile window prompt mbFolder filters = do- dialog <- fileChooserDialogNew- (Just prompt)- (Just window)- FileChooserActionOpen- [("gtk-cancel"- ,ResponseCancel)- ,("gtk-open"- ,ResponseAccept)]- forM_ mbFolder $ \folder ->- void (fileChooserSetCurrentFolder dialog folder)+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog prompt+ windowSetTransientFor dialog $ Just window+ fileChooserSetAction dialog FileChooserActionOpen+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "gtk-open" ResponseTypeAccept+ mapM_ (fileChooserSetCurrentFolder dialog) mbFolder forM_ filters (addFilter dialog) widgetShow dialog- response <- dialogRun dialog+ response <- dialogRun' dialog case response of- ResponseAccept -> do+ ResponseTypeAccept -> do fn <- fileChooserGetFilename dialog widgetDestroy dialog return fn- ResponseCancel -> do+ ResponseTypeCancel -> do widgetDestroy dialog return Nothing- ResponseDeleteEvent -> do+ ResponseTypeDeleteEvent -> do widgetDestroy dialog return Nothing _ -> return Nothing@@ -145,26 +198,26 @@ where addFilter dialog (description, exts) = do ff <- fileFilterNew- fileFilterSetName ff description- forM_ exts (fileFilterAddPattern ff)+ fileFilterSetName ff . Just $ T.pack description+ forM_ exts (fileFilterAddPattern ff . T.pack) fileChooserAddFilter dialog ff chooseSaveFile :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseSaveFile window prompt mbFolder = do- dialog <- fileChooserDialogNew- (Just prompt)- (Just window)- FileChooserActionSave- [("gtk-cancel", ResponseCancel)- ,("gtk-save", ResponseAccept)]- when (isJust mbFolder) $ void (fileChooserSetCurrentFolder dialog (fromJust mbFolder))+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog prompt+ windowSetTransientFor dialog $ Just window+ fileChooserSetAction dialog FileChooserActionSave+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "gtk-open" ResponseTypeAccept+ mapM_ (fileChooserSetCurrentFolder dialog) mbFolder widgetShow dialog- res <- dialogRun dialog+ res <- dialogRun' dialog case res of- ResponseAccept -> do- mbFileName <- fileChooserGetFilename dialog+ ResponseTypeAccept -> do+ fileName <- fileChooserGetFilename dialog widgetDestroy dialog- return mbFileName+ return fileName _ -> do widgetDestroy dialog return Nothing@@ -181,65 +234,83 @@ return () -- | Show a text dialog with an Ok button and a specific messagetype-showDialog :: Text -> MessageType -> IO ()-showDialog msg msgType = do- dialog <- messageDialogNew Nothing [] msgType ButtonsOk msg- _ <- dialogRun dialog+showDialog :: MonadIO m => Maybe Window -> Text -> MessageType -> m ()+showDialog parent msg msgType = do+ dialog <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogMessageType msgType,+ constructMessageDialogButtons ButtonsTypeOk,+ constructMessageDialogText msg]+ windowSetTransientFor dialog parent+ setWindowWindowPosition dialog WindowPositionCenterOnParent+ _ <- dialogRun' dialog widgetDestroy dialog return () -- | Show an error dialog with an Ok button-showErrorDialog :: Text -> IO ()-showErrorDialog msg = showDialog msg MessageError+showErrorDialog :: MonadIO m => Maybe Window -> Text -> m ()+showErrorDialog parent msg = showDialog parent msg MessageTypeError -- | Show a dialog with custom buttons and callbacks-showDialogOptions :: Text -- ^ the message+showDialogOptions :: MonadIO m+ => Maybe Window -- ^ Parent window to use with `windowSetTransientFor`+ -> Text -- ^ the message -> MessageType -- ^ type of dialog- -> [(Text, IO ())] -- ^ button text and corresponding actions+ -> [(Text, m ())] -- ^ button text and corresponding actions -> Maybe Int -- ^ index of button that has default focus (0-based)- -> IO ()-showDialogOptions msg msgType buttons mbIndex = do- dialog <- messageDialogNew Nothing [] msgType ButtonsNone msg+ -> m ()+showDialogOptions parent msg msgType buttons mbIndex = do+ dialog <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogMessageType msgType,+ constructMessageDialogButtons ButtonsTypeNone,+ constructMessageDialogText msg] - forM_ (zip [0..] buttons) $ \(n,(text, _)) -> do- dialogAddButton dialog text (ResponseUser n)+ windowSetTransientFor dialog parent+ forM_ (zip [0..] buttons) $ \(n,(text, _)) ->+ dialogAddButton' dialog text (AnotherResponseType n) - dialogSetDefaultResponse dialog (ResponseUser (fromMaybe 0 mbIndex))- set dialog [ windowWindowPosition := WinPosCenterOnParent ]- res <- dialogRun dialog+ dialogSetDefaultResponse' dialog (AnotherResponseType $ fromMaybe 0 mbIndex)+ setWindowWindowPosition dialog WindowPositionCenterOnParent+ res <- dialogRun' dialog widgetHide dialog case res of- ResponseUser n | n >= 0 && n < length buttons -> map snd buttons !! n+ AnotherResponseType n | n >= 0 && n < length buttons -> map snd buttons !! n _ -> return () ++ -- | Show a simple dialog that asks the user for some text-showInputDialog :: Text -- ^ The message text+showInputDialog :: Maybe Window -- ^ Parent window to use with `windowSetTransientFor`+ -> Text -- ^ The message text -> Text -- ^ The default value -> IO (Maybe Text)-showInputDialog msg def = do- dialog <- dialogNew -- Nothing [] MessageQuestion ButtonsOkCancel msg- vbox <- castToBox <$> dialogGetContentArea dialog- label <- labelNew (Just msg)- entry <- entryNew- set entry [entryText := def]- boxPackStart vbox label PackNatural 0- boxPackStart vbox entry PackNatural 0+showInputDialog parent msg def = do+ dialog <- new' Dialog [constructDialogUseHeaderBar 1] -- Nothing [] MessageQuestion ButtonsOkCancel msg+ windowSetTransientFor dialog parent+ vbox <- dialogGetContentArea dialog >>= unsafeCastTo Box+ label <- labelNew (Just msg)+ entry <- entryNew+ setEntryText entry def+ boxPackStart' vbox label PackNatural 0+ boxPackStart' vbox entry PackNatural 0 widgetShowAll vbox -- Can't use messageDialog because of https://github.com/gtk2hs/gtk2hs/issues/114- dialogAddButton dialog ("Cancel" :: Text) ResponseCancel- dialogAddButton dialog ("Ok" :: Text) ResponseOk- dialogSetDefaultResponse dialog ResponseOk+ dialogAddButton' dialog "Cancel" ResponseTypeCancel+ okBtn <- dialogAddButton' dialog "Ok" ResponseTypeOk+ onEntryActivate entry $ widgetActivate okBtn >> return ()+ dialogSetDefaultResponse' dialog ResponseTypeOk - res <- dialogRun dialog+ res <- dialogRun' dialog widgetHide dialog case res of- ResponseOk -> do- text <- get entry entryText+ ResponseTypeOk -> do+ text <- getEntryText entry widgetDestroy dialog return (Just text) _ -> widgetDestroy dialog >> return Nothing@@ -252,71 +323,93 @@ getFullScreenState :: PaneMonad alpha => alpha Bool getFullScreenState = do- ui <- getUIAction "ui/menubar/_View/_Full Screen" castToToggleAction- liftIO $toggleActionGetActive ui+ ui <- getUIAction "ui/menubar/_View/_Full Screen" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setFullScreenState :: PaneMonad alpha => Bool -> alpha () setFullScreenState b = do- ui <- getUIAction "ui/menubar/_View/_Full Screen" castToToggleAction- liftIO $toggleActionSetActive ui b+ ui <- getUIAction "ui/menubar/_View/_Full Screen" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b getDarkState :: PaneMonad alpha => alpha Bool getDarkState = do- ui <- getUIAction "ui/menubar/_View/_Use Dark Interface" castToToggleAction- liftIO $toggleActionGetActive ui+ ui <- getUIAction "ui/menubar/_View/_Use Dark Interface" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setDarkState :: PaneMonad alpha => Bool -> alpha () setDarkState b = do- ui <- getUIAction "ui/menubar/_View/_Use Dark Interface" castToToggleAction- liftIO $toggleActionSetActive ui b+ ui <- getUIAction "ui/menubar/_View/_Use Dark Interface" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b getMenuItem :: Text -> IDEM MenuItem-getMenuItem path = do+getMenuItem path = (do uiManager' <- getUiManager- mbWidget <- liftIO $ uiManagerGetWidget uiManager' path- case mbWidget of- Nothing -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " <> path)- Just widget -> return (castToMenuItem widget)+ mMenuItem <- uIManagerGetWidget uiManager' path+ case mMenuItem of+ Nothing -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " <> path)+ Just item -> liftIO $ unsafeCastTo MenuItem item)+ `catchIDE` \(_::UnexpectedNullPointerReturn) ->+ throwIDE ("State.hs>>getMenuItem: Can't find ui path " <> path) getBackgroundBuildToggled :: PaneMonad alpha => alpha Bool getBackgroundBuildToggled = do- ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction- liftIO $ toggleActionGetActive ui+ ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setBackgroundBuildToggled :: PaneMonad alpha => Bool -> alpha () setBackgroundBuildToggled b = do- ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction- liftIO $ toggleActionSetActive ui b+ ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b +getMakeDocs :: PaneMonad alpha => alpha Bool+getMakeDocs = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeDocs" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui++setMakeDocs :: PaneMonad alpha => Bool -> alpha ()+setMakeDocs b = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeDocs" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b+ getRunUnitTests :: PaneMonad alpha => alpha Bool getRunUnitTests = do- ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" castToToggleAction- liftIO $ toggleActionGetActive ui+ ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setRunUnitTests :: PaneMonad alpha => Bool -> alpha () setRunUnitTests b = do- ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" castToToggleAction- liftIO $ toggleActionSetActive ui b+ ui <- getUIAction "ui/toolbar/BuildToolItems/RunUnitTests" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b +getRunBenchmarks :: PaneMonad alpha => alpha Bool+getRunBenchmarks = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/RunBenchmarks" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui++setRunBenchmarks :: PaneMonad alpha => Bool -> alpha ()+setRunBenchmarks b = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/RunBenchmarks" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b+ getMakeModeToggled :: PaneMonad alpha => alpha Bool getMakeModeToggled = do- ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction- liftIO $ toggleActionGetActive ui+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setMakeModeToggled :: PaneMonad alpha => Bool -> alpha () setMakeModeToggled b = do- ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction- liftIO $ toggleActionSetActive ui b+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b getDebugToggled :: PaneMonad alpha => alpha Bool getDebugToggled = do- ui <- getUIAction "ui/toolbar/BuildToolItems/Debug" castToToggleAction- liftIO $ toggleActionGetActive ui+ ui <- getUIAction "ui/toolbar/BuildToolItems/Debug" (unsafeCastTo ToggleAction)+ toggleActionGetActive ui setDebugToggled :: PaneMonad alpha => Bool -> alpha () setDebugToggled b = do- ui <- getUIAction "ui/toolbar/BuildToolItems/Debug" castToToggleAction- liftIO $ toggleActionSetActive ui b+ ui <- getUIAction "ui/toolbar/BuildToolItems/Debug" (unsafeCastTo ToggleAction)+ toggleActionSetActive ui b getRecentFiles , getRecentWorkspaces, getVCS :: IDEM MenuItem getRecentFiles = getMenuItem "ui/menubar/_File/Recent Files"@@ -326,7 +419,7 @@ getVCS = getMenuItem "ui/menubar/Version Con_trol" --this could fail, try returning Menu if it does -- (toolbar) -stockIdFromType :: DescrType -> StockId+stockIdFromType :: DescrType -> Text stockIdFromType Variable = "ide_function" stockIdFromType Newtype = "ide_newtype" stockIdFromType Type = "ide_type"@@ -336,12 +429,10 @@ stockIdFromType Constructor = "ide_konstructor" stockIdFromType Field = "ide_slot" stockIdFromType Method = "ide_method"+stockIdFromType PatternSynonym = "ide_konstructor" stockIdFromType _ = "ide_other" -treeStoreGetForest :: TreeStore a -> IO (Forest a)-treeStoreGetForest store = subForest <$> (treeStoreGetTree store [])- -- | Toggles a row in a `TreeView` treeViewToggleRow treeView path = do expanded <- treeViewRowExpanded treeView path@@ -351,95 +442,98 @@ -- maps control key for Macos #if defined(darwin_HOST_OS)-mapControlCommand Alt = Control+mapControlCommand ModifierTypeMod1Mask = ModifierTypeControlMask #endif mapControlCommand a = a -- | Sets the context menu for a treeView widget-treeViewContextMenu' :: TreeViewClass treeView- => treeView -- ^ The view- -> TreeStore a -- ^ The model- -> (a -> TreePath -> TreeStore a -> IDEM [[(Text, IDEAction)]]) -- ^ Produces the menu items for the selected values when right clicking+treeViewContextMenu' :: TreeView -- ^ The view+ -> ForestStore a -- ^ The model+ -> (a -> TreePath -> ForestStore a -> IDEM [[(Text, IDEAction)]]) -- ^ Produces the menu items for the selected values when right clicking -- The lists are seperated by a seperator- -> IDEM (ConnectId treeView, ConnectId treeView)+ -> IDEM [Connection] treeViewContextMenu' view store itemsFor = reifyIDE $ \ideRef -> do- cid1 <- view `on` popupMenuSignal $ do- showMenu Nothing ideRef- cid2 <- view `on` buttonPressEvent $ do- button <- eventButton- click <- eventClick- timestamp <- eventTime- (x, y) <- eventCoordinates- case (button, click) of- (RightButton, SingleClick) -> liftIO $ do+ cid1 <- onWidgetPopupMenu view $ do+ t <- getCurrentEventTime+ showMenu 0 t ideRef+ cid2 <- onWidgetButtonPressEvent view $ \e -> do+ button <- getEventButtonButton e+ click <- getEventButtonType e+ timestamp <- getEventButtonTime e+ x <- getEventButtonX e+ y <- getEventButtonY e+ case (fromIntegral button, click) of+ (BUTTON_SECONDARY, EventTypeButtonPress) -> do sel <- treeViewGetSelection view selCount <- treeSelectionCountSelectedRows sel when (selCount <= 1) $ do- pathInfo <- treeViewGetPathAtPos view (floor x, floor y)+ pathInfo <- treeViewGetPathAtPos view (floor x) (floor y) case pathInfo of- Just (path, _, _) -> do+ (True, Just path, _, _, _) -> do treeSelectionUnselectAll sel treeSelectionSelectPath sel path _ -> return ()- showMenu (Just (button, timestamp)) ideRef+ showMenu button timestamp ideRef _ -> return False- return (cid1, cid2)+ return $ map (ConnectC view) [cid1, cid2] where- showMenu buttonEventDetails ideRef = do+ showMenu :: Word32 -> Word32 -> IDERef -> IO Bool+ showMenu button timestamp ideRef = do - selPaths <- treeViewGetSelection view >>= treeSelectionGetSelectedRows- selValues <- mapM (treeStoreGetValue store) selPaths- theMenu <- menuNew- menuAttachToWidget theMenu view+ selPaths <- treeViewGetSelection view >>= treeSelectionGetSelectedRows'+ selValues <- mapM (forestStoreGetValue store) selPaths+ theMenu <- menuNew+ menuAttachToWidget theMenu view Nothing forM_ (listToMaybe $ zip selValues selPaths) $ \(val, path) -> do itemsPerSection <- flip reflectIDE ideRef $ itemsFor val path store- menuItemsPerSection <- mapM (mapM (liftIO . menuItemNewWithLabel . fst)) itemsPerSection+ menuItemsPerSection <- mapM (mapM (menuItemNewWithLabel . fst)) itemsPerSection - forM_ (zip itemsPerSection menuItemsPerSection) $ \(section, itemsSection) -> do- forM_ (zip section itemsSection) $ \((_, onActivated), m) -> do- m `on` menuItemActivated $ reflectIDE onActivated ideRef+ forM_ (zip itemsPerSection menuItemsPerSection) $ \(section, itemsSection) ->+ forM_ (zip section itemsSection) $ \((_, onActivated), m) ->+ onMenuItemActivate m $ reflectIDE onActivated ideRef unless (null itemsPerSection) $ do itemsAndSeparators <- sequence $- intercalate [fmap castToMenuItem separatorMenuItemNew]- (map (map (return . castToMenuItem)) menuItemsPerSection)+ intercalate [separatorMenuItemNew >>= toMenuItem]+ (map (map return) menuItemsPerSection) mapM_ (menuShellAppend theMenu) itemsAndSeparators- menuPopup theMenu buttonEventDetails+ menuPopup theMenu noWidget noWidget Nothing button timestamp widgetShowAll theMenu return True -treeViewContextMenu :: TreeViewClass treeView- => treeView+treeViewContextMenu :: MonadIO m+ => TreeView -> (Menu -> IO ())- -> IO (ConnectId treeView, ConnectId treeView)+ -> m [Connection] treeViewContextMenu treeView populateMenu = do- cid1 <- treeView `on` popupMenuSignal $ showMenu Nothing- cid2 <- treeView `on` buttonPressEvent $ do- button <- eventButton- click <- eventClick- timestamp <- eventTime- (x, y) <- eventCoordinates- case (button, click) of- (RightButton, SingleClick) -> liftIO $ do+ cid1 <- onWidgetPopupMenu treeView $ showMenu 0 =<< getCurrentEventTime+ cid2 <- onWidgetButtonPressEvent treeView $ \e -> do+ button <- getEventButtonButton e+ click <- getEventButtonType e+ timestamp <- getEventButtonTime e+ x <- getEventButtonX e+ y <- getEventButtonY e+ case (fromIntegral button, click) of+ (BUTTON_SECONDARY, EventTypeButtonPress) -> do sel <- treeViewGetSelection treeView selCount <- treeSelectionCountSelectedRows sel when (selCount <= 1) $ do- pathInfo <- treeViewGetPathAtPos treeView (floor x, floor y)+ pathInfo <- treeViewGetPathAtPos treeView (floor x) (floor y) case pathInfo of- Just (path, _, _) -> do+ (True, Just path, _, _, _) -> do treeSelectionUnselectAll sel treeSelectionSelectPath sel path _ -> return ()- showMenu (Just (button, timestamp))+ showMenu button timestamp _ -> return False- return (cid1, cid2)+ return $ map (ConnectC treeView) [cid1, cid2] where- showMenu buttonEventDetails = do+ showMenu button timestamp = do theMenu <- menuNew- menuAttachToWidget theMenu treeView+ menuAttachToWidget theMenu treeView Nothing populateMenu theMenu- menuPopup theMenu buttonEventDetails+ menuPopup theMenu noWidget noWidget Nothing button timestamp widgetShowAll theMenu return True @@ -459,12 +553,12 @@ #endif fontDescription :: Maybe Text -> IDEM FontDescription-fontDescription mbFontString = liftIO $+fontDescription mbFontString = case mbFontString of Just str -> fontDescriptionFromString str Nothing -> do f <- fontDescriptionNew- fontDescriptionSetFamily f ("Monospace" :: Text)+ fontDescriptionSetFamily f "Monospace" return f
− src/IDE/Utils/GtkBindings.hs
@@ -1,32 +0,0 @@------------------------------------------------------------------------------------ Module : IDE.Utils.GtkBindings--- Copyright : 2007-2014 Juergen Nicklisch-Franken, Hamish Mackenzie--- License : GPL------ Maintainer : maintainer@leksah.org--- Stability : provisional--- Portability :------ |-----------------------------------------------------------------------------------module IDE.Utils.GtkBindings (- treeViewSetActiveOnSingleClick-) where--import Foreign.Ptr (Ptr)-import Graphics.UI.Gtk (toToolbar, TreeViewClass, TreeView)-import Foreign.ForeignPtr (withForeignPtr)-import Graphics.UI.GtkInternals (toTreeView, unTreeView)-import Foreign.C.Types (CInt(..))-import Foreign.Marshal.Utils (fromBool)--foreign import ccall safe "gtk_tree_view_set_activate_on_single_click"- gtk_tree_view_set_activate_on_single_click :: Ptr TreeView -> CInt -> IO ()--treeViewSetActiveOnSingleClick :: TreeViewClass self => self -> Bool -> IO ()-treeViewSetActiveOnSingleClick self singleClick =- withForeignPtr (unTreeView $ toTreeView self) $- \selfPtr -> gtk_tree_view_set_activate_on_single_click selfPtr (fromIntegral $ fromBool singleClick)
src/IDE/Utils/ServerConnection.hs view
@@ -27,7 +27,6 @@ import Control.Exception (SomeException(..), catch) import Prelude hiding(catch) import Control.Concurrent(forkIO, newEmptyMVar, putMVar, takeMVar, tryTakeMVar)-import Graphics.UI.Gtk(postGUIAsync) import Control.Event(triggerEvent) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (ask)
src/IDE/Workspaces.hs view
@@ -16,20 +16,27 @@ ----------------------------------------------------------------------------- module IDE.Workspaces ( workspaceNew+, projectNew , workspaceOpen+, projectOpen , workspaceTry , workspaceOpenThis+, projectOpenThis , workspaceClose , workspaceClean , workspaceMake , workspaceActivatePackage-, workspaceAddPackage-, workspaceAddPackage'-, workspaceRemovePackage+, projectAddPackage+, projectAddPackage'+, workspaceRemoveProject+, projectRemovePackage , workspacePackageNew-, workspacePackageClone+, projectPackageClone , workspaceTryQuiet , workspaceNewHere+, projectNewHere+, projectTry+, projectTryQuiet , packageTry , packageTryQuiet @@ -39,17 +46,20 @@ , fileOpen' ) where +import Prelude ()+import Prelude.Compat import IDE.Core.State import Graphics.UI.Editor.Parameters- (Parameter(..), (<<<-), paraName, emptyParams)+ (dialogRun', dialogSetDefaultResponse', dialogAddButton',+ Parameter(..), (<<<-), paraName, emptyParams) import Control.Monad (filterM, void, unless, when, liftM)-import Data.Maybe (isJust, fromJust, catMaybes)+import Data.Maybe (listToMaybe, isJust, fromJust, catMaybes) import IDE.Utils.GUIUtils- (chooseFile, chooseSaveFile, __)+ (showDialog, showDialogOptions, chooseFile, chooseSaveFile, __) import System.FilePath (takeFileName, (</>), isAbsolute, dropFileName, makeRelative, dropExtension, takeBaseName, addExtension, takeExtension,- takeDirectory)+ takeDirectory, (<.>)) import Text.PrinterParser (readFields, writeFields,@@ -59,33 +69,25 @@ mkFieldS, FieldDescriptionS(..)) import qualified Text.PrettyPrint as PP (text)-import Graphics.UI.Gtk- (dialogSetDefaultResponse, windowWindowPosition, widgetDestroy,- dialogRun, messageDialogNew, dialogAddButton, Window(..),- widgetHide, DialogFlags(..)) import IDE.Pane.PackageEditor (packageNew', packageClone, choosePackageFile, standardSetup) import Data.List (delete) import IDE.Package- (getModuleTemplate, getPackageDescriptionAndPath, activatePackage,- deactivatePackage, idePackageFromPath, idePackageFromPath)+ (getModuleTemplate, idePackageFromPath',+ getPackageDescriptionAndPath, activatePackage, deactivatePackage,+ ideProjectFromPath) import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, createDirectoryIfMissing, doesFileExist) import System.Time (getClockTime)-import Graphics.UI.Gtk.Windows.MessageDialog- (ButtonsType(..), MessageType(..))-import Graphics.UI.Gtk.Windows.Dialog (ResponseId(..)) import qualified Control.Exception as Exc (SomeException(..), throw, Exception) import qualified Data.Map as Map (empty) import IDE.Pane.SourceBuffer (belongsToWorkspace, IDEBuffer(..), maybeActiveBuf, fileOpenThis,- fileCheckAll, belongsToPackages')-import System.Glib.Attributes (AttrOp(..), set)-import Graphics.UI.Gtk.General.Enums (WindowPosition(..))+ fileCheckAll, belongsToPackages', belongsToPackage) import Control.Applicative ((<$>)) import IDE.Build import IDE.Utils.FileUtils(myCanonicalizePath)-import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.Reader (ask, asks) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import qualified Data.Set as Set (toList)@@ -99,18 +101,32 @@ import IDE.LogRef (logOutputDefault) import Data.Foldable (forM_) import Data.Text (Text)-import qualified Data.Text as T (unpack, pack)+import qualified Data.Text as T+ (unlines, isPrefixOf, lines, unpack, pack) import Data.Monoid ((<>)) import qualified Text.Printf as S (printf) import Text.Printf (PrintfType)-import qualified Data.Text.IO as T (writeFile)-import Graphics.UI.Gtk.Selectors.FileChooserDialog- (fileChooserDialogNew)-import Graphics.UI.Gtk.Selectors.FileChooser- (fileChooserGetFilename, fileChooserSetCurrentFolder,- FileChooserAction(..))-import Graphics.UI.Gtk.Abstract.Widget (widgetShow)+import qualified Data.Text.IO as T (readFile, writeFile) import Control.Exception (SomeException(..), catch)+import GI.Gtk.Objects.MessageDialog+ (setMessageDialogText, constructMessageDialogButtons, setMessageDialogMessageType,+ MessageDialog(..))+import GI.Gtk.Objects.Dialog (constructDialogUseHeaderBar)+import GI.Gtk.Objects.Window+ (windowSetTransientFor, setWindowTitle, Window(..),+ setWindowWindowPosition, setWindowModal)+import GI.Gtk.Enums+ (FileChooserAction(..), ResponseType(..), ButtonsType(..),+ WindowPosition(..), MessageType(..))+import Data.GI.Base (set, new')+import GI.Gtk.Objects.Widget+ (widgetShow, widgetDestroy, widgetHide)+import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..))+import GI.Gtk.Interfaces.FileChooser+ (fileChooserGetFilename, fileChooserSetCurrentFolder,+ fileChooserSetAction)+import IDE.Workspaces.Writer (WorkspaceFile(..))+import qualified Data.Map as M (member, delete, adjust, insert) printf :: PrintfType r => Text -> r printf = S.printf . T.unpack@@ -122,6 +138,12 @@ mbFile <- liftIO $ chooseSaveFile window (__ "New file for workspace") Nothing forM_ mbFile workspaceNewHere +projectNew :: WorkspaceAction+projectNew = do+ window <- liftIDE getMainWindow+ mbFile <- liftIO $ chooseSaveFile window (__ "New cabal.project or stack.yaml") Nothing+ forM_ mbFile projectNewHere+ workspaceNewHere :: FilePath -> IDEAction workspaceNewHere filePath = let realPath = if takeExtension filePath == leksahWorkspaceFileExtension@@ -130,106 +152,198 @@ in do dir <- liftIO $ myCanonicalizePath $ dropFileName realPath let cPath = dir </> takeFileName realPath- newWorkspace = emptyWorkspace {- wsName = T.pack $ takeBaseName cPath,- wsFile = cPath}+ newWorkspace = Writer.emptyWorkspaceFile {+ wsfName = T.pack $ takeBaseName cPath+ } liftIO $ writeFields cPath newWorkspace Writer.workspaceDescr- workspaceOpenThis False (Just cPath)+ workspaceOpenThis False cPath return () +projectNewHere :: FilePath -> WorkspaceAction+projectNewHere filePath =+ let realPath+ | takeExtension filePath == ".project" || takeExtension filePath == ".yaml"+ = filePath+ | takeBaseName filePath == "cabal" = filePath <.> "project"+ | otherwise = filePath <.> "yaml"+ in do+ dir <- liftIO $ myCanonicalizePath $ dropFileName realPath+ let cPath = dir </> takeFileName realPath+ liftIO (doesFileExist cPath) >>= \case+ True -> ideMessage Normal $ __ "Project already exists : " <> T.pack cPath+ False -> do+ liftIO $ T.writeFile cPath "packages:\n"+ projectOpenThis cPath+ workspaceOpen :: IDEAction workspaceOpen = do window <- getMainWindow- mbFilePath <- liftIO $ chooseWorkspaceFile window- workspaceOpenThis True mbFilePath- return ()+ liftIO (chooseWorkspaceFile window) >>= mapM_ (workspaceOpenThis True) +projectOpen :: WorkspaceAction+projectOpen = do+ window <- liftIDE getMainWindow+ liftIO (chooseProjectFile window) >>= mapM_ projectOpenThis+ workspaceTryQuiet :: WorkspaceAction -> IDEAction-workspaceTryQuiet f = do- maybeWorkspace <- readIDE workspace- case maybeWorkspace of+workspaceTryQuiet f =+ readIDE workspace >>= \case Just ws -> runWorkspace f ws Nothing -> ideMessage Normal (__ "No workspace open") +projectTryQuiet :: ProjectAction -> IDEAction+projectTryQuiet f = workspaceTryQuiet $+ readIDE activeProject >>= \case+ Just project -> runProject f project+ Nothing -> ideMessage Normal (__ "No project active")+ workspaceTry :: WorkspaceAction -> IDEAction-workspaceTry f = do- maybeWorkspace <- readIDE workspace- case maybeWorkspace of+workspaceTry f =+ readIDE workspace >>= \case Just ws -> runWorkspace f ws Nothing -> do mainWindow <- getMainWindow defaultWorkspace <- liftIO $ (</> "leksah.lkshw") <$> getHomeDirectory- resp <- liftIO $ do- defaultExists <- doesFileExist defaultWorkspace- md <- messageDialogNew (Just mainWindow) [DialogModal] MessageQuestion ButtonsCancel (- __ "You need to have a workspace open for this to work. "- <> __ "Choose ~/leksah.lkshw to "- <> __ (if defaultExists then "open workspace " else "create a workspace ")- <> T.pack defaultWorkspace)- dialogAddButton md (__ "_New Workspace") (ResponseUser 1)- dialogAddButton md (__ "_Open Workspace") (ResponseUser 2)- dialogAddButton md ("~/leksah.lkshw" :: Text) (ResponseUser 3)- dialogSetDefaultResponse md (ResponseUser 3)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetHide md- return resp+ defaultExists <- liftIO $ doesFileExist defaultWorkspace+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setWindowModal md True+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md (+ __ "You need to have a workspace open for this to work. "+ <> __ "Choose ~/leksah.lkshw to "+ <> __ (if defaultExists then "open workspace " else "create a workspace ")+ <> T.pack defaultWorkspace)+ windowSetTransientFor md (Just mainWindow)+ dialogAddButton' md (__ "_New Workspace") (AnotherResponseType 1)+ dialogAddButton' md (__ "_Open Workspace") (AnotherResponseType 2)+ dialogAddButton' md "~/leksah.lkshw" (AnotherResponseType 3)+ dialogSetDefaultResponse' md (AnotherResponseType 3)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetHide md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do workspaceNew postAsyncIDE $ workspaceTryQuiet f- ResponseUser 2 -> do+ AnotherResponseType 2 -> do workspaceOpen postAsyncIDE $ workspaceTryQuiet f- ResponseUser 3 -> do+ AnotherResponseType 3 -> do defaultExists <- liftIO $ doesFileExist defaultWorkspace if defaultExists- then workspaceOpenThis True (Just defaultWorkspace)+ then workspaceOpenThis True defaultWorkspace else workspaceNewHere defaultWorkspace postAsyncIDE $ workspaceTryQuiet f _ -> return () +projectTry :: ProjectAction -> IDEAction+projectTry f = workspaceTry $+ readIDE activeProject >>= \case+ Just project -> runProject f project+ Nothing -> do+ mainWindow <- liftIDE getMainWindow+ defaultCabal <- (</> "cabal.project") . takeDirectory <$> asks wsFile+ defaultStack <- (</> "stack.yaml") . takeDirectory <$> asks wsFile+ defaultCabalExists <- liftIO $ doesFileExist defaultCabal+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setWindowModal md True+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md (+ __ "You need to have a project open for this to work. "+ <> __ "Choose cabal.project to "+ <> __ (if defaultCabalExists then "open project " else "create a workspace ")+ <> T.pack defaultCabal)+ windowSetTransientFor md (Just mainWindow)+ dialogAddButton' md (__ "_New Project") (AnotherResponseType 1)+ dialogAddButton' md (__ "_Open Project") (AnotherResponseType 2)+ dialogAddButton' md "cabal.project" (AnotherResponseType 3)+ dialogAddButton' md "stack.yaml" (AnotherResponseType 4)+ dialogSetDefaultResponse' md (AnotherResponseType 3)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetHide md+ case resp of+ AnotherResponseType 1 -> do+ projectNew+ postAsyncIDE $ projectTryQuiet f+ AnotherResponseType 2 -> do+ projectOpen+ postAsyncIDE $ projectTryQuiet f+ AnotherResponseType 3 -> do+ defaultExists <- liftIO $ doesFileExist defaultCabal+ if defaultExists+ then projectOpenThis defaultCabal+ else projectNewHere defaultCabal+ postAsyncIDE $ projectTryQuiet f+ _ -> return ()+ chooseWorkspaceFile :: Window -> IO (Maybe FilePath) chooseWorkspaceFile window = chooseFile window (__ "Select leksah workspace file (.lkshw)") Nothing [("Leksah Workspace Files", ["*.lkshw"])] -workspaceOpenThis :: Bool -> Maybe FilePath -> IDEAction-workspaceOpenThis askForSession mbFilePath =- case mbFilePath of- Nothing -> return ()- Just filePath -> do- liftIO . debugM "leksah" $ "workspaceOpenThis " ++ show askForSession ++ " " ++ filePath- let spath = dropExtension filePath ++ leksahSessionFileExtension- workspaceClose- exists <- liftIO $ doesFileExist spath- wantToLoadSession <-- if exists && askForSession- then do- window <- getMainWindow- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsNone- $ __ "There are session settings stored with this workspace."- dialogAddButton md (__ "_Ignore Session") ResponseCancel- dialogAddButton md (__ "_Load Session") ResponseYes- dialogSetDefaultResponse md ResponseYes- set md [ windowWindowPosition := WinPosCenterOnParent ]- rid <- dialogRun md- widgetDestroy md- case rid of- ResponseYes -> return True- otherwise -> return False- else return False- if wantToLoadSession- then void (triggerEventIDE (LoadSession spath))- else do- ideR <- ask- catchIDE (do- workspace <- readWorkspace filePath+chooseProjectFile :: Window -> IO (Maybe FilePath)+chooseProjectFile window = chooseFile window (__ "Select cabal.project or stack.yaml file") Nothing [("Haskell Project", ["*.project", "*.yaml"])]++workspaceOpenThis :: Bool -> FilePath -> IDEAction+workspaceOpenThis askForSession filePath = do+ liftIO . debugM "leksah" $ "workspaceOpenThis " ++ show askForSession ++ " " ++ filePath+ getMainWindow >>= open+ where+ open mainWindow = do+ exists <- liftIO $ doesFileExist filePath+ sessionExists <- liftIO $ doesFileExist sessionPath+ if exists+ then workspaceClose >> if askForSession && sessionExists+ then sessionDialog+ else openWithoutSession+ else+ showDialog (Just mainWindow) ("Could not find workspace file at " <> T.pack filePath) MessageTypeError+ where+ sessionPath = dropExtension filePath ++ leksahSessionFileExtension++ openWithoutSession :: IDEAction+ openWithoutSession = do+ ideR <- ask+ catchIDE (+ Writer.readWorkspace filePath >>= \case+ Left errorMsg -> showDialog (Just mainWindow) (T.pack $ "Could not open " <> filePath <> ". " <> errorMsg) MessageTypeError+ Right workspace -> do Writer.setWorkspace (Just workspace {wsFile = filePath}) VCSWS.onWorkspaceOpen workspace)- (\ (e :: Exc.SomeException) -> reflectIDE- (ideMessage Normal (T.pack $ printf (__ "Can't load workspace file %s\n%s") filePath (show e))) ideR)+ (\ (e :: Exc.SomeException) -> reflectIDE+ (ideMessage Normal (T.pack $ printf (__ "Can't load workspace file %s\n%s") filePath (show e))) ideR) + sessionDialog :: IDEAction+ sessionDialog = showDialogOptions+ (Just mainWindow)+ "There are session settings stored with this workspace."+ MessageTypeQuestion+ [ ("_Ignore Session", openWithoutSession)+ , ("_Load Session" , void (triggerEventIDE (LoadSession sessionPath))) -- Also loads the workspace from that session+ ]+ Nothing +projectOpenThis :: FilePath -> WorkspaceAction+projectOpenThis filePath = do+ liftIO . debugM "leksah" $ "projectOpenThis " ++ filePath+ dir <- liftIO $ myCanonicalizePath $ dropFileName filePath+ let cPath = dir </> takeFileName filePath+ liftIO (doesFileExist cPath) >>= \case+ False -> ideMessage Normal $ __ "Project does not exists : " <> T.pack cPath+ True -> do+ ws <- ask+ liftIDE (ideProjectFromPath filePath) >>= \case+ Nothing -> ideMessage Normal $ __ "Unable to load project : " <> T.pack cPath+ Just project ->+ lift $ Writer.writeWorkspace $ ws {+ wsProjects = project : wsProjects ws+ , wsActiveProjectFile = Just cPath+ , wsActivePackFile = ipdCabalFile <$> listToMaybe (pjPackages project)+ , wsActiveComponent = Nothing }+ -- | Closes a workspace workspaceClose :: IDEAction workspaceClose = do@@ -252,27 +366,57 @@ return () return () - workspacePackageNew :: WorkspaceAction workspacePackageNew = do ws <- ask let path = dropFileName (wsFile ws)- lift $ packageNew' path logOutputDefault (\isNew fp -> do- window <- getMainWindow- workspaceTry $ void (workspaceAddPackage' fp)+ liftIDE . packageNew' path (wsProjects ws) logOutputDefault $ \isNew mbProject fp -> do+ liftIO $ debugM "leksah" $ "workspacePackageNew " <> show (isNew, pjFile <$> mbProject, fp)+ case mbProject of+ Just project -> workspaceTryQuiet . (`runProject` project) . void $ projectAddPackage' fp+ Nothing -> postAsyncIDE . workspaceTryQuiet $ do+ let packageDir = dropFileName fp+ liftIO (doesFileExist $ packageDir </> "cabal.project") >>= \case+ True -> projectOpenThis (packageDir </> "cabal.project")+ False ->+ liftIO (doesFileExist $ packageDir </> "stack.yaml") >>= \case+ True -> projectOpenThis (packageDir </> "stack.yaml")+ False -> do+ liftIO $ debugM "leksah" $ "workspacePackageNew show project creation dialog"+ window <- liftIDE getMainWindow+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "No project file found for this package would you like to add one?"+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "Add cabal.project") (AnotherResponseType 1)+ dialogAddButton' md (__ "Add stack.yaml") (AnotherResponseType 2)+ dialogSetDefaultResponse' md (AnotherResponseType 2)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetHide md+ case resp of+ AnotherResponseType 1 -> do+ liftIO $ T.writeFile (packageDir </> "cabal.project") "packages:\n ./\n"+ projectOpenThis (packageDir </> "cabal.project")+ AnotherResponseType 2 -> do+ liftIO $ T.writeFile (packageDir </> "stack.yaml") "packages:\n- '.'\n"+ projectOpenThis (packageDir </> "stack.yaml")+ _ -> return () when isNew $ do- mbPack <- idePackageFromPath logOutputDefault fp- constructAndOpenMainModules mbPack- void (triggerEventIDE UpdateWorkspaceInfo))+ mbPack <- liftIDE $ idePackageFromPath' fp+ liftIDE $ constructAndOpenMainModules mbPack+ liftIDE $ triggerEventIDE_ UpdateWorkspaceInfo -workspacePackageClone :: WorkspaceAction-workspacePackageClone = do- ws <- ask- let path = dropFileName (wsFile ws)- lift $ packageClone path logOutputDefault (\fp -> do- window <- getMainWindow- workspaceTry $ void (workspaceAddPackage' fp)- void (triggerEventIDE UpdateWorkspaceInfo))+projectPackageClone :: ProjectAction+projectPackageClone = do+ project <- ask+ let path = dropFileName (pjFile project)+ liftIDE . packageClone path logOutputDefault $ \fp ->+ projectTry $ do+ projectAddPackage' fp+ triggerEventIDE_ UpdateWorkspaceInfo constructAndOpenMainModules :: Maybe IDEPackage -> IDEAction constructAndOpenMainModules Nothing = return ()@@ -292,29 +436,44 @@ _ -> return () Nothing -> ideMessage Normal (__ "No package description") -workspaceAddPackage :: WorkspaceAction-workspaceAddPackage = do- ws <- ask- let path = dropFileName (wsFile ws)- window <- lift getMainWindow- mbFilePath <- liftIO $ choosePackageFile window (Just path)- case mbFilePath of+projectAddPackage :: ProjectAction+projectAddPackage = do+ project <- ask+ let path = dropFileName (pjFile project)+ window <- liftIDE getMainWindow+ liftIO (choosePackageFile window (Just path)) >>= \case Nothing -> return () Just fp -> do- void (workspaceAddPackage' fp)- lift $ void (triggerEventIDE UpdateWorkspaceInfo)+ void (projectAddPackage' fp)+ liftIDE $ triggerEventIDE_ UpdateWorkspaceInfo -workspaceAddPackage' :: FilePath -> WorkspaceM (Maybe IDEPackage)-workspaceAddPackage' fp = do- ws <- ask+projectAddPackage' :: FilePath -> ProjectM (Maybe IDEPackage)+projectAddPackage' fp = do+ project <- ask+ ws <- lift ask+ let projectFile = pjFile project cfp <- liftIO $ myCanonicalizePath fp- mbPack <- lift $ idePackageFromPath logOutputDefault cfp- case mbPack of+ liftIDE (idePackageFromPath' cfp) >>= \case Just pack -> do- unless (cfp `elem` map ipdCabalFile (wsPackages ws)) $ lift $- Writer.writeWorkspace $ ws {wsPackages = pack : wsPackages ws,- wsActivePackFile = Just (ipdCabalFile pack),- wsActiveExe = Nothing}+ let indent = case pjTool project of+ StackTool -> "- "+ CabalTool -> " "+ projectText <- liftIO $ T.readFile projectFile+ let projectLines = T.lines projectText+ relativePath = makeRelative (dropFileName projectFile) (dropFileName cfp)+ case span (/= "packages:") projectLines of+ (before, _:rest) ->+ case span (indent `T.isPrefixOf`) rest of+ (packs, rest') -> liftIO $ T.writeFile projectFile . T.unlines $+ before <> ("packages:":packs) <> [indent <> T.pack relativePath] <> rest'+ _ -> return ()+ unless (cfp `elem` map ipdCabalFile (pjPackages project)) $ liftIDE $+ Writer.writeWorkspace $ ws {+ wsProjects = map (\p -> if pjFile p == projectFile+ then p { pjPackageMap = M.insert (ipdCabalFile pack) pack $ pjPackageMap p }+ else p) (wsProjects ws)+ , wsActivePackFile = Just (ipdCabalFile pack)+ , wsActiveComponent = Nothing} return (Just pack) Nothing -> return Nothing @@ -322,98 +481,67 @@ packageTryQuiet f = do maybePackage <- readIDE activePack case maybePackage of- Just p -> workspaceTryQuiet $ runPackage f p+ Just p -> projectTryQuiet $ runPackage f p Nothing -> ideMessage Normal (__ "No active package") packageTry :: PackageAction -> IDEAction packageTry f = workspaceTry $ do+ maybeProject <- lift $ readIDE activeProject maybePackage <- lift $ readIDE activePack- case maybePackage of- Just p -> runPackage f p- Nothing -> do- window <- lift getMainWindow- resp <- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (__ "You need to have an active package for this to work.")- dialogAddButton md (__ "_New Package") (ResponseUser 1)- dialogAddButton md (__ "_Add Package") (ResponseUser 2)- dialogSetDefaultResponse md (ResponseUser 2)- set md [ windowWindowPosition := WinPosCenterOnParent ]- resp <- dialogRun md- widgetHide md- return resp+ case (maybeProject, maybePackage) of+ (Just project, Just package) -> runProject (runPackage f package) project+ _ -> do+ window <- liftIDE getMainWindow+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeCancel]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md $ __ "You need to have an active package for this to work."+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_New Package") (AnotherResponseType 1)+ dialogAddButton' md (__ "_Add Package") (AnotherResponseType 2)+ dialogSetDefaultResponse' md (AnotherResponseType 2)+ setWindowWindowPosition md WindowPositionCenterOnParent+ resp <- dialogRun' md+ widgetHide md case resp of- ResponseUser 1 -> do+ AnotherResponseType 1 -> do workspacePackageNew lift $ postAsyncIDE $ packageTryQuiet f- ResponseUser 2 -> do- workspaceAddPackage+ AnotherResponseType 2 -> do+ workspacePackageNew lift $ postAsyncIDE $ packageTryQuiet f _ -> return () -workspaceRemovePackage :: IDEPackage -> WorkspaceAction-workspaceRemovePackage pack = do- ws <- ask- when (pack `elem` wsPackages ws) $ lift $- Writer.writeWorkspace ws {wsPackages = delete pack (wsPackages ws)}- return ()--workspaceActivatePackage :: IDEPackage -> Maybe Text -> WorkspaceAction-workspaceActivatePackage pack exe = do+workspaceRemoveProject :: FilePath -> WorkspaceAction+workspaceRemoveProject projectFile = do ws <- ask- let activePath = takeDirectory $ ipdCabalFile pack- lift $ activatePackage (Just activePath) (Just pack) exe- when (pack `elem` wsPackages ws) $ lift $ do- Writer.writeWorkspace ws {wsActivePackFile = Just (ipdCabalFile pack)- ,wsActiveExe = exe}- return ()- return ()----readWorkspace :: FilePath -> IDEM Workspace-readWorkspace fp = do- liftIO $ debugM "leksah" "readWorkspace"- ws <- liftIO $ readFields fp Writer.workspaceDescr emptyWorkspace- ws' <- liftIO $ makePathsAbsolute ws fp- packages <- mapM (idePackageFromPath logOutputDefault) (wsPackagesFiles ws')- --TODO set package vcs here- return ws'{ wsPackages = catMaybes packages}-----makePathsAbsolute :: Workspace -> FilePath -> IO Workspace-makePathsAbsolute ws bp = do- wsFile' <- myCanonicalizePath bp- wsActivePackFile' <- case wsActivePackFile ws of- Nothing -> return Nothing- Just fp -> do- fp' <- makeAbsolute (dropFileName wsFile') fp- return (Just fp')- wsPackagesFiles' <- mapM (makeAbsolute (dropFileName wsFile')) (wsPackagesFiles ws)- return ws {wsActivePackFile = wsActivePackFile', wsFile = wsFile', wsPackagesFiles = wsPackagesFiles'}- where- makeAbsolute basePath relativePath =- myCanonicalizePath- (if isAbsolute relativePath- then relativePath- else basePath </> relativePath)--emptyWorkspace = Workspace {- wsVersion = Writer.workspaceVersion-, wsSaveTime = ""-, wsName = ""-, wsFile = ""-, wsPackages = []-, wsPackagesFiles = []-, wsActivePackFile = Nothing-, wsActiveExe = Nothing-, wsNobuildPack = []-, packageVcsConf = Map.empty-}+ when (any ((/= projectFile) . pjFile) $ wsProjects ws) . lift $+ Writer.writeWorkspace ws {wsProjects = filter ((/= projectFile) . pjFile) $ wsProjects ws} +projectRemovePackage :: IDEPackage -> ProjectAction+projectRemovePackage pack = do+-- ws <- ask+-- when (pack `elem` wsPackages ws) $ lift $+-- Writer.writeWorkspace ws {wsProjects = delete pack (wsPackages ws)}+ ideMessage Normal "projectRemovePackage not implemented" +workspaceActivatePackage :: Project -> Maybe IDEPackage -> Maybe Text -> WorkspaceAction+workspaceActivatePackage project mbPack exe = do+ (mbPackFile, mbExe) <- liftIDE $ case mbPack of+ Just pack | ipdCabalFile pack `elem` map ipdCabalFile (pjPackages project) -> do+ activatePackage (Just (ipdCabalFile pack)) (Just project) (Just pack) exe+ return (Just (ipdCabalFile pack), exe)+ _ -> do+ activatePackage Nothing (Just project) Nothing Nothing+ return (Nothing, Nothing)+ ws <- ask+ let projects = project : filter ((/= pjFile project) . pjFile) (wsProjects ws)+ liftIDE $ Writer.writeWorkspace ws+ {wsProjects = projects+ ,wsActiveProjectFile = Just (pjFile project)+ ,wsActivePackFile = mbPackFile+ ,wsActiveComponent = mbExe} addRecentlyUsedWorkspace :: FilePath -> IDEAction addRecentlyUsedWorkspace fp = do@@ -444,16 +572,16 @@ settings <- lift $ do prefs' <- readIDE prefs return (defaultMakeSettings prefs')- makePackages settings (wsPackages ws) MoClean MoClean moNoOp+ lift $ makePackages settings (map (\p -> (p, pjPackages p)) $ wsProjects ws) MoClean MoClean moNoOp -buildSteps :: Bool -> IDEM [MakeOp]-buildSteps runTests = do+buildSteps :: MakeSettings -> IDEM [MakeOp]+buildSteps settings = do debug <- isJust <$> readIDE debugState- return $ case (runTests, debug) of- (True, True) -> [MoBuild,MoDocu]- (True, False) -> [MoBuild,MoDocu,MoTest,MoCopy,MoRegister]- (False, True) -> [MoBuild]- (False, False) -> [MoBuild,MoCopy,MoRegister]+ return $ MoBuild+ : [MoDocu | msMakeDocs settings]+ ++ [MoTest | not debug && msRunUnitTests settings]+ ++ [MoInstall | not debug]+ ++ [MoBench | not debug && msRunBenchmarks settings] workspaceMake :: WorkspaceAction workspaceMake = do@@ -463,85 +591,67 @@ return ((defaultMakeSettings prefs'){ msMakeMode = True, msBackgroundBuild = False})- build <- lift . buildSteps $ msRunUnitTests settings- let steps = MoComposed (MoConfigure : build)- makePackages settings (wsPackages ws) steps steps MoMetaInfo+ build <- lift . buildSteps $ settings+ lift $ makePackages settings (map (\p -> (p, pjPackages p)) $ wsProjects ws) (MoComposed build) (MoComposed build) MoMetaInfo backgroundMake :: IDEAction backgroundMake = catchIDE (do ideR <- ask prefs <- readIDE prefs debug <- isJust <$> readIDE debugState- modifiedPacks <- if saveAllBeforeBuild prefs- then fileCheckAll belongsToPackages'+ modifiedFiles <- catMaybes <$> if saveAllBeforeBuild prefs+ then fileCheckAll (return . return . fileName) else return []- let isModified = not (null modifiedPacks)- when isModified $ do- let settings = defaultMakeSettings prefs- steps <- buildSteps $ msRunUnitTests settings- workspaceTryQuiet $ if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)- then makePackages settings modifiedPacks (MoComposed steps) (MoComposed []) moNoOp- else makePackages settings modifiedPacks (MoComposed steps)- (MoComposed (MoConfigure:steps)) MoMetaInfo+ workspaceTryQuiet $ do+ ws <- ask+ liftIDE $ do+ let modifiedPacks = filter (not . null . snd) $+ map (\project -> (project, filter (\pack -> any (`belongsToPackage` pack) modifiedFiles) (pjPackages project))) (wsProjects ws)+ settings = defaultMakeSettings prefs+ steps <- buildSteps settings+ if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)+ then makePackages settings modifiedPacks (MoComposed steps) (MoComposed []) moNoOp+ else makePackages settings modifiedPacks (MoComposed steps)+ (MoComposed steps) MoMetaInfo ) (\(e :: Exc.SomeException) -> sysMessage Normal (T.pack $ show e)) makePackage :: PackageAction makePackage = do+ liftIO $ debugM "leksah" "makePackage" p <- ask+ project <- lift ask liftIDE $ do- getLog >>= liftIO . bringPaneToFront+ getLog >>= bringPaneToFront showDefaultLogLaunch' prefs' <- readIDE prefs mbWs <- readIDE workspace let settings = (defaultMakeSettings prefs'){msBackgroundBuild = False}- case mbWs of- Nothing -> sysMessage Normal (__ "No workspace for build.")- Just ws -> do- debug <- isJust <$> readIDE debugState- steps <- buildSteps $ msRunUnitTests settings- if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)- then runWorkspace- (makePackages settings [p] (MoComposed steps) (MoComposed []) moNoOp) ws- else- runWorkspace- (makePackages settings [p]- (MoComposed steps)- (MoComposed (MoConfigure:steps))- MoMetaInfo) ws+ debug <- isJust <$> readIDE debugState+ steps <- buildSteps settings+ if debug || msSingleBuildWithoutLinking settings && not (msMakeMode settings)+ then makePackages settings [(project, [p])] (MoComposed steps) (MoComposed []) moNoOp+ else makePackages settings [(project, [p])] (MoComposed steps) (MoComposed steps) MoMetaInfo fileOpen :: IDEAction fileOpen = do window <- getMainWindow prefs <- readIDE prefs mbBuf <- maybeActiveBuf- mbFileName <- liftIO $ do- dialog <- fileChooserDialogNew- (Just $ __ "Open File")- (Just window)- FileChooserActionOpen- [("gtk-cancel"- ,ResponseCancel)- ,("gtk-open"- ,ResponseAccept)]- case mbBuf >>= fileName of- Just fn -> void (fileChooserSetCurrentFolder dialog (dropFileName fn))- Nothing -> return ()- widgetShow dialog- response <- dialogRun dialog- case response of- ResponseAccept -> do- f <- fileChooserGetFilename dialog- widgetDestroy dialog- return f- ResponseCancel -> do- widgetDestroy dialog- return Nothing- ResponseDeleteEvent-> do- widgetDestroy dialog- return Nothing- _ -> return Nothing- forM_ mbFileName fileOpen'+ dialog <- new' FileChooserDialog [constructDialogUseHeaderBar 1]+ setWindowTitle dialog $ __ "Open File"+ windowSetTransientFor dialog $ Just window+ fileChooserSetAction dialog FileChooserActionOpen+ dialogAddButton' dialog "gtk-cancel" ResponseTypeCancel+ dialogAddButton' dialog "gtk-open" ResponseTypeAccept+ case mbBuf >>= fileName of+ Just fn -> void (fileChooserSetCurrentFolder dialog (dropFileName fn))+ Nothing -> return ()+ widgetShow dialog+ response <- dialogRun' dialog+ when (response == ResponseTypeAccept) $+ fileChooserGetFilename dialog >>= mapM_ fileOpen'+ widgetDestroy dialog fileOpen' :: FilePath -> IDEAction fileOpen' fp = do@@ -550,45 +660,43 @@ unless knownFile $ if takeExtension fp == ".cabal" then do- resp <- liftIO $ do- md <- messageDialogNew- (Just window) []- MessageQuestion- ButtonsNone- (__ "Would you like to add the package " <> T.pack fp- <> __ " to the workspace so that it can be built by Leksah?")- dialogAddButton md (__ "_Add " <> T.pack (takeFileName fp)) (ResponseUser 1)- dialogAddButton md (__ "Just _open " <> T.pack (takeFileName fp)) (ResponseUser 2)- dialogSetDefaultResponse md (ResponseUser 1)- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md (__ "Would you like to add the package " <> T.pack fp+ <> __ " to the active project so that it can be built by Leksah?")+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Add " <> T.pack (takeFileName fp)) (AnotherResponseType 1)+ dialogAddButton' md (__ "Just _open " <> T.pack (takeFileName fp)) (AnotherResponseType 2)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> workspaceTry $ do- workspaceAddPackage' fp+ AnotherResponseType 1 -> projectTry $ do+ projectAddPackage' fp return () _ -> return () else liftIO (findCabalFile fp) >>= \case Nothing -> return () Just cabalFile -> do- resp <- liftIO $ do- md <- messageDialogNew- (Just window) []- MessageQuestion- ButtonsNone- (__ "The file " <> T.pack fp- <> __ " seems to belong to the package " <> T.pack cabalFile- <> __ " would you like to add " <> T.pack (takeFileName cabalFile)- <> __ " to your workspace?")- dialogAddButton md (__ "_Add " <> T.pack (takeFileName cabalFile)) (ResponseUser 1)- dialogAddButton md (__ "Just _open " <> T.pack (takeFileName fp)) (ResponseUser 2)- dialogSetDefaultResponse md (ResponseUser 1)- resp <- dialogRun md- widgetDestroy md- return resp+ md <- new' MessageDialog [+ constructDialogUseHeaderBar 0,+ constructMessageDialogButtons ButtonsTypeNone]+ setMessageDialogMessageType md MessageTypeQuestion+ setMessageDialogText md (__ "The file " <> T.pack fp+ <> __ " seems to belong to the package " <> T.pack cabalFile+ <> __ " would you like to add " <> T.pack (takeFileName cabalFile)+ <> __ " to your active project?")+ windowSetTransientFor md (Just window)+ dialogAddButton' md (__ "_Add " <> T.pack (takeFileName cabalFile)) (AnotherResponseType 1)+ dialogAddButton' md (__ "Just _open " <> T.pack (takeFileName fp)) (AnotherResponseType 2)+ dialogSetDefaultResponse' md (AnotherResponseType 1)+ resp <- dialogRun' md+ widgetDestroy md case resp of- ResponseUser 1 -> workspaceTry $ do- workspaceAddPackage' cabalFile+ AnotherResponseType 1 -> projectTry $ do+ projectAddPackage' cabalFile return () _ -> return () fileOpenThis fp
src/IDE/Workspaces/Writer.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Workspaces.Writer@@ -15,6 +16,10 @@ module IDE.Workspaces.Writer ( writeWorkspace+ ,readWorkspace+ ,makePathsAbsolute+ ,WorkspaceFile(..)+ ,emptyWorkspaceFile ,setWorkspace ,workspaceDescr ,workspaceVersion@@ -24,11 +29,11 @@ import IDE.Core.State import IDE.Package (getModuleTemplate, getPackageDescriptionAndPath, activatePackage,- deactivatePackage, idePackageFromPath)+ deactivatePackage, ideProjectFromPath) import IDE.Utils.FileUtils(myCanonicalizePath) import Data.Maybe-import Control.Monad (void, when)+import Control.Monad (join, void, when) import Control.Monad.Trans (liftIO) import System.Time (getClockTime) import Text.PrinterParser@@ -49,17 +54,107 @@ import System.Log.Logger (debugM) import qualified Data.Text as T (pack) import Data.Monoid ((<>))+import System.FSNotify (watchDir, Event(..), watchTree)+import Control.Monad.Reader (MonadReader(..))+import Data.Traversable (forM)+import qualified Data.Map as Map (empty)+import Text.ParserCombinators.Parsec (parseFromFile, CharParser)+import Text.PrinterParser (colon, symbol)+import Data.Text (Text)+import Data.Map (Map) +data WorkspaceFile = WorkspaceFile {+ wsfVersion :: Int+, wsfSaveTime :: Text+, wsfName :: Text+, wsfProjectFiles :: [FilePath]+, wsfActiveProjectFile :: Maybe FilePath+, wsfActivePackFile :: Maybe FilePath+, wsfActiveComponent :: Maybe Text+, wsfPackageVcsConf :: Map FilePath VCSConf+} deriving Show+ writeWorkspace :: Workspace -> IDEAction writeWorkspace ws = do timeNow <- liftIO getClockTime let newWs = ws {wsSaveTime = T.pack $ show timeNow,- wsVersion = workspaceVersion,- wsPackagesFiles = map ipdCabalFile (wsPackages ws)}+ wsVersion = workspaceVersion} setWorkspace $ Just newWs- newWs' <- liftIO $ makePathsRelative newWs- liftIO $ writeFields (wsFile newWs') (newWs' {wsFile = ""}) workspaceDescr+ newWs' <- liftIO $ makePathsRelative newWs (wsFile ws)+ liftIO $ writeFields (wsFile ws) newWs' workspaceDescr +readWorkspace :: FilePath -> IDEM (Either String Workspace)+readWorkspace fp = do+ liftIO $ debugM "leksah" "readWorkspace"+ liftIO (parseFromFile workspaceVerParser fp) >>= \case+ Left pe -> error $ "Error reading file " ++ show fp ++ " " ++ show pe+ Right version | version < 3 -> return $ Left+ "This workspace was created with an older version of Leksah that did not use project files (cabal.project and stack.yaml) to list packages in the workspace."+ Right version | version < workspaceVersion -> return $ Left+ "This workspace was created with an older version of Leksah."+ _ -> do+ ws <- liftIO $ readFields fp workspaceDescr emptyWorkspaceFile+ ws' <- makePathsAbsolute ws fp+ --TODO set package vcs here+ return $ Right ws'++makePathsAbsolute :: WorkspaceFile -> FilePath -> IDEM Workspace+makePathsAbsolute ws bp = do+ wsFile' <- liftIO $ myCanonicalizePath bp+ wsActivePackFile' <- case wsfActivePackFile ws of+ Nothing -> return Nothing+ Just fp -> do+ fp' <- liftIO $ makeAbsolute (dropFileName wsFile') fp+ return (Just fp')+ projectFiles <- liftIO $ mapM (makeAbsolute (dropFileName wsFile')) (wsfProjectFiles ws)+ projects <- catMaybes <$> mapM ideProjectFromPath projectFiles+ return Workspace+ { wsFile = wsFile'+ , wsVersion = wsfVersion ws+ , wsSaveTime = wsfSaveTime ws+ , wsName = wsfName ws+ , wsProjects = projects+ , wsActiveProjectFile = wsfActiveProjectFile ws+ , wsActivePackFile = wsActivePackFile'+ , wsActiveComponent = wsfActiveComponent ws+ , packageVcsConf = wsfPackageVcsConf ws+ }+ where+ makeAbsolute basePath relativePath =+ myCanonicalizePath+ (if isAbsolute relativePath+ then relativePath+ else basePath </> relativePath)++emptyWorkspace = Workspace {+ wsVersion = workspaceVersion+, wsSaveTime = ""+, wsName = ""+, wsFile = ""+, wsProjects = []+, wsActiveProjectFile = Nothing+, wsActivePackFile = Nothing+, wsActiveComponent = Nothing+, packageVcsConf = Map.empty+}++emptyWorkspaceFile = WorkspaceFile {+ wsfVersion = workspaceVersion+, wsfSaveTime = ""+, wsfName = ""+, wsfProjectFiles = []+, wsfActiveProjectFile = Nothing+, wsfActivePackFile = Nothing+, wsfActiveComponent = Nothing+, wsfPackageVcsConf = Map.empty+}++getProject :: FilePath -> [Project] -> Maybe Project+getProject fp projects =+ case filter (\ p -> pjFile p == fp) projects of+ [p] -> Just p+ l -> Nothing+ getPackage :: FilePath -> [IDEPackage] -> Maybe IDEPackage getPackage fp packages = case filter (\ p -> ipdCabalFile p == fp) packages of@@ -70,28 +165,31 @@ -- This needs to be incremented, when the workspace format changes -- workspaceVersion :: Int-workspaceVersion = 2+workspaceVersion = 4 setWorkspace :: Maybe Workspace -> IDEAction setWorkspace mbWs = do liftIO $ debugM "leksah" "setWorkspace"+ ideR <- ask mbOldWs <- readIDE workspace modifyIDE_ (\ide -> ide{workspace = mbWs}) let packFileAndExe = case mbWs of Nothing -> Nothing- Just ws -> Just (wsActivePackFile ws, wsActiveExe ws)+ Just ws -> Just (wsActiveProjectFile ws, wsActivePackFile ws, wsActiveComponent ws) let oldPackFileAndExe = case mbOldWs of Nothing -> Nothing- Just ws -> Just (wsActivePackFile ws, wsActiveExe ws)- let mbPackages = case mbWs of- Nothing -> Nothing- Just ws -> Just (wsPackages ws)- when (packFileAndExe /= oldPackFileAndExe) $- case packFileAndExe of- (Just (Just p, mbExe)) -> void (activatePackage (Just p) (getPackage p (fromJust mbPackages)) mbExe)+ Just ws -> Just (wsActiveProjectFile ws, wsActivePackFile ws, wsActiveComponent ws)+ case (packFileAndExe, mbWs) of+ (Just (Just pj, mbPackFile, mbExe), Just ws) ->+ case getProject pj (wsProjects ws) of+ Just project ->+ case (`getPackage` pjPackages project) =<< mbPackFile of+ Just package -> void (activatePackage mbPackFile (Just project) (Just package) mbExe)+ _ -> void (activatePackage Nothing (Just project) Nothing Nothing) _ -> deactivatePackage+ _ -> deactivatePackage mbPack <- readIDE activePack- mbExe <- readIDE activeExe+ mbComponent <- readIDE activeComponent let wsStr = case mbWs of Nothing -> "" Just ws -> wsName ws@@ -99,67 +197,106 @@ <> (case mbPack of Nothing -> "" Just p -> packageIdentifierToString (ipdPackageId p))- <> (case mbExe of+ <> (case mbComponent of Nothing -> ""- Just exe -> " " <> exe)+ Just component -> " " <> component)+-- case mbWs of+-- Just ws -> do+-- fsn <- readIDE fsnotify+-- newStop <- liftIO $ forM (wsProjects ws) (\project ->+-- watchDir fsn (dropFileName $ pjFile project) (\case+-- Modified f _ | takeFileName f == takeFileName (pjFile project) -> True+-- _ -> False) $ \_ ->+-- (`reflectIDE` ideR) $ postAsyncIDE $ do+-- ws' <- readWorkspace (wsFile ws)+-- setWorkspace (Just ws'))+-- oldStop <- readIDE stopWorkspaceNotify+-- modifyIDE_ $ \ide -> ide { stopWorkspaceNotify = sequence_ newStop }+-- liftIO oldStop+-- Nothing -> return () triggerEventIDE (StatusbarChanged [CompartmentPackage txt]) triggerEventIDE (WorkspaceChanged True True) triggerEventIDE UpdateWorkspaceInfo return () -makePathsRelative :: Workspace -> IO Workspace-makePathsRelative ws = do- wsFile' <- myCanonicalizePath (wsFile ws)- wsActivePackFile' <- case wsActivePackFile ws of- Nothing -> return Nothing- Just fp -> do- nfp <- liftIO $ myCanonicalizePath fp- return (Just (makeRelative (dropFileName wsFile') nfp))- wsPackagesFiles' <- mapM myCanonicalizePath (wsPackagesFiles ws)- let relativePathes = map (makeRelative (dropFileName wsFile')) wsPackagesFiles'- return ws {wsActivePackFile = wsActivePackFile', wsFile = wsFile', wsPackagesFiles = relativePathes}+makePathsRelative :: Workspace -> FilePath -> IO WorkspaceFile+makePathsRelative ws wsFile' = do+ wsActiveProjectFile' <- case wsActiveProjectFile ws of+ Nothing -> return Nothing+ Just fp -> do+ nfp <- liftIO $ myCanonicalizePath fp+ return (Just (makeRelative (dropFileName wsFile') nfp))+ wsActivePackFile' <- case wsActivePackFile ws of+ Nothing -> return Nothing+ Just fp -> do+ nfp <- liftIO $ myCanonicalizePath fp+ return (Just (makeRelative (dropFileName wsFile') nfp))+ wsProjectFiles' <- mapM myCanonicalizePath (wsProjectFiles ws)+ let relativePaths = map (makeRelative (dropFileName wsFile')) wsProjectFiles'+ return WorkspaceFile+ { wsfVersion = wsVersion ws+ , wsfSaveTime = wsSaveTime ws+ , wsfName = wsName ws+ , wsfProjectFiles = relativePaths+ , wsfActiveProjectFile = wsActiveProjectFile'+ , wsfActivePackFile = wsActivePackFile'+ , wsfActiveComponent = wsActiveComponent ws+ , wsfPackageVcsConf = packageVcsConf ws+ } -workspaceDescr :: [FieldDescriptionS Workspace]+workspaceVerParser :: CharParser () Int+workspaceVerParser = do+ symbol "Version of workspace file format"+ colon+ intParser++workspaceDescr :: [FieldDescriptionS WorkspaceFile] workspaceDescr = [ mkFieldS (paraName <<<- ParaName "Version of workspace file format" $ emptyParams) (PP.text . show) intParser- wsVersion- (\ b a -> a{wsVersion = b})+ wsfVersion+ (\ b a -> a{wsfVersion = b}) , mkFieldS (paraName <<<- ParaName "Time of storage" $ emptyParams) (PP.text . show) stringParser- wsSaveTime- (\ b a -> a{wsSaveTime = b})+ wsfSaveTime+ (\ b a -> a{wsfSaveTime = b}) , mkFieldS (paraName <<<- ParaName "Name of the workspace" $ emptyParams) (PP.text . show) stringParser- wsName- (\ b a -> a{wsName = b})+ wsfName+ (\ b a -> a{wsfName = b}) , mkFieldS- (paraName <<<- ParaName "File paths of contained packages" $ emptyParams)+ (paraName <<<- ParaName "File paths of contained projects" $ emptyParams) (PP.text . show) readParser- wsPackagesFiles- (\b a -> a{wsPackagesFiles = b})+ wsfProjectFiles+ (\b a -> a{wsfProjectFiles = b}) , mkFieldS+ (paraName <<<- ParaName "Maybe file path of an active project" $ emptyParams)+ (PP.text . show)+ readParser+ wsfActiveProjectFile+ (\fp a -> a{wsfActiveProjectFile = fp})+ , mkFieldS (paraName <<<- ParaName "Maybe file path of an active package" $ emptyParams) (PP.text . show) readParser- wsActivePackFile- (\fp a -> a{wsActivePackFile = fp})+ wsfActivePackFile+ (\fp a -> a{wsfActivePackFile = fp}) , mkFieldS- (paraName <<<- ParaName "Maybe name of an active executable" $ emptyParams)+ (paraName <<<- ParaName "Maybe name of an active component" $ emptyParams) (PP.text . show) readParser- wsActiveExe- (\fp a -> a{wsActiveExe = fp})+ wsfActiveComponent+ (\fp a -> a{wsfActiveComponent = fp}) , mkFieldS (paraName <<<- ParaName "Version Control System configurations for packages" $ emptyParams) (PP.text . show) readParser- packageVcsConf- (\filePath a -> a{packageVcsConf = filePath})]+ wsfPackageVcsConf+ (\filePath a -> a{wsfPackageVcsConf = filePath})]
− src/IDE/YiConfig.hs
@@ -1,127 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{- Based on example config yi example-configs/yi-vim.hs -}--module IDE.YiConfig (- defaultYiConfig-, Config-, Control-, ControlM-, YiM-, start-, runControl-, liftYi-) where--#ifdef LEKSAH_WITH_YI--import Data.List (reverse, isPrefixOf)--import Yi-import qualified Yi.Keymap.Vim as V2-import qualified Yi.Keymap.Vim.Common as V2-import qualified Yi.Keymap.Vim.Utils as V2--import qualified Yi.Mode.Haskell as Haskell--import qualified Yi.UI.Pango-import Yi.UI.Pango.Control--import Control.Monad (replicateM_)-import Control.Applicative (Alternative(..))-import qualified Data.Text as T (singleton)-import Data.Monoid ((<>))-import qualified Yi.Rope as R (toText)--start yiConfig f =- startControl yiConfig $ do- yiControl <- getControl- controlIO (f yiControl)---- Set soft tabs of 4 spaces in width.-prefIndent :: Mode s -> Mode s-prefIndent m = m {- modeIndentSettings = IndentSettings- {- expandTabs = True,- shiftWidth = 4,- tabSize = 4- }}--defaultYiConfig = defaultVimConfig {- modeTable = myModes ++ modeTable defaultVimConfig,- defaultKm = myKeymapSet,- configCheckExternalChangesObsessively = False-}--defaultSearchKeymap :: Keymap-defaultSearchKeymap = do- Event (KASCII c) [] <- anyEvent- write (isearchAddE $ T.singleton c)--myKeymapSet :: KeymapSet-myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this ->- let eval = V2.pureEval this- in super {- -- Here we can add custom bindings.- -- See Yi.Keymap.Vim.Common for datatypes and- -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE-- -- In case of conflict, that is if there exist multiple bindings- -- whose prereq function returns WholeMatch,- -- the first such binding is used.- -- So it's important to have custom bindings first.- V2.vimBindings = myBindings eval <> V2.vimBindings super- }--myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding]-myBindings eval =- let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)- imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of- V2.Insert _ ->- fmap (const (y >> return V2.Continue))- (evs `V2.matchesString` x)- _ -> V2.NoMatch)- in [ nmap "<C-h>" previousTabE- , nmap "<C-l>" nextTabE- , nmap "<C-l>" nextTabE-- -- Press space to clear incremental search highlight- , nmap " " (eval ":nohlsearch<CR>")-- -- for times when you don't press shift hard enough- , nmap ";" (eval ":")-- , nmap "<F3>" (withCurrentBuffer deleteTrailingSpaceB)- , nmap "<F4>" (withCurrentBuffer moveToSol)- , nmap "<F1>" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText)- , imap "<Home>" (withCurrentBuffer moveToSol)- , imap "<End>" (withCurrentBuffer moveToEol)- ]--myModes :: [AnyMode]-myModes = [- AnyMode Haskell.fastMode {- -- Disable beautification- modePrettify = const $ return ()- }- ]--#else--data Config = Config-data Control = Control-data ControlM a = ControlM-data YiM a = YiM--defaultYiConfig :: Config-defaultYiConfig = Config-start :: Config -> (Control -> IO a) -> IO a-start yiConfig f = f Control-runControl :: ControlM a -> Control -> IO a-runControl = undefined-liftYi :: YiM a -> ControlM a-liftYi = undefined--#endif-
− tests/IDE/TextEditor/Tests.hs
@@ -1,179 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}------------------------------------------------------------------------------------ Module : IDE.TextEditor.Tests--- Copyright : 2007-2013 Juergen Nicklisch-Franken, Hamish Mackenzie--- License : GPL Nothing------ Maintainer : maintainer@leksah.org--- Stability : provisional--- Portability :------ |-----------------------------------------------------------------------------------module IDE.TextEditor.Tests (- testEditors-) where--import Graphics.UI.Gtk- (mainQuit, postGUIAsync, windowSetPosition, windowSetDefaultSize,- mainGUI, widgetShowAll, containerAdd, uiManagerNew, widgetSetName,- windowNew)-import IDE.TextEditor- (CodeMirror(..), Yi(..), GtkSourceView(..), TextEditor(..))-import IDE.Core.Types- (IDEM, KeymapI, Prefs(..), IDE(..), IDEState(..))-import qualified Data.Map as Map (empty)-import Graphics.UI.Frame.Panes- (PaneLayout(..), FrameState(..))-import IDE.SourceCandy (parseCandy)-import IDE.Utils.FileUtils (getConfigFilePathForLoad)-import IDE.Utils.Utils- (leksahKeymapFileExtension, leksahCandyFileExtension)-import IDE.Preferences (defaultPrefs)-import IDE.Keymap (Keymap(..))-import IDE.Command (mkActions)-import qualified IDE.YiConfig as Yi (start)-import IDE.YiConfig (defaultYiConfig)-import Data.IORef (newIORef)-import IDE.Core.State (getDataDir, reflectIDE)-import Control.Monad.IO.Class (MonadIO(..))-import Graphics.UI.Gtk.General.Enums (WindowPosition(..))-import System.Log.Logger (debugM)-import Control.Concurrent (takeMVar, putMVar, newEmptyMVar)-import Test.QuickCheck.Monadic (assert, run, monadicIO)-import Test.QuickCheck.All (quickCheckAll)-import Graphics.UI.Frame.ViewFrame (getWindows)-import Test.QuickCheck (Property)-import Control.Monad.Loops (allM)-import System.IO (stderr, stdout, hFlush)-import Data.Text (Text)-import Data.Monoid ((<>))-import qualified Data.Text as T (unpack, pack)-import Data.Sequence (empty)---testIDE :: IDEM Bool -> IO Bool-testIDE f = do- result <- newEmptyMVar- Yi.start defaultYiConfig $ \yiControl -> do- uiManager <- uiManagerNew- dataDir <- getDataDir- candyPath <- getConfigFilePathForLoad- (case sourceCandy defaultPrefs of- (_,name) -> T.unpack name <> leksahCandyFileExtension) Nothing dataDir- candySt <- parseCandy candyPath- -- keystrokes- keysPath <- getConfigFilePathForLoad (T.unpack (keymapName defaultPrefs) <> leksahKeymapFileExtension) Nothing dataDir- keyMap <- parseKeymap keysPath- let accelActions = setKeymap (keyMap :: KeymapI) mkActions- specialKeys <- buildSpecialKeys keyMap accelActions-- win <- windowNew- windowSetDefaultSize win 900 600- windowSetPosition win WinPosCenter- widgetSetName win "Leksah Main Window"- let fs = FrameState- { windows = [win]- , uiManager = uiManager- , panes = Map.empty- , activePane = Nothing- , paneMap = Map.empty- , layout = TerminalP Map.empty Nothing (-1) Nothing Nothing- , panePathFromNB = Map.empty- }- ide = IDE- { frameState = fs- , recentPanes = []- , specialKeys = specialKeys- , specialKey = Nothing- , candy = candySt- , prefs = defaultPrefs- , workspace = Nothing- , activePack = Nothing- , activeExe = Nothing- , bufferProjCache = Map.empty- , allLogRefs = empty- , currentHist = 0- , currentEBC = (Nothing, Nothing, Nothing)- , systemInfo = Nothing- , packageInfo = Nothing- , workspaceInfo = Nothing- , workspInfoCache = Map.empty- , handlers = Map.empty- , currentState = IsStartingUp- , guiHistory = (False,[],-1)- , findbar = (False,Nothing)- , toolbar = (True,Nothing)- , recentFiles = []- , recentWorkspaces = []- , runningTool = Nothing- , debugState = Nothing- , completion = ((750,400),Nothing)- , yiControl = yiControl- , server = Nothing- , vcsData = (Map.empty, Nothing)- , logLaunches = Map.empty- , autoCommand = return ()- , autoURI = Nothing- , hlintQueue = Nothing- , serverQueue = Nothing- }- ideR <- newIORef ide- (`reflectIDE` ideR) f >>= putMVar result- takeMVar result--allEditors :: (forall editor. TextEditor editor- => ( Maybe FilePath- -> Text- -> IDEM (EditorBuffer editor))- -> IDEM Bool)- -> IO Bool-allEditors test = allM id- [ doTest GtkSourceView-#ifdef MIN_VERSION_yi- , doTest Yi-#endif- , doTest CodeMirror]- where- doTest :: forall editor. (TextEditor editor, Show editor) => editor -> IO Bool- doTest editor = do- hFlush stdout- hFlush stderr- debugM "leksah" $ show editor- testIDE $ test (newBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer editor))--prop_test :: String -> Property-prop_test s = monadicIO $ do- let input = filter (not . flip elem "\NUL\r") s- result <- run $ allEditors (\buf -> do- (win:_) <- getWindows- buffer <- buf Nothing (T.pack "")- view <- newView buffer (Just $ T.pack "monospace")- sw <- getScrolledWindow view- liftIO $ containerAdd win sw- setText buffer (T.pack input)- first <- getStartIter buffer- last <- getEndIter buffer- out <- getText buffer first last True- return $ T.pack input == out)- assert result---- workaround for issue with $quickcheckall--- see https://hackage.haskell.org/package/QuickCheck-2.4.2/docs/Test-QuickCheck-All.html-return []--testEditors :: IO Bool-testEditors = do- result <- newEmptyMVar- postGUIAsync $ do- $quickCheckAll >>= putMVar result- mainQuit- mainGUI- takeMVar result-
− tests/Tests.hs
@@ -1,66 +0,0 @@-{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}------------------------------------------------------------------------------------ Module : Tests--- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie--- License : GNU-GPL------ Maintainer : <maintainer at leksah.org>--- Stability : provisional--- Portability : portable------ |------------------------------------------------------------------------------------module Main (main) where--import System.Exit (exitFailure)-import Test.QuickCheck.All (quickCheckAll)-import IDE.ImportTool (parseHiddenModule, HiddenModuleResult(..))-import Control.Monad (unless)-import Distribution.Package- (PackageName(..), PackageIdentifier(..))-import Distribution.Version (Version(..))-import Graphics.UI.Gtk (timeoutAddFull, initGUI)-import IDE.TextEditor.Tests (testEditors)-import System.Log.Logger- (errorM, setLevel, rootLoggerName, updateGlobalLogger)-import System.Log (Priority(..))-import Control.Concurrent- (yield, takeMVar, putMVar, newEmptyMVar, threadDelay, forkIO)-import System.Glib.MainLoop (priorityLow)-import Data.Monoid ((<>))--testString = " Could not find module `Graphics.UI.Gtk':\n" - <> " It is a member of the hidden package `gtk-0.11.0'.\n" - <> " Perhaps you need to add `gtk' to the build-depends in your .cabal file.\n" - <> " Use -v to see a list of the files searched for." --prop_parseHiddenModule = parseHiddenModule testString == Just HiddenModuleResult {hiddenModule = "Graphics.UI.Gtk", missingPackage = PackageIdentifier {pkgName = PackageName "gtk", pkgVersion = Version {versionBranch = [0,11,0], versionTags = []}}} ---- At some point the : was removed from this message...-testString2 = " Could not find module `Data.Attoparsec.Lazy'\n"- <> " It is a member of the hidden package `attoparsec-0.10.2.0'.\n"- <> " Perhaps you need to add `attoparsec' to the build-depends in your .cabal file.\n"- <> " Use -v to see a list of the files searched for.\n"- -prop_parseHiddenModule2 = parseHiddenModule testString2 == Just HiddenModuleResult {hiddenModule = "Data.Attoparsec.Lazy", missingPackage = PackageIdentifier {pkgName = PackageName "attoparsec", pkgVersion = Version {versionBranch = [0,10,2,0], versionTags = []}}} ---- workaround for issue with $quickcheckall--- see https://hackage.haskell.org/package/QuickCheck-2.4.2/docs/Test-QuickCheck-All.html-return []-main = do- result <- newEmptyMVar- forkIO $ do- updateGlobalLogger rootLoggerName (setLevel DEBUG)- allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions- initGUI- timeoutAddFull (yield >> return True) priorityLow 10- editorsOk <- testEditors- putMVar result (allPass && editorsOk)- forkIO $ do- threadDelay 60000000- errorM "leksah tests" "Test took too long to run"- putMVar result False- r <- takeMVar result- unless r exitFailure
win32/makeinstaller.sh view
@@ -32,7 +32,9 @@ cp -u leksah.bat SourceDir cp -u leksah-server.bat SourceDir cp -u leksah-rebuild-metadata.bat SourceDir+$LNDIR etc SourceDir # has to be done before copying the gtk etc folder since this has the right settings.ini $LNDIR "$GTK_PREFIX_U"/etc SourceDir+$LNDIR share SourceDir mkdir -p SourceDir/leksah $LNDIR "$LEKSAH_PREFIX/$LEKSAH_X_X_X_X"/data SourceDir/leksah $LNDIR "$LEKSAH_PREFIX/$LEKSAH_X_X_X_X"/language-specs SourceDir/leksah@@ -59,15 +61,13 @@ $LN "$CABAL_USER_BIN"/leksah-server.exe SourceDir/bin $LN "$CABAL_USER_BIN"/leksahecho.exe SourceDir/bin $LN "$CABAL_USER_BIN"/leksahtrue.exe SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/iconv.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/icudata50.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/icui18n50.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/icule50.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/icuuc50.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libiconv-2.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libicu*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libatk-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libbz2-1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libcairo-2.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libcairo-gobject-2.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libdbus*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libenchant.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libepoxy-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libexpat-1.dll SourceDir/bin@@ -79,12 +79,14 @@ $LN "$GTK_PREFIX_U"/bin/libgcc_s_seh-1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgdk-3-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgdk_pixbuf-2.0-0.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libgeoclue-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgio-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libglib-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgmodule-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgmp-10.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgnutls-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgobject-2.0-0.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libgraphite2.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgst*-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgthread-2.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libgtk-3-0.dll SourceDir/bin@@ -92,15 +94,19 @@ $LN "$GTK_PREFIX_U"/bin/libharfbuzz-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libharfbuzz-icu-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libhogweed-*.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libidn-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libintl-8.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libjavascriptcoregtk-3.0-0.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/libjpeg-62.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libjpeg-*.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/liblzma-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libnettle-*.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/liborc-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libp11-kit-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpango-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpangocairo-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpangoft2-1.0-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpangowin32-1.0-0.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libpcre-*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpixman-1-0.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libpng16-16.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libsoup-2.4-1.dll SourceDir/bin@@ -110,11 +116,10 @@ $LN "$GTK_PREFIX_U"/bin/libxml2-2.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libxslt-1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libwebkitgtk-3.0-0.dll SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/libwebp-5.dll SourceDir/bin+$LN "$GTK_PREFIX_U"/bin/libwebp*.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/libwinpthread-1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/zlib1.dll SourceDir/bin $LN "$GTK_PREFIX_U"/bin/pkg-config.exe SourceDir/bin-$LN "$GTK_PREFIX_U"/bin/grep.exe SourceDir/bin $LN "$GTK_PREFIX_U"/bin/xsltproc.exe SourceDir/bin mkdir -p SourceDir/share $LNDIR "$GTK_PREFIX_U"/share/themes SourceDir/share