From 559341d66d1a3e126fa33ef9bf861a02ebec63ee Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@cis.upenn.edu>
Date: Tue, 29 Dec 2009 17:39:15 +0100
Subject: new contrib module from Tomas Janousek, X.A.WorkspaceNames
Ignore-this: 5bc7caaf38647de51949a24498001474
darcs-hash:20091229163915-1e371-78c02a000c6b80a30b7c552c7bfa503f051aad1a.gz
---
XMonad/Actions/WorkspaceNames.hs | 155 +++++++++++++++++++++++++++++++++++++++
1 file changed, 155 insertions(+)
create mode 100644 XMonad/Actions/WorkspaceNames.hs
(limited to 'XMonad')
diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs
new file mode 100644
index 0000000..c2dadd5
--- /dev/null
+++ b/XMonad/Actions/WorkspaceNames.hs
@@ -0,0 +1,155 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Actions.WorkspaceNames
+-- Copyright : (c) Tomas Janousek <tomi@nomi.cz>
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Tomas Janousek <tomi@nomi.cz>
+-- Stability : experimental
+-- Portability : unportable
+--
+-- Provides bindings to rename workspaces, show these names in DynamicLog and
+-- swap workspaces along with their names. These names survive restart.
+-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
+-- dynamic topic space workflow.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.WorkspaceNames (
+ -- * Usage
+ -- $usage
+
+ -- * Workspace naming
+ renameWorkspace,
+ workspaceNamesPP,
+ getWorkspaceNames,
+ setWorkspaceName,
+ setCurrentWorkspaceName,
+
+ -- * Workspace swapping
+ swapTo,
+ swapTo',
+ swapWithCurrent,
+ ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
+import qualified XMonad.Actions.SwapWorkspaces as Swap
+import XMonad.Hooks.DynamicLog (PP(..))
+import XMonad.Prompt (showXPrompt, mkXPrompt, XPrompt, XPConfig)
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.WorkspaceNames
+--
+-- Then add keybindings like the following:
+--
+-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig)
+--
+-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
+--
+-- > myLogHook =
+-- > workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
+--
+-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
+-- functionality, which may be used this way:
+--
+-- > , ((modMask .|. shiftMask, xK_Left ), swapTo Prev)
+-- > , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
+--
+-- > [((modm .|. controlMask, k), swapWithCurrent i)
+-- > | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+
+-- | Workspace names container.
+newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
+ deriving (Typeable, Read, Show)
+
+instance ExtensionClass WorkspaceNames where
+ initialValue = WorkspaceNames M.empty
+ extensionType = PersistentExtension
+
+-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
+-- workspaces with a name, and to @\"t\"@ otherwise.
+getWorkspaceNames :: X (WorkspaceId -> String)
+getWorkspaceNames = do
+ WorkspaceNames m <- XS.get
+ return $ \wks -> case M.lookup wks m of
+ Nothing -> wks
+ Just s -> wks ++ ":" ++ s
+
+-- | Sets the name of a workspace. Empty string makes the workspace unnamed
+-- again.
+setWorkspaceName :: WorkspaceId -> String -> X ()
+setWorkspaceName w name = do
+ WorkspaceNames m <- XS.get
+ XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m
+ refresh
+
+-- | Sets the name of the current workspace. See 'setWorkspaceName'.
+setCurrentWorkspaceName :: String -> X ()
+setCurrentWorkspaceName name = do
+ current <- gets (W.currentTag . windowset)
+ setWorkspaceName current name
+
+data Wor = Wor String
+instance XPrompt Wor where
+ showXPrompt (Wor x) = x
+
+-- | Prompt for a new name for the current workspace and set it.
+renameWorkspace :: XPConfig -> X ()
+renameWorkspace conf = do
+ mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
+ where pr = Wor "Workspace name: "
+
+-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
+-- workspace names as well.
+workspaceNamesPP :: PP -> X PP
+workspaceNamesPP pp = do
+ names <- getWorkspaceNames
+ return $
+ pp {
+ ppCurrent = ppCurrent pp . names,
+ ppVisible = ppVisible pp . names,
+ ppHidden = ppHidden pp . names,
+ ppHiddenNoWindows = ppHiddenNoWindows pp . names,
+ ppUrgent = ppUrgent pp . names
+ }
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
+swapTo :: Direction1D -> X ()
+swapTo dir = swapTo' dir AnyWS
+
+-- | Swap with the previous or next workspace of the given type.
+swapTo' :: Direction1D -> WSType -> X ()
+swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
+-- same with names.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent t = do
+ current <- gets (W.currentTag . windowset)
+ swapNames t current
+ windows $ Swap.swapWorkspaces t current
+
+-- | Swap names of the two workspaces.
+swapNames :: WorkspaceId -> WorkspaceId -> X ()
+swapNames w1 w2 = do
+ WorkspaceNames m <- XS.get
+ let getname w = fromMaybe "" $ M.lookup w m
+ set w name m' = if null name then M.delete w m' else M.insert w name m'
+ XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
--
cgit v1.2.3