MasseR
/
xmonad-masser
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
xmonad-masser/src/XMonad/Config/MasseR.hs

277 lines
12 KiB
Haskell
Raw Blame History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module XMonad.Config.MasseR where
import Control.Lens ((^.))
import Data.Generics.Product (field)
import qualified Data.List as List
import XMonad
import XMonad.Actions.CycleWS (swapNextScreen)
import XMonad.Actions.Search
import XMonad.CustomPrompt
import XMonad.Hooks.EwmhDesktops (ewmh, ewmhDesktopsStartup)
import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Hooks.UrgencyHook (args, dzenUrgencyHook,
withUrgencyHook)
import XMonad.Layout.Accordion
import XMonad.Layout.BinarySpacePartition (emptyBSP)
import XMonad.Layout.Decoration (Decoration,
DefaultShrinker)
import XMonad.Layout.DwmStyle
import XMonad.Layout.LayoutModifier (ModifiedLayout)
import XMonad.Layout.Master
import XMonad.Layout.NoBorders (noBorders, smartBorders)
import XMonad.Layout.PerWorkspace (onWorkspace)
import XMonad.Layout.Renamed
import XMonad.Layout.Simplest (Simplest)
import XMonad.Layout.Spiral
import XMonad.Layout.Tabbed (TabbedDecoration,
Theme (..), shrinkText,
tabbed)
import XMonad.Layout.ToggleLayouts (ToggleLayout (..),
toggleLayouts)
import XMonad.Password
import XMonad.Prompt.RunOrRaise (runOrRaisePrompt)
import XMonad.Prompt.Shell (shellPrompt)
import qualified XMonad.StackSet as W
import XMonad.TopicSpace
import XMonad.Util.EZConfig
import XMonad.XMobar (zenburnPP)
import Data.Monoid (Endo, (<>))
import XMonad.Util.NamedScratchpad
import XMonad.Util.SpawnOnce
import System.IO (hClose, hPutStr)
import XMonad.Actions.Navigation2D
import XMonad.Actions.UpdatePointer (updatePointer)
import XMonad.Util.NamedActions
import XMonad.Util.Run (spawnPipe)
import XMonad.Config.MasseR.ExtraConfig
-- import Customizations
import qualified Data.Text as T
import XMonad.Hooks.DynamicLog (statusBar)
import qualified Data.Set as S
spotify :: ExtraConfig -> XConfig l -> NamedAction
spotify extraConf conf = submapName . mkNamedKeymap conf $
[ ("M-p", addName "Play" $ spawn (musicToggle . applications $ extraConf)) ]
scratchpads :: [NamedScratchpad]
scratchpads = [
NS "notes" "vim -g --role notes -c 'e ~/wikidata/index.md'" (wmRole =? "notes") nonFloating
]
where wmRole = stringProperty "WM_WINDOW_ROLE"
scratchSubmaps :: XConfig l -> NamedAction
scratchSubmaps conf = submapName . mkNamedKeymap conf $ [
("M-n", addName "Open notes" $ namedScratchpadAction scratchpads "notes")
]
-- Search engines inside submaps
searchSubmaps :: ExtraConfig -> XConfig l -> NamedAction
searchSubmaps extraConfig conf =
let mkBrowser = promptSearchBrowser def (extraConfig ^. field @"applications" . field @"browser")
_googleP = addName "Search google" $ mkBrowser google
_ddgP = addName "Search duckduckgo" $ mkBrowser (searchEngine "duckduckgo" "http://duckduckgo.com/?q=")
searx = addName "Search searx" $ mkBrowser (searchEngine "searx" "https://searx.me/?q=")
extras = [(key, addName name $ mkBrowser (searchEngine name url)) | Search{..} <- searchEndpoints extraConfig]
in submapName . mkNamedKeymap conf $
[ ("d", searx) -- Training to use ddg again
, ("g", searx) -- training to use ddg again
] ++ extras
myNav2d :: Navigation2DConfig
myNav2d = def { defaultTiledNavigation = lineNavigation }
showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
showKeybindings x = addName "Show keybindings" $ io $ do
h <- spawnPipe "zenity --text-info --font=terminus"
hPutStr h (unlines $ showKm x)
hClose h
-- Layout
myTabConfig :: Theme
myTabConfig = def {
activeBorderColor = "#DCDCCC"
, activeTextColor = "#DCDCCC"
, activeColor = "#3F3F3F"
, fontName = "xft:Inconsolata-9"
, inactiveBorderColor = "#262626"
, inactiveTextColor = "#9FAFAF"
, inactiveColor = "#262626"
}
(=~?) :: XMonad.Query String -> String -> XMonad.Query Bool
q =~? x = fmap (x `List.isInfixOf`) q
-- Manage hooks
-- Move programs to their workspaces
myManageHook :: XMonad.Query (Endo WindowSet)
myManageHook = composeAll $ concat [
dynamicsHook
, webHooks
, pdfHooks
, documentHooks
, floatHooks
, debuggerHooks
, ideHooks
, flowHook
]
where
classHook y = map (\x -> className =? x --> y)
ideHooks = classHook (doShift "eclipse") [
"Anypoint Studio"
]
webHooks = classHook (doShift "web") [
"Firefox"
, "qutebrowser"
, "Midori"
, "chromium-browser"
, "Uzbl-tabbed"
, "Uzbl-core"
]
pdfHooks = classHook (doShift "pdf") [
"Evince"
, "Okular"
, "Kpdf"
, "Xdvi"
, ".zathura-wrapped_"
]
documentHooks = classHook (doShift "documents") [
"libreoffice"
, "libreoffice-calc"
, "Assistant"
, "Bouml"
]
floatHooks = classHook doFloat [
"SMplayer"
, "Gimp"
, "MPlayer"
, "Kaffeine"
, "Xmessage"
, "Wfica_Seamless"
, "mpv"
]
debuggerHooks = classHook (doShift "debugger") [
"JSwat Debugger",
"DBeaver"
]
dynamicsHook = [title =~? "Dynamics" --> doShift "dynamics"]
flowHook = [title =~? "www.flowdock.com" --> doShift "flowdock"]
myKeys :: ExtraConfig -> XConfig l -> [((KeyMask, KeySym), NamedAction)]
myKeys extraConfig conf =
let subKeys str ks = subtitle str : mkNamedKeymap conf ks in
subKeys "Actions" [ ("M-S-r", addName "foobar" (recompile True >> spawn "xmonad --restart"))
, ("M-C-l", addName "Lock screen" $ spawn locker)] ^++^
subKeys "System" [ ("<XF86Sleep>", addName "Suspend machine" $ spawn "sudo pm-suspend")
, ("<XF86AudioRaiseVolume>", addName "Increase volume" $ spawn "amixer set Master 2%+")
, ("<XF86AudioLowerVolume>", addName "Decrease volume" $ spawn "amixer set Master 2%-")
, ("M-<plus>", addName "Increase volume" $ spawn "amixer set Master 2+")
, ("M-<minus>", addName "Decrease volume" $ spawn "amixer set Master 2-")
, ("<XF86AudioPlay>", addName "Play/pause mopidy" $ spawn "mpc toggle")
, ("M-m", spotify extraConfig conf)
, ("M-S-<Space>", addName "Swap screens" swapNextScreen)
, ("M-<Backspace>", addName "Kill window" kill)
-- scrot requires `unGrab`
, ("M-<Print>", addName "Take screenshot" $ spawn (screenshot . applications $ extraConfig))] ^++^
subKeys "Launchers" [ ("M-S-<Return>", addName "Open terminal" $ spawn $ XMonad.terminal conf)
, ("M-n", scratchSubmaps conf)
, ("M-s", searchSubmaps extraConfig conf)
, ("M-p", addName "Retrieve password" $ passPrompt def)
, ("M-e", addName "Run app" $ runOrRaisePrompt def)
, ("M-S-e", addName "Run shell command" $ shellPrompt def)] ^++^
subKeys "Windows" [ ("M-j", addName "Go down" $ windowGo D False)
, ("M-k", addName "Go up" $ windowGo U False)
, ("M-h", addName "Go left" $ windowGo L False)
, ("M-l", addName "Go right" $ windowGo R False)
, ("M-S-j", addName "Shift window down" $ windowSwap D False)
, ("M-S-k", addName "Shift window up" $ windowSwap U False)
, ("M-S-h", addName "Shift window left" $ windowSwap L False)
, ("M-S-l", addName "Shift window right" $ windowSwap R False)
, ("M-.", addName "Go to previous window" $ windows W.focusDown)
, ("M-,", addName "Go to next window" $ windows W.focusUp)
, ("M-S-m", addName "Swap master" $ windows W.swapMaster)
] ^++^
subKeys "Projects & Workspaces" (topicKeys' extraConfig conf) ^++^
subKeys "Layout management" [ ("M-C-<Space>", addName "Toggle layout" $ sendMessage ToggleLayout)
, ("M-z", addName "Toggle zoom" $ sendMessage (Toggle "Zoom"))
, ("M-<Space>", addName "Next layout" $ sendMessage NextLayout)] ^++^
subKeys "Resize" []
where
locker = "xset s activate"
myStartupHook :: X ()
myStartupHook = spawnOnce "$HOME/wminit"
masser :: ExtraConfig -> IO ()
masser extraConfig = xmonad =<< statusBar (bar extraConfig) zenburnPP toggleStrutsKey myConfig
where
toggleStrutsKey XConfig{modMask=modm} = (modm, xK_b)
bar = prompt . applications
myConfig = withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"]} $
withNavigation2DConfig myNav2d $
ewmh $
addDescrKeys' ((mod4Mask, xK_F1), showKeybindings) (myKeys extraConfig) $
def {
modMask = mod4Mask -- Hyper
, terminal = urxvt . applications $ extraConfig
, keys = const mempty
, workspaces = let defaults = ["irc", "web", "mail"]
external = map (T.unpack . topicName) . topics $ extraConfig
in S.toList (S.fromList defaults <> S.fromList external)
, layoutHook = smartBorders myLayout
, clickJustFocuses = False
, startupHook = myStartupHook >> ewmhDesktopsStartup >> setWMName "LG3D"
, borderWidth = 2
, normalBorderColor = "#262626"
, focusedBorderColor = "#7F9F7F"
, manageHook = myManageHook
, focusFollowsMouse = True
, logHook = updatePointer (0.25, 0.25) (0.25, 0.25)
}
myLayout = toggleLayouts zoom workspaceLayouts
where
zoom = renamed [Replace "Zoom"] (noBorders Full)
workspaceLayouts = onWorkspace "web" webLayout $
onWorkspace "dynamics" webLayout $
onWorkspace "pdf" pdfLayout $
onWorkspace "documents" documentLayout $
onWorkspace "mail" mailLayout
defLayout
-- Default layout
defLayout = tiled ||| tabLayout ||| readLayout ||| bspLayout ||| vimLayout ||| spiral (6/7) ||| Full
-- Pdfs are restricted to tabs
vimLayout = Mirror (mastered (1/100) (4/5) Accordion)
pdfLayout = readLayout ||| tiled ||| tabLayout
readLayout = renamed [Replace "2/3"] (dwmStyle shrinkText myTabConfig (mastered (1/100) (2/3) Accordion))
bspLayout = renamed [Replace "master bsp"] (dwmStyle shrinkText myTabConfig (mastered (1/100) (2/3) (Mirror emptyBSP)))
-- Documents are by default tabs, but have looser restrictions
documentLayout = tabLayout ||| Full ||| tiled ||| Mirror tiled
-- Web is either tabbed, full, or tiled
webLayout = readLayout ||| tabLayout ||| Full ||| tiled
tiled = Tall nmaster delta ratio
-- I need to restrict the type or type inferencer can't deduce type classes
tabLayout :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
tabLayout = tabbed shrinkText myTabConfig
mailLayout = readLayout ||| tabLayout
delta = 3/100
ratio = 1/2
nmaster = 1
Reference in New Issue View Git Blame Copy Permalink