Merge pull request #239 from marcsaegesser/SpawnOnceEnhancements

Add spawnOnOnce and related functions.

CHANGES.md

@@ -4,6 +4,11 @@
 
 ### Breaking Changes
 
+  * `XMonad.Util.SpawnOnce`
+
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
+      to shift spawned windows to a specific workspace.
+
   * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
 
   * `XMonad.Actions.GridSelect`

XMonad/Config/Saegesser.hs

@@ -0,0 +1,79 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+---------------------------------------------------------------------
+-- |
+-- A mostly striped down configuration that demonstrates spawnOnOnce
+--
+---------------------------------------------------------------------
+import System.IO
+
+import XMonad
+
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.FadeInactive
+
+import XMonad.Layout.NoBorders
+import XMonad.Layout.ResizableTile
+import XMonad.Layout.Mosaic
+
+import XMonad.Util.Run
+import XMonad.Util.Cursor
+import XMonad.Util.NamedScratchpad
+import XMonad.Util.Scratchpad
+import XMonad.Util.SpawnOnce
+
+import XMonad.Actions.CopyWindow
+import XMonad.Actions.SpawnOn
+
+import qualified XMonad.StackSet as W
+
+main = do
+  myStatusBarPipe <- spawnPipe "xmobar"
+  xmonad $ docks $ withUrgencyHook NoUrgencyHook $ def
+    { terminal          = "xterm"
+    , workspaces        = myWorkspaces
+    , layoutHook        = myLayoutHook
+    , manageHook        = myManageHook <+> manageSpawn
+    , startupHook       = myStartupHook
+    , logHook           = myLogHook myStatusBarPipe
+    , focusFollowsMouse = False
+    }
+
+myManageHook = composeOne
+  [ isDialog                     -?> doFloat
+  , className =? "trayer"        -?> doIgnore
+  , className =? "Skype"         -?> doShift "chat"
+  , appName   =? "libreoffice"   -?> doShift "office"
+  , return True                  -?> doF W.swapDown
+  ]
+
+myWorkspaces = [ "web", "emacs", "chat", "vm", "office", "media", "xterms", "8", "9", "0"]
+
+myStartupHook = do
+  setDefaultCursor xC_left_ptr
+  spawnOnOnce "emacs" "emacs"
+  spawnNOnOnce 4 "xterms" "xterm"
+
+myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
+  where standardLayouts = tiled ||| mosaic 2 [3,2]  ||| Mirror tiled ||| Full
+        tiled = ResizableTall nmaster delta ratio []
+        nmaster = 1
+        delta = 0.03
+        ratio = 0.6
+
+myLogHook p =  do
+  copies <- wsContainingCopies
+  let check ws | ws == "NSP" = ""                               -- Hide the scratchpad workspace
+               | ws `elem` copies = xmobarColor "red" "black" $ ws  -- Workspaces with copied windows are red on black
+               | otherwise = ws
+  dynamicLogWithPP $ xmobarPP { ppHidden = check
+                              , ppOutput = hPutStrLn p
+                              , ppUrgent = xmobarColor "white" "red"
+                              , ppTitle  = xmobarColor "green" "" . shorten 180
+                              }
+  fadeInactiveLogHook 0.6
+

XMonad/Util/SpawnOnce.hs

@@ -15,9 +15,10 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Util.SpawnOnce (spawnOnce) where
+module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where
 
 import XMonad
+import XMonad.Actions.SpawnOn
 import Data.Set as Set
 import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad
@@ -29,11 +30,31 @@ instance ExtensionClass SpawnOnce where
     initialValue = SpawnOnce Set.empty
     extensionType = PersistentExtension
 
--- | The first time 'spawnOnce' is executed on a particular command, that
--- command is executed.  Subsequent invocations for a command do nothing.
-spawnOnce :: String -> X ()
-spawnOnce xs = do
-    b <- XS.gets (Set.member xs . unspawnOnce)
+doOnce :: (String -> X ()) -> String -> X ()
+doOnce f s = do
+    b <- XS.gets (Set.member s . unspawnOnce)
     when (not b) $ do
-        spawn xs
-        XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
+        f s
+        XS.modify (SpawnOnce . Set.insert s . unspawnOnce)
+
+
+-- | The first time 'spawnOnce' is executed on a particular command,
+-- that command is executed.  Subsequent invocations for a command do
+-- nothing.
+spawnOnce :: String -> X ()
+spawnOnce cmd = doOnce spawn cmd
+
+-- | Like spawnOnce but launches the application on the given workspace.
+spawnOnOnce :: WorkspaceId -> String -> X ()
+spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd
+
+-- | Lanch the given application n times on the specified
+-- workspace. Subsequent attempts to spawn this application will be
+-- ignored.
+spawnNOnOnce :: Int -> WorkspaceId -> String -> X ()
+spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd
+
+-- | Spawn the application once and apply the manage hook. Subsequent
+-- attempts to spawn this application will be ignored.
+spawnAndDoOnce :: ManageHook -> String -> X ()
+spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd