diff --git a/home/ui/xmonad/config.hs b/home/ui/xmonad/config.hs index d609144..44e428e 100644 --- a/home/ui/xmonad/config.hs +++ b/home/ui/xmonad/config.hs @@ -10,7 +10,8 @@ import qualified Codec.Binary.UTF8.String as UTF8 import qualified DBus as D import qualified DBus.Client as D -import qualified Data.Map as M +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Monoid import System.Exit import XMonad @@ -41,6 +42,7 @@ import XMonad.Layout.ThreeColumns (ThreeCol (..)) import XMonad.Prompt (XPConfig, XPType (..), XPrompt (..), mkComplFunFromList', mkXPromptWithModes) import qualified XMonad.StackSet as W import XMonad.Util.EZConfig +import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run -- The preferred terminal program, which is used in a binding below and by @@ -102,7 +104,7 @@ main = mkDbusClient >>= main' main' :: D.Client -> IO () main' dbus = - xmonad . docks . ewmhFullscreen . ewmh $ + xmonad . docks . ewmhFullscreen . ewmh . dynProjects $ def { -- simple stuff terminal = myTerminal, @@ -123,6 +125,8 @@ main' dbus = logHook = myPolybarLogHook dbus, startupHook = myStartupHook } + where + dynProjects = dynamicProjects myProjects ------------------------------------------------------------------------ -- Polybar settings (needs DBus client). @@ -343,7 +347,7 @@ myKeys conf = -- Mouse bindings: default actions bound to mouse events -- myMouseBindings (XConfig {XMonad.modMask = modm}) = - M.fromList + Map.fromList -- mod-button1, Set the window to floating mode and move by dragging [ ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster), -- mod-button2, Raise the window to the top of the stack @@ -353,6 +357,20 @@ myMouseBindings (XConfig {XMonad.modMask = modm}) = -- you may also bind events to the mouse scroll wheel (button4 and button5) ] +myProjects :: [Project] +myProjects = + [ Project + { projectName = "foo", + projectStartHook = Just $ do + spawn "alacritty --working-directory ~/repos/myconfig" + spawn "alacritty --working-directory ~/repos/tas" + }, + Project + { projectName = "bar", + projectStartHook = Nothing + } + ] + ------------------------------------------------------------------------ -- Project type ProjectName = String @@ -362,18 +380,55 @@ data Project = Project projectStartHook :: !(Maybe (X ())) } +type ProjectTable = Map ProjectName Project + +data ProjectState = ProjectState {projects :: !ProjectTable} + +instance ExtensionClass ProjectState where + initialValue = ProjectState Map.empty + data ProjectPrompt = ProjectPrompt XPConfig [ProjectName] +dynamicProjects :: [Project] -> XConfig a -> XConfig a +dynamicProjects ps c = + c {startupHook = dynamicProjectsStartupHook ps <> startupHook c} + +dynamicProjectsStartupHook :: [Project] -> X () +dynamicProjectsStartupHook ps = XS.modify go + where + go :: ProjectState -> ProjectState + go s = s {projects = update $ projects s} + + update :: ProjectTable -> ProjectTable + update = Map.union (Map.fromList $ map entry ps) + + entry :: Project -> (ProjectName, Project) + entry p = (projectName p, p) + instance XPrompt ProjectPrompt where showXPrompt (ProjectPrompt _ _) = "Choose Project: " completionFunction (ProjectPrompt c ns) = mkComplFunFromList' c ns - modeAction (ProjectPrompt _ _) buf auto = xmessage buf + modeAction (ProjectPrompt _ _) buf auto = do + let name = if null auto then buf else auto + ps <- XS.gets projects + + case Map.lookup name ps of + Just p -> openProject p + Nothing -> return () + +openProject :: Project -> X () +openProject p = + case projectStartHook p of + Just h -> h + Nothing -> return () projectPrompt :: XPConfig -> X () projectPrompt c = do - let names = ["hello", "world"] + ps <- XS.gets projects + + let names = Map.keys ps modes = [XPT $ ProjectPrompt c names] mkXPromptWithModes modes c