emacs-style keybindings patch
Max Desyatov
explicitcall at googlemail.com
Tue Jun 2 18:26:27 EDT 2009
Hi.
I've implemented few functions, which are present in standard
readline, and absence of them in ghci-haskeline annoyed me. These are
for making word capitalized, lowercased and uppercased, they are
binded to M-c, M-l and M-u.
A patch produced with darcs send is attached to this message.
WBR, Max.
-------------- next part --------------
Wed Jun 3 01:21:09 EEST 2009 explicitcall at gmail.com
* added emacs-style functions M-u, M-l and M-c which uppercase, lowercase and capitalize current word respectively
New patches:
[added emacs-style functions M-u, M-l and M-c which uppercase, lowercase and capitalize current word respectively
explicitcall at gmail.com**20090602222109
Ignore-this: 2d28529a84a7b491f09b5d72e688703c
] {
hunk ./System/Console/Haskeline/Emacs.hs 19
emacsCommands = runCommand $ choiceCmd [simpleActions, controlActions]
simpleActions, controlActions :: InputCmd InsertMode InsertMode
-simpleActions = choiceCmd
+simpleActions = choiceCmd
[ simpleChar '\n' +> finish
, simpleKey LeftKey +> change goLeft
, simpleKey RightKey +> change goRight
hunk ./System/Console/Haskeline/Emacs.hs 24
, simpleKey Backspace +> change deletePrev
- , simpleKey Delete +> change deleteNext
+ , simpleKey Delete +> change deleteNext
, changeFromChar insertChar
, saveForUndo $ simpleChar '\t' +> completionCmd
, simpleKey UpKey +> historyBack
hunk ./System/Console/Haskeline/Emacs.hs 30
, simpleKey DownKey +> historyForward
, searchHistory
- ]
-
+ ]
+
controlActions = choiceCmd
hunk ./System/Console/Haskeline/Emacs.hs 33
- [ ctrlChar 'a' +> change moveToStart
+ [ ctrlChar 'a' +> change moveToStart
, ctrlChar 'e' +> change moveToEnd
, ctrlChar 'b' +> change goLeft
, ctrlChar 'f' +> change goRight
hunk ./System/Console/Haskeline/Emacs.hs 41
, ctrlChar 'l' +> clearScreenCmd
, metaChar 'f' +> change wordRight
, metaChar 'b' +> change wordLeft
+ , metaChar 'c' +> change capital
+ , metaChar 'l' +> change lower
+ , metaChar 'u' +> change upper
, ctrlChar '_' +> commandUndo
hunk ./System/Console/Haskeline/Emacs.hs 45
- , ctrlChar 'x' +> change id
+ , ctrlChar 'x' +> change id
, simpleKey Home +> change moveToStart
, simpleKey End +> change moveToEnd
>|> choiceCmd [ctrlChar 'u' +> commandUndo
hunk ./System/Console/Haskeline/Emacs.hs 65
else Just $ Change (deleteNext s) >=> justDelete)
where
justDelete = try (change deleteNext k >|> justDelete)
-
-wordRight, wordLeft, bigWordLeft :: InsertMode -> InsertMode
-wordRight = skipRight isAlphaNum . skipRight (not . isAlphaNum)
-wordLeft = skipLeft isAlphaNum . skipLeft (not . isAlphaNum)
-bigWordLeft = skipLeft (not . isSpace) . skipLeft isSpace
hunk ./System/Console/Haskeline/LineState.hs 3
module System.Console.Haskeline.LineState where
+import Data.Char
class LineState s where
beforeCursor :: String -> s -> String -- text to left of cursor
hunk ./System/Console/Haskeline/LineState.hs 27
class Move s where
goLeft, goRight, moveToStart, moveToEnd :: s -> s
-
hunk ./System/Console/Haskeline/LineState.hs 28
-data InsertMode = IMode String String
+
+data InsertMode = IMode String String
deriving (Show, Eq)
instance LineState InsertMode where
hunk ./System/Console/Haskeline/LineState.hs 40
toResult (IMode xs ys) = reverse xs ++ ys
instance Move InsertMode where
- goLeft im@(IMode [] _) = im
+ goLeft im@(IMode [] _) = im
goLeft (IMode (x:xs) ys) = IMode xs (x:ys)
goRight im@(IMode _ []) = im
hunk ./System/Console/Haskeline/LineState.hs 66
deleteNext (IMode xs (_:ys)) = IMode xs ys
deletePrev im@(IMode [] _) = im
-deletePrev (IMode (_:xs) ys) = IMode xs ys
+deletePrev (IMode (_:xs) ys) = IMode xs ys
+
+capital :: InsertMode -> InsertMode
+capital im@(IMode _ []) = im
+capital (IMode xs (y:ys)) = wordRight $ IMode xs (toUpper y:ys)
+
+lower :: InsertMode -> InsertMode
+lower im@(IMode _ []) = im
+lower (IMode xs ys) = wordRight $ IMode xs $ map toLower ys1 ++ ys2
+ where
+ (ys1, ys2) = span (/= ' ') ys
+
+upper :: InsertMode -> InsertMode
+upper im@(IMode _ []) = im
+upper (IMode xs ys) = wordRight $ IMode xs $ map toUpper ys1 ++ ys2
+ where
+ (ys1, ys2) = span (/= ' ') ys
skipLeft, skipRight :: (Char -> Bool) -> InsertMode -> InsertMode
hunk ./System/Console/Haskeline/LineState.hs 85
-skipLeft f (IMode xs ys) = let (ws,zs) = span f xs
+skipLeft f (IMode xs ys) = let (ws,zs) = span f xs
in IMode zs (reverse ws ++ ys)
hunk ./System/Console/Haskeline/LineState.hs 87
-skipRight f (IMode xs ys) = let (ws,zs) = span f ys
+skipRight f (IMode xs ys) = let (ws,zs) = span f ys
in IMode (reverse ws ++ xs) zs
hunk ./System/Console/Haskeline/LineState.hs 177
addNum :: Int -> ArgMode s -> ArgMode s
addNum n am
| arg am >= 1000 = am -- shouldn't ever need more than 4 digits
- | otherwise = am {arg = arg am * 10 + n}
+ | otherwise = am {arg = arg am * 10 + n}
-- todo: negatives
applyArg :: (s -> s) -> ArgMode s -> s
hunk ./System/Console/Haskeline/LineState.hs 208
deleteFromMove :: (InsertMode -> InsertMode) -> InsertMode -> InsertMode
deleteFromMove f = \x -> deleteFromDiff x (f x)
+
+wordRight, wordLeft, bigWordLeft :: InsertMode -> InsertMode
+wordRight = skipRight isAlphaNum . skipRight (not . isAlphaNum)
+wordLeft = skipLeft isAlphaNum . skipLeft (not . isAlphaNum)
+bigWordLeft = skipLeft (not . isSpace) . skipLeft isSpace
}
Context:
[Fix #73: keep track of multi-line input correctly.
Judah Jacobson <judah.jacobson at gmail.com>**20090524221947
Ignore-this: 2e64941e9b7feca5554857e43fca5eff
]
[Fix ghc issue #3258: don't leave an a.out file in the current directory when configure checks for iconv.
Judah Jacobson <judah.jacobson at gmail.com>**20090524215637
Ignore-this: 2ce3816236ab2106053fe4abb44de182
]
[Bump version to 0.6.1.6.
Judah Jacobson <judah.jacobson at gmail.com>**20090522151815
Ignore-this: 9d70615e82937acffa89964c3e024389
]
[Remove empty Posix directory.
Judah Jacobson <judah.jacobson at gmail.com>**20090522151743
Ignore-this: ba900f86457186d627fccd265515a43e
]
[Partial fix for #80.
judah.jacobson at gmail.com**20090521161411
Ignore-this: f42398a349224a3ac4e3afd6f41553e2
]
[TAG 0.6.1.5
judah.jacobson at gmail.com**20090513153250
Ignore-this: 223cf28a526416d5cb2e52678a01bed4
]
[Bump version to 0.6.1.5.
judah.jacobson at gmail.com**20090426212747
Ignore-this: 64fb89732e7bab5971e87414e062a778
]
[Explicit alignment for Coords, now that ghc>=6.10.3 actually uses it.
judah.jacobson at gmail.com**20090426212604
Ignore-this: 7897e69175ece9243ac54b232f7178f1
]
[Bump version to 0.6.1.4.
judah.jacobson at gmail.com**20090421021235
Ignore-this: 36f4260e784d348ac3ed2d2bb05a83a8
]
[Update Setup script to pull -I and -L dirs from the package dependencies. (e.g. the rts package can point to /usr/local/lib on OpenBSD.)
judah.jacobson at gmail.com**20090421020948
Ignore-this: 1d7d223c4d03a79930f7baa3c5c6c110
]
[Allow unix-2.0 as a dependency (it comes with ghc-6.6.0)
judah.jacobson at gmail.com**20090313160240
Ignore-this: 25d90a7bc0bf20a4f1934ef8d8819c9e
]
[Emit '?' when encountering encode/decode errors.
judah.jacobson at gmail.com**20090308220305
Ignore-this: d3df373e60302e1a6a609a5733944c84
]
[TAG 0.6.1.3
judah.jacobson at gmail.com**20090219181340
Ignore-this: c5fca2eaa38d29ae604706cc8bc86f81
]
Patch bundle hash:
1294acf35b5cae47cefd122202c8352fca657665
More information about the Haskeline
mailing list