content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Actions.LinkWorkspaces
  -- Copyright   :  (c) Jan-David Quesel <quesel@gmail.org>
  -- License     :  BSD3-style (see LICENSE)
  --
  -- Maintainer  :  none
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Provides bindings to add and delete links between workspaces. It is aimed
  -- at providing useful links between workspaces in a multihead setup. Linked
  -- workspaces are view at the same time.
  --
  -----------------------------------------------------------------------------
  
  {-# LANGUAGE DeriveDataTypeable  #-}
  module XMonad.Actions.LinkWorkspaces (
                                           -- * Usage
                                           -- $usage
                                          switchWS,
                                          removeAllMatchings,
                                          unMatch,
                                          toggleLinkWorkspaces,
                                          defaultMessageConf,
                                          MessageConfig(..)
                                         ) where
  
  import XMonad
  import qualified XMonad.StackSet as W
  import XMonad.Layout.IndependentScreens(countScreens)
  import qualified XMonad.Util.ExtensibleState as XS (get, put)
  import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen')
  import qualified Data.Map as M
      ( insert, delete, Map, lookup, empty, filter )
  
  -- $usage
  -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
  --
  -- > import XMonad.Actions.LinkWorkspaces
  --
  -- and add a function to print messages like
  --
  -- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1)
  -- > message_color_func c1 c2 msg = dzenColor c1 c2 msg
  -- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen
  --
  -- alternatively you can use the noMessages function as the argument
  --
  -- Then add keybindings like the following:
  --
  -- > ,((modm, xK_p), toggleLinkWorkspaces message)
  -- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message)
  --
  -- >   [ ((modm .|. m, k), a i)
  -- >       | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)]
  -- >       , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
  --
  -- For detailed instructions on editing your key bindings, see
  -- "XMonad.Doc.Extending#Editing_key_bindings".
  
  data MessageConfig = MessageConfig {  messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
                      , foreground :: [Char]
                      , alertedForeground :: [Char]
                      , background :: [Char]
                     }
  
  defaultMessageConf :: MessageConfig
  defaultMessageConf = MessageConfig { messageFunction = noMessageFn
                       , background = "#000000"
                       , alertedForeground = "#ff7701"
                       , foreground = "#00ff00" }
  
  noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
  noMessageFn _ _ _ _ = return () :: X ()
  
  -- | Stuff for linking workspaces
  data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
  instance ExtensionClass WorkspaceMap 
      where initialValue = WorkspaceMap M.empty
            extensionType = PersistentExtension
  
  switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
  switchWS f m ws = switchWS' f m ws Nothing
  
  -- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
  -- | we already did switching on
  switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> (Maybe ScreenId) -> X ()
  switchWS' switchFn message workspace stopAtScreen = do
    ws <- gets windowset
    nScreens <- countScreens
    let now = W.screen (W.current ws)
    let next = ((now + 1) `mod` nScreens)
    switchFn workspace
    case stopAtScreen of
      Nothing -> sTM now next (Just now)
      Just sId -> if sId == next then return () else sTM now next (Just sId)
    where sTM = switchToMatching (switchWS' switchFn message) message workspace
  
  -- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
  -- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
  switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId 
      -> ScreenId -> (Maybe ScreenId) -> X ()
  switchToMatching f message t now next stopAtScreen = do
      WorkspaceMap matchings <- XS.get :: X WorkspaceMap
      case (M.lookup t matchings) of
          Nothing -> return () :: X()
          Just newWorkspace -> do
              onScreen' (f newWorkspace stopAtScreen) FocusCurrent next 
              messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))
  
  -- | Insert a mapping between t1 and t2 or remove it was already present
  toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
  toggleMatching message t1 t2 = do
      WorkspaceMap matchings <- XS.get :: X WorkspaceMap
      case (M.lookup t1 matchings) of
          Nothing -> setMatching message t1 t2 matchings
          Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
      return ()
  
  -- | Insert a mapping between t1 and t2 and display a message
  setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
  setMatching message t1 t2 matchings = do
     ws <- gets windowset
     let now = W.screen (W.current ws)
     XS.put $ WorkspaceMap $ M.insert t1 t2 matchings
     messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2))
  
  -- currently this function is called manually this means that if workspaces
  -- were deleted, some links stay in the RAM even though they are not used
  -- anymore... because of the small amount of memory used for those there is no
  -- special cleanup so far
  removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
  removeMatching' message t1 t2 matchings = do
     ws <- gets windowset
     let now = W.screen (W.current ws)
     XS.put $ WorkspaceMap $ M.delete t1 matchings
     messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2)
  
  -- | Remove all maps between workspaces
  removeAllMatchings :: MessageConfig -> X ()
  removeAllMatchings message = do
     ws <- gets windowset
     let now = W.screen (W.current ws)
     XS.put $ WorkspaceMap $ M.empty
     messageFunction message now (alertedForeground message) (background message) "All links removed!"
  
  -- | remove all matching regarding a given workspace
  unMatch :: WorkspaceId -> X ()
  unMatch workspace = do
      WorkspaceMap matchings <- XS.get :: X WorkspaceMap
      XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings)
  
  -- | Toggle the currently displayed workspaces as matching. Starting from the one with focus
  -- | a linked list of workspaces is created that will later be iterated by switchToMatching.
  toggleLinkWorkspaces :: MessageConfig -> X ()
  toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message
  
  toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
  toggleLinkWorkspaces' first message = do
      ws <- gets windowset
      nScreens <- countScreens
      let now = W.screen (W.current ws)
      let next = (now + 1) `mod` nScreens
      if next == first then return () else do -- this is also the case if there is only one screen
          case (W.lookupWorkspace next ws) of
              Nothing -> return ()
              Just name -> toggleMatching message (W.currentTag ws) (name)
          onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
  