towards configurable keybindings

5 files changed, 78 insertions, 35 deletions

diff --git a/src/Lazymail/Config.hs b/src/Lazymail/Config.hs
index 2566bc9..bfe2333 100644
--- a/src/Lazymail/Config.hs
+++ b/src/Lazymail/Config.hs
@@ -26,7 +26,7 @@ defaultConfig = LazymailConfig {
   , filterMaildirsHook =  \mds -> return mds
   , indexDateFormat    = "%m %d"
   , headersToShow      = ["date", "from", "to", "cc", "bcc", "subject", "reply-to"]
-  , globalKeymaps      = defaultGlobalKeymap
+  , globalKeymap       = defaultGlobalKeymap
   , maildirModeKeymap  = defaultMaildirKeymap
   , indexModeKeymap    = defaultIndexKeymap
   , emailModeKeymap    = defaultEmailKeymap
diff --git a/src/Lazymail/Handlers.hs b/src/Lazymail/Handlers.hs
index bd1d27a..c63d6fc 100644
--- a/src/Lazymail/Handlers.hs
+++ b/src/Lazymail/Handlers.hs
@@ -24,23 +24,26 @@ import Lazymail.Print
 import Lazymail.State
 import Lazymail.Types
 
-previousMode :: Mode -> LazymailCurses ()
-previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
-previousMode EmailMode   = do
+previousMode :: LazymailCurses ()
+previousMode = get >>= \st -> previousMode' (mode st)
+
+previousMode' MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
+previousMode' EmailMode   = do
   st <- get
   if (triggerUpdateIn . indexState $ st)
   then do
-    changeMode MaildirMode
+    advanceMode
     solveIndexUpdate
   else put $ st { mode = IndexMode }
-previousMode IndexMode   = do
+previousMode' IndexMode   = do
   st <- get
   let ist = (indexState st) { selectedRowIn = 0, scrollRowIn = 0 }
   put $ st { mode = MaildirMode, indexState = ist }
 
-changeMode :: Mode -> LazymailCurses ()
-changeMode EmailMode   = return ()
-changeMode IndexMode   = do
+advanceMode :: LazymailCurses ()
+advanceMode = get >>= \st -> advanceMode' (mode st)
+
+advanceMode' IndexMode   = do
   st <- get
   let fp = selectedEmailPath . indexState $ st
   nfp <- if (isNew fp)
@@ -55,7 +58,7 @@ changeMode IndexMode   = do
   let est = (emailState st) { currentEmail = email, emailLines = el, scrollRowEm = 0 }
   put $ st { mode = EmailMode, emailState = est }
 
-changeMode MaildirMode =  do
+advanceMode' MaildirMode =  do
   st <- get
   unsortedEmails <- liftIO $ do
     freeOldHandlers st
@@ -81,10 +84,15 @@ changeMode MaildirMode =  do
       let date = maybe startOfTime id $ parseDateTime rfc822DateFormat $ takeWhile (/= '(') $ lookupField "date" headers
       return (Email value date fp handle)
 
+advanceMode' _  = return ()
+
 freeOldHandlers st = mapM (hClose . emailHandle) $ selectedEmails . indexState $ st
 
-{- Boilerplate code -}
-scrollDown IndexMode = do
+scrollDown :: LazymailCurses ()
+scrollDown = get >>= \st -> scrollDown' (mode st)
+
+-- Boilerplate code
+scrollDown' IndexMode = do
   st <- get
   let inSt = indexState st
   let selRow = selectedRowIn inSt
@@ -101,7 +109,7 @@ scrollDown IndexMode = do
      else -- Move the selected row
        put $ incrementSelectedRow st
 
-scrollDown MaildirMode = do
+scrollDown' MaildirMode = do
   st <- get
   let mdSt = maildirState st
   let selRow = selectedRowMD mdSt
@@ -119,7 +127,7 @@ scrollDown MaildirMode = do
        put $ incrementSelectedRow st
 
 {- Down-scrolling in Email mode -}
-scrollDown EmailMode = do
+scrollDown' EmailMode = do
   st <- get
   let est = emailState st
   let cur = scrollRowEm est
@@ -130,10 +138,13 @@ scrollDown EmailMode = do
   when ((totalRows - scrRows + (bodyStartRow est) - 1) > (scrollRowEm est)) $
     put $ st { emailState = est' }
 
-scrollDown _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
+scrollDown' _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
+
+scrollUp :: LazymailCurses ()
+scrollUp = get >>= \st -> scrollUp' (mode st)
 
-{- More boilerplate code -}
-scrollUp IndexMode = do
+-- More boilerplate code
+scrollUp' IndexMode = do
   st <- get
   let inSt = indexState st
   let selRow = selectedRowIn inSt
@@ -148,7 +159,7 @@ scrollUp IndexMode = do
       else
         put $ decrementSelectedRow st
 
-scrollUp MaildirMode = do
+scrollUp' MaildirMode = do
   st <- get
   let mdSt = maildirState st
   let selRow = selectedRowMD mdSt
@@ -163,7 +174,7 @@ scrollUp MaildirMode = do
       else
         put $ decrementSelectedRow st
 
-scrollUp EmailMode = do
+scrollUp' EmailMode = do
   st <- get
   let est = emailState st
   let cur = scrollRowEm est
@@ -174,7 +185,7 @@ scrollUp EmailMode = do
   when (cur > 0) $
     put $ st { emailState = est' }
 
-scrollUp _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
+scrollUp' _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
 
 incrementSelectedRow st | (selectedRow st) < limit =
   case (mode st) of
@@ -227,7 +238,7 @@ scrollCrop top rows xs = take rows $ drop top xs
 
 formatIndexModeRows :: LazymailState -> [Email] -> [(FilePath, String)]
 formatIndexModeRows st = map formatRow where
-  formatRow e = 
+  formatRow e =
     let fp = emailPath e
         email = emailValue e
         hs = mime_val_headers email
diff --git a/src/Lazymail/Keymap.hs b/src/Lazymail/Keymap.hs
index 1cef1b1..27dce60 100644
--- a/src/Lazymail/Keymap.hs
+++ b/src/Lazymail/Keymap.hs
@@ -1,16 +1,48 @@
+{- Lazymail default keymap.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
 module Lazymail.Keymap
        ( defaultGlobalKeymap
        , defaultMaildirKeymap
        , defaultIndexKeymap
        , defaultEmailKeymap
        , defaultComposeKeymap
+       , findHandler
        ) where
 
-import UI.NCurses(Event(..))
-import Lazymail.Types(LazymailCurses)
+import UI.NCurses(Event(..), Key(..))
+
+import Lazymail.Types(Keymap, LazymailState(..), Mode(..), LazymailConfig(..))
+import Lazymail.Handlers(advanceMode, previousMode, scrollUp, scrollDown)
 
-defaultGlobalKeymap = []
+defaultGlobalKeymap = [ ([EventCharacter '\n', EventSpecialKey KeyRightArrow], advanceMode)
+                      , ([EventCharacter 'q', EventCharacter 'Q'], previousMode)
+                      , ([EventSpecialKey KeyUpArrow, EventCharacter 'k'], scrollUp)
+                      , ([EventSpecialKey KeyDownArrow, EventCharacter 'j'], scrollDown)
+                      ]
 defaultMaildirKeymap = []
-defaultIndexKeymap = []
-defaultEmailKeymap = []
-defaultComposeKeymap = []
\ No newline at end of file
+defaultIndexKeymap   = []
+defaultEmailKeymap   = []
+defaultComposeKeymap = []
+
+-- | Try to find a keymap for the current mode. If nothing is found, then
+--   try looking up in the global keymap.
+findHandler st cfg ev = case modeHandler (mode st) ev of
+  Nothing -> globalHandler ev
+  Just h  -> Just h -- I think I saw a way of using an as-pattern in this case
+  where
+    modeHandler MaildirMode = lookupHandler $ maildirModeKeymap cfg
+    modeHandler IndexMode   = lookupHandler $ indexModeKeymap  cfg
+    modeHandler EmailMode   = lookupHandler $ emailModeKeymap   cfg
+    modeHandler ComposeMode = lookupHandler $ composeModeKeymap cfg
+
+    globalHandler = lookupHandler $ globalKeymap cfg
+
+    lookupHandler [] _   = Nothing
+    lookupHandler (km:kms) ev
+      | elem ev (fst km) = Just $ snd km
+      | otherwise        = lookupHandler kms ev
\ No newline at end of file
diff --git a/src/Lazymail/Screen.hs b/src/Lazymail/Screen.hs
index d6937dd..7bc980b 100644
--- a/src/Lazymail/Screen.hs
+++ b/src/Lazymail/Screen.hs
@@ -229,16 +229,16 @@ handleEvent = loop where
       Nothing  -> loop
       Just ev' ->
         case ev' of
-          EventCharacter 'q'            -> EH.previousMode (mode st)
+          EventCharacter 'q'            -> EH.previousMode
 
-          EventSpecialKey KeyUpArrow    -> EH.scrollUp (mode st)
-          EventCharacter 'k'            -> EH.scrollUp (mode st)
+          EventSpecialKey KeyUpArrow    -> EH.scrollUp
+          EventCharacter 'k'            -> EH.scrollUp
 
-          EventSpecialKey KeyDownArrow  -> EH.scrollDown (mode st)
-          EventCharacter 'j'            -> EH.scrollDown (mode st)
+          EventSpecialKey KeyDownArrow  -> EH.scrollDown
+          EventCharacter 'j'            -> EH.scrollDown
 
-          EventCharacter '\n'           -> EH.changeMode (mode st)
-          EventSpecialKey KeyRightArrow -> EH.changeMode (mode st)
+          EventCharacter '\n'           -> EH.advanceMode
+          EventSpecialKey KeyRightArrow -> EH.advanceMode
 
           _ ->  loop
 
diff --git a/src/Lazymail/Types.hs b/src/Lazymail/Types.hs
index fb30f91..ce46f65 100644
--- a/src/Lazymail/Types.hs
+++ b/src/Lazymail/Types.hs
@@ -34,7 +34,7 @@ data LazymailConfig = LazymailConfig {
   , filterMaildirsHook :: [FilePath] -> IO [FilePath]
   , indexDateFormat    :: String
   , headersToShow      :: [String]
-  , globalKeymaps      :: [Keymap]
+  , globalKeymap       :: [Keymap]
   , maildirModeKeymap  :: [Keymap]
   , indexModeKeymap    :: [Keymap]
   , emailModeKeymap    :: [Keymap]