From 7af6e583d7d6893f67745e23017eba436f8ed826 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= Date: Thu, 5 Sep 2013 21:41:20 -0300 Subject: towards configurable keybindings --- src/Lazymail/Config.hs | 2 +- src/Lazymail/Handlers.hs | 51 +++++++++++++++++++++++++++++------------------- src/Lazymail/Keymap.hs | 44 +++++++++++++++++++++++++++++++++++------ src/Lazymail/Screen.hs | 14 ++++++------- src/Lazymail/Types.hs | 2 +- 5 files changed, 78 insertions(+), 35 deletions(-) (limited to 'src/Lazymail') 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 + - + - 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] -- cgit v1.2.3