Ticket #90: cbind.diff

File cbind.diff, 10.3 kB (added by Émeric, 2 years ago)
  • System/Console/Haskeline/Command/Completion.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/Command/Completion.hs new-haskeline/System/Console/Haskeline/Command/Completion.hs
    old new  
    105105        ] 
    106106  where 
    107107    oneLine = clearMessage >> effect (PrintLines [w]) >> pageCompletions ws 
    108     clearMessage = effect $ LineChange $ const ([],[]) 
     108    clearMessage = effect $ LineChange Insert $ const ([],[]) 
    109109 
    110110printPage :: MonadReader Layout m => [String] -> CmdM m () 
    111111printPage ls = do 
  • System/Console/Haskeline/Command.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/Command.hs new-haskeline/System/Console/Haskeline/Command.hs
    old new  
    3434import System.Console.Haskeline.LineState 
    3535import System.Console.Haskeline.Key 
    3636 
    37 data Effect = LineChange (Prefix -> LineChars) 
     37data Effect = LineChange Mode (Prefix -> LineChars) 
    3838              | PrintLines [String] 
    3939              | ClearScreen 
    4040              | RingBell 
    4141 
    4242lineChange :: LineState s => s -> Effect 
    43 lineChange = LineChange . flip lineChars 
     43lineChange s = LineChange (mode s) $ flip lineChars s 
    4444 
    4545data KeyMap a = KeyMap {lookupKM :: Key -> Maybe (KeyConsumed a)} 
    4646 
  • System/Console/Haskeline/LineState.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/LineState.hs new-haskeline/System/Console/Haskeline/LineState.hs
    old new  
    4343                    beforeChar, 
    4444                    afterChar, 
    4545                    overChar, 
     46                    Mode(..), 
    4647                    -- ** CommandMode 
    4748                    CommandMode(..), 
    4849                    deleteChar, 
     
    133134                    -> [Grapheme] -- ^ The text to the left of the cursor 
    134135                                  -- (including the prefix). 
    135136    afterCursor :: s -> [Grapheme] -- ^ The text under and to the right of the cursor. 
     137    mode :: s -> Mode 
     138 
     139data Mode = Command | Insert | Arg 
     140  deriving (Show) 
    136141 
    137142type Prefix = [Grapheme] 
    138143 
     
    172177instance LineState InsertMode where 
    173178    beforeCursor prefix (IMode xs _) = prefix ++ reverse xs 
    174179    afterCursor (IMode _ ys) = ys 
     180    mode _ = Insert 
    175181 
    176182instance Result InsertMode where 
    177183    toResult (IMode xs ys) = graphemesToString $ reverse xs ++ ys 
     
    251257    beforeCursor prefix (CMode xs _ _) = prefix ++ reverse xs 
    252258    afterCursor CEmpty = [] 
    253259    afterCursor (CMode _ c ys) = c:ys 
     260    mode _ = Command 
    254261 
    255262instance Result CommandMode where 
    256263    toResult CEmpty = "" 
     
    328335    beforeCursor _ am = let pre = map baseGrapheme $ "(arg: " ++ show (arg am) ++ ") " 
    329336                             in beforeCursor pre (argState am)  
    330337    afterCursor = afterCursor . argState 
     338    mode _ = Arg 
    331339 
    332340instance Result s => Result (ArgMode s) where 
    333341    toResult = toResult . argState 
  • System/Console/Haskeline/Prefs.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/Prefs.hs new-haskeline/System/Console/Haskeline/Prefs.hs
    old new  
    66                        BellStyle(..), 
    77                        EditMode(..), 
    88                        HistoryDuplicates(..), 
    9                         lookupKeyBinding 
     9                        lookupKeyBinding, 
     10                        lookupKeyViCBinding 
    1011                        ) where 
    1112 
    1213import Data.Char(isSpace,toLower) 
     
    4647                        -- will ring the bell and only display them if the user 
    4748                        -- presses @TAB@ again. 
    4849                     customBindings :: Map.Map Key [Key], 
     50                      
     51                     customViCBindings :: Map.Map Key [Key], 
    4952                        -- (termName, keysequence, key) 
    5053                     customKeySequences :: [(Maybe String, String,Key)] 
    5154                     } 
     
    7679                      listCompletionsImmediately = True, 
    7780                      historyDuplicates = AlwaysAdd, 
    7881                      customBindings = Map.empty, 
     82                      customViCBindings = Map.empty, 
    7983                      customKeySequences = [] 
    8084                    } 
    8185 
     
    98102          ,("listcompletionsimmediately", mkSettor $ \x p -> p {listCompletionsImmediately = x}) 
    99103          ,("historyduplicates", mkSettor $ \x p -> p {historyDuplicates = x}) 
    100104          ,("bind", addCustomBinding) 
     105          ,("cbind", addCustomViCBinding) 
    101106          ,("keyseq", addCustomKeySequence) 
    102107          ] 
    103108 
     
    106111    Just (k:ks) -> p {customBindings = Map.insert k ks (customBindings p)} 
    107112    _ -> p 
    108113 
     114addCustomViCBinding :: String -> Prefs -> Prefs 
     115addCustomViCBinding str p = case mapM parseKey (words str) of 
     116    Just (k:ks) -> p {customViCBindings = Map.insert k ks (customViCBindings p)} 
     117    _ -> p 
     118 
    109119addCustomKeySequence :: String -> Prefs -> Prefs 
    110120addCustomKeySequence str = maybe id addKS maybeParse 
    111121    where 
     
    123133lookupKeyBinding :: Key -> Prefs -> [Key] 
    124134lookupKeyBinding k = Map.findWithDefault [k] k . customBindings 
    125135 
     136lookupKeyViCBinding :: Key -> Prefs -> [Key] 
     137lookupKeyViCBinding k = Map.findWithDefault [k] k . customViCBindings 
     138 
    126139-- | Read 'Prefs' from a given file.  If there is an error reading the file, 
    127140-- the 'defaultPrefs' will be returned. 
    128141readPrefs :: FilePath -> IO Prefs 
  • System/Console/Haskeline/RunCommand.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/RunCommand.hs new-haskeline/System/Console/Haskeline/RunCommand.hs
    old new  
    2323runCommandLoop' liftE tops prefix initState cmds getEvent = do 
    2424    let s = lineChars prefix initState 
    2525    drawLine s 
    26     readMoreKeys s (fmap (liftM (\x -> (x,[])) . ($ initState)) cmds) 
     26    readMoreKeys (mode initState) s (fmap (liftM (\x -> (x,[])) . ($ initState)) cmds) 
    2727  where 
    28     readMoreKeys :: LineChars -> KeyMap (CmdM m (a,[Key])) -> n a 
    29     readMoreKeys s next = do 
     28    readMoreKeys :: Mode -> LineChars -> KeyMap (CmdM m (a,[Key])) -> n a 
     29    readMoreKeys m s next@(KeyMap cmd) = do 
    3030        event <- handle (\(e::SomeException) -> moveToNextLine s 
    3131                                    >> throwIO e) getEvent 
     32        -- liftIO $ print m 
    3233        case event of 
    3334                    ErrorEvent e -> moveToNextLine s >> throwIO e 
    3435                    WindowResize -> do 
    3536                        drawReposition liftE tops s 
    36                         readMoreKeys s next 
     37                        readMoreKeys m s next 
    3738                    KeyInput ks -> do 
    38                         bound_ks <- mapM (asks . lookupKeyBinding) ks 
    39                         loopCmd s $ applyKeysToMap (concat bound_ks) next 
     39                        bound_ks <- mapM (asks . lookupKey m) ks 
     40                        loopCmd m s $ applyKeysToMap (concat bound_ks) next 
     41    -- lookupKey cmd k p = case editMode p of 
     42    --                       Emacs -> lookupKeyBinding k p 
     43    --                       Vi    -> lookupViBinding cmd k p 
     44    lookupKey cmd k p = case cmd of  
     45                            Command -> lookupKeyViCBinding k p 
     46                            Insert  -> lookupKeyBinding k p 
     47                            Arg     -> lookupKeyViCBinding k p 
    4048 
    41     loopCmd :: LineChars -> CmdM m (a,[Key]) -> n a 
    42     loopCmd s (GetKey next) = readMoreKeys s next 
     49 
     50    loopCmd :: Mode -> LineChars -> CmdM m (a,[Key]) -> n a 
     51    loopCmd m s (GetKey next) = readMoreKeys m s next 
    4352    -- If there are multiple consecutive LineChanges, only render the diff 
    4453    -- to the last one, and skip the rest. This greatly improves speed when 
    4554    -- a large amount of text is pasted in at once. 
    46     loopCmd s (DoEffect (LineChange _) 
    47                 e@(DoEffect (LineChange _) _)) = loopCmd s e 
    48     loopCmd s (DoEffect e next) = do 
     55    loopCmd m s (DoEffect (LineChange m' _) 
     56                e@(DoEffect (LineChange _ _) _)) = loopCmd m' s e 
     57    loopCmd m s (DoEffect e@(LineChange m' _) next) = do 
     58                                    t <- drawEffect prefix s e 
     59                                    loopCmd m' t next 
     60    loopCmd m s (DoEffect e next) = do 
    4961                                    t <- drawEffect prefix s e 
    50                                     loopCmd t next 
    51     loopCmd s (CmdM next) = liftE next >>= loopCmd s 
    52     loopCmd s (Result (x,ks)) = do 
     62                                    loopCmd m t next 
     63    loopCmd m s (CmdM next) = liftE next >>= loopCmd m s 
     64    loopCmd m s (Result (x,ks)) = do 
    5365                                    liftIO (saveUnusedKeys tops ks) 
    5466                                    moveToNextLine s 
    5567                                    return x 
     
    6577 
    6678drawEffect :: (Term m, MonadReader Prefs m) 
    6779    => Prefix -> LineChars -> Effect -> m LineChars 
    68 drawEffect prefix s (LineChange ch) = do 
     80drawEffect prefix s (LineChange m ch) = do 
    6981    let t = ch prefix 
    7082    drawLineDiff s t 
    7183    return t 
     
    8193drawEffect _ s RingBell = actBell >> return s 
    8294 
    8395actBell :: (Term m, MonadReader Prefs m) => m () 
    84 actBell = do 
     96actBell = do  
    8597    style <- asks bellStyle 
    8698    case style of 
    8799        NoBell -> return () 
  • System/Console/Haskeline/Vi.hs

    diff -rN -u old-haskeline/System/Console/Haskeline/Vi.hs new-haskeline/System/Console/Haskeline/Vi.hs
    old new  
    99import System.Console.Haskeline.Command.Undo 
    1010import System.Console.Haskeline.LineState 
    1111import System.Console.Haskeline.InputT 
    12  
     12import qualified System.Console.Haskeline.LineState as L  
    1313import Data.Char 
    1414import Control.Monad(liftM) 
    1515 
     
    409409    beforeCursor prefix se = beforeCursor (prefix ++ stringToGraphemes [searchChar se]) 
    410410                                (entryState se) 
    411411    afterCursor = afterCursor . entryState 
     412    mode s = L.Command 
    412413 
    413414viEnterSearch :: Monad m => Char -> Direction 
    414415                    -> Command (ViT m) CommandMode CommandMode