File: Default.hs

package info (click to toggle)
yi 0.7.1-5
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 7,532 kB
  • ctags: 1
  • sloc: haskell: 25,311; sh: 10; makefile: 9
file content (287 lines) | stat: -rw-r--r-- 11,989 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
{-# LANGUAGE CPP #-}
-- Copyright (c) Jean-Philippe Bernardy 2006,2007,2008.

module Yi.Config.Default (defaultConfig, availableFrontends, 
                          defaultEmacsConfig, defaultVimConfig, defaultCuaConfig,
                          toVimStyleConfig, toVim2StyleConfig, toEmacsStyleConfig, toCuaStyleConfig) where

import Control.Monad (forever)
import Data.Default
import Data.Either (rights)
import Paths_yi
import Prelude ()
import System.Directory
import System.FilePath
import System.IO (readFile)
import Yi.Command (cabalBuildE, cabalConfigureE, grepFind, makeBuild, reloadProjectE, searchSources, shell)
import {-# source #-} Yi.Boot
import Yi.Config
import Yi.Config.Misc
import Yi.Paths(getConfigFilename)
import Yi.Core
import Yi.Eval(publishedActions)
import Yi.File
import Yi.IReader (saveAsNewArticle)
import Yi.Mode.IReader (ireaderMode, ireadMode)
import Yi.Layout
import Yi.Modes
#ifdef SCION
import Yi.Scion
#endif
import Yi.Search
import Yi.Style.Library
import qualified Data.Map as M
import qualified Data.HashMap.Strict as HM
import qualified Yi.Keymap.Cua  as Cua
import qualified Yi.Keymap.Emacs  as Emacs
import qualified Yi.Keymap.Vim  as Vim
import qualified Yi.Keymap.Vim2  as Vim2
import qualified Yi.Mode.Abella as Abella
import qualified Yi.Mode.Haskell as Haskell
import qualified Yi.Mode.JavaScript as JS
import qualified Yi.Mode.Latex as Latex
import qualified Yi.Interact as I
import qualified Data.Rope as R

#ifdef FRONTEND_VTE
import qualified Yi.UI.Vte
#endif
#ifdef FRONTEND_VTY
import qualified Yi.UI.Vty
import qualified Graphics.Vty.Config as Vty
#endif
#ifdef FRONTEND_PANGO
import qualified Yi.UI.Pango
#endif
#ifdef FRONTEND_COCOA
import qualified Yi.UI.Cocoa
#endif
import qualified Yi.UI.Batch

availableFrontends :: [(String, UIBoot)]
availableFrontends =
#ifdef FRONTEND_VTE
   ("vte", Yi.UI.Vte.start) :
#endif
#ifdef FRONTEND_VTY
   ("vty", Yi.UI.Vty.start) :
#endif
#ifdef FRONTEND_PANGO
   ("pango", Yi.UI.Pango.start) :
#endif
#ifdef FRONTEND_COCOA
   ("cocoa", Yi.UI.Cocoa.start) :
#endif
   ("batch", Yi.UI.Batch.start) :
   []

-- | List of published Actions

-- THIS MUST BE OF THE FORM:
-- ("symbol", box symbol")
-- ... so we can hope getting rid of this someday.
-- Failing to conform to this rule exposes the code to instant deletion.

defaultPublishedActions :: HM.HashMap String Action
defaultPublishedActions = HM.fromList $ 
    [ 
      ("atBoundaryB"            , box atBoundaryB)
    , ("cabalBuildE"            , box cabalBuildE)
    , ("cabalConfigureE"        , box cabalConfigureE)
    , ("closeBufferE"           , box closeBufferE)
    , ("deleteB"                , box deleteB)
    , ("deleteBlankLinesB"      , box deleteBlankLinesB)
    , ("getSelectRegionB"       , box getSelectRegionB)
    , ("grepFind"               , box grepFind)
    , ("insertB"                , box insertB)
    , ("iread"                  , box ireadMode)
    , ("ireadSaveAsArticle"     , box saveAsNewArticle)
    , ("leftB"                  , box leftB)
    , ("linePrefixSelectionB"   , box linePrefixSelectionB)
    , ("lineStreamB"            , box lineStreamB)
--    , ("mkRegion"               , box mkRegion) -- can't make 'instance Promptable Region'
    , ("makeBuild"              , box makeBuild)
    , ("moveB"                  , box moveB)
    , ("numberOfB"              , box numberOfB)
    , ("pointB"                 , box pointB) 
    , ("regionOfB"              , box regionOfB)
    , ("regionOfPartB"          , box regionOfPartB)
    , ("regionOfPartNonEmptyB"  , box regionOfPartNonEmptyB)
    , ("reloadEditor"           , box reload)
    , ("reloadProjectE"         , box reloadProjectE)
    , ("replaceString"          , box replaceString)
    , ("revertE"                , box revertE)
    , ("shell"                  , box shell)
    , ("searchSources"          , box searchSources)
    , ("setAnyMode"             , box setAnyMode)
    , ("sortLines"              , box sortLines)
    , ("unLineCommentSelectionB", box unLineCommentSelectionB)
    , ("writeB"                 , box writeB)
    , ("ghciGet"                , box Haskell.ghciGet)
    , ("abella"                 , box Abella.abella)
#ifdef SCION
    , ("scion"                  , box scion)
#endif
    ]

  where 
    box :: (Show x, YiAction a x) => a -> Action
    box = makeAction


defaultConfig :: Config
defaultConfig = 
  publishedActions ^= defaultPublishedActions $ 
  Config { startFrontEnd    = case availableFrontends of
             [] -> error "panic: no frontend compiled in! (configure with -fvty or another frontend.)"
             ((_,f):_) -> f
         , configUI         =  UIConfig 
           { configFontSize = Nothing
           , configFontName = Nothing
           , configScrollWheelAmount = 4
           , configScrollStyle = Nothing
           , configCursorStyle = FatWhenFocusedAndInserting
           , configLineWrap = True
           , configLeftSideScrollBar = True
           , configAutoHideScrollBar = False
           , configAutoHideTabBar = True
           , configWindowFill = ' '
           , configTheme = defaultTheme
#ifdef FRONTEND_VTY
           , configVty = def
#endif
           }
         , defaultKm        = modelessKeymapSet nilKeymap
         , startActions     = []
         , initialActions   = []
         , modeTable = [AnyMode Haskell.cleverMode,
                        AnyMode Haskell.preciseMode,
                        AnyMode Latex.latexMode3,
                        AnyMode Latex.fastMode,
                        AnyMode Abella.abellaModeEmacs,
                        AnyMode cMode,
                        AnyMode objectiveCMode,
                        AnyMode cppMode,
                        AnyMode Haskell.literateMode,
                        AnyMode cabalMode,
                        AnyMode gnuMakeMode,
                        AnyMode srmcMode,
                        AnyMode ocamlMode,
                        AnyMode ottMode,
                        AnyMode perlMode,
                        AnyMode (JS.hooks JS.javaScriptMode),
                        AnyMode pythonMode,
                        AnyMode rubyMode,
                        AnyMode javaMode,
                        AnyMode jsonMode,
                        AnyMode ireaderMode,
                        AnyMode svnCommitMode,
                        AnyMode gitCommitMode,
                        AnyMode whitespaceMode,
                        AnyMode fundamentalMode]
         , debugMode = False
         , configKillringAccumulate = False
         , configCheckExternalChangesObsessively = True
         , configRegionStyle = Exclusive
         , configInputPreprocess = I.idAutomaton
         , bufferUpdateHandler = []
         , layoutManagers = [hPairNStack 1, vPairNStack 1, tall, wide]
         , configVars = initial
         }

defaultEmacsConfig, defaultVimConfig, defaultCuaConfig :: Config
defaultEmacsConfig = toEmacsStyleConfig defaultConfig
defaultVimConfig = toVimStyleConfig defaultConfig
defaultCuaConfig = toCuaStyleConfig defaultConfig

toEmacsStyleConfig, toVimStyleConfig, toVim2StyleConfig, toCuaStyleConfig :: Config -> Config
toEmacsStyleConfig cfg 
    = cfg {
            configUI = (configUI cfg)
                       { configScrollStyle = Just SnapToCenter
#ifdef FRONTEND_VTY
                       -- corey: does this actually matter? escToMeta appears to perform all the
                       -- meta joining required. I'm not an emacs user and cannot evaluate feel. For
                       -- me these settings join esc;key to meta-key OK. The 100 millisecond lag in
                       -- ESC is terrible for me. Maybe that's just how it is under emacs...
                       , configVty = def { Vty.vtime = Just 100, Vty.vmin = Just 2 }
#endif
                       },
            defaultKm = Emacs.keymap,
            startActions = makeAction openScratchBuffer : startActions cfg,
            configInputPreprocess = escToMeta,
            configKillringAccumulate = True
          }

-- | Input preprocessor: Transform Esc;Char into Meta-Char
-- Useful for emacs lovers ;)
escToMeta :: I.P Event Event
escToMeta = mkAutomaton $ forever $ (anyEvent >>= I.write) ||> do
    discard $ event (spec KEsc)
    c <- printableChar
    I.write (Event (KASCII c) [MMeta])

toVimStyleConfig cfg = cfg { defaultKm = Vim.keymapSet
                           , configUI = (configUI cfg) { configScrollStyle = Just SingleLine}
                           , configRegionStyle = Inclusive
                           , modeTable = AnyMode Abella.abellaModeVim : modeTable cfg }

toVim2StyleConfig cfg = cfg { defaultKm = Vim2.keymapSet
                            , configUI = (configUI cfg) { configScrollStyle = Just SingleLine}
                            , configRegionStyle = Inclusive }

toCuaStyleConfig cfg = cfg {defaultKm = Cua.keymap}

-- | Open an emacs-like scratch buffer if no file is open.
openScratchBuffer :: YiM ()
openScratchBuffer = withEditor $ do 
      noFileBufOpen <- null . rights . fmap (getVal identA) . M.elems <$> getA buffersA
      when noFileBufOpen $ do
           discard $ newBufferE (Left "scratch") $ R.fromString $ unlines
                   ["This buffer is for notes you don't want to save.", --, and for haskell evaluation" -- maybe someday?
                    "If you want to create a file, open that file,",
                    "then enter the text in that file's own buffer."]

nilKeymap :: Keymap
nilKeymap = choice [
             char 'c' ?>>  openCfg (Cua.keymap)    "yi-cua.hs",
             char 'e' ?>>  openCfg (Emacs.keymap)  "yi.hs",
             char 'v' ?>>  openCfg (Vim.keymapSet) "yi-vim.hs",
             char 'q' ?>>! quitEditor,
             char 'r' ?>>! reload,
             char 'h' ?>>! configHelp
            ] 
            <|| (anyEvent >>! errorEditor "Keymap not defined, 'q' to quit, 'h' for help.")
    where configHelp = newBufferE (Left "configuration help") $ R.fromString $ unlines $
                         ["This instance of Yi is not configured.",
                          "To get a standard reasonable keymap, you can run yi with either --as=cua, --as=vim or --as=emacs.",
                          "You should however create your own ~/.config/yi/yi.hs file: ",
                          "You can type 'c', 'e' or 'v' now to create and edit it using a temporary cua, emacs or vim keymap."]
          openCfg km kmName = write $ do
            dataDir <- io getDataDir
            let exampleCfg = dataDir </> "example-configs" </> kmName
            cfgFile <- getConfigFilename -- automatically creates directory, if missing
            cfgExists <- io $ doesFileExist cfgFile
            discard $ editFile cfgFile -- load config file
            -- locally override the keymap to the user choice
            withBuffer $ modifyMode (\m -> m { modeKeymap = const km })
            when (not cfgExists) $ do
                -- file did not exist, load a reasonable default
                defCfg <- io $ readFile exampleCfg
                withBuffer $ insertN defCfg
--          openCfg km kmName = write $ do
--            dataDir <- io $ getDataDir
--            let exampleCfg = dataDir </> "example-configs" </> kmName
--            homeDir <- io $ getHomeDirectory
--            let cfgDir = homeDir </> ".yi"
--                cfgFile = cfgDir </> "yi.hs"
--            cfgExists <- io $ doesFileExist cfgFile
--            -- io $ print cfgExists
--            io $ createDirectoryIfMissing True cfgDir -- so that the file can be saved.
--            discard $ editFile cfgFile -- load config file
--            -- locally override the keymap to the user choice
--            withBuffer $ modifyMode (\m -> m {modeKeymap = const km})
--            when (not cfgExists) $ do
--                 -- file did not exist, load a reasonable default
--                 defCfg <- io $ readFile exampleCfg
--                 withBuffer $ insertN defCfg