clifm-0.4.1.0: src/Widgets/Menu.hs
module Widgets.Menu where
import Commons
import qualified Widgets.Pane as Pane
import qualified Widgets.Tab as Tab
import qualified Widgets.Entry as Entry
import Data.Char (toUpper)
import System.FilePath (takeFileName)
import Brick.Widgets.Core ((<+>), str, hLimit, hBox, clickable)
import Brick.Types (Widget)
import Brick.Widgets.Border (borderWithLabel, border)
import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl))
data Menu = Menu {clipboard :: Clipboard, menuType :: MenuType}
data MenuType = Main | Selection | Tab | Pane
data Clipboard = CopyBoard {fromEntry :: Entry.Entry} | CutBoard {fromEntry :: Entry.Entry} | EmptyBoard
instance Show Clipboard where
show EmptyBoard = " -empty- "
show board = takeFileName . Entry.path $ fromEntry board
-- creation functions
make :: Menu
make = Menu {clipboard = EmptyBoard, menuType = Main}
makeCopyBoard :: Entry.Entry -> Clipboard
makeCopyBoard = CopyBoard
makeCutBoard :: Entry.Entry -> Clipboard
makeCutBoard = CutBoard
-- rendering functions
render :: Menu -> Pane.Pane -> Widget Name
render m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m)
renderButtons :: MenuType -> Pane.Pane -> [Widget Name]
renderButtons tp pane = map renderButton $ case tp of
Main -> mainButtons
Selection -> (backButton :) . selectionButtons $ Pane.selectedEntry pane
Tab -> (backButton :) . tabButtons $ Pane.currentTab pane
Pane -> backButton : paneButtons
renderButton :: (Widget Name, Maybe String, Name) -> Widget Name
renderButton (bContent, bLabel, bName) = clickable bName $ case bLabel of
Just txt -> borderWithLabel (str txt) bContent
Nothing -> border bContent
mainButtons :: [(Widget Name, Maybe String, Name)]
mainButtons = [
(str "se" <+> keybindStr "l" <+> str "ection menu", Nothing, Button {keyBind = KChar 'l', withCtrl = False}),
(str "t" <+> keybindStr "a" <+> str "b menu", Nothing, Button {keyBind = KChar 'a', withCtrl = False}),
(keybindStr "p" <+> str "ane menu", Nothing, Button {keyBind = KChar 'p', withCtrl = False}),
(keybindStr "q" <+> str "uit", Nothing, Button {keyBind = KChar 'q', withCtrl = False})
]
selectionButtons :: Maybe Entry.Entry -> [(Widget Name, Maybe String, Name)]
selectionButtons e = case e of
Just Entry.File {} -> anySelectionButtons
Just Entry.Dir {} -> anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})]
_ -> []
anySelectionButtons :: [(Widget Name, Maybe String, Name)]
anySelectionButtons = [
(str "cut", ctrlText 'x', Button {keyBind = KChar 'x', withCtrl = True}),
(str "copy", ctrlText 'c', Button {keyBind = KChar 'c', withCtrl = True}),
(keybindStr "r" <+> str "ename", ctrlText 'r', Button {keyBind = KChar 'r', withCtrl = True}),
(keybindStr "d" <+> str "elete", ctrlText 'd', Button {keyBind = KChar 'd', withCtrl = True}),
(keybindStr "s" <+> str "how info", Nothing, Button {keyBind = KChar 's', withCtrl = False})
]
tabButtons :: Tab.Tab -> [(Widget Name, Maybe String, Name)]
tabButtons tab = case tab of
Tab.Dir {Tab.entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons
Tab.Search {Tab.entryOrder = order} -> entryTabButtons order ++ anyTabButtons
_ -> anyTabButtons
dirTabButtons :: [(Widget Name, Maybe String, Name)]
dirTabButtons = [
(str "paste", ctrlText 'v', Button {keyBind = KChar 'v', withCtrl = True}),
(keybindStr "s" <+> str "earch", ctrlText 's', Button {keyBind = KChar 's', withCtrl = True}),
(keybindStr "m" <+> str "ake dir", Nothing, Button {keyBind = KChar 'm', withCtrl = False}),
(keybindStr "t" <+> str "ouch file", Nothing, Button {keyBind = KChar 't', withCtrl = False})
]
entryTabButtons :: Tab.EntryOrder -> [(Widget Name, Maybe String, Name)]
entryTabButtons order = [
(keybindStr "r" <+> str "efresh", Nothing, Button {keyBind = KChar 'r', withCtrl = False}),
(keybindStr "o" <+> str ("rder by " ++ (show . Tab.nextOrderType $ Tab.orderType order)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}),
(keybindStr "i" <+> str "nvert order", Nothing, Button {keyBind = KChar 'i', withCtrl = False})
]
anyTabButtons :: [(Widget Name, Maybe String, Name)]
anyTabButtons = [
(keybindStr "g" <+> str "o to", Nothing, Button {keyBind = KChar 'g', withCtrl = False}),
(keybindStr "e" <+> str "mpty tab", Nothing, Button {keyBind = KChar 'e', withCtrl = False}),
(keybindStr "k" <+> str "ill tab", Nothing, Button {keyBind = KChar 'k', withCtrl = False})
]
paneButtons :: [(Widget Name, Maybe String, Name)]
paneButtons = [
(keybindStr "e" <+> str "mpty pane", ctrlText 'e', Button {keyBind = KChar 'e', withCtrl = True}),
(keybindStr "k" <+> str "ill pane", ctrlText 'k', Button {keyBind = KChar 'k', withCtrl = True})
]
ctrlText :: Char -> Maybe String
ctrlText c = Just $ "C-" ++ [toUpper c]
backButton :: (Widget Name, Maybe String, Name)
backButton = (str "<_", Nothing, Button {keyBind = KBS, withCtrl = False})
renderClipboard :: Clipboard -> Widget Name
renderClipboard = hLimit 24 . borderWithLabel (str "clipboard") . str . show
-- state changing functions
change :: MenuType -> Menu -> Menu
change tp menu = menu {menuType = tp}
changeClipboard :: Clipboard -> Menu -> Menu
changeClipboard cb menu = menu {clipboard = cb}