aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/Stoppable.hs
blob: 35c3c010c720f2080724819da8ed3d728ef265c1 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Stoppable
-- Copyright   :  (c) Anton Vorontsov <anton@enomsg.org> 2014
-- License     :  BSD-style (as xmonad)
--
-- Maintainer  :  Anton Vorontsov <anton@enomsg.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module implements a special kind of layout modifier, which when
-- applied to a layout, causes xmonad to stop all non-visible processes.
-- In a way, this is a sledge-hammer for applications that drain power.
-- For example, given a web browser on a stoppable workspace, once the
-- workspace is hidden the web browser will be stopped.
--
-- Note that the stopped application won't be able to communicate with X11
-- clipboard. For this, the module actually stops applications after a
-- certain delay, giving a chance for a user to complete copy-paste
-- sequence. By default, the delay equals to 15 seconds, it is
-- configurable via 'Stoppable' constructor.
--
-- The stoppable modifier prepends a mark (by default equals to
-- \"Stoppable\") to the layout description (alternatively, you can choose
-- your own mark and use it with 'Stoppable' constructor). The stoppable
-- layout (identified by a mark) spans to multiple workspaces, letting you
-- to create groups of stoppable workspaces that only stop processes when
-- none of the workspaces are visible, and conversely, unfreezing all
-- processes even if one of the stoppable workspaces are visible.
--
-- To stop the process we use signals, which works for most cases. For
-- processes that tinker with signal handling (debuggers), another
-- (Linux-centric) approach may be used. See
-- <https://www.kernel.org/doc/Documentation/cgroups/freezer-subsystem.txt>
--
-----------------------------------------------------------------------------

module XMonad.Layout.Stoppable
    ( -- $usage
      Stoppable(..)
    , stoppable
    ) where

import XMonad
import XMonad.Actions.WithAll
import XMonad.Util.WindowProperties
import XMonad.Util.Timer
import XMonad.StackSet hiding (filter)
import XMonad.Layout.LayoutModifier
import System.Posix.Env
import System.Posix.Signals
import Data.Maybe
import Control.Monad

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Layout.Stoppable
-- >
-- > main = xmonad def
-- >    { layoutHook = layoutHook def ||| stoppable (layoutHook def) }
--
-- Note that the module has to distinguish between local and remote
-- proccesses, which means that it needs to know the hostname, so it looks
-- for environment variables (e.g. HOST).
--
-- Beware that as of now this module does not support dynamically changing
-- hostnames.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

signalWindow :: Signal -> Window -> X ()
signalWindow s w = do
    pid <- getProp32s "_NET_WM_PID" w
    io $ (signalProcess s . fromIntegral) `mapM_` fromMaybe [] pid

signalLocalWindow :: Signal -> Window -> X ()
signalLocalWindow s w  = do
    host <- io $ pickOneMaybe `liftM` (getEnv `mapM` vars)
    hasProperty (Machine host) w >>= flip when (signalWindow s w)
  where
    pickOneMaybe = last . (mzero:) . take 1 . catMaybes
    vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"]

withAllOn :: (a -> X ()) -> Workspace i l a -> X ()
withAllOn f wspc = f `mapM_` integrate' (stack wspc)

withAllFiltered :: (Workspace i l a -> Bool)
                -> [Workspace i l a]
                -> (a -> X ()) -> X ()
withAllFiltered p wspcs f = withAllOn f `mapM_` filter p wspcs

sigStoppableWorkspacesHook :: String -> X ()
sigStoppableWorkspacesHook k = do
    ws <- gets windowset
    withAllFiltered isStoppable (hidden ws) (signalLocalWindow sigSTOP)
  where
    isStoppable ws = k `elem` words (description $ layout ws)

-- | Data type for ModifiedLayout. The constructor lets you to specify a
-- custom mark/description modifier and a delay. You can also use
-- 'stoppable' helper function.
data Stoppable a = Stoppable
    { mark :: String
    , delay :: Rational
    , timer :: Maybe TimerId
    } deriving (Show,Read)

instance LayoutModifier Stoppable Window where
    modifierDescription = mark

    hook _   = withAll $ signalLocalWindow sigCONT

    handleMess (Stoppable m _ (Just tid)) msg
        | Just ev <- fromMessage msg = handleTimer tid ev run
          where run = sigStoppableWorkspacesHook m >> return Nothing
    handleMess (Stoppable m d _) msg
        | Just Hide <- fromMessage msg =
            (Just . Stoppable m d . Just) `liftM` startTimer d
        | otherwise = return Nothing

-- | Convert a layout to a stoppable layout using the default mark
-- (\"Stoppable\") and a delay of 15 seconds.
stoppable :: l a -> ModifiedLayout Stoppable l a
stoppable = ModifiedLayout (Stoppable "Stoppable" 15 Nothing)