nixos-config/nixos/system/desktop/home-manager/xmonad/Main.hs

{-# LANGUAGE FlexibleContexts #-}

module Main where

import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (safeSpawn)
import           BoringWindows                    (BoringMessage (..),
                                                   boringWindows, clearBoring,
                                                   focusDown, focusUp)
import qualified Data.Map                         as M
import           Data.Monoid                      (All, Endo)
import           Data.Ratio                       ((%))
import           FloatKeys                        (keysResizeWindow)
import           Memo                             (nextRectangle)
import           NixCommands
import qualified SolarizedLight                   as Solarized
import           System.Exit
import           XMonad
import           XMonad.Actions.CopyWindow        (copy, copyToAll, kill1,
                                                   killAllOtherCopies,
                                                   wsContainingCopies)
import           XMonad.Actions.CycleWS           (toggleWS')
import           XMonad.Actions.DynamicProjects   (Project (..),
                                                   dynamicProjects)
import           XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace, removeEmptyWorkspaceAfterExcept,
                                                   renameWorkspace,
                                                   withWorkspace)
import           XMonad.Actions.Navigation2D      (additionalNav2DKeysP,
                                                   windowGo, windowSwap)
import           XMonad.Actions.UpdatePointer     (updatePointer)
import           XMonad.Actions.Warp              (warpToScreen)
import           XMonad.Hooks.DynamicLog          (dynamicLog)
import           XMonad.Hooks.ManageDebug         (debugManageHook)
import           XMonad.Hooks.ManageHelpers       (doCenterFloat)
import           XMonad.Hooks.SetWMName           (setWMName)
import           XMonad.Hooks.UrgencyHook         (withUrgencyHook,
                                                   UrgencyHook(..))
import           XMonad.Layout.Mosaic             (Aspect (Reset))
import           XMonad.Layout.NoBorders          (noBorders, smartBorders)
import           XMonad.Layout.ResizableTile      (MirrorResize (MirrorExpand, MirrorShrink),
                                                   ResizableTall (..))
import           XMonad.Layout.StateFull          (focusTracking)
import           XMonad.Layout.WindowNavigation   (configurableNavigation,
                                                   noNavigateBorders)
import           XMonad.Prompt                    (XPConfig (..))
import qualified XMonad.StackSet                  as W
import           XMonad.Util.EZConfig             (additionalKeysP)
import           XMonad.Util.Scratchpad           (scratchpadManageHook,
                                                   scratchpadSpawnAction)
import           XMonad.Util.SpawnOnce            (spawnOnce)

------------------------------------------------------------------------
--
-- Layouts
--
------------------------------------------------------------------------
selectionColor :: String
selectionColor = Solarized.magenta

nonSelectionColor :: String
nonSelectionColor = Solarized.base02

myLayout =
  (windowConfiguration $ smartBorders $ boringWindows resizeableTall) |||
  noBorders Full
  where
    resizeableTall = ResizableTall nmaster delta ratio []
     -- The default number of windows in the master pane
    nmaster = 1
     -- Default proportion of screen occupied by master pane
    ratio = 1 / 2
     -- Percent of screen to increment by when resizing panes
    delta = 3 / 100
    windowConfiguration = configurableNavigation noNavigateBorders

-- ------------------------------------------------------------
--
-- predefined workspaces
--
-- ------------------------------------------------------------
-- default workspaces they will always be there.
-- And they are protected against renaming
myWorkspaces :: [String]
myWorkspaces = ["1", "2", "3", "4", "5", "6"]

-- workspaces names to be used only by one program, partly spawning on startup.
autoSpawnWorkspaces :: [String]
autoSpawnWorkspaces = ["-copyq"]

-- theses workspaces should not be removed by the workspace
-- switch commands
nonRemovableWorkspaces :: [String]
nonRemovableWorkspaces = myWorkspaces ++ autoSpawnWorkspaces

-- projects
-- named workspaces with predefined behavior
projects :: [Project]
projects =
  [ Project
      { projectName = "audio"
      , projectDirectory = "~/music-library"
      , projectStartHook = Just $ spawn nixStartAudacious
      }
  , Project
      { projectName = "nixos"
      , projectDirectory = "~/dev/nixos/nixos-config"
      , projectStartHook = Nothing
      }
  , Project
      { projectName = "-copyq"
      , projectDirectory = "~/"
      , projectStartHook = Just $ spawn nixShowCopyq
      }
  , Project
      { projectName = "chat"
      , projectDirectory = "~/"
      , projectStartHook = Just $ spawn nixShowChat
      }
  , Project
      { projectName = "joplin"
      , projectDirectory = "~/"
      , projectStartHook = Just $ spawn nixShowJoplin
      }
  ]

-- ------------------------------------------------------------
--
-- key definitions
--
-- ------------------------------------------------------------
myKeys :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
myKeys XConfig {modMask = modm} =
  M.fromList $
    -- ------------------------------------------------------------
    --
    -- predefined workspaces
    --
    -- ------------------------------------------------------------
    --
    -- mod-[1..9], Switch to workspace N
  [ ( (m .|. modm, k)
    , do removeEmptyWorkspaceAfterExcept nonRemovableWorkspaces $ windows $ f i
         updateBoring)
  | (i, k) <- zip myWorkspaces [xK_1 .. xK_9]
  , (f, m) <- [(W.greedyView, 0)]
  ] ++
    -- mod-<shift>-[1..9] move window to workspace N
    -- mod-<control>-[1..9] copy window to workspace N
  [ ( (m .|. modm, k)
    , do windows $ f i
         updateBoring)
  | (i, k) <- zip myWorkspaces [xK_1 .. xK_9]
  , (f, m) <- [(W.shift, shiftMask), (copy, controlMask)]
  ]

-- ------------------------------------------------------------
--
-- select next Screen/Monitor.
--  (works for 2 and 1 monitor, but might also work for more)
--
-- ------------------------------------------------------------
selectNextScreen :: X ()
selectNextScreen = do
  W.StackSet {W.current = current, W.visible = visible} <- gets windowset
  warpToScreen (nextScreen current visible) (1 % 2) (1 % 2)
  where
    nextScreen current [] = W.screen current
    nextScreen _ (x:_)    = W.screen x

isFloat :: Window -> X Bool
isFloat w = gets windowset >>= \ws -> return (M.member w $ W.floating ws)

-- | add different shortcuts for different type
-- of situation. Floating or Tiling
floatTileCommand :: X () -> X () -> Window -> X ()
floatTileCommand forFloating forTileing window = do
  floating <- isFloat window
  if floating
    then forFloating
    else forTileing

toggleFloating :: W.RationalRect -> Window -> X ()
toggleFloating position =
  floatTileCommand
    (withFocused (windows . W.sink))
    (withFocused (windows . (`W.float` position)))

multiKeys [] = []
multiKeys ((key, command):xs) = (createMultiKey key command) ++ multiKeys xs
  where
    createMultiKey keyString command =
      [("M4-" ++ keyString, command), ("M4-z " ++ keyString, command)]

myAdditionaKeys :: [(String, X ())]
myAdditionaKeys
    -- ------------------------------------------------------------
    --
    -- dynamic workspaces
    --
    -- ------------------------------------------------------------
    -- switch to workspace
 =
  (multiKeys
     [ ( "`"
       , do removeEmptyWorkspaceAfterExcept
              nonRemovableWorkspaces
              (withWorkspace autoXPConfig (windows . W.greedyView))
            updateBoring)
    -- move focused window to workspace
     , ("S-<Space>", withWorkspace myXPConfig (windows . W.shift))
    -- copy focused window to workspace
     , ("C-<Space>", withWorkspace myXPConfig (windows . copy))
    -- make windows "sticky" by copy and remove them to and from all other windows
     , ( "s"
       , do copies <- wsContainingCopies
            if not (null copies)
              then do
                killAllOtherCopies
                clearBoring
              else do
                windows copyToAll
                withFocused (broadcastMessage . IsBoring))
    -- rename workspace but make sure myWorkspaces still exist
     , ( "r"
       , do renameWorkspace myXPConfig
            sequence_ [addHiddenWorkspace ws | ws <- myWorkspaces])
     , ( "<Esc>"
       , do toggleWS' ["NSP"]
            updateBoring)
     ]) ++
    -- ------------------------------------------------------------
    --
    -- launch applications
    --
    -- ------------------------------------------------------------
  (multiKeys
    -- launch a terminal
     [ ("<Return>", spawn $ XMonad.terminal defaults)
     , ("q", kill1)
    -- open scratchpad
     , ( "-"
       , do scratchpadSpawnAction defaults
            updateBoring)
     ]) ++
  [ ( "<Print>"
    -- create screenshot
    , spawn nixStartFlameshot)
    -- invert color for bright or dark days
  , ("<Pause>", spawn nixInvertColors)
  ] ++
    -- ------------------------------------------------------------
    --
    -- Window and Layout
    --
    -- ------------------------------------------------------------
  (multiKeys
    -- Move focus to the next window
     [ ( "j"
       , do sendMessage FirstLayout
            focusDown)
     -- Move focus to the previous window
     , ( "k"
       , do sendMessage FirstLayout
            focusUp)
    -- Swap the focused window and the master window
     , ("<Tab>", windows W.swapMaster)
    -- Swap the focused window with the next window
     , ( "S-j"
       , do sendMessage FirstLayout
            windows W.swapDown)
    -- Swap the focused window with the previous window
     , ( "S-k"
       , do sendMessage FirstLayout
            windows W.swapUp)
     -- Rotate through the available layout algorithms
     , ("f", sendMessage NextLayout)
    -- Shrink the current area
    -- Shrink the master area
     , ( "h"
       , withFocused $
         floatTileCommand
           (withFocused (keysResizeWindow (10, 0) (1, 1 % 2)))
           (do sendMessage Shrink
               sendMessage Reset))
    -- Expand the master area
     , ( "l"
       , withFocused $
         floatTileCommand
           (withFocused (keysResizeWindow (-10, 0) (1, 1 % 2)))
           (do sendMessage Expand
               sendMessage Reset))
    -- Expand the current area
     , ( "S-l"
       , withFocused $
         floatTileCommand
           (withFocused (keysResizeWindow (0, -10) (1 % 2, 1)))
           (do sendMessage MirrorExpand
               sendMessage Reset))
     , ( "S-h"
       , withFocused $
         floatTileCommand
           (withFocused (keysResizeWindow (0, 10) (1 % 2, 1)))
           (do sendMessage MirrorShrink
               sendMessage Reset))
    -- Toggle window tiling/floating
     , ( "t"
       , do next <- nextRectangle
            withFocused $ toggleFloating next)
     , ( "n"
       , withFocused $
         floatTileCommand
           (do position <- nextRectangle
               withFocused (windows . (`W.float` position)))
           (return ()))
    -- Increment the number of windows in the master area
     , (",", sendMessage (IncMasterN 1))
    -- Deincrement the number of windows in the master area
     , (".", sendMessage (IncMasterN (-1)))
     ]) ++
    -- ------------------------------------------------------------
    --
    -- Xmonad Commands
    --
    -- ------------------------------------------------------------
    --  Quit xmonad
  (multiKeys
     [ ("S-q", io exitSuccess)
    --  restart xmonad
     , ("S-r", spawn "xmonad --recompile; xmonad --restart")
    --  select next screen/monitor
     , ("<Backspace>", selectNextScreen)
    --  move window next screen/monitor
    -- , ("M4-S-<Backspace>", moveWindowToNextScreen)
     ]) ++
    -- ------------------------------------------------------------
    --
    -- Volume Control
    --
    -- ------------------------------------------------------------
  [ ("<XF86AudioRaiseVolume>", spawn nixAlsaRaiseVolume)
  , ("<XF86AudioLowerVolume>", spawn nixAlsaLowerVolume)
  , ("<XF86AudioMute>", spawn nixAlsaMute)
  ] ++
    -- ------------------------------------------------------------
    --
    -- Redshift
    --
    -- ------------------------------------------------------------
  [("M4-<F9>", spawn nixStartRedshift), ("M4-<F10>", spawn nixResetRedshift)] ++
  -- ------------------------------------------------------------
  --
  -- programs
  --
  -- ------------------------------------------------------------
  [("M4-b", spawn nixSetBackground)]

------------------------------------------------------------------------
-- Mouse bindings: default actions bound to mouse events
--
mouse :: XConfig t -> M.Map (KeyMask, Button) (Window -> X ())
-- mouse _ = M.empty
mouse XConfig {XMonad.modMask = modm} =
  M.fromList
    -- mod-button1, Set the window to floating mode and move by dragging
    [ ( (modm, button1)
      , \w -> do
          focus w
          mouseMoveWindow w
          windows W.shiftMaster)
    -- mod-button2, Raise the window to the top of the stack
    , ( (modm, button2)
      , \w -> do
          focus w
          windows W.shiftMaster)
    -- mod-button3, Set the window to floating mode and resize by dragging
    , ( (modm, button3)
      , \w -> do
          focus w
          mouseResizeWindow w
          windows W.shiftMaster)
    -- you may also bind events to the mouse scroll wheel (button4 and button5)
    ]

------------------------------------------------------------------------
-- Window rules:
-- Execute arbitrary actions and WindowSet manipulations when managing
-- a new window. You can use this to, for example, always float a
-- particular program, or have a client always appear on a particular
-- workspace.
--
-- To find the property name associated with a program, use
-- > xprop | grep WM_CLASS
-- and click on the client you're interested in.
--
-- To match on the WM_NAME, you can use 'title' in the same way that
-- 'className' and 'resource' are used below.
--
myManageHook :: Query (Endo WindowSet)
myManageHook =
  composeAll
    [ className =? "Gimp" --> doFloat
    , className =? "zettlr" --> doFloat
    , title =? "fzfmenu" --> doCenterFloat
    , resource =? "copyq" --> doShift "-copyq"
    , scratchpadManageHook
        (W.RationalRect
          -- | percentage distance from left
           0.2
          -- | percentage distance from top
           0.2
          -- | width
           0.6
          -- | height
           0.6)
    ]

------------------------------------------------------------------------
-- Event handling
-- * EwmhDesktops users should change this to ewmhDesktopsEventHook
--
-- Defines a custom handler function for X Events. The function should
-- return (All True) if the default handler is to be run afterwards. To
-- combine event hooks use mappend or mconcat from Data.Monoid.
--
myEventHook :: Event -> X All
myEventHook = mempty

------------------------------------------------------------------------
-- Status bars and logging
-- Perform an arbitrary action on each internal state change or X event.
-- See the 'XMonad.Hooks.DynamicLog' extension for examples.
--
myLogHook :: X ()
myLogHook = do
  dynamicLog
    -- make sure the pointer always follows the focused window, when we use shortcuts
  updatePointer (0.5, 0.5) (0, 0)

------------------------------------------------------------------------
-- Startup hook
-- Perform an arbitrary action each time xmonad starts or is restarted
-- with mod-q.  Used by, e.g., XMonad.Layout.PerWorkspace to initialize
-- per-workspace layout choices.
--
-- By default, do nothing.
startUp :: X ()
startUp
  -- java fix
 = do
  setWMName "LG3D"
  spawn nixSetCursorImage
  spawn nixSetBackground
  spawn nixStartAlbert
  spawnOnce nixStartCopyq

------------------------------------------------------------------------
-- Now run xmonad with all the defaults we set up.
-- Run xmonad with the settings you specify. No need to modify this.
--
main :: IO ()
main = do
  xmonad $
    withUrgencyHook LibNotifyUrgencyHook $
    dynamicProjects projects $
    -- debugManageHook $
    defaults

myTerm :: FilePath
myTerm = nixStartTerminal

-- make sure we never select a boring window
-- when we select another workspace.
updateBoring :: X ()
updateBoring = do
  focusUp
  focusDown

-- A structure containing your configuration settings, overriding
-- fields in the default config. Any you don't override, will
-- use the defaults defined in xmonad/XMonad/Config.hs
--
-- No need to modify this.
--
defaults =
  additionalNav2DKeysP
    ("<Up>", "<Left>", "<Down>", "<Right>")
    [("M-", windowGo), ("M-S-", windowSwap)]
    False
    def
      { terminal = myTerm
    -- Whether focus follows the mouse pointer.
      , focusFollowsMouse = True
    -- Whether clicking on a window to focus also passes the click to the window
      , clickJustFocuses = False
    -- color configuration
      , normalBorderColor = nonSelectionColor
      , focusedBorderColor = selectionColor
      , borderWidth = 1
    -- modMask lets you specify which modkey you want to use.
    -- mod1Mask ("left alt").
    -- mod3Mask ("right alt")
    -- mod4Mask ("windows key")
      , modMask = mod4Mask
      , workspaces = nonRemovableWorkspaces
    -- key bindings
      , keys = myKeys
      , mouseBindings = mouse
    -- , layoutHook = focusTracking $ historyLayout myLayout
      , layoutHook = focusTracking myLayout
    -- , logHook = myLogHook <> runAllPending
      , logHook = myLogHook
      , startupHook = startUp
      , manageHook = myManageHook
      , handleEventHook = myEventHook
      } `additionalKeysP`
  myAdditionaKeys

autoXPConfig :: XPConfig
autoXPConfig = myXPConfig {autoComplete = Just 5000}

myXPConfig :: XPConfig
myXPConfig =
  def
    { bgColor = Solarized.base03
    , fgColor = Solarized.base0
    , promptBorderWidth = 0
    , font = "xft:DejaVu Sans:pixelsize=16:antialias=true:hinting=true"
    }

data LibNotifyUrgencyHook = LibNotifyUrgencyHook deriving (Read, Show)

instance UrgencyHook LibNotifyUrgencyHook where
    urgencyHook LibNotifyUrgencyHook w = do
        name     <- getName w
        Just idx <- fmap (W.findTag w) $ gets windowset

        safeSpawn nixNotifySend [show name, "workspace " ++ idx]