{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeOperators #-} -- Copyright (c) 2005,2007,2008 Jean-Philippe Bernardy {- This module is aimed at being a helper for the Emacs keybindings. In particular this should be useful for anyone that has a custom keymap derived from or based on the Emacs one. -} module Yi.Keymap.Emacs.Utils ( UnivArgument , argToInt , askQuitEditor , askSaveEditor , modifiedQuitEditor , withMinibuffer , queryReplaceE , isearchKeymap , cabalConfigureE , cabalBuildE , reloadProjectE , executeExtendedCommandE , evalRegionE , readUniversalArg , scrollDownE , scrollUpE , switchBufferE , killBufferE , insertNextC , findFile , findFileNewTab , promptFile , promptTag , justOneSep , joinLinesE ) where {- Standard Library Module Imports -} import Prelude (take) import Data.List ((\\)) import Data.Maybe (maybe) import System.FriendlyPath () import System.FilePath (takeDirectory, takeFileName, ()) import System.Directory ( doesDirectoryExist ) import Control.Monad.Trans (MonadIO (..)) {- External Library Module Imports -} {- Local (yi) module imports -} import Control.Monad (filterM, replicateM_) import Yi.Command (cabalConfigureE, cabalBuildE, reloadProjectE) import Yi.Core import Yi.Eval import Yi.File import Yi.MiniBuffer import Yi.Misc (promptFile) import Yi.Regex import Yi.Tag import Yi.Search import Yi.Window {- End of Module Imports -} type UnivArgument = Maybe Int ---------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are unmodified buffers then we ask individually for -- each modified buffer whether or not the user wishes to save -- it or not. If we get to the end of this list and there are still -- some modified buffers then we ask again if the user wishes to -- quit, but this is then a simple yes or no. askQuitEditor, askSaveEditor :: YiM () askQuitEditor = askIndividualSave True =<< getModifiedBuffers askSaveEditor = askIndividualSave False =<< getModifiedBuffers getModifiedBuffers :: YiM [FBuffer] getModifiedBuffers = filterM deservesSave =<< gets bufferSet deservesSave :: FBuffer -> YiM Bool deservesSave b | isUnchangedBuffer b = return False | otherwise = isFileBuffer b -- | Is there a proper file associated with the buffer? -- In other words, does it make sense to offer to save it? isFileBuffer :: (Functor m, MonadIO m) => FBuffer -> m Bool isFileBuffer b = case b ^. identA of Left _ -> return False Right fn -> not <$> liftIO (doesDirectoryExist fn) -------------------------------------------------- -- Takes in a list of buffers which have been identified -- as modified since their last save. askIndividualSave :: Bool -> [FBuffer] -> YiM () askIndividualSave True [] = modifiedQuitEditor askIndividualSave False [] = return () askIndividualSave hasQuit allBuffers@(firstBuffer : others) = withEditor (spawnMinibufferE saveMessage (const askKeymap)) >> return () where saveMessage = concat [ "do you want to save the buffer: " , bufferName , "? (y/n/"++ (if hasQuit then "q/" else "") ++"c/!)" ] bufferName = identString firstBuffer askKeymap = choice ([ char 'n' ?>>! noAction , char 'y' ?>>! yesAction , char '!' ?>>! allAction , oneOf [char 'c', ctrl $ char 'g'] >>! closeBufferAndWindowE -- cancel ] ++ [char 'q' ?>>! quitEditor | hasQuit]) yesAction = do fwriteBufferE (bkey firstBuffer) withEditor closeBufferAndWindowE continue noAction = do withEditor closeBufferAndWindowE continue allAction = do mapM_ fwriteBufferE $ fmap bkey allBuffers withEditor closeBufferAndWindowE askIndividualSave hasQuit [] continue = askIndividualSave hasQuit others --------------------------- --------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are then simply confirms with the user that they -- with to quit. modifiedQuitEditor :: YiM () modifiedQuitEditor = do modifiedBuffers <- getModifiedBuffers if null modifiedBuffers then quitEditor else withEditor $ spawnMinibufferE modifiedMessage (const askKeymap) >> return () where modifiedMessage = "Modified buffers exist really quit? (y/n)" askKeymap = choice [ char 'n' ?>>! noAction , char 'y' ?>>! quitEditor ] noAction = closeBufferAndWindowE ----------------------------- -- isearch selfSearchKeymap :: Keymap selfSearchKeymap = do Event (KASCII c) [] <- anyEvent write (isearchAddE [c]) searchKeymap :: Keymap searchKeymap = selfSearchKeymap <|> choice [ -- ("C-g", isearchDelE) -- Only if string is not empty. ctrl (char 'r') ?>>! isearchPrevE , ctrl (char 's') ?>>! isearchNextE , ctrl (char 'w') ?>>! isearchWordE , meta (char 'p') ?>>! isearchHistory 1 , meta (char 'n') ?>>! isearchHistory (-1) , spec KBS ?>>! isearchDelE ] isearchKeymap :: Direction -> Keymap isearchKeymap dir = do write $ isearchInitE dir discard $ many searchKeymap choice [ ctrl (char 'g') ?>>! isearchCancelE , oneOf [ctrl (char 'm'), spec KEnter] >>! isearchFinishE ] <|| write isearchFinishE ---------------------------- -- query-replace queryReplaceE :: YiM () queryReplaceE = do withMinibufferFree "Replace:" $ \replaceWhat -> do withMinibufferFree "With:" $ \replaceWith -> do b <- gets currentBuffer win <- getA currentWindowA let replaceKm = choice [char 'n' ?>>! qrNext win b re, char '!' ?>>! qrReplaceAll win b re replaceWith, oneOf [char 'y', char ' '] >>! qrReplaceOne win b re replaceWith, oneOf [char 'q', ctrl (char 'g')] >>! qrFinish ] Right re = makeSearchOptsM [] replaceWhat withEditor $ do setRegexE re discard $ spawnMinibufferE ("Replacing " ++ replaceWhat ++ " with " ++ replaceWith ++ " (y,n,q,!):") (const replaceKm) qrNext win b re executeExtendedCommandE :: YiM () executeExtendedCommandE = withMinibuffer "M-x" (const getAllNamesInScope) execEditorAction evalRegionE :: YiM () evalRegionE = do discard $ withBuffer (getSelectRegionB >>= readRegionB) >>= return -- FIXME: do something sensible. return () -- * Code for various commands -- This ideally should be put in their own module, -- without a prefix, so M-x ... would be easily implemented -- by looking up that module's contents -- | Insert next character, "raw" insertNextC :: UnivArgument -> KeymapM () insertNextC a = do c <- anyEvent write $ replicateM_ (argToInt a) $ insertB (eventToChar c) -- | Convert the universal argument to a number of repetitions argToInt :: UnivArgument -> Int argToInt a = case a of Nothing -> 1 Just x -> x digit :: (Event -> Event) -> KeymapM Char digit f = charOf f '0' '9' -- TODO: replace tt by digit meta tt :: KeymapM Char tt = do Event (KASCII c) _ <- foldr1 (<|>) $ fmap (event . metaCh ) ['0'..'9'] return c -- doing the argument precisely is kind of tedious. -- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html -- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html readUniversalArg :: KeymapM (Maybe Int) readUniversalArg = Just <$> ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4)) <|> (read <$> (some tt))) <|> pure Nothing -- | Open a file using the minibuffer. We have to set up some stuff to allow hints -- and auto-completion. findFile :: YiM () findFile = promptFile "find file:" $ \filename -> do msgEditor $ "loading " ++ filename discard $ editFile filename -- | Open a file in a new tab using the minibuffer. findFileNewTab :: YiM () findFileNewTab = promptFile "find file (new tab): " $ \filename -> do withEditor newTabE msgEditor $ "loading " ++ filename discard $ editFile filename scrollDownE :: UnivArgument -> BufferM () scrollDownE a = case a of Nothing -> downScreenB Just n -> scrollB n scrollUpE :: UnivArgument -> BufferM () scrollUpE a = case a of Nothing -> upScreenB Just n -> scrollB (negate n) switchBufferE :: YiM () switchBufferE = do openBufs <- fmap bufkey . toList <$> getA windowsA names <- withEditor $ do bs <- fmap bkey <$> getBufferStack let choices = (bs \\ openBufs) ++ openBufs -- put the open buffers at the end. prefix <- gets commonNamePrefix forM choices $ \k -> gets (shortIdentString prefix . findBufferWith k) withMinibufferFin "switch to buffer:" names (withEditor . switchToBufferWithNameE) killBufferE :: BufferRef ::: ToKill -> YiM () killBufferE (Doc b) = do buf <- withEditor $ gets $ findBufferWith b ch <- deservesSave buf let askKeymap = choice [ char 'n' ?>>! closeBufferAndWindowE , char 'y' ?>>! delBuf >> closeBufferAndWindowE , ctrlCh 'g' ?>>! closeBufferAndWindowE ] delBuf = deleteBuffer b withEditor $ if ch then (spawnMinibufferE (identString buf ++ " changed, close anyway? (y/n)") (const askKeymap)) >> return () else delBuf -- | If on separators (space, tab, unicode seps), reduce multiple -- separators to just a single separator. justOneSep :: BufferM () justOneSep = doIfCharB isAnySep $ do genMaybeMoveB unitSepThisLine (Backward,InsideBound) Backward moveB Character Forward doIfCharB isAnySep $ deleteB unitSepThisLine Forward -- | Join this line to previous (or next N if universal) joinLinesE :: UnivArgument -> BufferM () joinLinesE a = do case a of Nothing -> return () Just _n -> moveB VLine Forward moveToSol >> transformB (\_ -> " ") Character Backward >> justOneSep -- | Shortcut to use a default list when a blank list is given. -- Used for default values to emacs queries maybeList :: [a] -> [a] -> [a] maybeList def [] = def maybeList _ ls = ls -------------------------------------------------- -- TAGS - See Yi.Tag for more info -- | Prompt the user to give a tag and then jump to that tag promptTag :: YiM () promptTag = do -- default tag is where the buffer is on defaultTag <- withBuffer $ readUnitB unitWord -- if we have tags use them to generate hints tagTable <- withEditor getTags -- Hints are expensive - only lazily generate 10 let hinter = return . take 10 . maybe fail hintTags tagTable -- Completions are super-cheap. Go wild let completer = return . maybe id completeTag tagTable withMinibufferGen "" hinter ("Find tag: (default " ++ defaultTag ++ ")") completer $ -- if the string is "" use the defaultTag gotoTag . maybeList defaultTag -- | Opens the file that contains @tag@. Uses the global tag table and prompts -- the user to open one if it does not exist gotoTag :: Tag -> YiM () gotoTag tag = visitTagTable $ \tagTable -> case lookupTag tag tagTable of Nothing -> fail $ "No tags containing " ++ tag Just (filename, line) -> do discard $ editFile filename discard $ withBuffer $ gotoLn line return () -- | Call continuation @act@ with the TagTable. Uses the global table -- and prompts the user if it doesn't exist visitTagTable :: (TagTable -> YiM ()) -> YiM () visitTagTable act = do posTagTable <- withEditor getTags -- does the tagtable exist? case posTagTable of Just tagTable -> act tagTable Nothing -> promptFile ("Visit tags table: (default tags)") $ \path -> do -- default emacs behavior, append tags let filename = maybeList "tags" $ takeFileName path tagTable <- io $ importTagTable $ takeDirectory path filename withEditor $ setTags tagTable act tagTable {- TODO: export or remove resetTagTable :: YiM () resetTagTable = withEditor resetTags -}