mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-03 05:31:53 -07:00
Compare commits
198 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
25896cd43d | ||
|
7325062ccf | ||
|
df58a90077 | ||
|
9dae24bfd8 | ||
|
9515818409 | ||
|
1f2162781f | ||
|
4d2365734d | ||
|
1df08883b8 | ||
|
79b0c3401a | ||
|
bfc265d663 | ||
|
26e40e555e | ||
|
e58933b9c1 | ||
|
1c03ecc596 | ||
|
1a9af96070 | ||
|
8aa2076a45 | ||
|
e9980e2052 | ||
|
94101637c9 | ||
|
cfaadb644e | ||
|
ed49f823d0 | ||
|
f29f38fbeb | ||
|
f06a147057 | ||
|
e0ebbc1ea8 | ||
|
52192efe56 | ||
|
18ae6a3e2c | ||
|
b775d682ca | ||
|
99f9c8acc3 | ||
|
95b26ac219 | ||
|
374c034628 | ||
|
ae1010882a | ||
|
afb54c64b0 | ||
|
23588c09ae | ||
|
60e02bb08a | ||
|
ddb522d0cb | ||
|
2dc1b0c5f7 | ||
|
7cc6859496 | ||
|
6530f28720 | ||
|
ddc49ade7b | ||
|
1c18687ec4 | ||
|
4dc9baca48 | ||
|
389e23b979 | ||
|
d988bda23f | ||
|
78f934255b | ||
|
f6e166c5ea | ||
|
a8c84232f3 | ||
|
f736a57bf0 | ||
|
244c75bee7 | ||
|
303107fbae | ||
|
aa9e7ca663 | ||
|
744b8197ee | ||
|
7b81a45619 | ||
|
da64090416 | ||
|
aa8275e491 | ||
|
955a4bd24f | ||
|
5c908f986a | ||
|
f95fa1f551 | ||
|
3436683f88 | ||
|
8bec9a32e1 | ||
|
f13c352bff | ||
|
5895a401be | ||
|
5fc69c1ae7 | ||
|
0cbb8b83af | ||
|
65109b90c6 | ||
|
25de482d5f | ||
|
7ef87af128 | ||
|
8a4ffb3e57 | ||
|
12e54671a5 | ||
|
e3974a91b3 | ||
|
8c65d469db | ||
|
3cbccce5e8 | ||
|
7a3ff21b89 | ||
|
0140d63947 | ||
|
8a646c9983 | ||
|
e355598321 | ||
|
dd0ad36b22 | ||
|
826512a460 | ||
|
f4b537a06e | ||
|
6c2489e4a5 | ||
|
52d2a731c9 | ||
|
21dd3fed8f | ||
|
7852e704fa | ||
|
1d93dfba51 | ||
|
60f269f0b3 | ||
|
4d520a4f20 | ||
|
7d34680a9c | ||
|
ac6f1a66fe | ||
|
921097c9b5 | ||
|
2d60591715 | ||
|
4d1bc6eecb | ||
|
bb5fd00967 | ||
|
864f3382ce | ||
|
95e5210d95 | ||
|
6eb5074bd1 | ||
|
70caa5a67b | ||
|
cdeb842834 | ||
|
255a04753e | ||
|
8f0b9fa066 | ||
|
98c70dd264 | ||
|
5338391ae9 | ||
|
ad787b2d5f | ||
|
50420922eb | ||
|
b45722cf82 | ||
|
07b2f424b1 | ||
|
090d77236d | ||
|
4b8575f3ae | ||
|
5e045d018b | ||
|
e8b19b8b33 | ||
|
0350117f47 | ||
|
26b1a747c6 | ||
|
33b0a1b760 | ||
|
82a6bea527 | ||
|
7c9948f9ee | ||
|
58610f1c15 | ||
|
e3eb2151da | ||
|
52932bcd03 | ||
|
d38b2b4f72 | ||
|
72c42e6b0a | ||
|
2a2c33b37f | ||
|
c66c634cf0 | ||
|
90d5b56d45 | ||
|
8677090476 | ||
|
1e6c4e485a | ||
|
476fb301d4 | ||
|
570f6c9cf1 | ||
|
0a118f1179 | ||
|
99d0c45074 | ||
|
5e7462d9b2 | ||
|
b15fd831fe | ||
|
82975240b7 | ||
|
e35e0a001c | ||
|
4fff234f3b | ||
|
a46e04fef7 | ||
|
034eee34e3 | ||
|
49b705906b | ||
|
0df598fa5d | ||
|
b2c1e077b2 | ||
|
2418d4b374 | ||
|
aca6fd8058 | ||
|
8e5df4b950 | ||
|
336c617cbe | ||
|
bcc4295d3d | ||
|
2e050d29d9 | ||
|
19156cb3ff | ||
|
5344db6c90 | ||
|
b1d4d97c1a | ||
|
adbee1ce2c | ||
|
adde0fc668 | ||
|
c98059db64 | ||
|
58f10da612 | ||
|
ab782c936a | ||
|
117c3bd6b1 | ||
|
9e6dca0fa1 | ||
|
1071d0a4e1 | ||
|
56031b1f63 | ||
|
59fc99504f | ||
|
413023b5d0 | ||
|
b2b1671630 | ||
|
999029d95f | ||
|
4277d11def | ||
|
cdfbf3ebce | ||
|
c86409624f | ||
|
e28702c57b | ||
|
ef25a538bf | ||
|
b495c7f725 | ||
|
1950a4e2cc | ||
|
c15eea99c9 | ||
|
8783bc727c | ||
|
8d2f363729 | ||
|
2747f802df | ||
|
0971238cf6 | ||
|
6c324cbfed | ||
|
f1d91209a4 | ||
|
5d352c8bf4 | ||
|
63bac5b539 | ||
|
7e3cb59c23 | ||
|
adbf9032ca | ||
|
d2df9b329e | ||
|
25c23eb79d | ||
|
e170cfc611 | ||
|
7382e616a9 | ||
|
64396d85ab | ||
|
acd13fd324 | ||
|
a4fb5d127f | ||
|
494823eb82 | ||
|
dcd1aea5d6 | ||
|
6c19138d55 | ||
|
8816dc5c3f | ||
|
110c3863e8 | ||
|
f77f71512b | ||
|
7abbbd4568 | ||
|
5bbf9700f3 | ||
|
c857ebe29c | ||
|
da5452b009 | ||
|
a09ed70091 | ||
|
bc0851f52a | ||
|
4e66e0ad1b | ||
|
8efc32759a | ||
|
c86dd6f097 | ||
|
0d310df103 |
@@ -53,5 +53,5 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
y = ey - fromIntegral (wa_y wa)
|
||||
sz = if c then (max x y, max x y) else (x,y)
|
||||
io $ resizeWindow d w `uncurry`
|
||||
applySizeHints sh sz)
|
||||
applySizeHintsContents sh sz)
|
||||
(float w)
|
||||
|
@@ -2,10 +2,10 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.CopyWindow
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : ???
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -17,12 +17,12 @@
|
||||
module XMonad.Actions.CopyWindow (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
copy, copyWindow, kill1
|
||||
copy, copyToAll, copyWindow, killAllOtherCopies, kill1
|
||||
) where
|
||||
|
||||
import Prelude hiding ( filter )
|
||||
import Prelude hiding (filter)
|
||||
import qualified Data.List as L
|
||||
import XMonad hiding (modify)
|
||||
import XMonad hiding (modify, workspaces)
|
||||
import XMonad.StackSet
|
||||
|
||||
-- $usage
|
||||
@@ -50,16 +50,31 @@ import XMonad.StackSet
|
||||
--
|
||||
-- > , ((modMask x .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window
|
||||
--
|
||||
-- Another possibility which this extension provides is 'making window
|
||||
-- always visible' (i.e. always on current workspace), similar to corresponding
|
||||
-- metacity functionality. This behaviour is emulated through copying given
|
||||
-- window to all the workspaces and then removing it when it's unneeded on
|
||||
-- all workspaces any more.
|
||||
--
|
||||
-- Here is the example of keybindings which provide these actions:
|
||||
--
|
||||
-- > , ((modMask x, xK_v )", windows copyToAll) -- @@ Make focused window always visible
|
||||
-- > , ((modMask x .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
-- | copy. Copy the focussed window to a new workspace.
|
||||
copy :: WorkspaceId -> WindowSet -> WindowSet
|
||||
copy :: (Eq s, Eq i, Eq a) => i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
copy n s | Just w <- peek s = copyWindow w n s
|
||||
| otherwise = s
|
||||
|
||||
-- | copyToAll. Copy the focused window to all of workspaces.
|
||||
copyToAll :: (Eq s, Eq i, Eq a) => StackSet i l a s sd -> StackSet i l a s sd
|
||||
copyToAll s = foldr copy s $ map tag (workspaces s)
|
||||
|
||||
-- | copyWindow. Copy a window to a new workspace
|
||||
copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet
|
||||
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
copyWindow w n = copy'
|
||||
where copy' s = if n `tagMember` s
|
||||
then view (tag (workspace (current s))) $ insertUp' w $ view n s
|
||||
@@ -83,3 +98,19 @@ kill1 = do ss <- gets windowset
|
||||
then windows $ delete'' w
|
||||
else kill
|
||||
where delete'' w = modify Nothing (filter (/= w))
|
||||
|
||||
-- | Kill all other copies of focused window (if they're present)
|
||||
-- 'All other' means here 'copies, which are not on current workspace'
|
||||
--
|
||||
-- Consider calling this function after copyToAll
|
||||
--
|
||||
killAllOtherCopies :: X ()
|
||||
killAllOtherCopies = do ss <- gets windowset
|
||||
whenJust (peek ss) $ \w -> windows $
|
||||
view (tag (workspace (current ss))) .
|
||||
delFromAllButCurrent w
|
||||
where
|
||||
delFromAllButCurrent w ss = foldr ($) ss $
|
||||
map (delWinFromWorkspace w . tag) $
|
||||
hidden ss ++ map workspace (visible ss)
|
||||
delWinFromWorkspace w wid ss = modify Nothing (filter (/= w)) $ view wid ss
|
||||
|
85
XMonad/Actions/CycleRecentWS.hs
Normal file
85
XMonad/Actions/CycleRecentWS.hs
Normal file
@@ -0,0 +1,85 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.CycleRecentWS
|
||||
-- Copyright : (c) Michal Janeczek <janeczek@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Michal Janeczek <janeczek@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Provides bindings to cycle through most recently used workspaces
|
||||
-- with repeated presses of a single key (as long as modifier key is
|
||||
-- held down). This is similar to how many window managers handle
|
||||
-- window switching.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.CycleRecentWS (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
cycleRecentWS,
|
||||
cycleWindowSets
|
||||
) where
|
||||
|
||||
import XMonad hiding (workspaces)
|
||||
import XMonad.StackSet
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Actions.CycleRecentWS
|
||||
-- >
|
||||
-- > , ((modMask x, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
-- | Cycle through most recent workspaces with repeated presses of a key, while
|
||||
-- a modifier key is held down. The recency of workspaces previewed while browsing
|
||||
-- to the target workspace is not affected. That way a stack of most recently used
|
||||
-- workspaces is maintained, similarly to how many window managers handle window
|
||||
-- switching. For best effects use the same modkey+key combination as the one used
|
||||
-- to invoke this action.
|
||||
cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
|
||||
-- As soon as one of them is released, the final switch is made.
|
||||
-> KeySym -- ^ Key used to switch to next (less recent) workspace.
|
||||
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
|
||||
-- If it's the same as the nextWorkspace key, it is effectively ignored.
|
||||
-> X ()
|
||||
cycleRecentWS = cycleWindowSets options
|
||||
where options w = map (view `flip` w) (recentTags w)
|
||||
recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
|
||||
|
||||
|
||||
cycref :: [a] -> Int -> a
|
||||
cycref l i = l !! (i `mod` length l)
|
||||
|
||||
-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
|
||||
-- a modifier key is held down. For best effects use the same modkey+key combination
|
||||
-- as the one used to invoke this action.
|
||||
cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
|
||||
-> [KeySym] -- ^ A list of modifier keys used when invoking this action.
|
||||
-- As soon as one of them is released, the final WindowSet is chosen and the action exits.
|
||||
-> KeySym -- ^ Key used to preview next WindowSet from the list of generated options
|
||||
-> KeySym -- ^ Key used to preview previous WindowSet from the list of generated options.
|
||||
-- If it's the same as nextOption key, it is effectively ignored.
|
||||
-> X ()
|
||||
cycleWindowSets genOptions mods keyNext keyPrev = do
|
||||
options <- gets $ genOptions . windowset
|
||||
XConf {theRoot = root, display = d} <- ask
|
||||
let event = allocaXEvent $ \p -> do
|
||||
maskEvent d (keyPressMask .|. keyReleaseMask) p
|
||||
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
|
||||
s <- keycodeToKeysym d c 0
|
||||
return (t, s)
|
||||
let setOption n = do windows $ const $ options `cycref` n
|
||||
(t, s) <- io event
|
||||
case () of
|
||||
() | t == keyPress && s == keyNext -> setOption (n+1)
|
||||
| t == keyPress && s == keyPrev -> setOption (n-1)
|
||||
| t == keyRelease && s `elem` mods -> return ()
|
||||
| otherwise -> setOption n
|
||||
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
||||
setOption 0
|
||||
io $ ungrabKeyboard d currentTime
|
@@ -1,10 +1,10 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.DeManage
|
||||
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -4,7 +4,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -17,6 +17,7 @@ module XMonad.Actions.DynamicWorkspaces (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
addWorkspace, removeWorkspace,
|
||||
addHiddenWorkspace,
|
||||
withWorkspace,
|
||||
selectWorkspace, renameWorkspace,
|
||||
toNthWorkspace, withNthWorkspace
|
||||
@@ -100,6 +101,8 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
|
||||
addWorkspace :: String -> X ()
|
||||
addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
|
||||
|
||||
|
||||
-- | Add a new hidden workspace with the given name.
|
||||
addHiddenWorkspace :: String -> X ()
|
||||
addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
|
||||
windows (addHiddenWorkspace' newtag l)
|
||||
|
@@ -92,7 +92,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
npos = wpos + offset * atl
|
||||
nbr = (wpos + wsize) + offset * abr
|
||||
ntl = minP (nbr - (32, 32)) npos --minimum size
|
||||
nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)
|
||||
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
|
||||
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
|
||||
return ())
|
||||
(float w)
|
||||
|
@@ -53,7 +53,7 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y]
|
||||
io $ moveResizeWindow d w (fx px (fromIntegral ex))
|
||||
(fy py (fromIntegral ey))
|
||||
`uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
|
||||
`uncurry` applySizeHintsContents sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
|
||||
(float w)
|
||||
where
|
||||
firstHalf :: CInt -> Position -> Bool
|
||||
|
@@ -94,7 +94,7 @@ keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
|
||||
keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
|
||||
keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
|
||||
where
|
||||
(nw, nh) = applySizeHints sh (w + dx, h + dy)
|
||||
(nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
|
||||
nx :: Rational
|
||||
nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
|
||||
ny :: Rational
|
||||
@@ -103,7 +103,7 @@ keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (n
|
||||
keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
|
||||
keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
|
||||
where
|
||||
(nw, nh) = applySizeHints sh (w + dx, h + dy)
|
||||
(nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
|
||||
nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
|
||||
ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
|
||||
|
||||
|
@@ -22,7 +22,7 @@ module XMonad.Actions.MouseGestures (
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Layout.WindowNavigation (Direction(..))
|
||||
import XMonad.Hooks.ManageDocks (Direction(..))
|
||||
|
||||
import Data.IORef
|
||||
import qualified Data.Map as M
|
||||
|
235
XMonad/Actions/Plane.hs
Normal file
235
XMonad/Actions/Plane.hs
Normal file
@@ -0,0 +1,235 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.Plane
|
||||
-- Copyright : (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
|
||||
-- Leonardo Serra <leoserra@minaslivre.org>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Marco Túlio Gontijo e Silva <marcot@riseup.net>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This module has functions to navigate through workspaces in a bidimensional
|
||||
-- manner. It allows the organization of workspaces in lines, and provides
|
||||
-- functions to move and shift windows in all four directions (left, up, right
|
||||
-- and down) possible in a surface.
|
||||
--
|
||||
-- This functionality was inspired by GNOME (finite) and KDE (infinite)
|
||||
-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for
|
||||
-- the idea of applying this approach to XMonad.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.Plane
|
||||
(
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Data types
|
||||
Direction (..)
|
||||
, Limits (..)
|
||||
, Lines (..)
|
||||
|
||||
-- * Navigating through workspaces
|
||||
, planeShift
|
||||
, planeMove
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad
|
||||
import Data.List hiding (union)
|
||||
import Data.Maybe
|
||||
|
||||
import XMonad
|
||||
import XMonad.StackSet hiding (workspaces)
|
||||
import XMonad.Util.Run
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Actions.Plane
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {keys = myKeys}
|
||||
-- >
|
||||
-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf
|
||||
-- >
|
||||
-- > myNewkeys (XConfig {modMask = m}) =
|
||||
-- > fromList
|
||||
-- > [ ((keyMask .|. m, keySym), function (Lines 3) Finite direction)
|
||||
-- > | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft
|
||||
-- > , (keyMask, function) <- [(0, planeMove), (shiftMask, planeShift)]
|
||||
-- > ]
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
-- | Direction to go in the plane.
|
||||
data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum
|
||||
|
||||
-- | Defines whether it's a finite or a circular organization of workspaces.
|
||||
data Limits
|
||||
= Finite -- ^ When you're at a edge of the plane, there's no way to move
|
||||
-- to the next region.
|
||||
| Circular -- ^ If you try to move, you'll get to the other edge, on the
|
||||
-- other side.
|
||||
| Linear -- ^ The plan comes as a row.
|
||||
deriving Eq
|
||||
|
||||
-- | The number of lines in which the workspaces will be arranged. It's
|
||||
-- possible to use a number of lines that is not a divisor of the number of
|
||||
-- workspaces, but the results are better when using a divisor. If it's not a
|
||||
-- divisor, the last line will have the remaining workspaces.
|
||||
data Lines
|
||||
= GConf -- ^ Use @gconftool-2@ to find out the number of lines.
|
||||
| Lines Int -- ^ Specify the number of lines explicity.
|
||||
|
||||
-- $navigating
|
||||
--
|
||||
-- There're two parameters that must be provided to navigate, and it's a good
|
||||
-- idea to use them with the same values in each keybinding.
|
||||
--
|
||||
-- The first is the number of lines in which the workspaces are going to be
|
||||
-- organized. It's possible to use a number of lines that is not a divisor
|
||||
-- of the number of workspaces, but the results are better when using a
|
||||
-- divisor. If it's not a divisor, the last line will have the remaining
|
||||
-- workspaces.
|
||||
--
|
||||
-- The other one is 'Limits'.
|
||||
|
||||
-- | Shift a window to the next workspace in 'Direction'. Note that this will
|
||||
-- also move to the next workspace.
|
||||
planeShift
|
||||
:: Lines
|
||||
-> Limits
|
||||
-> Direction
|
||||
-> X ()
|
||||
planeShift = plane shift'
|
||||
|
||||
shift' ::
|
||||
(Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
shift' area = greedyView area . shift area
|
||||
|
||||
-- | Move to the next workspace in 'Direction'.
|
||||
planeMove :: Lines -> Limits -> Direction -> X ()
|
||||
planeMove = plane greedyView
|
||||
|
||||
plane ::
|
||||
(WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
|
||||
X ()
|
||||
plane function numberLines_ limits direction = do
|
||||
state <- get
|
||||
xconf <- ask
|
||||
|
||||
numberLines <-
|
||||
liftIO $
|
||||
case numberLines_ of
|
||||
Lines numberLines__ ->
|
||||
return numberLines__
|
||||
GConf ->
|
||||
do
|
||||
numberLines__ <-
|
||||
runProcessWithInput gconftool parameters ""
|
||||
case reads numberLines__ of
|
||||
[(numberRead, _)] -> return numberRead
|
||||
_ ->
|
||||
do
|
||||
trace $
|
||||
"XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++
|
||||
unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1."
|
||||
return 1
|
||||
|
||||
let
|
||||
notBorder :: Bool
|
||||
notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction
|
||||
|
||||
circular_ :: Int
|
||||
circular_ = circular currentWS
|
||||
|
||||
circular :: Int -> Int
|
||||
circular =
|
||||
[ onLine pred
|
||||
, onColumn pred
|
||||
, onLine succ
|
||||
, onColumn succ
|
||||
]
|
||||
!! fromEnum direction
|
||||
|
||||
linear :: Int -> Int
|
||||
linear =
|
||||
[ onLine pred . onColumn pred
|
||||
, onColumn pred . onLine pred
|
||||
, onLine succ . onColumn succ
|
||||
, onColumn succ . onLine succ
|
||||
]
|
||||
!! fromEnum direction
|
||||
|
||||
onLine :: (Int -> Int) -> Int -> Int
|
||||
onLine f currentWS_
|
||||
| line < areasLine = mod_ columns
|
||||
| otherwise = mod_ areasColumn
|
||||
where
|
||||
line, column :: Int
|
||||
(line, column) = split currentWS_
|
||||
|
||||
mod_ :: Int -> Int
|
||||
mod_ columns_ = compose line $ mod (f column) columns_
|
||||
|
||||
onColumn :: (Int -> Int) -> Int -> Int
|
||||
onColumn f currentWS_
|
||||
| column < areasColumn || areasColumn == 0 = mod_ numberLines
|
||||
| otherwise = mod_ $ pred numberLines
|
||||
where
|
||||
line, column :: Int
|
||||
(line, column) = split currentWS_
|
||||
|
||||
mod_ :: Int -> Int
|
||||
mod_ lines_ = compose (mod (f line) lines_) column
|
||||
|
||||
compose :: Int -> Int -> Int
|
||||
compose line column = line * columns + column
|
||||
|
||||
split :: Int -> (Int, Int)
|
||||
split currentWS_ =
|
||||
(operation div, operation mod)
|
||||
where
|
||||
operation :: (Int -> Int -> Int) -> Int
|
||||
operation f = f currentWS_ columns
|
||||
|
||||
areasLine :: Int
|
||||
areasLine = div areas columns
|
||||
|
||||
areasColumn :: Int
|
||||
areasColumn = mod areas columns
|
||||
|
||||
columns :: Int
|
||||
columns =
|
||||
if mod areas numberLines == 0 then preColumns else preColumns + 1
|
||||
|
||||
currentWS :: Int
|
||||
currentWS = fromJust mCurrentWS
|
||||
|
||||
preColumns :: Int
|
||||
preColumns = div areas numberLines
|
||||
|
||||
mCurrentWS :: Maybe Int
|
||||
mCurrentWS = elemIndex (currentTag $ windowset state) areaNames
|
||||
|
||||
areas :: Int
|
||||
areas = length areaNames
|
||||
|
||||
run :: (Int -> Int) -> X ()
|
||||
run f = windows $ function $ areaNames !! f currentWS
|
||||
|
||||
areaNames :: [String]
|
||||
areaNames = workspaces $ config xconf
|
||||
|
||||
when (isJust mCurrentWS) $
|
||||
case limits of
|
||||
Finite -> when notBorder $ run circular
|
||||
Circular -> run circular
|
||||
Linear -> if notBorder then run circular else run linear
|
||||
|
||||
gconftool :: String
|
||||
gconftool = "gconftool-2"
|
||||
|
||||
parameters :: [String]
|
||||
parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]
|
@@ -1,44 +1,49 @@
|
||||
{- |
|
||||
Module : XMonad.Actions.Search
|
||||
Copyright : (C) 2007 Gwern Branwen
|
||||
License : None; public domain
|
||||
{- | Module : XMonad.Actions.Search
|
||||
Copyright : (C) 2007 Gwern Branwen
|
||||
License : None; public domain
|
||||
|
||||
Maintainer : <gwern0@gmail.com>
|
||||
Stability : unstable
|
||||
Portability : unportable
|
||||
Maintainer : <gwern0@gmail.com>
|
||||
Stability : unstable
|
||||
Portability : unportable; depends on XSelection, XPrompt
|
||||
|
||||
A module for easily running Internet searches on web sites through xmonad.
|
||||
Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
|
||||
A module for easily running Internet searches on web sites through xmonad.
|
||||
Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
|
||||
|
||||
Additional sites welcomed.
|
||||
-}
|
||||
module XMonad.Actions.Search ( -- * Usage
|
||||
-- $usage
|
||||
search,
|
||||
simpleEngine,
|
||||
promptSearch,
|
||||
selectSearch,
|
||||
Additional sites welcomed. -}
|
||||
module XMonad.Actions.Search ( -- * Usage
|
||||
-- $usage
|
||||
search,
|
||||
SearchEngine(..),
|
||||
searchEngine,
|
||||
promptSearch,
|
||||
promptSearchBrowser,
|
||||
selectSearch,
|
||||
selectSearchBrowser,
|
||||
|
||||
amazon,
|
||||
google,
|
||||
hoogle,
|
||||
imdb,
|
||||
maps,
|
||||
mathworld,
|
||||
scholar,
|
||||
wayback,
|
||||
wikipedia
|
||||
amazon,
|
||||
codesearch,
|
||||
dictionary,
|
||||
google,
|
||||
hoogle,
|
||||
imdb,
|
||||
maps,
|
||||
mathworld,
|
||||
scholar,
|
||||
thesaurus,
|
||||
wayback,
|
||||
wikipedia,
|
||||
youtube
|
||||
|
||||
-- * Use case: searching with a submap
|
||||
-- $tip
|
||||
-- * Use case: searching with a submap
|
||||
-- $tip
|
||||
|
||||
) where
|
||||
|
||||
import Data.Char (chr, ord, isAlpha, isMark, isDigit)
|
||||
import Numeric (showIntAtBase)
|
||||
import XMonad (X(), MonadIO)
|
||||
import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())
|
||||
import XMonad.Prompt.Shell (getShellCompl)
|
||||
import XMonad (X(), MonadIO, liftIO)
|
||||
import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletion)
|
||||
import XMonad.Prompt.Shell (getBrowser)
|
||||
import XMonad.Util.Run (safeSpawn)
|
||||
import XMonad.Util.XSelection (getSelection)
|
||||
|
||||
@@ -62,12 +67,16 @@ import XMonad.Util.XSelection (getSelection)
|
||||
want, the browser you want, and anything special they might need;
|
||||
this whole line is then bound to a key of you choosing in your
|
||||
xmonad.hs. For specific examples, see each function. This module
|
||||
is easily extended to new sites by using 'simpleEngine'.
|
||||
is easily extended to new sites by using 'searchEngine'.
|
||||
|
||||
The currently available search engines are:
|
||||
|
||||
* 'amazon' -- Amazon keyword search.
|
||||
|
||||
* 'codesearch' -- Google Labs Code Search search.
|
||||
|
||||
* 'dictionary' -- dictionary.reference.com search.
|
||||
|
||||
* 'google' -- basic Google search.
|
||||
|
||||
* 'hoogle' -- Hoogle, the Haskell libraries search engine.
|
||||
@@ -80,12 +89,15 @@ import XMonad.Util.XSelection (getSelection)
|
||||
|
||||
* 'scholar' -- Google scholar academic search.
|
||||
|
||||
* 'thesaurus' -- thesaurus.reference.com search.
|
||||
|
||||
* 'wayback' -- the Wayback Machine.
|
||||
|
||||
* 'wikipedia' -- basic Wikipedia search.
|
||||
|
||||
Feel free to add more!
|
||||
-}
|
||||
* 'youtube' -- Youtube video search.
|
||||
|
||||
Feel free to add more! -}
|
||||
|
||||
{- $tip
|
||||
|
||||
@@ -108,9 +120,9 @@ Then add the following to your key bindings:
|
||||
> ...
|
||||
>
|
||||
> searchEngineMap method = M.fromList $
|
||||
> [ ((0, xK_g), method \"firefox\" S.google)
|
||||
> , ((0, xK_h), method \"firefox\" S.hoogle)
|
||||
> , ((0, xK_w), method \"firefox\" S.wikipedia)
|
||||
> [ ((0, xK_g), method S.google)
|
||||
> , ((0, xK_h), method S.hoogle)
|
||||
> , ((0, xK_w), method S.wikipedia)
|
||||
> ]
|
||||
|
||||
Make sure to set firefox to open new pages in a new window instead of
|
||||
@@ -125,17 +137,16 @@ If you select something in whatever application and hit /mod-shift-s/ +
|
||||
/g/\//h/\//w/ it will search the selected string with the specified
|
||||
engine.
|
||||
|
||||
Happy searching!
|
||||
-}
|
||||
Happy searching! -}
|
||||
|
||||
-- A customized prompt.
|
||||
data Search = Search
|
||||
-- | A customized prompt indicating we are searching, and the name of the site.
|
||||
data Search = Search Name
|
||||
instance XPrompt Search where
|
||||
showXPrompt Search = "Search: "
|
||||
showXPrompt (Search name)= "Search [" ++ name ++ "]: "
|
||||
|
||||
-- | Escape the search string so search engines understand it.
|
||||
-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
|
||||
-- but then that'd be hard enough to copy-and-paste we'd need to depend on 'network'.
|
||||
-- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.
|
||||
escape :: String -> String
|
||||
escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
|
||||
where -- Copied from Network.URI.
|
||||
@@ -160,56 +171,77 @@ escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
|
||||
|
||||
type Browser = FilePath
|
||||
type Query = String
|
||||
type SearchEngine = String -> String
|
||||
type Site = String
|
||||
type Name = String
|
||||
data SearchEngine = SearchEngine Name Site
|
||||
|
||||
{- | Given a browser, a search engine, and a search term, perform the
|
||||
requested search in the browser. -}
|
||||
search :: MonadIO m => Browser -> SearchEngine -> Query -> m ()
|
||||
search browser site query = safeSpawn browser $ site query
|
||||
-- | Given a browser, a search engine, and a search term, perform the
|
||||
-- requested search in the browser.
|
||||
search :: Browser -> Site -> Query -> X ()
|
||||
search browser site query = safeSpawn browser (site ++ (escape query))
|
||||
|
||||
{- | Given a base URL, create the SearchEngine that escapes the query and
|
||||
appends it to the base. You can easily define a new engine locally using simpleEngine
|
||||
without needing to modify Search.hs:
|
||||
{- | Given a base URL, create the 'SearchEngine' that escapes the query and
|
||||
appends it to the base. You can easily define a new engine locally using
|
||||
exported functions without needing to modify "XMonad.Actions.Search":
|
||||
|
||||
> newEngine = simpleEngine "http://site.com/search="
|
||||
> myNewEngine = searchEngine "site" "http://site.com/search="
|
||||
|
||||
The important thing is that the site has a interface which accepts the query
|
||||
string as part of the URL. Alas, the exact URL to feed simpleEngine varies
|
||||
from site to site, often considerably. Generally, examining the resultant URL
|
||||
of a search will allow you to reverse-engineer it if you can't find the
|
||||
necessary URL already described in other projects such as Surfraw. -}
|
||||
simpleEngine :: Query -> SearchEngine
|
||||
simpleEngine site query = site ++ escape query
|
||||
The important thing is that the site has a interface which accepts the escaped query
|
||||
string as part of the URL. Alas, the exact URL to feed searchEngine varies
|
||||
from site to site, often considerably, so there's no general way to cover this.
|
||||
|
||||
Generally, examining the resultant URL of a search will allow you to reverse-engineer
|
||||
it if you can't find the necessary URL already described in other projects such as Surfraw. -}
|
||||
searchEngine :: Name -> Site -> SearchEngine
|
||||
searchEngine name site = SearchEngine name site
|
||||
|
||||
-- The engines.
|
||||
amazon, google, hoogle, imdb, maps, mathworld, scholar, wayback, wikipedia :: SearchEngine
|
||||
amazon = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
|
||||
google = simpleEngine "http://www.google.com/search?num=100&q="
|
||||
hoogle = simpleEngine "http://www.haskell.org/hoogle/?q="
|
||||
imdb = simpleEngine "http://www.imdb.com/Find?select=all&for="
|
||||
maps = simpleEngine "http://maps.google.com/maps?q="
|
||||
mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query="
|
||||
scholar = simpleEngine "http://scholar.google.com/scholar?q="
|
||||
wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
|
||||
wayback = simpleEngine "http://web.archive.org/"
|
||||
amazon, codesearch, dictionary, google, hoogle, imdb, maps, mathworld,
|
||||
scholar, thesaurus, wayback, wikipedia, youtube :: SearchEngine
|
||||
amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
|
||||
codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
|
||||
dictionary = searchEngine "dictionary" "http://dictionary.reference.com/browse/"
|
||||
google = searchEngine "google" "http://www.google.com/search?num=100&q="
|
||||
hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q="
|
||||
imdb = searchEngine "imdb" "http://www.imdb.com/Find?select=all&for="
|
||||
maps = searchEngine "maps" "http://maps.google.com/maps?q="
|
||||
mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query="
|
||||
scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q="
|
||||
thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q="
|
||||
wikipedia = searchEngine "wikipedia" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
|
||||
youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query="
|
||||
{- This doesn't seem to work, but nevertheless, it seems to be the official
|
||||
method at <http://web.archive.org/collections/web/advanced.html> to get the
|
||||
latest backup. -}
|
||||
wayback = searchEngine "wayback" "http://web.archive.org/"
|
||||
|
||||
{- | Like 'search', but for use with the output from a Prompt; it grabs the
|
||||
Prompt's result, passes it to a given searchEngine and opens it in a given
|
||||
browser. -}
|
||||
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
|
||||
promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletion) $ search browser site
|
||||
|
||||
{- | Like 'search', but in this case, the string is not specified but grabbed
|
||||
from the user's response to a prompt. Example:
|
||||
|
||||
> , ((modm, xK_g), promptSearch greenXPConfig "firefox" google)
|
||||
> , ((modm, xK_g), promptSearch greenXPConfig google)
|
||||
|
||||
-}
|
||||
promptSearch :: XPConfig -> Browser -> SearchEngine -> X ()
|
||||
promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site
|
||||
This specializes "promptSearchBrowser" by supplying the browser argument as
|
||||
supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
|
||||
promptSearch :: XPConfig -> SearchEngine -> X ()
|
||||
promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine
|
||||
|
||||
-- | Like 'search', but for use with the X selection; it grabs the selection,
|
||||
-- passes it to a given searchEngine and opens it in a given browser.
|
||||
selectSearchBrowser :: Browser -> SearchEngine -> X ()
|
||||
selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection
|
||||
|
||||
{- | Like 'search', but for use with the X selection; it grabs the selection,
|
||||
passes it to a given searchEngine and opens it in the given browser. Example:
|
||||
passes it to a given searchEngine and opens it in the default browser . Example:
|
||||
|
||||
> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google)
|
||||
> , ((modm .|. shiftMask, xK_g), selectSearch google)
|
||||
|
||||
-}
|
||||
selectSearch :: MonadIO m => Browser -> SearchEngine -> m ()
|
||||
selectSearch browser searchEngine = search browser searchEngine =<< getSelection
|
||||
This specializes "selectSearchBrowser" by supplying the browser argument as
|
||||
supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
|
||||
selectSearch :: SearchEngine -> X ()
|
||||
selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine
|
||||
|
@@ -17,10 +17,15 @@ module XMonad.Actions.SwapWorkspaces (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
swapWithCurrent,
|
||||
swapWorkspaces
|
||||
swapTo,
|
||||
swapWorkspaces,
|
||||
WSDirection(..)
|
||||
) where
|
||||
|
||||
import XMonad (windows, X())
|
||||
import XMonad.StackSet
|
||||
import XMonad.Actions.CycleWS
|
||||
import XMonad.Util.WorkspaceCompare
|
||||
|
||||
|
||||
-- $usage
|
||||
@@ -45,6 +50,11 @@ import XMonad.StackSet
|
||||
swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s
|
||||
|
||||
-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
|
||||
-- This is an @X ()@ so can be hooked up to your keybindings directly.
|
||||
swapTo :: WSDirection -> X ()
|
||||
swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
|
||||
|
||||
-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
|
||||
-- one with the two corresponding workspaces' tags swapped.
|
||||
swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
|
@@ -25,6 +25,7 @@ module XMonad.Actions.UpdatePointer
|
||||
|
||||
import XMonad
|
||||
import Control.Monad
|
||||
import XMonad.StackSet (member)
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
@@ -45,22 +46,26 @@ import Control.Monad
|
||||
-- To use this with an existing logHook, use >> :
|
||||
--
|
||||
-- > logHook = dynamicLog
|
||||
-- > >> updatePointer (RelativePosition 1 1)
|
||||
-- > >> updatePointer (Relative 1 1)
|
||||
--
|
||||
-- which moves the pointer to the bottom-right corner of the focused window.
|
||||
|
||||
data PointerPosition = Nearest | Relative Rational Rational
|
||||
|
||||
-- | Update the pointer's location to the currently focused
|
||||
-- window unless it's already there
|
||||
-- window unless it's already there, or unless the user was changing
|
||||
-- focus with the mouse
|
||||
updatePointer :: PointerPosition -> X ()
|
||||
updatePointer p = withFocused $ \w -> do
|
||||
ws <- gets windowset
|
||||
dpy <- asks display
|
||||
root <- asks theRoot
|
||||
mouseIsMoving <- asks mouseFocused
|
||||
wa <- io $ getWindowAttributes dpy w
|
||||
(_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root
|
||||
-- Can sameRoot ever be false in this case? I'm going to assume not
|
||||
unless (w == w') $
|
||||
(_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
|
||||
unless (pointWithinRegion rootx rooty (wa_x wa) (wa_y wa) (wa_width wa) (wa_height wa)
|
||||
|| mouseIsMoving
|
||||
|| not (currentWindow `member` ws)) $
|
||||
case p of
|
||||
Nearest -> do
|
||||
let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width wa))
|
||||
@@ -79,3 +84,9 @@ moveWithin current lower upper =
|
||||
then upper
|
||||
else current
|
||||
|
||||
-- Test that a point resides within a region.
|
||||
-- This belongs somewhere more generally accessible than this module.
|
||||
pointWithinRegion :: Integral a => a -> a -> a -> a -> a -> a -> Bool
|
||||
pointWithinRegion px py rx ry rw rh =
|
||||
within px rx (rx + rw) && within py ry (ry + rh)
|
||||
where within x left right = x >= left && x <= right
|
||||
|
@@ -15,6 +15,8 @@
|
||||
module XMonad.Actions.Warp (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
banish,
|
||||
Corner(..),
|
||||
warpToScreen,
|
||||
warpToWindow
|
||||
) where
|
||||
@@ -39,19 +41,31 @@ then add appropriate keybindings to warp the pointer; for example:
|
||||
> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
|
||||
|
||||
Note that warping to a particular screen may change the focus.
|
||||
|
||||
'warpToScreen' and 'warpToWindow' can be used in a variety of
|
||||
ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
|
||||
which moves the mouse pointer to a corner; you could define:
|
||||
|
||||
> banish :: X ()
|
||||
> banish = warpToWindow 1 1 -- lower left
|
||||
|
||||
-}
|
||||
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
|
||||
data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight
|
||||
|
||||
{- | Move the mouse cursor to a corner of the screen. Useful for
|
||||
uncluttering things.
|
||||
|
||||
Internally, this uses numerical parameters. We parametrize on the 'Corner'
|
||||
type so the user need not see the violence inherent in
|
||||
the system.
|
||||
|
||||
'warpToScreen' and 'warpToWindow' can be used in a variety of
|
||||
ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
|
||||
which moves the mouse pointer to a corner? warpToWindow can do that! -}
|
||||
banish :: Corner -> X ()
|
||||
banish direction = case direction of
|
||||
LowerRight -> warpToWindow 1 1
|
||||
LowerLeft -> warpToWindow 0 1
|
||||
UpperLeft -> warpToWindow 0 0
|
||||
UpperRight -> warpToWindow 1 0
|
||||
|
||||
fraction :: (Integral a, Integral b) => Rational -> a -> b
|
||||
fraction f x = floor (f * fromIntegral x)
|
||||
|
||||
|
@@ -17,7 +17,8 @@
|
||||
module XMonad.Actions.WindowBringer (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
gotoMenu, bringMenu, windowMapWith
|
||||
gotoMenu, bringMenu, windowMap,
|
||||
bringWindow
|
||||
) where
|
||||
|
||||
import Data.Char (toLower)
|
||||
@@ -47,29 +48,29 @@ import XMonad.Util.NamedWindows (getName)
|
||||
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
||||
-- taken to the corresponding workspace.
|
||||
gotoMenu :: X ()
|
||||
gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView)
|
||||
where workspaceMap = windowMapWith (W.tag . fst)
|
||||
gotoMenu = actionMenu W.focusWindow
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and it will be
|
||||
-- dragged, kicking and screaming, into your current workspace.
|
||||
bringMenu :: X ()
|
||||
bringMenu = windowMap >>= actionMenu (windows . bringWindow)
|
||||
where windowMap = windowMapWith snd
|
||||
bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
|
||||
bringMenu = actionMenu bringWindow
|
||||
|
||||
-- | Calls dmenuMap to grab the appropriate element from the Map, and hands it
|
||||
-- off to action if found.
|
||||
actionMenu :: (a -> X ()) -> M.Map String a -> X ()
|
||||
actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action
|
||||
-- | Brings the specified window into the current workspace.
|
||||
bringWindow :: Window -> X.WindowSet -> X.WindowSet
|
||||
bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
|
||||
|
||||
-- | Generates a Map from window name to \<whatever you specify\>. For
|
||||
-- use with dmenuMap.
|
||||
windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a)
|
||||
windowMapWith value = do -- TODO: extract the pure, creamy center.
|
||||
-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
|
||||
-- if found.
|
||||
actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()
|
||||
actionMenu action = windowMap >>= dmenuMap >>= flip X.whenJust (windows . action)
|
||||
|
||||
-- | A map from window names to Windows.
|
||||
windowMap :: X (M.Map String Window)
|
||||
windowMap = do
|
||||
ws <- gets X.windowset
|
||||
M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
|
||||
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
|
||||
keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w
|
||||
keyValuePair ws w = flip (,) w `fmap` decorateName ws w
|
||||
|
||||
-- | Returns the window name as will be listed in dmenu.
|
||||
-- Lowercased, for your convenience (since dmenu is case-sensitive).
|
||||
|
@@ -10,22 +10,30 @@ Defines a few convenient operations for raising (traveling to) windows based on
|
||||
monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can
|
||||
find a specified window; you would use this to automatically travel to your
|
||||
Firefox or Emacs session, or start a new one (for example), instead of trying to
|
||||
remember where you left it or whether you still have one running.
|
||||
-}
|
||||
remember where you left it or whether you still have one running. -}
|
||||
|
||||
module XMonad.Actions.WindowGo (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
raise,
|
||||
raiseNext,
|
||||
runOrRaise,
|
||||
runOrRaiseNext,
|
||||
raiseMaybe,
|
||||
raiseNextMaybe,
|
||||
|
||||
raiseBrowser,
|
||||
raiseEditor,
|
||||
module XMonad.ManageHook
|
||||
) where
|
||||
|
||||
import XMonad (Query(), X(), withWindowSet, spawn, runQuery, focus)
|
||||
import Control.Monad (filterM)
|
||||
import qualified XMonad.StackSet as W (allWindows)
|
||||
import Data.Char (toLower)
|
||||
|
||||
import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO, focus)
|
||||
import XMonad.ManageHook
|
||||
import XMonad.Prompt.Shell (getBrowser, getEditor)
|
||||
import qualified XMonad.StackSet as W (allWindows, peek)
|
||||
|
||||
{- $usage
|
||||
|
||||
@@ -38,12 +46,15 @@ and define appropriate key bindings:
|
||||
> , ((modMask x .|. shiftMask, xK_g), raise (className =? "Firefox"))
|
||||
> , ((modMask x .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox"))
|
||||
|
||||
(Note that Firefox v3 and up have a class-name of "Firefox" and "Navigator";
|
||||
lower versions use other classnames such as "Firefox-bin"
|
||||
(Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\";
|
||||
lower versions use other classnames such as \"Firefox-bin\". Either choose the
|
||||
appropriate one, or cover your bases by using instead something like
|
||||
@(className =? \"Firefox\" <||> className =? \"Firefox-bin\")@.)
|
||||
|
||||
For detailed instructions on editing your key bindings, see
|
||||
"XMonad.Doc.Extending#Editing_key_bindings". -}
|
||||
|
||||
-- | 'action' is an executable to be run via 'spawn' if the Window cannot be found.
|
||||
-- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") if the Window cannot be found.
|
||||
-- Presumably this executable is the same one that you were looking for.
|
||||
runOrRaise :: String -> Query Bool -> X ()
|
||||
runOrRaise action = raiseMaybe $ spawn action
|
||||
@@ -54,27 +65,27 @@ raise = raiseMaybe $ return ()
|
||||
|
||||
{- | 'raiseMaybe' queries all Windows based on a boolean provided by the
|
||||
user. Currently, there are three such useful booleans defined in
|
||||
XMonad.ManageHook: title, resource, className. Each one tests based pretty
|
||||
"XMonad.ManageHook": title, resource, className. Each one tests based pretty
|
||||
much as you would think. ManageHook also defines several operators, the most
|
||||
useful of which is (=?). So a useful test might be finding a Window whose
|
||||
class is Firefox. Firefox declares the class "Firefox", so you'd want to
|
||||
pass in a boolean like '(className =? "Firefox")'.
|
||||
class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to
|
||||
pass in a boolean like @(className =? \"Firefox\")@.
|
||||
|
||||
If the boolean returns True on one or more windows, then XMonad will quickly
|
||||
make visible the first result. If no Window meets the criteria, then the
|
||||
If the boolean returns @True@ on one or more windows, then XMonad will quickly
|
||||
make visible the first result. If no @Window@ meets the criteria, then the
|
||||
first argument comes into play.
|
||||
|
||||
The first argument is an arbitrary IO function which will be executed if the
|
||||
tests fail. This is what enables runOrRaise to use raiseMaybe: it simply runs
|
||||
tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs
|
||||
the desired program if it isn't found. But you don't have to do that. Maybe
|
||||
you want to do nothing if the search fails (the definition of 'raise'), or
|
||||
maybe you want to write to a log file, or call some prompt function, or
|
||||
something crazy like that. This hook gives you that flexibility. You can do
|
||||
some cute things with this hook. Suppose you want to do the same thing for
|
||||
Mutt which you just did for Firefox - but Mutt runs inside a terminal window?
|
||||
No problem: you search for a terminal window calling itself 'mutt', and if
|
||||
No problem: you search for a terminal window calling itself \"mutt\", and if
|
||||
there isn't you run a terminal with a command to run Mutt! Here's an example
|
||||
(borrowing "XMonad.Utils.Run"'s 'runInTerm'):
|
||||
(borrowing 'runInTerm' from "XMonad.Utils.Run"):
|
||||
|
||||
> , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
|
||||
-}
|
||||
@@ -84,3 +95,42 @@ raiseMaybe f thatUserQuery = withWindowSet $ \s -> do
|
||||
case maybeResult of
|
||||
[] -> f
|
||||
(x:_) -> focus x
|
||||
|
||||
-- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches.
|
||||
runOrRaiseNext :: String -> Query Bool -> X ()
|
||||
runOrRaiseNext action = raiseNextMaybe $ spawn action
|
||||
|
||||
-- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches.
|
||||
raiseNext :: Query Bool -> X ()
|
||||
raiseNext = raiseNextMaybe $ return ()
|
||||
|
||||
{- | See 'raiseMaybe'.
|
||||
'raiseNextMaybe' is an alternative version that allows cycling
|
||||
through the matching windows. If the focused window matches the
|
||||
query the next matching window is raised. If no matches are found
|
||||
the function f is executed.
|
||||
-}
|
||||
raiseNextMaybe :: X () -> Query Bool -> X ()
|
||||
raiseNextMaybe f thatUserQuery = withWindowSet $ \s -> do
|
||||
ws <- filterM (runQuery thatUserQuery) (W.allWindows s)
|
||||
case ws of
|
||||
[] -> f
|
||||
(x:_) -> let go (Just w) | (w `elem` ws) = next w $ cycle ws
|
||||
go _ = focus x
|
||||
in go $ W.peek s
|
||||
where
|
||||
next w (x:y:_) | x==w = focus y
|
||||
next w (_:xs) = next w xs
|
||||
next _ _ = error "raiseNextMaybe: empty list"
|
||||
|
||||
-- | Given a function which gets us a String, we try to raise a window with that classname,
|
||||
-- or we then interpret that String as a executable name.
|
||||
raiseVar :: IO String -> X ()
|
||||
raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var)
|
||||
|
||||
{- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either
|
||||
take you to the specified program's window, or they try to run it. This is most useful
|
||||
if your variables are simple and look like 'firefox' or 'emacs'. -}
|
||||
raiseBrowser, raiseEditor :: X ()
|
||||
raiseBrowser = raiseVar getBrowser
|
||||
raiseEditor = raiseVar getEditor
|
||||
|
214
XMonad/Actions/WindowNavigation.hs
Normal file
214
XMonad/Actions/WindowNavigation.hs
Normal file
@@ -0,0 +1,214 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.WindowNavigation
|
||||
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>,
|
||||
-- Devin Mullins <me@twifkak.com>
|
||||
-- Maintainer : Devin Mullins <me@twifkak.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- This is a rewrite of "XMonad.Layout.WindowNavigation". WindowNavigation
|
||||
-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian
|
||||
-- window coordinates, rather than just going j\/k on the stack.
|
||||
--
|
||||
-- This module is experimental. You'll have better luck with the original.
|
||||
--
|
||||
-- This module differs from the other in a few ways:
|
||||
--
|
||||
-- (1) You can go up\/down\/left\/right across multiple screens.
|
||||
--
|
||||
-- (2) It doesn't provide little border colors for your neighboring windows.
|
||||
--
|
||||
-- (3) It doesn't provide the \'Move\' action, which seems to be related to
|
||||
-- the XMonad.Layout.Combo extension.
|
||||
--
|
||||
-- (4) It tries to be slightly smarter about tracking your current position.
|
||||
--
|
||||
-- (5) Configuration is different.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.WindowNavigation (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
withWindowNavigation,
|
||||
withWindowNavigationKeys,
|
||||
WNAction(..),
|
||||
go, swap,
|
||||
Direction(..)
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Hooks.ManageDocks (Direction(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Arrow (second)
|
||||
import Data.IORef
|
||||
import Data.List (sortBy)
|
||||
import Data.Map (Map())
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.Set as S
|
||||
import Graphics.X11.Xlib
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- To use it, you're going to apply the 'withWindowNavigation' function.
|
||||
-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use
|
||||
-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog".
|
||||
-- In particular:
|
||||
--
|
||||
-- > main = do
|
||||
-- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
|
||||
-- > $ defaultConfig { ... }
|
||||
-- > xmonad config
|
||||
--
|
||||
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
|
||||
-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
|
||||
-- to swap windows.
|
||||
--
|
||||
-- If you want more flexibility over your keybindings, you can use
|
||||
-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather
|
||||
-- than a tuple of the four directional keys. See the source code of
|
||||
-- 'withWindowNavigation' for an example.
|
||||
|
||||
-- TODO:
|
||||
-- - monad for WNState?
|
||||
-- - cleanup (including inr)
|
||||
-- - more documentation
|
||||
-- - tests? (esp. for edge cases in currentPosition)
|
||||
-- - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2
|
||||
-- - solve the 2+3, middle right to bottom left problem
|
||||
-- - command to iteratively swapUp/swapDown instead of directly swapping with target
|
||||
-- - manageHook to draw window decos?
|
||||
|
||||
withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
|
||||
withWindowNavigation (u,l,d,r) conf =
|
||||
withWindowNavigationKeys [ ((modMask conf , u), WNGo U),
|
||||
((modMask conf , l), WNGo L),
|
||||
((modMask conf , d), WNGo D),
|
||||
((modMask conf , r), WNGo R),
|
||||
((modMask conf .|. shiftMask, u), WNSwap U),
|
||||
((modMask conf .|. shiftMask, l), WNSwap L),
|
||||
((modMask conf .|. shiftMask, d), WNSwap D),
|
||||
((modMask conf .|. shiftMask, r), WNSwap R) ]
|
||||
conf
|
||||
|
||||
withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
|
||||
withWindowNavigationKeys wnKeys conf = do
|
||||
posRef <- newIORef M.empty
|
||||
return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
|
||||
`M.union` keys conf cnf,
|
||||
logHook = logHook conf >> trackMovement posRef }
|
||||
where fromWNAction posRef (WNGo dir) = go posRef dir
|
||||
fromWNAction posRef (WNSwap dir) = swap posRef dir
|
||||
|
||||
data WNAction = WNGo Direction | WNSwap Direction
|
||||
|
||||
type WNState = Map WorkspaceId Point
|
||||
|
||||
-- go:
|
||||
-- 1. get current position, verifying it matches the current window
|
||||
-- 2. get target windowrect
|
||||
-- 3. focus window
|
||||
-- 4. set new position
|
||||
go :: IORef WNState -> Direction -> X ()
|
||||
go = withTargetWindow W.focusWindow
|
||||
|
||||
swap :: IORef WNState -> Direction -> X ()
|
||||
swap = withTargetWindow swapWithFocused
|
||||
where swapWithFocused targetWin winSet =
|
||||
case W.peek winSet of
|
||||
Just currentWin -> W.focusWindow currentWin $
|
||||
mapWindows (swapWin currentWin targetWin) winSet
|
||||
Nothing -> winSet
|
||||
mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
|
||||
mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
|
||||
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
|
||||
swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
|
||||
|
||||
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X ()
|
||||
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
||||
targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
|
||||
whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
|
||||
windows (adj targetWin)
|
||||
setPosition posRef pos targetRect
|
||||
|
||||
trackMovement :: IORef WNState -> X ()
|
||||
trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
|
||||
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
|
||||
|
||||
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
|
||||
fromCurrentPoint posRef f = withFocused $ \win -> do
|
||||
currentPosition posRef >>= f win
|
||||
|
||||
-- Gets the current position from the IORef passed in, or if nothing (say, from
|
||||
-- a restart), derives the current position from the current window. Also,
|
||||
-- verifies that the position is congruent with the current window (say, if you
|
||||
-- used mod-j/k or mouse or something).
|
||||
currentPosition :: IORef WNState -> X Point
|
||||
currentPosition posRef = do
|
||||
root <- asks theRoot
|
||||
currentWindow <- gets (W.peek . windowset)
|
||||
currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
|
||||
|
||||
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
||||
mp <- M.lookup wsid <$> io (readIORef posRef)
|
||||
|
||||
return $ maybe (middleOf currentRect) (`inside` currentRect) mp
|
||||
|
||||
where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
|
||||
|
||||
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
|
||||
setPosition posRef oldPos newRect = do
|
||||
wsid <- gets (W.tag . W.workspace . W.current . windowset)
|
||||
io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
|
||||
|
||||
inside :: Point -> Rectangle -> Point
|
||||
Point x y `inside` Rectangle rx ry rw rh =
|
||||
Point (x `within` (rx, rw)) (y `within` (ry, rh))
|
||||
where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
|
||||
then pos
|
||||
else midPoint lower dim
|
||||
|
||||
midPoint :: Position -> Dimension -> Position
|
||||
midPoint pos dim = pos + fromIntegral dim `div` 2
|
||||
|
||||
navigableTargets :: Point -> Direction -> X [(Window, Rectangle)]
|
||||
navigableTargets point dir = navigable dir point <$> windowRects
|
||||
|
||||
-- Filters and sorts the windows in terms of what is closest from the Point in
|
||||
-- the Direction.
|
||||
navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
|
||||
navigable d pt = sortby d . filter (inr d pt . snd)
|
||||
|
||||
-- Produces a list of normal-state windows, on any screen. Rectangles are
|
||||
-- adjusted based on screen position relative to the current screen, because I'm
|
||||
-- bad like that.
|
||||
windowRects :: X [(Window, Rectangle)]
|
||||
windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
|
||||
|
||||
windowRect :: Window -> X (Maybe (Window, Rectangle))
|
||||
windowRect win = withDisplay $ \dpy -> do
|
||||
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
|
||||
return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
|
||||
`catchX` return Nothing
|
||||
|
||||
-- Modified from droundy's implementation of WindowNavigation:
|
||||
|
||||
inr :: Direction -> Point -> Rectangle -> Bool
|
||||
inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
|
||||
py < ry + fromIntegral h
|
||||
inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
|
||||
py > ry
|
||||
inr R (Point px py) (Rectangle rx ry _ h) = px < rx &&
|
||||
py >= ry && py < ry + fromIntegral h
|
||||
inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w &&
|
||||
py >= ry && py < ry + fromIntegral h
|
||||
|
||||
sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)]
|
||||
sortby D = sortBy $ comparing (rect_y . snd)
|
||||
sortby R = sortBy $ comparing (rect_x . snd)
|
||||
sortby U = reverse . sortby D
|
||||
sortby L = reverse . sortby R
|
@@ -20,13 +20,12 @@ module XMonad.Config.Arossato
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import System.IO (hPutStrLn)
|
||||
|
||||
import XMonad hiding ( (|||) )
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Actions.CycleWS
|
||||
import XMonad.Hooks.DynamicLog
|
||||
import XMonad.Hooks.DynamicLog hiding (xmobar)
|
||||
import XMonad.Hooks.ManageDocks
|
||||
import XMonad.Hooks.ServerMode
|
||||
import XMonad.Layout.Accordion
|
||||
|
37
XMonad/Config/Desktop.hs
Normal file
37
XMonad/Config/Desktop.hs
Normal file
@@ -0,0 +1,37 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Desktop
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
--
|
||||
-- This module provides a config suitable for use with a desktop
|
||||
-- environment such as KDE or GNOME.
|
||||
|
||||
module XMonad.Config.Desktop (
|
||||
-- * Usage
|
||||
-- -- $usage
|
||||
desktopConfig,
|
||||
desktopLayoutModifiers
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Config (defaultConfig)
|
||||
import XMonad.Hooks.ManageDocks
|
||||
import XMonad.Hooks.EwmhDesktops
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
desktopConfig = defaultConfig
|
||||
{ logHook = ewmhDesktopsLogHook
|
||||
, layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks
|
||||
, keys = \c -> desktopKeys c `M.union` keys defaultConfig c }
|
||||
|
||||
desktopKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
||||
|
||||
desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout
|
@@ -1,28 +0,0 @@
|
||||
--------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Dons
|
||||
-- Copyright : (c) Galois, Inc. 2007
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer: Don Stewart <dons@galois.com>
|
||||
--
|
||||
-- An example, simple configuration file.
|
||||
--
|
||||
--------------------------------------------------------------------
|
||||
|
||||
module XMonad.Config.Dons where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Hooks.DynamicLog
|
||||
import XMonad.Layout.NoBorders
|
||||
|
||||
donsMain :: IO ()
|
||||
donsMain = dzen $ \x -> xmonad $ x
|
||||
{ terminal = "term"
|
||||
, normalBorderColor = "#333333"
|
||||
, focusedBorderColor = "red"
|
||||
, layoutHook = smartBorders (layoutHook x)
|
||||
, manageHook =
|
||||
manageHook x <+>
|
||||
(className =? "Toplevel" --> doFloat)
|
||||
}
|
@@ -21,15 +21,16 @@ import XMonad.Layout.Tabbed ( tabbed, defaultTheme,
|
||||
import XMonad.Layout.Combo ( combineTwo )
|
||||
import XMonad.Layout.Named ( named )
|
||||
import XMonad.Layout.LayoutCombinators
|
||||
import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
import XMonad.Layout.Square ( Square(Square) )
|
||||
import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L),
|
||||
windowNavigation )
|
||||
import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,
|
||||
focusUp, focusDown )
|
||||
import XMonad.Layout.NoBorders ( smartBorders )
|
||||
import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )
|
||||
import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
|
||||
import XMonad.Layout.ShowWName ( showWName )
|
||||
import XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace )
|
||||
import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
|
||||
|
||||
import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )
|
||||
import XMonad.Prompt.Layout ( layoutPrompt )
|
||||
@@ -62,13 +63,13 @@ keys x = M.fromList $
|
||||
-- launching and killing programs
|
||||
[ ((modMask x .|. shiftMask, xK_c ), kill1) -- %! Close the focused window
|
||||
|
||||
, ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
|
||||
, ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default
|
||||
, ((modMask x .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
|
||||
, ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default
|
||||
|
||||
-- move focus up or down the window stack
|
||||
, ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window
|
||||
, ((modMask x, xK_j ), windows W.focusDown) -- %! Move focus to the next window
|
||||
, ((modMask x, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window
|
||||
, ((modMask x, xK_Tab ), focusDown) -- %! Move focus to the next window
|
||||
, ((modMask x, xK_j ), focusDown) -- %! Move focus to the next window
|
||||
, ((modMask x, xK_k ), focusUp ) -- %! Move focus to the previous window
|
||||
|
||||
, ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window
|
||||
, ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window
|
||||
@@ -98,6 +99,8 @@ keys x = M.fromList $
|
||||
, ((0, xK_F2 ), spawn "gnome-terminal") -- %! Launch gnome-terminal
|
||||
, ((0, xK_F3 ), shellPrompt myXPConfig) -- %! Launch program
|
||||
, ((0, xK_F11 ), spawn "ksnapshot") -- %! Take snapshot
|
||||
, ((modMask x .|. shiftMask, xK_b ), markBoring)
|
||||
, ((controlMask .|. modMask x .|. shiftMask, xK_b ), clearBoring)
|
||||
, ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig)
|
||||
, ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)
|
||||
, ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig)
|
||||
@@ -106,8 +109,7 @@ keys x = M.fromList $
|
||||
, ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)
|
||||
, ((modMask x, xK_l ), layoutPrompt myXPConfig)
|
||||
, ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
|
||||
, ((modMask x .|. controlMask .|. shiftMask, xK_space),
|
||||
toggleScratchWorkspace (Simplest */* Simplest) )
|
||||
, ((modMask x, xK_space), sendMessage Toggle)
|
||||
|
||||
]
|
||||
|
||||
@@ -120,8 +122,8 @@ config = defaultConfig
|
||||
{ borderWidth = 1 -- Width of the window border in pixels.
|
||||
, XMonad.workspaces = ["mutt","iceweasel"]
|
||||
, layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $
|
||||
smartBorders $ windowNavigation $
|
||||
toggleLayouts Full $ avoidStruts $
|
||||
boringWindows $ smartBorders $ windowNavigation $
|
||||
maximizeVertical $ toggleLayouts Full $ avoidStruts $
|
||||
named "tabbed" mytab |||
|
||||
named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
|
||||
named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
|
||||
@@ -131,7 +133,7 @@ config = defaultConfig
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
|
||||
, logHook = ewmhDesktopsLogHook -- actually, no logging here, just other stuff
|
||||
, terminal = "xterm" -- The preferred terminal program.
|
||||
, normalBorderColor = "#dddddd" -- Border color for unfocused windows.
|
||||
, normalBorderColor = "#222222" -- Border color for unfocused windows.
|
||||
, focusedBorderColor = "#00ff00" -- Border color for focused windows.
|
||||
, XMonad.modMask = mod1Mask
|
||||
, XMonad.keys = keys
|
||||
|
55
XMonad/Config/Gnome.hs
Normal file
55
XMonad/Config/Gnome.hs
Normal file
@@ -0,0 +1,55 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Gnome
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
--
|
||||
-- This module provides a config suitable for use with the GNOME desktop
|
||||
-- environment.
|
||||
|
||||
module XMonad.Config.Gnome (
|
||||
-- * Usage
|
||||
-- -- $usage
|
||||
gnomeConfig,
|
||||
gnomeRun
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Config.Desktop
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- $usage
|
||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.Gnome
|
||||
-- >
|
||||
-- > main = xmonad gnomeConfig
|
||||
--
|
||||
|
||||
gnomeConfig = desktopConfig
|
||||
{ terminal = "gnome-terminal"
|
||||
, keys = \c -> gnomeKeys c `M.union` keys desktopConfig c }
|
||||
|
||||
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_p), gnomeRun)
|
||||
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
|
||||
|
||||
-- | Launch the "Run Application" dialog. gnome-panel must be running for this
|
||||
-- to work.
|
||||
gnomeRun :: X ()
|
||||
gnomeRun = withDisplay $ \dpy -> do
|
||||
rw <- asks theRoot
|
||||
gnome_panel <- getAtom "_GNOME_PANEL_ACTION"
|
||||
panel_run <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG"
|
||||
|
||||
io $ allocaXEvent $ \e -> do
|
||||
setEventType e clientMessage
|
||||
setClientMessageEvent e rw gnome_panel 32 panel_run 0
|
||||
sendEvent dpy rw False structureNotifyMask e
|
||||
sync dpy False
|
41
XMonad/Config/Kde.hs
Normal file
41
XMonad/Config/Kde.hs
Normal file
@@ -0,0 +1,41 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Kde
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
--
|
||||
-- This module provides a config suitable for use with the KDE desktop
|
||||
-- environment.
|
||||
|
||||
module XMonad.Config.Kde (
|
||||
-- * Usage
|
||||
-- -- $usage
|
||||
kdeConfig
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Config.Desktop
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- $usage
|
||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.Kde
|
||||
-- >
|
||||
-- > main = xmonad kdeConfig
|
||||
--
|
||||
|
||||
kdeConfig = desktopConfig
|
||||
{ terminal = "konsole"
|
||||
, keys = \c -> kdeKeys c `M.union` keys desktopConfig c }
|
||||
|
||||
kdeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
|
||||
]
|
528
XMonad/Config/PlainConfig.hs
Normal file
528
XMonad/Config/PlainConfig.hs
Normal file
@@ -0,0 +1,528 @@
|
||||
{-# LANGUAGE
|
||||
FlexibleInstances,
|
||||
FlexibleContexts,
|
||||
MultiParamTypeClasses,
|
||||
ExistentialQuantification
|
||||
#-}
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.PlainConfig
|
||||
-- Copyright : Braden Shepherdson <Braden.Shepherdson@gmail.com>
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : Braden Shepherdson <Braden.Shepherdson@gmail.com>
|
||||
--
|
||||
-- Proof-of-concept (but usable) plain-text configuration file
|
||||
-- parser, for use instead of xmonad.hs. Does not require recompilation,
|
||||
-- allowing xmonad to be free of the GHC dependency.
|
||||
--
|
||||
-------------------------------------------------------------------------
|
||||
|
||||
|
||||
module XMonad.Config.PlainConfig
|
||||
(
|
||||
-- * Introduction
|
||||
-- $usage
|
||||
|
||||
-- * Supported Layouts
|
||||
-- $layouts
|
||||
|
||||
-- * Support Key Bindings
|
||||
-- $keys
|
||||
|
||||
-- * Other Notes
|
||||
-- $notes
|
||||
|
||||
-- * Example Config File
|
||||
-- $example
|
||||
|
||||
plainConfig ,readConfig, checkConfig
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import XMonad
|
||||
import System.Exit
|
||||
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified Data.Map as M
|
||||
import Data.List
|
||||
import Data.Maybe (isJust,fromJust)
|
||||
import Data.Char (isSpace)
|
||||
|
||||
|
||||
--import Control.Monad
|
||||
import Control.Monad.Error
|
||||
import Control.Monad.Identity
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
|
||||
import Text.ParserCombinators.ReadP
|
||||
|
||||
import System.IO
|
||||
import Control.Exception (bracket)
|
||||
|
||||
import XMonad.Util.EZConfig (mkKeymap)
|
||||
|
||||
|
||||
|
||||
-- $usage
|
||||
-- The @xmonad.hs@ file is very minimal when used with PlainConfig.
|
||||
-- It typically contains only the following:
|
||||
--
|
||||
-- > module Main where
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.PlainConfig (plainConfig)
|
||||
-- > main = plainConfig
|
||||
--
|
||||
-- The 'plainConfig' function parses @~\/.xmonad\/xmonad.conf@,
|
||||
-- the format of which is described below.
|
||||
|
||||
|
||||
-- $layouts
|
||||
-- Only 'Tall', 'Wide' and 'Full' are supported at present.
|
||||
|
||||
|
||||
|
||||
-- $keys
|
||||
--
|
||||
-- Key bindings are specified as a pair of an arbitrary EZConfig and
|
||||
-- one of the following:
|
||||
--
|
||||
-- @ Name Haskell equivalent Default binding(s)@
|
||||
--
|
||||
-- * @spawn \<cmd\> spawn \"\<cmd\>\" none@
|
||||
--
|
||||
-- * @kill kill M-S-c@
|
||||
--
|
||||
-- * @nextLayout sendMessage NextLayout M-\<Space\>@
|
||||
--
|
||||
-- * @refresh refresh M-S-\<Space\>@
|
||||
--
|
||||
-- * @focusDown windows W.focusDown M-\<Tab\>, M-j@
|
||||
--
|
||||
-- * @focusUp windows W.focusUp M-k@
|
||||
--
|
||||
-- * @focusMaster windows W.focusMaster M-m@
|
||||
--
|
||||
-- * @swapDown windows W.swapDown M-S-j@
|
||||
--
|
||||
-- * @swapUp windows W.swapUp M-S-k@
|
||||
--
|
||||
-- * @swapMaster windows W.swapMaster M-\<Return\>@
|
||||
--
|
||||
-- * @shrink sendMessage Shrink M-h@
|
||||
--
|
||||
-- * @expand sendMessage Expand M-l@
|
||||
--
|
||||
-- * @sink withFocused $ windows . W.sink M-t@
|
||||
--
|
||||
-- * @incMaster sendMessage (IncMasterN 1) M-,@
|
||||
--
|
||||
-- * @decMaster sendMessage (IncMasterN (-1)) M-.@
|
||||
--
|
||||
-- * @quit io $ exitWith ExitSuccess M-S-q@
|
||||
--
|
||||
-- * @restart broadcastMessageReleaseResources >> restart \"xmonad\" True M-q@
|
||||
--
|
||||
|
||||
|
||||
-- $notes
|
||||
-- Submaps are allowed.
|
||||
-- These settings override the defaults. Changes made here will be used over
|
||||
-- the default bindings for those keys.
|
||||
|
||||
|
||||
-- $example
|
||||
-- An example @~\/.xmonad\/xmonad.conf@ file follows:
|
||||
--
|
||||
-- @modMask = 3@
|
||||
--
|
||||
-- @numlockMask = 2@
|
||||
--
|
||||
-- @borderWidth = 1@
|
||||
--
|
||||
-- @normalBorderColor = #dddddd@
|
||||
--
|
||||
-- @focusedBorderColor = #00ff00@
|
||||
--
|
||||
-- @terminal=urxvt@
|
||||
--
|
||||
-- @workspaces=[\"1: IRC\",\"2: Web\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\"]@
|
||||
--
|
||||
-- @focusFollowsMouse=True@
|
||||
--
|
||||
-- @layouts=[\"Tall\",\"Full\",\"Wide\"]@
|
||||
--
|
||||
-- @key=(\"M-x t\", \"spawn xmessage Test\")@
|
||||
--
|
||||
-- @manageHook=(ClassName \"MPlayer\" , \"float\" )@
|
||||
--
|
||||
-- @manageHook=(ClassName \"Gimp\" , \"float\" )@
|
||||
--
|
||||
-- @manageHook=(Resource \"desktop_window\", \"ignore\" )@
|
||||
--
|
||||
-- @manageHook=(Resource \"kdesktop\" , \"ignore\" )@
|
||||
--
|
||||
-- @manageHook=(Resource \"gnome-panel\" , \"ignore\" )@
|
||||
--
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------------------------------
|
||||
------ Several functions for parsing the key-value file. -------
|
||||
----------------------------------------------------------------
|
||||
|
||||
parseKVBy :: Char -> ReadP (String,String)
|
||||
parseKVBy sep = do
|
||||
skipSpaces
|
||||
k <- munch1 (\x -> x /= ' ' && x /= sep)
|
||||
skipSpaces
|
||||
char kvSep
|
||||
skipSpaces
|
||||
v <- munch1 (\x -> x /= ' ') --or EOS
|
||||
return (k,v)
|
||||
|
||||
parseKVVBy :: Char -> ReadP (String,String)
|
||||
parseKVVBy sep = do
|
||||
skipSpaces
|
||||
k <- munch1 (\x -> x /= ' ' && x /= sep)
|
||||
skipSpaces
|
||||
char kvSep
|
||||
skipSpaces
|
||||
v <- munch1 (const True) -- until EOS
|
||||
return (k,v)
|
||||
|
||||
|
||||
kvSep :: Char
|
||||
kvSep = '='
|
||||
|
||||
parseKV, parseKVV :: ReadP (String,String)
|
||||
parseKV = parseKVBy kvSep
|
||||
parseKVV = parseKVVBy kvSep
|
||||
|
||||
|
||||
|
||||
readKV :: String -> Integer -> RC (String,String)
|
||||
readKV s ln = case readP_to_S parseKV s of
|
||||
[((k,v),"")] -> return (k,v) --single, correct parse
|
||||
[] -> throwError [(ln,"No parse")]
|
||||
_ -> do
|
||||
case readP_to_S parseKVV s of
|
||||
[((k,v),"")] -> return (k,v) --single, correct parse
|
||||
[] -> throwError [(ln,"No parse")]
|
||||
xs -> throwError [(ln,"Ambiguous parse: "
|
||||
++ show xs)]
|
||||
|
||||
|
||||
|
||||
isComment :: String -> Bool
|
||||
isComment = not . null . readP_to_S parseComment
|
||||
where parseComment = skipSpaces >> char '#' >> return ()
|
||||
-- null means failed parse, so _not_ a comment.
|
||||
|
||||
|
||||
isBlank :: String -> Bool
|
||||
isBlank = null . filter (not . isSpace)
|
||||
|
||||
|
||||
type RC = ErrorT [(Integer,String)] Identity
|
||||
|
||||
instance Error [(Integer,String)] where
|
||||
noMsg = [(-1, "Unknown error.")]
|
||||
strMsg s = [(-1, s)]
|
||||
|
||||
|
||||
parseFile :: [String] -> RC (XConfig Layout)
|
||||
parseFile ss = parseLines baseConfig theLines
|
||||
where theLines = filter (not . liftM2 (||) isComment isBlank . snd)
|
||||
$ zip [1..] ss
|
||||
|
||||
|
||||
|
||||
parseLines :: XConfig Layout -> [(Integer,String)] -> RC (XConfig Layout)
|
||||
parseLines = foldM parse
|
||||
|
||||
|
||||
parse :: XConfig Layout -> (Integer, String) -> RC (XConfig Layout)
|
||||
parse xc (ln,s) = do
|
||||
(k,v) <- readKV s ln
|
||||
case M.lookup k commands of
|
||||
Nothing -> throwError [(ln,"Unknown command: "++k)]
|
||||
Just f -> f v ln xc
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------------------------------
|
||||
-- Now the semantic parts, that convert from the relevant --
|
||||
-- key-value entries to values in an XConfig --
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
type Command = String -> Integer -> XConfig Layout -> RC (XConfig Layout)
|
||||
|
||||
commands :: M.Map String Command
|
||||
commands = M.fromList $
|
||||
[("modMask" , cmd_modMask )
|
||||
,("numlockMask" , cmd_numlockMask )
|
||||
,("normalBorderColor" , cmd_normalBorderColor )
|
||||
,("focusedBorderColor" , cmd_focusedBorderColor)
|
||||
,("terminal" , cmd_terminal )
|
||||
,("workspaces" , cmd_workspaces )
|
||||
,("focusFollowsMouse" , cmd_focusFollowsMouse )
|
||||
,("layouts" , cmd_layouts )
|
||||
,("key" , cmd_key )
|
||||
,("manageHook" , cmd_manageHook )
|
||||
,("borderWidth" , cmd_borderWidth )
|
||||
]
|
||||
|
||||
|
||||
-- | Behind-the-scenes helper for both 'cmd_modMask' and 'cmd_numlockMask'.
|
||||
genericModKey :: (KeyMask -> XConfig Layout) -> Command
|
||||
genericModKey f s ln _ = do
|
||||
x <- rcRead s ln :: RC Integer
|
||||
case lookup x (zip [1..] [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]) of
|
||||
Just y -> return $ f y
|
||||
Nothing -> throwError [(ln,"Invalid mod key number: "++ show x)]
|
||||
|
||||
|
||||
-- | Reads the mod key modifier number.
|
||||
cmd_modMask :: Command
|
||||
cmd_modMask s ln xc = genericModKey (\k -> xc{modMask = k}) s ln xc
|
||||
|
||||
-- | Reads the numlock key modifier number.
|
||||
cmd_numlockMask :: Command
|
||||
cmd_numlockMask s ln xc = genericModKey (\k -> xc{numlockMask = k}) s ln xc
|
||||
|
||||
|
||||
-- | Reads the border width.
|
||||
cmd_borderWidth :: Command
|
||||
cmd_borderWidth s ln xc = do
|
||||
w <- rcRead s ln
|
||||
return $ xc { borderWidth = w }
|
||||
|
||||
|
||||
-- | Reads the colors but just keeps them as RRGGBB Strings.
|
||||
cmd_normalBorderColor, cmd_focusedBorderColor :: Command
|
||||
cmd_normalBorderColor s _ xc = return $ xc{ normalBorderColor = s }
|
||||
cmd_focusedBorderColor s _ xc = return $ xc{ focusedBorderColor = s }
|
||||
|
||||
|
||||
-- | Reads the terminal. It is just a String, no parsing.
|
||||
cmd_terminal :: Command
|
||||
cmd_terminal s _ xc = return $ xc{ terminal = s }
|
||||
|
||||
|
||||
-- | Reads the workspace tag list. This is given as a Haskell [String].
|
||||
cmd_workspaces :: Command
|
||||
cmd_workspaces s ln xc = rcRead s ln >>= \x -> return xc{ workspaces = x }
|
||||
|
||||
|
||||
-- | Reads the focusFollowsMouse, as a Haskell Bool.
|
||||
cmd_focusFollowsMouse :: Command
|
||||
cmd_focusFollowsMouse s ln xc = rcRead s ln >>=
|
||||
\x -> return xc{focusFollowsMouse = x}
|
||||
|
||||
|
||||
-- | The list known layouts, mapped by name.
|
||||
-- An easy location for improvement is to add more contrib layouts here.
|
||||
layouts :: M.Map String (Layout Window)
|
||||
layouts = M.fromList
|
||||
[("Tall", Layout (Tall 1 (3/100) (1/2)))
|
||||
,("Wide", Layout (Mirror (Tall 1 (3/100) (1/2))))
|
||||
,("Full", Layout Full)
|
||||
]
|
||||
|
||||
|
||||
-- | Expects a [String], the strings being layout names. Quotes required.
|
||||
-- Draws from the `layouts' list above.
|
||||
cmd_layouts :: Command
|
||||
cmd_layouts s ln xc = do
|
||||
xs <- rcRead s ln -- read the list of strings
|
||||
let ls = map (id &&& (flip M.lookup) layouts) xs
|
||||
when (null ls) $ throwError [(ln,"Empty layout list")]
|
||||
case filter (not . isJust . snd) ls of
|
||||
[] -> return $ xc{ layoutHook = foldr1
|
||||
(\(Layout l) (Layout r) ->
|
||||
Layout (l ||| r)) (map (fromJust . snd) ls)
|
||||
}
|
||||
ys -> throwError $ map (\(x,_) -> (ln, "Unknown layout: "++ x)) ys
|
||||
|
||||
|
||||
|
||||
-- | A Map from names to key binding actions.
|
||||
key_actions :: M.Map String (X ())
|
||||
key_actions = M.fromList
|
||||
[("kill" , kill )
|
||||
,("nextLayout" , sendMessage NextLayout )
|
||||
--,("prevLayout" , sendMessage PrevLayout )
|
||||
--,("resetLayout" , setLayout $ XMonad.layoutHook conf)
|
||||
,("refresh" , refresh )
|
||||
,("focusDown" , windows W.focusDown )
|
||||
,("focusUp" , windows W.focusUp )
|
||||
,("focusMaster" , windows W.focusMaster )
|
||||
,("swapMaster" , windows W.swapMaster )
|
||||
,("swapDown" , windows W.swapDown )
|
||||
,("swapUp" , windows W.swapUp )
|
||||
,("shrink" , sendMessage Shrink )
|
||||
,("expand" , sendMessage Expand )
|
||||
,("sink" , withFocused $ windows . W.sink)
|
||||
,("incMaster" , sendMessage (IncMasterN 1))
|
||||
,("decMaster" , sendMessage (IncMasterN (-1)))
|
||||
,("quit" , io $ exitWith ExitSuccess)
|
||||
,("restart" , broadcastMessage ReleaseResources
|
||||
>> restart "xmonad" True)
|
||||
]
|
||||
|
||||
|
||||
-- | Expects keys as described in the preamble, as
|
||||
-- (\"EZConfig key name\", \"action name\"),
|
||||
-- eg. (\"M-S-t\", \"spawn thunderbird\")
|
||||
-- One key per "key=" line.
|
||||
cmd_key :: Command
|
||||
cmd_key s ln xc = do
|
||||
(k,v) <- rcRead s ln
|
||||
if "spawn " `isPrefixOf` v
|
||||
then return $ xc {
|
||||
keys = \c -> M.union (mkKeymap c
|
||||
[(k, spawn (drop 6 v))]
|
||||
) ((keys xc) c)
|
||||
}
|
||||
else do
|
||||
case M.lookup v key_actions of
|
||||
Nothing -> throwError [(ln, "Unknown key action \"" ++ v ++ "\"")]
|
||||
Just ac -> return $
|
||||
xc { keys = \c -> M.union (mkKeymap c [(k, ac)])
|
||||
((keys xc) c)
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- | Map of names to actions for 'ManageHook's.
|
||||
manageHook_actions :: M.Map String ManageHook
|
||||
manageHook_actions = M.fromList
|
||||
[("float" , doFloat )
|
||||
,("ignore" , doIgnore )
|
||||
]
|
||||
|
||||
|
||||
-- | Parses 'ManageHook's in the form given in the preamble.
|
||||
-- eg. (ClassName \"MPlayer\", \"float\")
|
||||
cmd_manageHook :: Command
|
||||
cmd_manageHook s ln xc = do
|
||||
(k,v) <- rcRead s ln
|
||||
let q = parseQuery k
|
||||
if "toWorkspace " `isPrefixOf` v
|
||||
then return $ xc { manageHook = manageHook xc <+>
|
||||
(q --> doShift (drop 12 v))
|
||||
}
|
||||
else case M.lookup v manageHook_actions of
|
||||
Nothing -> throwError [(ln, "Unknown ManageHook action \""
|
||||
++ v ++ "\"")]
|
||||
Just ac -> return $ xc { manageHook = manageHook xc <+> (q --> ac) }
|
||||
|
||||
|
||||
|
||||
-- | Core of the ManageHook expression parser.
|
||||
-- Taken from Roman Cheplyaka's WindowProperties
|
||||
parseQuery :: Property -> Query Bool
|
||||
parseQuery (Title s) = title =? s
|
||||
parseQuery (ClassName s) = className =? s
|
||||
parseQuery (Resource s) = resource =? s
|
||||
parseQuery (And p q) = parseQuery p <&&> parseQuery q
|
||||
parseQuery (Or p q) = parseQuery p <&&> parseQuery q
|
||||
parseQuery (Not p) = not `fmap` parseQuery p
|
||||
parseQuery (Const b) = return b
|
||||
|
||||
|
||||
-- | Property constructors are quite self-explaining.
|
||||
-- Taken from Roman Cheplyaka's WindowProperties
|
||||
data Property = Title String
|
||||
| ClassName String
|
||||
| Resource String
|
||||
| And Property Property
|
||||
| Or Property Property
|
||||
| Not Property
|
||||
| Const Bool
|
||||
deriving (Read, Show)
|
||||
|
||||
|
||||
|
||||
-- | A wrapping of the read function into the RC monad.
|
||||
rcRead :: (Read a) => String -> Integer -> RC a
|
||||
rcRead s ln = case reads s of
|
||||
[(x,"")] -> return x
|
||||
_ -> throwError [(ln, "Failed to parse value")]
|
||||
|
||||
|
||||
|
||||
-- | The standard Config.hs 'defaultConfig', with the layout wrapped.
|
||||
baseConfig :: XConfig Layout
|
||||
baseConfig = defaultConfig{ layoutHook = Layout (layoutHook defaultConfig) }
|
||||
|
||||
|
||||
|
||||
-- | Core function that attempts to parse @~\/.xmonad\/xmonad.conf@
|
||||
readConfig :: IO (Maybe (XConfig Layout))
|
||||
readConfig = do
|
||||
dir <- getXMonadDir
|
||||
cs <- bracket (openFile (dir++"/xmonad.conf") ReadMode)
|
||||
(\h -> hClose h) -- vv force the lazy IO
|
||||
(\h -> (lines `fmap` hGetContents h) >>= \ss ->
|
||||
length ss `seq` return ss)
|
||||
let xce = runIdentity $ runErrorT $ parseFile cs
|
||||
case xce of
|
||||
Left es -> mapM_ (\(ln,e) ->
|
||||
putStrLn $ "readConfig error: line "++show ln++
|
||||
": "++ e) es
|
||||
>> return Nothing
|
||||
Right xc -> return $ Just xc
|
||||
|
||||
|
||||
-- | Attempts to run readConfig, and checks if it failed.
|
||||
checkConfig :: IO Bool
|
||||
checkConfig = isJust `fmap` readConfig
|
||||
|
||||
|
||||
|
||||
{- REMOVED: It was for debugging, and causes an 'orphaned instances'
|
||||
warning to boot.
|
||||
|
||||
|
||||
|
||||
-- | Reads in the config, and then prints the resulting XConfig
|
||||
dumpConfig :: IO ()
|
||||
dumpConfig = readConfig >>= print
|
||||
|
||||
|
||||
instance Show (XConfig Layout) where
|
||||
show x = "XConfig { "
|
||||
++ "normalBorderColor = "++ normalBorderColor x ++", "
|
||||
++ "focusedBorderColor = "++ focusedBorderColor x++", "
|
||||
++ "terminal = "++ terminal x ++", "
|
||||
++ "workspaces = "++ show (workspaces x) ++", "
|
||||
++ "numlockMask = "++ show (numlockMask x) ++", "
|
||||
++ "modMask = "++ show (modMask x) ++", "
|
||||
++ "borderWidth = "++ show (borderWidth x) ++", "
|
||||
++ "focusFollowsMouse = "++ show (focusFollowsMouse x) ++", "
|
||||
++ "layouts = "++ show (layoutHook x) ++" }"
|
||||
|
||||
-}
|
||||
|
||||
-- | Handles the unwrapping of the Layout. Intended for use as
|
||||
-- @main = plainConfig@
|
||||
plainConfig :: IO ()
|
||||
plainConfig = do
|
||||
conf <- readConfig
|
||||
case conf of
|
||||
(Just xc@XConfig{layoutHook= (Layout l)}) ->
|
||||
xmonad (xc{ layoutHook = l })
|
||||
Nothing ->
|
||||
spawn $ "xmessage Failed to read xmonad.conf. See xmonad.errors."
|
||||
|
@@ -8,7 +8,7 @@ import XMonad.Layout.Tabbed
|
||||
import XMonad.Layout.HintedTile
|
||||
import XMonad.Config (defaultConfig)
|
||||
import XMonad.Layout.NoBorders
|
||||
import XMonad.Hooks.DynamicLog
|
||||
import XMonad.Hooks.DynamicLog hiding (xmobar)
|
||||
import XMonad.Hooks.ManageDocks
|
||||
import XMonad.Prompt
|
||||
import XMonad.Prompt.Shell
|
||||
@@ -21,19 +21,23 @@ sjanssenConfig = do
|
||||
xmobar <- spawnPipe "xmobar"
|
||||
return $ defaultConfig
|
||||
{ terminal = "urxvtc"
|
||||
, workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]
|
||||
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
||||
, logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }
|
||||
, modMask = mod4Mask
|
||||
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
|
||||
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
|
||||
, keys = \c -> mykeys c `M.union` keys defaultConfig c
|
||||
, layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme)
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks
|
||||
, layoutHook = modifiers layouts
|
||||
, manageHook = composeAll [className =? x --> doF (W.shift w)
|
||||
| (x, w) <- [ ("Firefox", "web")
|
||||
, ("Ktorrent", "7")]]
|
||||
<+> manageHook defaultConfig <+> manageDocks
|
||||
}
|
||||
where
|
||||
tiled = HintedTile 1 0.03 0.5 TopLeft
|
||||
tiled = HintedTile 1 0.03 0.5 TopLeft
|
||||
layouts = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
|
||||
modifiers = avoidStruts . smartBorders
|
||||
|
||||
mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
|
||||
[((modm, xK_p ), shellPrompt myPromptConfig)
|
||||
|
42
XMonad/Config/Xfce.hs
Normal file
42
XMonad/Config/Xfce.hs
Normal file
@@ -0,0 +1,42 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Xfce
|
||||
-- Copyright : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
||||
--
|
||||
-- This module provides a config suitable for use with the Xfce desktop
|
||||
-- environment.
|
||||
|
||||
module XMonad.Config.Xfce (
|
||||
-- * Usage
|
||||
-- -- $usage
|
||||
xfceConfig
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Config.Desktop
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- $usage
|
||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.Xfce
|
||||
-- >
|
||||
-- > main = xmonad xfceConfig
|
||||
--
|
||||
|
||||
xfceConfig = desktopConfig
|
||||
{ terminal = "Terminal"
|
||||
, keys = \c -> xfceKeys c `M.union` keys desktopConfig c }
|
||||
|
||||
xfceKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_p), spawn "xfrun4")
|
||||
, ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
|
||||
]
|
@@ -56,8 +56,8 @@ is available from <http://code.haskell.org/XMonadContrib> via darcs:
|
||||
Each stable release of xmonad is accompanied by a stable release of
|
||||
the contrib library, which you should use if (and only if) you're
|
||||
using a stable release of xmonad. You can find the most recent
|
||||
(Mar. 2008) tarball here:
|
||||
<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.7>
|
||||
tarball here:
|
||||
<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib>
|
||||
|
||||
-}
|
||||
|
||||
|
@@ -211,7 +211,7 @@ generated by layouts or the user.
|
||||
"XMonad.Core" defines a class that generalizes the concept of events,
|
||||
'XMonad.Core.Message', constrained to types with a
|
||||
'Data.Typeable.Typeable' instance definition (which can be
|
||||
automatically derived by ghc). 'XMonad.Core.Message's are wrapped
|
||||
automatically derived by GHC). 'XMonad.Core.Message's are wrapped
|
||||
within an existential type 'XMonad.Core.SomeMessage'. The
|
||||
'Data.Typeable.Typeable' constraint allows for the definition of a
|
||||
'XMonad.Core.fromMessage' function that can unwrap the message with
|
||||
@@ -253,21 +253,22 @@ xmonad contributed extensions.
|
||||
|
||||
* Follow the coding style of the other modules.
|
||||
|
||||
* Code should be compilable with -Wall -Werror. There should be no warnings.
|
||||
* Code should be compilable with "ghc-options: -Wall -Werror" set in the
|
||||
xmonad-contrib.cabal file. There should be no warnings.
|
||||
|
||||
* Partial functions should be avoided: the window manager should not
|
||||
crash, so do not call 'error' or 'undefined'.
|
||||
crash, so never call 'error' or 'undefined'.
|
||||
|
||||
* Tabs are /illegal/. Use 4 spaces for indenting.
|
||||
|
||||
* Any pure function added to the core should have QuickCheck properties
|
||||
precisely defining its behaviour.
|
||||
* Any pure function added to the core must have QuickCheck properties
|
||||
precisely defining its behaviour. Tests for everything else are encouraged.
|
||||
|
||||
For examples of Haddock documentation syntax, have a look at other
|
||||
extensions. Important points are:
|
||||
|
||||
* Every exported function (or even better, every function) should have
|
||||
a Haddock comment explaining what it does.
|
||||
a Haddock comment explaining what it does, and providing examples.
|
||||
|
||||
* Literal chunks of code can be written in comments using
|
||||
\"birdtrack\" notation (a greater-than symbol at the beginning of
|
||||
@@ -286,7 +287,7 @@ To generate and view the Haddock documentation for your extension, run
|
||||
and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.
|
||||
|
||||
For more information, see the Haddock documentation:
|
||||
<http://www.haskell.org/haddock/haddock-html-0.8/index.html>.
|
||||
<http://www.haskell.org/haddock/doc/html/index.html>.
|
||||
|
||||
For more information on the nuts and bolts of how to develop your own
|
||||
extension, see the tutorial on the wiki:
|
||||
|
122
XMonad/Hooks/DynamicHooks.hs
Normal file
122
XMonad/Hooks/DynamicHooks.hs
Normal file
@@ -0,0 +1,122 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DynamicHooks
|
||||
-- Copyright : (c) Braden Shepherdson 2008
|
||||
-- License : BSD-style (as xmonad)
|
||||
--
|
||||
-- Maintainer : Braden.Shepherdson@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- One-shot and permanent ManageHooks that can be updated at runtime.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.DynamicHooks (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
initDynamicHooks
|
||||
,dynamicMasterHook
|
||||
,addDynamicHook
|
||||
,updateDynamicHook
|
||||
,oneShotHook
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import System.IO
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Data.Monoid
|
||||
import Data.IORef
|
||||
|
||||
-- $usage
|
||||
-- Provides two new kinds of 'ManageHooks' that can be defined at runtime.
|
||||
--
|
||||
-- * One-shot 'ManageHooks' that are deleted after they execute.
|
||||
--
|
||||
-- * Permanent 'ManageHooks' (unless you want to destroy them)
|
||||
--
|
||||
-- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!
|
||||
-- If you want them to last, you should create them as normal in your @xmonad.hs@.
|
||||
--
|
||||
-- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:
|
||||
--
|
||||
-- > dynHooksRef <- initDynamicHooks
|
||||
--
|
||||
-- and then pass this value to the other functions in this module.
|
||||
--
|
||||
-- You also need to add the base 'ManageHook':
|
||||
--
|
||||
-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }
|
||||
--
|
||||
-- You must include this @dynHooksRef@ value when using the functions in this
|
||||
-- module:
|
||||
--
|
||||
-- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList
|
||||
-- > [((modMask conf, xK_i), oneShotHook dynHooksRef
|
||||
-- > "FFlaunchHook" (className =? "firefox") (doShift "3")
|
||||
-- > >> spawn "firefox")
|
||||
-- > ,((modMask conf, xK_u), addDynamicHook dynHooksRef
|
||||
-- > (className =? "example" --> doFloat))
|
||||
-- > ,((modMask conf, xK_y), updatePermanentHook dynHooksRef
|
||||
-- > (const idHook))) ] -- resets the permanent hook.
|
||||
--
|
||||
|
||||
data DynamicHooks = DynamicHooks
|
||||
{ transients :: [(Query Bool, ManageHook)]
|
||||
, permanent :: ManageHook }
|
||||
|
||||
|
||||
-- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.
|
||||
initDynamicHooks :: IO (IORef DynamicHooks)
|
||||
initDynamicHooks = newIORef (DynamicHooks { transients = [],
|
||||
permanent = idHook })
|
||||
|
||||
|
||||
-- this hook is always executed, and the IORef's contents checked.
|
||||
-- note that transient hooks are run second, therefore taking precedence
|
||||
-- over permanent ones on matters such as which workspace to shift to.
|
||||
-- doFloat and doIgnore are idempotent.
|
||||
-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
|
||||
dynamicMasterHook :: IORef DynamicHooks -> ManageHook
|
||||
dynamicMasterHook ref = return True -->
|
||||
(ask >>= \w -> liftX (do
|
||||
dh <- io $ readIORef ref
|
||||
(Endo f) <- runQuery (permanent dh) w
|
||||
ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)
|
||||
let (ts',nts) = partition fst ts
|
||||
gs <- mapM (flip runQuery w . snd . snd) ts'
|
||||
let (Endo g) = maybe (Endo id) id $ listToMaybe gs
|
||||
io $ writeIORef ref $ dh { transients = map snd nts }
|
||||
return $ Endo $ f . g
|
||||
))
|
||||
|
||||
-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
|
||||
addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()
|
||||
addDynamicHook ref m = updateDynamicHook ref (<+> m)
|
||||
|
||||
|
||||
-- | Modifies the permanent 'ManageHook' with an arbitrary function.
|
||||
updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()
|
||||
updateDynamicHook ref f =
|
||||
io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }
|
||||
|
||||
|
||||
-- | Creates a one-shot 'ManageHook'. Note that you have to specify the two
|
||||
-- parts of the 'ManageHook' separately. Where you would usually write:
|
||||
--
|
||||
-- > className =? "example" --> doFloat
|
||||
--
|
||||
-- you must call 'oneShotHook' as
|
||||
--
|
||||
-- > oneShotHook dynHooksRef (className =? "example) doFloat
|
||||
--
|
||||
oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()
|
||||
oneShotHook ref q a =
|
||||
io $ modifyIORef ref
|
||||
$ \dh -> dh { transients = (q,a):(transients dh) }
|
||||
|
||||
|
||||
|
||||
|
@@ -22,6 +22,7 @@ module XMonad.Hooks.DynamicLog (
|
||||
|
||||
-- * Drop-in loggers
|
||||
dzen,
|
||||
xmobar,
|
||||
dynamicLog,
|
||||
dynamicLogDzen,
|
||||
dynamicLogXmobar,
|
||||
@@ -51,13 +52,18 @@ module XMonad.Hooks.DynamicLog (
|
||||
import XMonad
|
||||
import Data.Maybe ( isJust, catMaybes )
|
||||
import Data.List
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord ( comparing )
|
||||
import qualified XMonad.StackSet as S
|
||||
import System.IO
|
||||
import XMonad.Util.WorkspaceCompare
|
||||
import XMonad.Util.NamedWindows
|
||||
import XMonad.Util.Run
|
||||
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Util.Font
|
||||
import XMonad.Hooks.UrgencyHook
|
||||
import XMonad.Hooks.ManageDocks
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
@@ -75,6 +81,9 @@ import XMonad.Hooks.UrgencyHook
|
||||
--
|
||||
-- > main = dzen $ \conf -> xmonad $ conf { <your customizations> }
|
||||
--
|
||||
-- Also you can use 'xmobar' function instead of 'dzen' in the examples above,
|
||||
-- if you have xmobar installed.
|
||||
--
|
||||
-- Alternatively, you can choose among several default status bar
|
||||
-- formats ('dynamicLog', 'dynamicLogDzen', 'dynamicLogXmobar', or
|
||||
-- 'dynamicLogXinerama') by simply setting your logHook to the
|
||||
@@ -101,6 +110,8 @@ import XMonad.Hooks.UrgencyHook
|
||||
-- appropriately, either by putting it in your @.xsession@ or similar
|
||||
-- file, or by using @spawnPipe@ in your @main@ function, for example:
|
||||
--
|
||||
-- > import XMonad.Util.Run -- for spawnPipe and hPutStrLn
|
||||
-- >
|
||||
-- > main = do
|
||||
-- > h <- spawnPipe "xmobar -options -foo -bar"
|
||||
-- > xmonad $ defaultConfig {
|
||||
@@ -126,6 +137,8 @@ import XMonad.Hooks.UrgencyHook
|
||||
--
|
||||
-- * add an xmobarEscape function
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | Run xmonad with a dzen status bar set to some nice defaults. Output
|
||||
-- is taken from the dynamicLogWithPP hook.
|
||||
--
|
||||
@@ -140,17 +153,57 @@ import XMonad.Hooks.UrgencyHook
|
||||
-- If you wish to customize the status bar format at all, you'll have to
|
||||
-- use something like 'dynamicLogWithPP' instead.
|
||||
--
|
||||
dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO ()
|
||||
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
|
||||
-- handle screen placement for dzen, and enables 'mod-b' for toggling
|
||||
-- the menu bar.
|
||||
--
|
||||
dzen ::
|
||||
(XConfig
|
||||
(ModifiedLayout AvoidStruts
|
||||
(Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t
|
||||
dzen f = do
|
||||
h <- spawnPipe ("dzen2" ++ " " ++ flags)
|
||||
f $ defaultConfig
|
||||
{ defaultGaps = [(15,0,0,0)] -- for fixed
|
||||
, logHook = dynamicLogWithPP dzenPP
|
||||
{ ppOutput = hPutStrLn h } }
|
||||
{ logHook = dynamicLogWithPP dzenPP
|
||||
{ ppOutput = hPutStrLn h }
|
||||
,layoutHook = avoidStrutsOn [U] (layoutHook defaultConfig)
|
||||
,keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c
|
||||
,manageHook = manageHook defaultConfig <+> manageDocks
|
||||
}
|
||||
where
|
||||
fg = "'#a8a3f7'" -- n.b quoting
|
||||
bg = "'#3f3c6d'"
|
||||
flags = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
|
||||
flags = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
|
||||
|
||||
|
||||
-- | Run xmonad with a xmobar status bar set to some nice defaults. Output
|
||||
-- is taken from the dynamicLogWithPP hook.
|
||||
--
|
||||
-- > main = xmobar xmonad
|
||||
--
|
||||
-- This works pretty much the same as 'dzen' function above
|
||||
--
|
||||
xmobar ::
|
||||
(XConfig
|
||||
(ModifiedLayout AvoidStruts
|
||||
(Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t
|
||||
xmobar f = do
|
||||
h <- spawnPipe "xmobar"
|
||||
f $ defaultConfig
|
||||
{ logHook = dynamicLogWithPP xmobarPP { ppOutput = hPutStrLn h }
|
||||
, layoutHook = avoidStruts $ layoutHook defaultConfig
|
||||
, keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks
|
||||
}
|
||||
|
||||
-- |
|
||||
-- Helper function which provides ToggleStruts keybinding
|
||||
--
|
||||
toggleStrutsKey :: XConfig t -> M.Map (KeyMask, KeySym) (X ())
|
||||
toggleStrutsKey XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_b ), sendMessage ToggleStruts) ]
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | An example log hook, which prints status information to stdout in
|
||||
-- the default format:
|
||||
@@ -203,7 +256,7 @@ dynamicLogString pp = do
|
||||
-- run extra loggers, ignoring any that generate errors.
|
||||
extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
|
||||
|
||||
return $ sepBy (ppSep pp) . ppOrder pp $
|
||||
return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $
|
||||
[ ws
|
||||
, ppLayout pp ld
|
||||
, ppTitle pp wt
|
||||
@@ -403,8 +456,8 @@ xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
|
||||
-- example. Note the use of 'xmobarColor' and the record update on
|
||||
-- 'defaultPP'.
|
||||
sjanssenPP :: PP
|
||||
sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000"
|
||||
, ppTitle = xmobarColor "#00ee00" "" . shorten 80
|
||||
sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black"
|
||||
, ppTitle = xmobarColor "#00ee00" "" . shorten 120
|
||||
}
|
||||
|
||||
-- | The options that byorgey likes to use with dzen, as another example.
|
||||
|
@@ -15,7 +15,9 @@
|
||||
module XMonad.Hooks.EwmhDesktops (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
EwmhDesktopsHook,
|
||||
ewmhDesktopsLogHook,
|
||||
ewmhDesktopsLogHookCustom,
|
||||
ewmhDesktopsLayout
|
||||
) where
|
||||
|
||||
@@ -37,13 +39,15 @@ import XMonad.Hooks.EventHook
|
||||
-- > import XMonad.Hooks.EwmhDesktops
|
||||
-- >
|
||||
-- > myLogHook :: X ()
|
||||
-- > myLogHook = do ewmhDesktopsLogHook
|
||||
-- > return ()
|
||||
-- > myLogHook = ewmhDesktopsLogHook
|
||||
-- >
|
||||
-- > layoutHook = ewmhDesktopsLayout $ avoidStruts $ simpleTabbed ||| Full ||| etc..
|
||||
-- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
|
||||
--
|
||||
-- 'avoidStruts' is used to automatically leave space for dock programs, and
|
||||
-- can be found in 'XMonad.Hooks.ManageDocks'.
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
|
||||
@@ -52,14 +56,23 @@ import XMonad.Hooks.EventHook
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
|
||||
|
||||
|
||||
|
||||
-- |
|
||||
-- Notifies pagers and window lists, such as those in the gnome-panel
|
||||
-- of the current state of workspaces and windows.
|
||||
ewmhDesktopsLogHook :: X ()
|
||||
ewmhDesktopsLogHook = withWindowSet $ \s -> do
|
||||
ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
|
||||
|
||||
|
||||
-- |
|
||||
-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
|
||||
-- user-specified function to transform the workspace list (post-sorting)
|
||||
ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
|
||||
ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
|
||||
sort' <- getSortByIndex
|
||||
let ws = sort' $ W.workspaces s
|
||||
let wins = W.allWindows s
|
||||
let ws = f $ sort' $ W.workspaces s
|
||||
|
||||
setSupported
|
||||
|
||||
@@ -74,6 +87,8 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
|
||||
|
||||
setCurrentDesktop curr
|
||||
|
||||
-- all windows, with focused windows last
|
||||
let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
|
||||
setClientList wins
|
||||
|
||||
-- Per window Desktop
|
||||
@@ -100,7 +115,7 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
|
||||
--
|
||||
-- * _NET_WM_DESKTOP (move windows to other desktops)
|
||||
--
|
||||
-- * _NET_ACTIVE_WINDOW (activate another window)
|
||||
-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
|
||||
--
|
||||
ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a
|
||||
ewmhDesktopsLayout = eventHook EwmhDesktopsHook
|
||||
@@ -122,6 +137,7 @@ handle ClientMessageEvent {
|
||||
a_cd <- getAtom "_NET_CURRENT_DESKTOP"
|
||||
a_d <- getAtom "_NET_WM_DESKTOP"
|
||||
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
|
||||
a_cw <- getAtom "_NET_CLOSE_WINDOW"
|
||||
if mt == a_cd then do
|
||||
let n = fromIntegral (head d)
|
||||
if 0 <= n && n < length ws then
|
||||
@@ -134,6 +150,9 @@ handle ClientMessageEvent {
|
||||
else trace $ "Bad _NET_DESKTOP with data[0]="++show n
|
||||
else if mt == a_aw then do
|
||||
windows $ W.focusWindow w
|
||||
else if mt == a_cw then do
|
||||
windows $ W.focusWindow w
|
||||
kill
|
||||
else trace $ "Unknown ClientMessageEvent " ++ show mt
|
||||
handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match
|
||||
|
||||
@@ -199,7 +218,7 @@ setSupported = withDisplay $ \dpy -> do
|
||||
|
||||
setActiveWindow :: X ()
|
||||
setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
|
||||
let w = fromMaybe 0 (W.peek s)
|
||||
let w = fromMaybe none (W.peek s)
|
||||
r <- asks theRoot
|
||||
a <- getAtom "_NET_ACTIVE_WINDOW"
|
||||
c <- getAtom "WINDOW"
|
||||
|
75
XMonad/Hooks/FadeInactive.hs
Normal file
75
XMonad/Hooks/FadeInactive.hs
Normal file
@@ -0,0 +1,75 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.FadeInactive
|
||||
-- Copyright : (c) 2008 Justin Bogner <mail@justinbogner.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Justin Bogner <mail@justinbogner.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,
|
||||
-- which causes those windows to become slightly translucent if something
|
||||
-- like xcompmgr is running
|
||||
-----------------------------------------------------------------------------
|
||||
module XMonad.Hooks.FadeInactive (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
fadeInactiveLogHook
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
import Control.Monad (forM_)
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Hooks.FadeInactive
|
||||
-- >
|
||||
-- > myLogHook :: X ()
|
||||
-- > myLogHook = fadeInactiveLogHook fadeAmount
|
||||
-- > where fadeAmount = 0xdddddddd
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { logHook = myLogHook }
|
||||
--
|
||||
-- fadeAmount can be any integer
|
||||
-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
|
||||
-- or something similar for this to do anything
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
|
||||
-- |
|
||||
-- sets the opacity of a window
|
||||
setOpacity :: Window -> Integer -> X ()
|
||||
setOpacity w t = withDisplay $ \dpy -> do
|
||||
a <- getAtom "_NET_WM_WINDOW_OPACITY"
|
||||
c <- getAtom "CARDINAL"
|
||||
io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t]
|
||||
|
||||
-- |
|
||||
-- fades a window out by setting the opacity
|
||||
fadeOut :: Integer -> Window -> X ()
|
||||
fadeOut amt = flip setOpacity amt
|
||||
|
||||
-- |
|
||||
-- makes a window completely opaque
|
||||
fadeIn :: Window -> X ()
|
||||
fadeIn = flip setOpacity 0xffffffff
|
||||
|
||||
-- |
|
||||
-- lowers the opacity of inactive windows to the specified amount
|
||||
fadeInactiveLogHook :: Integer -> X ()
|
||||
fadeInactiveLogHook amt = withWindowSet $ \s ->
|
||||
forM_ (concatMap visibleWins $ W.current s : W.visible s) (fadeOut amt) >>
|
||||
withFocused fadeIn
|
||||
where
|
||||
visibleWins = maybe [] unfocused . W.stack . W.workspace
|
||||
unfocused (W.Stack _ l r) = l ++ r
|
@@ -17,7 +17,8 @@
|
||||
module XMonad.Hooks.ManageDocks (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts)
|
||||
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
|
||||
ToggleStruts(..), Direction(..)
|
||||
) where
|
||||
|
||||
|
||||
@@ -27,28 +28,46 @@ import Foreign.C.Types (CLong)
|
||||
import Control.Monad
|
||||
import XMonad.Layout.LayoutModifier
|
||||
|
||||
import Data.List (delete)
|
||||
|
||||
-- $usage
|
||||
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- The first component is a 'ManageHook' which recognizes these windows. To
|
||||
-- enable it:
|
||||
-- The first component is a 'ManageHook' which recognizes these
|
||||
-- windows and de-manages them, so that xmonad does not try to tile
|
||||
-- them. To enable it:
|
||||
--
|
||||
-- > manageHook = ... <+> manageDocks
|
||||
--
|
||||
-- The second component is a layout modifier that prevents windows from
|
||||
-- overlapping these dock windows. It is intended to replace xmonad's
|
||||
-- so-called "gap" support. First, you must add it to your list of layouts:
|
||||
-- The second component is a layout modifier that prevents windows
|
||||
-- from overlapping these dock windows. It is intended to replace
|
||||
-- xmonad's so-called \"gap\" support. First, you must add it to your
|
||||
-- list of layouts:
|
||||
--
|
||||
-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
|
||||
-- > where tall = Tall 1 (3/100) (1/2)
|
||||
--
|
||||
-- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar
|
||||
-- to:
|
||||
-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
|
||||
-- similar to:
|
||||
--
|
||||
-- > ,((modMask x, xK_b ), sendMessage ToggleStruts)
|
||||
--
|
||||
-- If you have multiple docks, you can toggle their gaps individually.
|
||||
-- For example, to toggle only the top gap:
|
||||
--
|
||||
-- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut U)
|
||||
--
|
||||
-- Similarly, you can use 'D', 'L', and 'R' to individually toggle
|
||||
-- gaps on the bottom, left, or right.
|
||||
--
|
||||
-- If you want certain docks to be avoided but others to be covered by
|
||||
-- default, you can manually specify the sides of the screen on which
|
||||
-- docks should be avoided, using 'avoidStrutsOn'. For example:
|
||||
--
|
||||
-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
|
||||
--
|
||||
-- /Important note/: if you are switching from manual gaps
|
||||
-- (defaultGaps in your config) to avoidStruts (recommended, since
|
||||
-- manual gaps will probably be phased out soon), be sure to switch
|
||||
@@ -58,15 +77,27 @@ import XMonad.Layout.LayoutModifier
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
--
|
||||
|
||||
-- |
|
||||
-- Detects if the given window is of type DOCK and if so, reveals it, but does
|
||||
-- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
|
||||
-- | An enumeration of the four cardinal directions\/sides of the
|
||||
-- screen.
|
||||
--
|
||||
-- Ideally this would go in its own separate module in Util,
|
||||
-- but ManageDocks is angling for inclusion into the xmonad core,
|
||||
-- so keep the dependencies to a minimum.
|
||||
data Direction = U -- ^ Up\/top
|
||||
| D -- ^ Down\/bottom
|
||||
| R -- ^ Right
|
||||
| L -- ^ Left
|
||||
deriving ( Read, Show, Eq, Ord, Enum, Bounded )
|
||||
|
||||
-- | Detects if the given window is of type DOCK and if so, reveals
|
||||
-- it, but does not manage it. If the window has the STRUT property
|
||||
-- set, adjust the gap accordingly.
|
||||
manageDocks :: ManageHook
|
||||
manageDocks = checkDock --> doIgnore
|
||||
|
||||
-- |
|
||||
-- Checks if a window is a DOCK or DESKTOP window
|
||||
-- | Checks if a window is a DOCK or DESKTOP window
|
||||
checkDock :: Query Bool
|
||||
checkDock = ask >>= \w -> liftX $ do
|
||||
a <- getAtom "_NET_WM_WINDOW_TYPE"
|
||||
@@ -77,8 +108,7 @@ checkDock = ask >>= \w -> liftX $ do
|
||||
Just [r] -> return $ elem (fromIntegral r) [dock, desk]
|
||||
_ -> return False
|
||||
|
||||
-- |
|
||||
-- Gets the STRUT config, if present, in xmonad gap order
|
||||
-- | Gets the STRUT config, if present, in xmonad gap order
|
||||
getStrut :: Window -> X [Strut]
|
||||
getStrut w = do
|
||||
spa <- getAtom "_NET_WM_STRUT_PARTIAL"
|
||||
@@ -93,23 +123,21 @@ getStrut w = do
|
||||
|
||||
parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2]
|
||||
= filter (\(_, n, _, _) -> n /= 0)
|
||||
[(L, l, ly1, ly2), (R, r, ry1, ry2), (T, t, tx1, tx2), (B, b, bx1, bx2)]
|
||||
[(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)]
|
||||
parseStrutPartial _ = []
|
||||
|
||||
-- |
|
||||
-- Helper to read a property
|
||||
-- | Helper to read a property
|
||||
getProp :: Atom -> Window -> X (Maybe [CLong])
|
||||
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
|
||||
|
||||
-- |
|
||||
-- Goes through the list of windows and find the gap so that all STRUT
|
||||
-- settings are satisfied.
|
||||
calcGap :: X (Rectangle -> Rectangle)
|
||||
calcGap = withDisplay $ \dpy -> do
|
||||
-- | Goes through the list of windows and find the gap so that all
|
||||
-- STRUT settings are satisfied.
|
||||
calcGap :: [Direction] -> X (Rectangle -> Rectangle)
|
||||
calcGap ss = withDisplay $ \dpy -> do
|
||||
rootw <- asks theRoot
|
||||
-- We don't keep track of dock like windows, so we find all of them here
|
||||
(_,_,wins) <- io $ queryTree dpy rootw
|
||||
struts <- concat `fmap` mapM getStrut wins
|
||||
struts <- (filter careAbout . concat) `fmap` mapM getStrut wins
|
||||
|
||||
-- we grab the window attributes of the root window rather than checking
|
||||
-- the width of the screen because xlib caches this info and it tends to
|
||||
@@ -117,30 +145,50 @@ calcGap = withDisplay $ \dpy -> do
|
||||
wa <- io $ getWindowAttributes dpy rootw
|
||||
let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
|
||||
return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
|
||||
where careAbout (s,_,_,_) = s `elem` ss
|
||||
|
||||
-- | Adjust layout automagically.
|
||||
-- | Adjust layout automagically: don't cover up any docks, status
|
||||
-- bars, etc.
|
||||
avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
|
||||
avoidStruts = ModifiedLayout (AvoidStruts True)
|
||||
avoidStruts = avoidStrutsOn [U,D,L,R]
|
||||
|
||||
data AvoidStruts a = AvoidStruts Bool deriving ( Read, Show )
|
||||
-- | Adjust layout automagically: don't cover up docks, status bars,
|
||||
-- etc. on the indicated sides of the screen. Valid sides are U
|
||||
-- (top), D (bottom), R (right), or L (left).
|
||||
avoidStrutsOn :: LayoutClass l a =>
|
||||
[Direction]
|
||||
-> l a
|
||||
-> ModifiedLayout AvoidStruts l a
|
||||
avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss)
|
||||
|
||||
data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show )
|
||||
|
||||
-- | Message type which can be sent to an 'AvoidStruts' layout
|
||||
-- modifier to alter its behavior.
|
||||
data ToggleStruts = ToggleStruts
|
||||
| ToggleStrut Direction
|
||||
deriving (Read,Show,Typeable)
|
||||
|
||||
data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)
|
||||
instance Message ToggleStruts
|
||||
|
||||
instance LayoutModifier AvoidStruts a where
|
||||
modifyLayout (AvoidStruts b) w r = do
|
||||
nr <- if b then fmap ($ r) calcGap else return r
|
||||
modifyLayout (AvoidStruts ss) w r = do
|
||||
nr <- fmap ($ r) (calcGap ss)
|
||||
runLayout w nr
|
||||
|
||||
handleMess (AvoidStruts b ) m
|
||||
| Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b)
|
||||
handleMess (AvoidStruts ss) m
|
||||
| Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss)
|
||||
| Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss)
|
||||
| otherwise = return Nothing
|
||||
where toggleAll [] = [U,D,L,R]
|
||||
toggleAll _ = []
|
||||
toggleOne x xs | x `elem` xs = delete x xs
|
||||
| otherwise = x : xs
|
||||
|
||||
data Side = L | R | T | B
|
||||
|
||||
-- | (Side, height\/width, initial pixel, final pixel).
|
||||
-- | (Direction, height\/width, initial pixel, final pixel).
|
||||
|
||||
type Strut = (Side, CLong, CLong, CLong)
|
||||
type Strut = (Direction, CLong, CLong, CLong)
|
||||
|
||||
-- | (Initial x pixel, initial y pixel,
|
||||
-- final x pixel, final y pixel).
|
||||
@@ -173,8 +221,8 @@ reduce :: RectC -> Strut -> RectC -> RectC
|
||||
reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
|
||||
L | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 )
|
||||
R | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 )
|
||||
T | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 )
|
||||
B | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1)
|
||||
U | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 )
|
||||
D | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1)
|
||||
_ -> (x0 , y0 , x1 , y1 )
|
||||
where
|
||||
mx a b = max a (b + n)
|
||||
|
@@ -8,8 +8,8 @@
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This module provides helper functions to be used in @manageHook@. Here's how you
|
||||
-- might use this:
|
||||
-- This module provides helper functions to be used in @manageHook@. Here's
|
||||
-- how you might use this:
|
||||
--
|
||||
-- > import XMonad.Hooks.ManageHelpers
|
||||
-- > main =
|
||||
@@ -18,6 +18,7 @@
|
||||
-- > manageHook = composeOne [
|
||||
-- > isKDETrayWindow -?> doIgnore,
|
||||
-- > transience,
|
||||
-- > isFullscreen -?> doFullFloat,
|
||||
-- > resource =? "stalonetray" -?> doIgnore
|
||||
-- > ],
|
||||
-- > ...
|
||||
@@ -27,12 +28,14 @@ module XMonad.Hooks.ManageHelpers (
|
||||
composeOne,
|
||||
(-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
|
||||
isKDETrayWindow,
|
||||
isFullscreen,
|
||||
transientTo,
|
||||
maybeToDefinite,
|
||||
MaybeManageHook,
|
||||
transience,
|
||||
transience',
|
||||
doRectFloat,
|
||||
doFullFloat,
|
||||
doCenterFloat
|
||||
) where
|
||||
|
||||
@@ -109,6 +112,18 @@ isKDETrayWindow = ask >>= \w -> liftX $ do
|
||||
Just [_] -> True
|
||||
_ -> False
|
||||
|
||||
-- | A predicate to check whether a window wants to fill the whole screen.
|
||||
-- See also 'doFullFloat'.
|
||||
isFullscreen :: Query Bool
|
||||
isFullscreen = ask >>= \w -> liftX $ do
|
||||
dpy <- asks display
|
||||
state <- getAtom "_NET_WM_STATE"
|
||||
full <- getAtom "_NET_WM_STATE_FULLSCREEN"
|
||||
r <- io $ getWindowProperty32 dpy state w
|
||||
return $ case r of
|
||||
Just xs -> fromIntegral full `elem` xs
|
||||
_ -> False
|
||||
|
||||
-- | A predicate to check whether a window is Transient.
|
||||
-- It holds the result which might be the window it is transient to
|
||||
-- or it might be 'Nothing'.
|
||||
@@ -140,6 +155,10 @@ doRectFloat :: W.RationalRect -- ^ The rectangle to float the window in. 0 to 1
|
||||
-> ManageHook
|
||||
doRectFloat r = ask >>= \w -> doF (W.float w r)
|
||||
|
||||
-- | Floats the window and makes it use the whole screen. Equivalent to
|
||||
-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.
|
||||
doFullFloat :: ManageHook
|
||||
doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1
|
||||
|
||||
-- | Floats a new window with its original size, but centered.
|
||||
doCenterFloat :: ManageHook
|
||||
|
54
XMonad/Hooks/Script.hs
Normal file
54
XMonad/Hooks/Script.hs
Normal file
@@ -0,0 +1,54 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.Script
|
||||
-- Copyright : (c) Trevor Elliott <trevor@galois.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Trevor Elliott <trevor@galois.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Provides a simple interface for running a ~\/.xmonad\/hooks script with the
|
||||
-- name of a hook.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.Script (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Script Hook Interface
|
||||
execScriptHook
|
||||
) where
|
||||
|
||||
--
|
||||
-- Useful Imports
|
||||
--
|
||||
import XMonad
|
||||
|
||||
import Control.Monad.Trans
|
||||
import System.Directory
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- This module allows you to run a centrally located script with the text
|
||||
-- name of a hook. The script is assumed to be located at @~\/.xmonad\/hooks@.
|
||||
--
|
||||
-- For example, if you wanted to run the hook "startup" in your script every
|
||||
-- time your startup hook ran, you could modify your xmonad config as such:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > ...
|
||||
-- > startupHook = execScriptHook "startup"
|
||||
-- > ...
|
||||
-- > }
|
||||
--
|
||||
-- Now, everytime the startup hook runs, the command
|
||||
-- @~\/.xmonad\/hooks startup@ will also.
|
||||
|
||||
-- | Execute a named script hook
|
||||
execScriptHook :: MonadIO m => String -> m ()
|
||||
execScriptHook hook = io $ do
|
||||
home <- getHomeDirectory
|
||||
let script = home ++ "/.xmonad/hooks "
|
||||
spawn (script ++ hook)
|
@@ -14,13 +14,13 @@
|
||||
-- May be useful for making Java GUI programs work, just set WM name to "LG3D"
|
||||
-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.
|
||||
--
|
||||
-- Remember that you need to call the setWMName action yourself (at least until
|
||||
-- we have startup hooks). E.g., you can bind it in your Config.hs:
|
||||
-- To your @~\/.xmonad\/xmonad.hs@ file, add the following line:
|
||||
--
|
||||
-- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
|
||||
-- > import XMonad.Hooks.SetWMName
|
||||
--
|
||||
-- and press the key combination before running the Java programs (you only
|
||||
-- need to do it once per XMonad execution)
|
||||
-- Then edit your @startupHook@:
|
||||
--
|
||||
-- > startupHook = setWMName "LG3D"
|
||||
--
|
||||
-- For details on the problems with running Java GUI programs in non-reparenting
|
||||
-- WMs, see <http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=6429775> and
|
||||
@@ -31,8 +31,8 @@
|
||||
-- set to 0, while for other WMs the insets are \"guessed\" and the algorithm
|
||||
-- fails miserably by guessing absolutely bogus values.
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
-- For detailed instructions on editing your hooks, see
|
||||
-- "XMonad.Doc.Extending#4".
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.SetWMName (
|
||||
|
@@ -19,40 +19,81 @@
|
||||
module XMonad.Hooks.UrgencyHook (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
withUrgencyHook,
|
||||
|
||||
-- ** Pop up a temporary dzen
|
||||
-- $temporary
|
||||
|
||||
-- ** Highlight in existing dzen
|
||||
-- $existing
|
||||
|
||||
-- ** Useful keybinding
|
||||
-- $keybinding
|
||||
|
||||
-- ** Note
|
||||
-- $note
|
||||
|
||||
-- * Troubleshooting
|
||||
-- $troubleshooting
|
||||
|
||||
-- * Example: Setting up irssi + rxvt-unicode
|
||||
-- $example
|
||||
|
||||
-- ** Configuring irssi
|
||||
-- $irssi
|
||||
|
||||
-- ** Configuring screen
|
||||
-- $screen
|
||||
|
||||
-- ** Configuring rxvt-unicode
|
||||
-- $urxvt
|
||||
|
||||
-- ** Configuring xmonad
|
||||
-- $xmonad
|
||||
|
||||
-- * Stuff for your config file:
|
||||
withUrgencyHook, withUrgencyHookC,
|
||||
UrgencyConfig(..), urgencyConfig,
|
||||
SuppressWhen(..),
|
||||
focusUrgent,
|
||||
dzenUrgencyHook,
|
||||
DzenUrgencyHook(..), seconds,
|
||||
NoUrgencyHook(..),
|
||||
FocusHook(..),
|
||||
-- * Stuff for developers:
|
||||
readUrgents, withUrgents,
|
||||
urgencyLayoutHook,
|
||||
NoUrgencyHook(..), StdoutUrgencyHook(..),
|
||||
dzenUrgencyHook, DzenUrgencyHook(..),
|
||||
UrgencyHook(urgencyHook),
|
||||
seconds
|
||||
StdoutUrgencyHook(..),
|
||||
SpawnUrgencyHook(..),
|
||||
UrgencyHook(urgencyHook)
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Layout.LayoutModifier hiding (hook)
|
||||
import XMonad.Hooks.EventHook
|
||||
import XMonad.Util.Dzen (dzenWithArgs, seconds)
|
||||
import XMonad.Util.NamedWindows (getName)
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (when)
|
||||
import Data.Bits (testBit, clearBit)
|
||||
import Data.Bits (testBit)
|
||||
import Data.IORef
|
||||
import Data.List ((\\), delete)
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Data.Maybe (listToMaybe, maybeToList)
|
||||
import qualified Data.Set as S
|
||||
import Foreign (unsafePerformIO)
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- To wire this up, first add:
|
||||
--
|
||||
-- > import XMonad.Hooks.UrgencyHook
|
||||
--
|
||||
-- to your import list in your config file. Now, choose an urgency hook. If
|
||||
-- you're just interested in displaying the urgency state in your custom
|
||||
-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided
|
||||
-- 'dzenUrgencyHook', or write your own.
|
||||
-- to your import list in your config file. Now, you have a decision to make:
|
||||
-- When a window deems itself urgent, do you want to pop up a temporary dzen
|
||||
-- bar telling you so, or do you have an existing dzen wherein you would like to
|
||||
-- highlight urgent workspaces?
|
||||
|
||||
-- $temporary
|
||||
--
|
||||
-- Enable your urgency hook by wrapping your config record in a call to
|
||||
-- 'withUrgencyHook'. For example:
|
||||
@@ -60,24 +101,135 @@ import Foreign (unsafePerformIO)
|
||||
-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
|
||||
-- > $ defaultConfig
|
||||
--
|
||||
-- If you want to modify your logHook to print out information about urgent windows,
|
||||
-- the functions 'readUrgents' and 'withUrgents' are there to help you with that.
|
||||
-- No example for you.
|
||||
-- This will pop up a dzen bar for five seconds telling you you've got an
|
||||
-- urgent window.
|
||||
|
||||
-- | This is the preferred method of enabling an urgency hook. It will prepend
|
||||
-- an action to your logHook that removes visible windows from the list of urgent
|
||||
-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead.
|
||||
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) =>
|
||||
h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l)
|
||||
withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf
|
||||
, logHook = removeVisiblesFromUrgents >> logHook conf
|
||||
}
|
||||
-- $existing
|
||||
--
|
||||
-- In order for xmonad to track urgent windows, you must install an urgency hook.
|
||||
-- You can use the above 'dzenUrgencyHook', or if you're not interested in the
|
||||
-- extra popup, install NoUrgencyHook, as so:
|
||||
--
|
||||
-- > main = xmonad $ withUrgencyHook NoUrgencyHook
|
||||
-- > $ defaultConfig
|
||||
--
|
||||
-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent
|
||||
-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,
|
||||
-- then you should be good. Otherwise, you want to figure out how to set
|
||||
-- 'ppUrgent'.
|
||||
|
||||
-- | The logHook action used by 'withUrgencyHook'.
|
||||
removeVisiblesFromUrgents :: X ()
|
||||
removeVisiblesFromUrgents = do
|
||||
visibles <- gets mapped
|
||||
adjustUrgents (\\ (S.toList visibles))
|
||||
-- $keybinding
|
||||
--
|
||||
-- You can set up a keybinding to jump to the window that was recently marked
|
||||
-- urgent. See an example at 'focusUrgent'.
|
||||
|
||||
-- $note
|
||||
-- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your
|
||||
-- urgency hook and restart xmonad, you may need to rejigger your layout by
|
||||
-- hitting mod-shift-space.
|
||||
|
||||
-- $troubleshooting
|
||||
--
|
||||
-- There are three steps to get right:
|
||||
--
|
||||
-- 1. The X client must set the UrgencyHint flag. How to configure this
|
||||
-- depends on the application. If you're using a terminal app, this is in
|
||||
-- two parts:
|
||||
--
|
||||
-- * The console app must send a ^G (bell). In bash, a helpful trick is
|
||||
-- @sleep 1; echo -e \'\a\'@.
|
||||
--
|
||||
-- * The terminal must convert the bell into UrgencyHint.
|
||||
--
|
||||
-- 2. XMonad must be configured to notice UrgencyHints. If you've added
|
||||
-- withUrgencyHook, you may need to hit mod-shift-space to reset the layout.
|
||||
--
|
||||
-- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it
|
||||
-- supports all of the arguments you told DzenUrgencyHook to pass it. Also,
|
||||
-- set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test
|
||||
-- if that works.
|
||||
--
|
||||
-- As best you can, try to isolate which one(s) of those is failing.
|
||||
|
||||
-- $example
|
||||
--
|
||||
-- This is a commonly asked example. By default, the window doesn't get flagged
|
||||
-- urgent when somebody messages you in irssi. You will have to configure some
|
||||
-- things. If you're using different tools than this, your mileage will almost
|
||||
-- certainly vary. (For example, in Xchat2, it's just a simple checkbox.)
|
||||
|
||||
-- $irssi
|
||||
-- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@.
|
||||
-- However, on all console applications is bestown the greatest of all notification
|
||||
-- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your
|
||||
-- friend, the bell. To configure @irssi@ to send a bell when you receive a message:
|
||||
--
|
||||
-- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT
|
||||
--
|
||||
-- Consult your local @irssi@ documentation for more detail.
|
||||
|
||||
-- $screen
|
||||
-- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros
|
||||
-- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console
|
||||
-- applications -- in particular, to turn bell characters into evil, smelly
|
||||
-- \"visual bells.\" To turn this off, add:
|
||||
--
|
||||
-- > vbell off # or remove the existing 'vbell on' line
|
||||
--
|
||||
-- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an
|
||||
-- immediate but temporary fix.
|
||||
|
||||
-- $urxvt
|
||||
-- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell
|
||||
-- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have
|
||||
-- an urxvt version 8.3 or newer, and second, set the following in your
|
||||
-- @.Xdefaults@:
|
||||
--
|
||||
-- > urxvt.urgentOnBell: true
|
||||
--
|
||||
-- Depending on your setup, you may need to @xrdb@ that.
|
||||
|
||||
-- $xmonad
|
||||
-- Hopefully you already read the section on how to configure xmonad. If not,
|
||||
-- hopefully you know where to find it.
|
||||
|
||||
-- | This is the method to enable an urgency hook. It suppresses urgency status
|
||||
-- for windows that are currently visible. If you'd like to change that behavior,
|
||||
-- use 'withUrgencyHookC'.
|
||||
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
|
||||
h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
|
||||
withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
|
||||
|
||||
-- | If you'd like to configure *when* to trigger the urgency hook, call this
|
||||
-- function with a custom 'UrgencyConfig'. Or, by example:
|
||||
--
|
||||
-- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }
|
||||
--
|
||||
-- (Don't type the @...@, you dolt.) See documentation on your options at 'SuppressWhen'.
|
||||
withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
|
||||
h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
|
||||
withUrgencyHookC hook urgConf conf = conf {
|
||||
layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook conf,
|
||||
logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
|
||||
}
|
||||
|
||||
-- | Global configuration, applicable to all types of 'UrgencyHook'.
|
||||
data UrgencyConfig = UrgencyConfig
|
||||
{ suppressWhen :: SuppressWhen -- ^ see 'SuppressWhen' for options
|
||||
} deriving (Read, Show)
|
||||
|
||||
-- | The default 'UrgencyConfig'. Use a variation of this in your config just
|
||||
-- as you use a variation of defaultConfig for your xmonad definition.
|
||||
urgencyConfig :: UrgencyConfig
|
||||
urgencyConfig = UrgencyConfig { suppressWhen = Visible }
|
||||
|
||||
-- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window.
|
||||
-- The default is 'Visible'. Prefix each of the following with \"don't bug me when\":
|
||||
data SuppressWhen = Visible -- ^ the window is currently visible
|
||||
| OnScreen -- ^ the window is on the currently focused physical screen
|
||||
| Focused -- ^ the window is currently focused
|
||||
| Never -- ^ ... aww, heck, go ahead and bug me, just in case.
|
||||
deriving (Read, Show)
|
||||
|
||||
-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
|
||||
-- Example keybinding:
|
||||
@@ -103,85 +255,119 @@ readUrgents = io $ readIORef urgents
|
||||
withUrgents :: ([Window] -> X a) -> X a
|
||||
withUrgents f = readUrgents >>= f
|
||||
|
||||
data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)
|
||||
data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show)
|
||||
|
||||
-- The Non-ICCCM Manifesto:
|
||||
-- Note: Some non-standard choices have been made in this implementation to
|
||||
-- account for the fact that things are different in a tiling window manager:
|
||||
-- 1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag
|
||||
-- 9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly.
|
||||
-- so in order to prevent that, we immediately clear the urgency flag.
|
||||
-- 2. In normal window managers, windows may overlap, so clients wait for focus to
|
||||
-- 1. In normal window managers, windows may overlap, so clients wait for focus to
|
||||
-- be set before urgency is cleared. In a tiling WM, it's sufficient to be able
|
||||
-- see the window, since we know that means you can see it completely.
|
||||
-- 3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
|
||||
-- 2. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
|
||||
-- has focus, and won't clear until it loses and regains focus. This is stupid.
|
||||
-- In order to account for these quirks, we clear the urgency bit immediately upon
|
||||
-- receiving notification (thus suppressing the repeated notifications) and track
|
||||
-- the list of urgent windows ourselves, allowing us to clear urgency when a window
|
||||
-- is visible, and not to set urgency if a window is visible.
|
||||
-- If you have a better idea, please, let us know!
|
||||
instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where
|
||||
handleMess (WithUrgencyHook hook) mess
|
||||
| Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do
|
||||
-- In order to account for these quirks, we track the list of urgent windows
|
||||
-- ourselves, allowing us to clear urgency when a window is visible, and not to
|
||||
-- set urgency if a window is visible. If you have a better idea, please, let us
|
||||
-- know!
|
||||
instance UrgencyHook h => EventHook (WithUrgencyHook h) where
|
||||
handleEvent wuh event =
|
||||
case event of
|
||||
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
|
||||
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
|
||||
wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
|
||||
when (testBit flags urgencyHintBit) $ do
|
||||
-- Call the urgencyHook.
|
||||
userCode $ urgencyHook hook w
|
||||
-- Clear the bit to prevent repeated notifications, as described above.
|
||||
io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
|
||||
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
|
||||
if (testBit flags urgencyHintBit) then do
|
||||
-- Add to list of urgents.
|
||||
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
|
||||
-- Call logHook after IORef has been modified.
|
||||
userCode =<< asks (logHook . config)
|
||||
return Nothing
|
||||
| Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do
|
||||
-- Call the urgencyHook.
|
||||
callUrgencyHook wuh w
|
||||
else do
|
||||
-- Remove from list of urgents.
|
||||
adjustUrgents (delete w)
|
||||
-- Call logHook after IORef has been modified.
|
||||
userCode =<< asks (logHook . config)
|
||||
DestroyWindowEvent {ev_window = w} -> do
|
||||
adjustUrgents (delete w)
|
||||
return Nothing
|
||||
| otherwise =
|
||||
return Nothing
|
||||
_ ->
|
||||
return ()
|
||||
|
||||
adjustUrgents :: ([Window] -> [Window]) -> X ()
|
||||
adjustUrgents f = io $ modifyIORef urgents f
|
||||
|
||||
urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) =>
|
||||
h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window
|
||||
urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook
|
||||
callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
|
||||
callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw }) w =
|
||||
whenX (not <$> shouldSuppress sw w)
|
||||
(userCode $ urgencyHook hook w)
|
||||
|
||||
shouldSuppress :: SuppressWhen -> Window -> X Bool
|
||||
shouldSuppress sw w = elem w <$> suppressibleWindows sw
|
||||
|
||||
cleanupUrgents :: SuppressWhen -> X ()
|
||||
cleanupUrgents sw = do
|
||||
suppressibles <- suppressibleWindows sw
|
||||
adjustUrgents (\\ suppressibles)
|
||||
|
||||
suppressibleWindows :: SuppressWhen -> X [Window]
|
||||
suppressibleWindows Visible = gets $ S.toList . mapped
|
||||
suppressibleWindows OnScreen = gets $ W.index . windowset
|
||||
suppressibleWindows Focused = gets $ maybeToList . W.peek . windowset
|
||||
suppressibleWindows Never = return []
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Urgency Hooks
|
||||
|
||||
-- | The class definition, and some pre-defined instances.
|
||||
|
||||
class (Read h, Show h) => UrgencyHook h a where
|
||||
urgencyHook :: h -> a -> X ()
|
||||
class (Read h, Show h) => UrgencyHook h where
|
||||
urgencyHook :: h -> Window -> X ()
|
||||
|
||||
data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook NoUrgencyHook Window where
|
||||
instance UrgencyHook NoUrgencyHook where
|
||||
urgencyHook _ _ = return ()
|
||||
|
||||
data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] }
|
||||
-- | Your set of options for configuring a dzenUrgencyHook.
|
||||
data DzenUrgencyHook = DzenUrgencyHook {
|
||||
duration :: Int, -- ^ number of microseconds to display the dzen
|
||||
-- (hence, you'll probably want to use 'seconds')
|
||||
args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen
|
||||
}
|
||||
deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook DzenUrgencyHook Window where
|
||||
instance UrgencyHook DzenUrgencyHook where
|
||||
urgencyHook DzenUrgencyHook { duration = d, args = a } w = do
|
||||
visibles <- gets mapped
|
||||
name <- getName w
|
||||
ws <- gets windowset
|
||||
whenJust (W.findTag w ws) (flash name visibles)
|
||||
where flash name visibles index =
|
||||
when (not $ S.member w visibles) $
|
||||
whenJust (W.findTag w ws) (flash name)
|
||||
where flash name index =
|
||||
dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d
|
||||
|
||||
-- | Flashes when a window requests your attention and you can't see it. Configurable
|
||||
-- duration and args to dzen.
|
||||
{- | A hook which will automatically send you to anything which sets the urgent
|
||||
flag (as opposed to printing some sort of message. You would use this as
|
||||
usual, eg.
|
||||
|
||||
> withUrgencyHook FocusHook $ myconfig { ...
|
||||
-}
|
||||
data FocusHook = FocusHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook FocusHook where
|
||||
urgencyHook _ _ = focusUrgent
|
||||
|
||||
-- | Flashes when a window requests your attention and you can't see it.
|
||||
-- Defaults to a duration of five seconds, and no extra args to dzen.
|
||||
-- See 'DzenUrgencyHook'.
|
||||
dzenUrgencyHook :: DzenUrgencyHook
|
||||
dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] }
|
||||
|
||||
-- For debugging purposes, really.
|
||||
-- | Spawn a commandline thing, appending the window id to the prefix string
|
||||
-- you provide. (Make sure to add a space if you need it.) Do your crazy
|
||||
-- xcompmgr thing.
|
||||
newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook SpawnUrgencyHook where
|
||||
urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w
|
||||
|
||||
-- | For debugging purposes, really.
|
||||
data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook StdoutUrgencyHook Window where
|
||||
instance UrgencyHook StdoutUrgencyHook where
|
||||
urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w
|
||||
|
67
XMonad/Layout/BoringWindows.hs
Normal file
67
XMonad/Layout/BoringWindows.hs
Normal file
@@ -0,0 +1,67 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.BoringWindows
|
||||
-- Copyright : (c) 2008 David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- BoringWindows is an extension to allow windows to be marked boring
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.BoringWindows (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
boringWindows,
|
||||
markBoring, clearBoring,
|
||||
focusUp, focusDown
|
||||
) where
|
||||
|
||||
import XMonad hiding (Point)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Util.Invisible
|
||||
|
||||
data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
|
||||
deriving ( Read, Show, Typeable )
|
||||
instance Message BoringMessage
|
||||
|
||||
markBoring, clearBoring, focusUp, focusDown :: X ()
|
||||
markBoring = withFocused (sendMessage . IsBoring)
|
||||
clearBoring = sendMessage ClearBoring
|
||||
focusUp = sendMessage FocusUp
|
||||
focusDown = sendMessage FocusDown
|
||||
|
||||
data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
|
||||
|
||||
boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
|
||||
boringWindows = ModifiedLayout (BoringWindows (I []))
|
||||
|
||||
instance LayoutModifier BoringWindows Window where
|
||||
handleMessOrMaybeModifyIt (BoringWindows (I bs)) m
|
||||
| Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs))
|
||||
| Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I [])
|
||||
| Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp'
|
||||
return Nothing
|
||||
| Just FocusDown <- fromMessage m =
|
||||
do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
|
||||
return Nothing
|
||||
where focusUp' (W.Stack t ls rs)
|
||||
| (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs)
|
||||
| otherwise = case skipBoring (reverse (t:rs)++ls) of
|
||||
(a,x:xs) -> W.Stack x xs a
|
||||
_ -> W.Stack t ls rs
|
||||
skipBoring [] = ([],[])
|
||||
skipBoring (x:xs) | x `elem` bs = case skipBoring xs of
|
||||
(a,b) -> (x:a,b)
|
||||
| otherwise = ([],x:xs)
|
||||
handleMessOrMaybeModifyIt _ _ = return Nothing
|
||||
|
||||
-- | reverse a stack: up becomes down and down becomes up.
|
||||
reverseStack :: W.Stack a -> W.Stack a
|
||||
reverseStack (W.Stack t ls rs) = W.Stack t rs ls
|
@@ -7,7 +7,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -253,7 +253,7 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
|
||||
return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds))
|
||||
|
||||
handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m
|
||||
| Just e <- fromMessage m :: Maybe Event = do decorationEventHook ds s e
|
||||
| Just e <- fromMessage m = do decorationEventHook ds s e
|
||||
handleEvent sh t s e
|
||||
return Nothing
|
||||
| Just Hide <- fromMessage m = do hideDecos (map snd dwrs)
|
||||
@@ -276,9 +276,9 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
|
||||
handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()
|
||||
handleEvent sh t (DS dwrs fs) e
|
||||
| PropertyEvent {ev_window = w} <- e
|
||||
, w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs
|
||||
, Just i <- w `elemIndex` (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i)
|
||||
| ExposeEvent {ev_window = w} <- e
|
||||
, w `elem` (catMaybes $ map (fst . snd) dwrs) = updateDecos sh t fs dwrs
|
||||
, Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i)
|
||||
handleEvent _ _ _ _ = return ()
|
||||
|
||||
-- | Mouse focus and mouse drag are handled by the same function, this
|
||||
|
@@ -4,13 +4,12 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.DragPane
|
||||
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- David Roundy <droundy@darcs.net>,
|
||||
-- Andrea Rossato <andrea.rossato@unibz.it>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Andrea Rossato <andrea.rossato@unibz.it>
|
||||
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -133,4 +132,6 @@ newDragWin r = do
|
||||
let mask = Just $ exposureMask .|. buttonPressMask
|
||||
w <- createNewWindow r mask handleColor False
|
||||
showWindow w
|
||||
d <- asks display
|
||||
liftIO $ lowerWindow d w
|
||||
return w
|
||||
|
@@ -51,6 +51,19 @@ import XMonad.Layout.Decoration
|
||||
-- and
|
||||
--
|
||||
-- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig)
|
||||
--
|
||||
-- A complete xmonad.hs file for this would therefore be:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Layout.DwmStyle
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {
|
||||
-- > layoutHook =
|
||||
-- > dwmStyle shrinkText defaultTheme
|
||||
-- > (layoutHook defaultConfig)
|
||||
-- > }
|
||||
--
|
||||
|
||||
|
||||
-- | Add simple old dwm-style decorations to windows of a layout.
|
||||
dwmStyle :: (Eq a, Shrinker s) => s -> Theme
|
||||
|
148
XMonad/Layout/Gaps.hs
Normal file
148
XMonad/Layout/Gaps.hs
Normal file
@@ -0,0 +1,148 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
|
||||
-- for now, use -fglasgow-exts for compatibility with ghc 6.6, which chokes
|
||||
-- on some of the LANGUAGE pragmas below
|
||||
{- LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances -}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.Gaps
|
||||
-- Copyright : (c) 2008 Brent Yorgey
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : <byorgey@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Create manually-sized gaps along edges of the screen which will not
|
||||
-- be used for tiling, along with support for toggling gaps on and
|
||||
-- off.
|
||||
--
|
||||
-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for
|
||||
-- leaving space for your dock-type applications (status bars,
|
||||
-- toolbars, docks, etc.), since it automatically sets up appropriate
|
||||
-- gaps, allows them to be toggled, etc. However, this module may
|
||||
-- still be useful in some situations where the automated approach of
|
||||
-- ManageDocks does not work; for example, to work with a dock-type
|
||||
-- application that does not properly set the STRUTS property, or to
|
||||
-- leave part of the screen blank which is truncated by a projector,
|
||||
-- and so on.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.Gaps (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
Direction(..),
|
||||
GapSpec, gaps, GapMessage(..)
|
||||
|
||||
) where
|
||||
|
||||
import XMonad.Core
|
||||
import Graphics.X11 (Rectangle(..))
|
||||
|
||||
import XMonad.Hooks.ManageDocks (Direction(..))
|
||||
import XMonad.Layout.LayoutModifier
|
||||
|
||||
import Data.List (delete)
|
||||
|
||||
-- $usage
|
||||
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Layout.Gaps
|
||||
--
|
||||
-- and applying the 'gaps' modifier to your layouts as follows (for
|
||||
-- example):
|
||||
--
|
||||
-- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full -- leave gaps at the top and right
|
||||
--
|
||||
-- You can additionally add some keybindings to toggle or modify the gaps,
|
||||
-- for example:
|
||||
--
|
||||
-- > , ((modMask x .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
|
||||
-- > , ((modMask x .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
|
||||
-- > , ((modMask x .|. controlMask, xK_w), sendMessage $ IncGap R 5) -- increment the right-hand gap
|
||||
-- > , ((modMask x .|. controlMask, xK_q), sendMessage $ DecGap R 5) -- decrement the right-hand gap
|
||||
--
|
||||
-- If you want complete control over all gaps, you could include
|
||||
-- something like this in your keybindings, assuming in this case you
|
||||
-- are using 'XMonad.Util.EZConfig.mkKeymap' or
|
||||
-- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig"
|
||||
-- for string keybinding specifications:
|
||||
--
|
||||
-- > ++
|
||||
-- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d)
|
||||
-- > | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)]
|
||||
-- > , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)]
|
||||
-- > ]
|
||||
--
|
||||
-- Given the above keybinding definition, for example, you could type
|
||||
-- @M-g, v, a@ to toggle the top gap.
|
||||
--
|
||||
-- To configure gaps differently per-screen, use
|
||||
-- "XMonad.Layout.PerScreen" (coming soon).
|
||||
|
||||
-- | A manual gap configuration. Each side of the screen on which a
|
||||
-- gap is enabled is paired with a size in pixels.
|
||||
type GapSpec = [(Direction,Int)]
|
||||
|
||||
-- | The gap state. The first component is the configuration (which
|
||||
-- gaps are allowed, and their current size), the second is the gaps
|
||||
-- which are currently active.
|
||||
data Gaps a = Gaps GapSpec [Direction]
|
||||
deriving (Show, Read)
|
||||
|
||||
-- | Messages which can be sent to a gap modifier.
|
||||
data GapMessage = ToggleGaps -- ^ Toggle all gaps.
|
||||
| ToggleGap !Direction -- ^ Toggle a single gap.
|
||||
| IncGap !Int !Direction -- ^ Increase a gap by a certain number of pixels.
|
||||
| DecGap !Int !Direction -- ^ Decrease a gap.
|
||||
deriving (Typeable)
|
||||
|
||||
instance Message GapMessage
|
||||
|
||||
instance LayoutModifier Gaps a where
|
||||
modifyLayout g w r = runLayout w (applyGaps g r)
|
||||
|
||||
pureMess (Gaps conf cur) m
|
||||
| Just ToggleGaps <- fromMessage m
|
||||
= Just $ Gaps conf (toggleGaps conf cur)
|
||||
| Just (ToggleGap d) <- fromMessage m
|
||||
= Just $ Gaps conf (toggleGap conf cur d)
|
||||
| Just (IncGap i d) <- fromMessage m
|
||||
= Just $ Gaps (incGap conf d i) cur
|
||||
| Just (DecGap i d) <- fromMessage m
|
||||
= Just $ Gaps (incGap conf d (-i)) cur
|
||||
| otherwise = Nothing
|
||||
|
||||
applyGaps :: Gaps a -> Rectangle -> Rectangle
|
||||
applyGaps gs r = foldr applyGap r (activeGaps gs)
|
||||
where
|
||||
applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z)
|
||||
applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z)
|
||||
applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h
|
||||
applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h
|
||||
|
||||
activeGaps :: Gaps a -> GapSpec
|
||||
activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf
|
||||
|
||||
toggleGaps :: GapSpec -> [Direction] -> [Direction]
|
||||
toggleGaps conf [] = map fst conf
|
||||
toggleGaps _ _ = []
|
||||
|
||||
toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction]
|
||||
toggleGap conf cur d | d `elem` cur = delete d cur
|
||||
| d `elem` (map fst conf) = d:cur
|
||||
| otherwise = cur
|
||||
|
||||
incGap :: GapSpec -> Direction -> Int -> GapSpec
|
||||
incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
|
||||
|
||||
fi :: (Num b, Integral a) => a -> b
|
||||
fi = fromIntegral
|
||||
|
||||
-- | Add togglable manual gaps to a layout.
|
||||
gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes.
|
||||
-> l a -- ^ The layout to modify.
|
||||
-> ModifiedLayout Gaps l a
|
||||
gaps g = ModifiedLayout (Gaps g (map fst g))
|
||||
|
@@ -17,7 +17,7 @@
|
||||
module XMonad.Layout.Grid (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
Grid(..), arrange
|
||||
Grid(..), arrange
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -44,23 +44,23 @@ instance LayoutClass Grid a where
|
||||
|
||||
arrange :: Rectangle -> [a] -> [(a, Rectangle)]
|
||||
arrange (Rectangle rx ry rw rh) st = zip st rectangles
|
||||
where
|
||||
nwins = length st
|
||||
ncols = max 1 . round . sqrt $ fromIntegral nwins * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double)
|
||||
mincs = nwins `div` ncols
|
||||
extrs = nwins - ncols * mincs
|
||||
chop :: Int -> Dimension -> [(Position, Dimension)]
|
||||
chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
|
||||
where
|
||||
nwins = length st
|
||||
ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins
|
||||
mincs = nwins `div` ncols
|
||||
extrs = nwins - ncols * mincs
|
||||
chop :: Int -> Dimension -> [(Position, Dimension)]
|
||||
chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
|
||||
where
|
||||
k :: Dimension
|
||||
k = m `div` fromIntegral n
|
||||
m' = fromIntegral m
|
||||
k' :: Position
|
||||
k' = fromIntegral k
|
||||
xcoords = chop ncols rw
|
||||
ycoords = chop mincs rh
|
||||
ycoords' = chop (succ mincs) rh
|
||||
(xbase, xext) = splitAt (ncols - extrs) xcoords
|
||||
rectangles = combine ycoords xbase ++ combine ycoords' xext
|
||||
where
|
||||
combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]
|
||||
k :: Dimension
|
||||
k = m `div` fromIntegral n
|
||||
m' = fromIntegral m
|
||||
k' :: Position
|
||||
k' = fromIntegral k
|
||||
xcoords = chop ncols rw
|
||||
ycoords = chop mincs rh
|
||||
ycoords' = chop (succ mincs) rh
|
||||
(xbase, xext) = splitAt (ncols - extrs) xcoords
|
||||
rectangles = combine ycoords xbase ++ combine ycoords' xext
|
||||
where
|
||||
combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]
|
||||
|
116
XMonad/Layout/HintedGrid.hs
Normal file
116
XMonad/Layout/HintedGrid.hs
Normal file
@@ -0,0 +1,116 @@
|
||||
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.HintedGrid
|
||||
-- Copyright : (c) Lukas Mai
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : <l.mai@web.de>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A not so simple layout that attempts to put all windows in a square grid
|
||||
-- while obeying their size hints.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.HintedGrid (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
Grid(..), arrange
|
||||
) where
|
||||
|
||||
import Prelude hiding ((.))
|
||||
|
||||
import XMonad
|
||||
import XMonad.StackSet
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
|
||||
infixr 9 .
|
||||
(.) :: (Functor f) => (a -> b) -> f a -> f b
|
||||
(.) = fmap
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.HintedGrid
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the 'Grid' layout:
|
||||
--
|
||||
-- > myLayouts = Grid False ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
|
||||
|
||||
-- | Automatic mirroring of hinted layouts doesn't work very well, so this
|
||||
-- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout,
|
||||
-- @Grid True@ is the mirrored variant (rotated by 90 degrees).
|
||||
data Grid a = Grid Bool deriving (Read, Show)
|
||||
|
||||
instance LayoutClass Grid Window where
|
||||
doLayout (Grid m) r w = flip (,) Nothing . arrange m r (integrate w)
|
||||
|
||||
replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
|
||||
replicateS n = runState . replicateM n . State
|
||||
|
||||
doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D]
|
||||
doColumn width height k adjs =
|
||||
let
|
||||
(ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs
|
||||
(_, ds) = doC height k fs
|
||||
in
|
||||
map snd . sortBy (comparing fst) . zip ind $ ds
|
||||
where
|
||||
doC h _ [] = (h, [])
|
||||
doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs
|
||||
where
|
||||
adj@(_, h') = f (width, h `div` n)
|
||||
|
||||
doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
|
||||
doRect height = doR
|
||||
where
|
||||
doR _ _ [] = []
|
||||
doR width n (c : cs) =
|
||||
let
|
||||
v = fromIntegral $ length c
|
||||
c' = doColumn (width `div` n) height v c
|
||||
(ws, hs) = unzip c'
|
||||
maxw = maximum ws
|
||||
height' = sum hs
|
||||
hbonus = height - height'
|
||||
hsingle = hbonus `div` v
|
||||
hoffset = hsingle `div` 2
|
||||
width' = width - maxw
|
||||
ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs
|
||||
xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws
|
||||
in
|
||||
zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs
|
||||
|
||||
-- | The internal function for computing the grid layout.
|
||||
arrange :: Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]
|
||||
arrange mirror (Rectangle rx ry rw rh) wins = do
|
||||
proto <- mapM mkAdjust wins
|
||||
let
|
||||
adjs = map (\f -> twist . f . twist) proto
|
||||
rs = arrange' (twist (rw, rh)) adjs
|
||||
rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs
|
||||
return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs'
|
||||
where
|
||||
twist
|
||||
| mirror = \(a, b) -> (b, a)
|
||||
| otherwise = id
|
||||
|
||||
arrange' :: D -> [D -> D] -> [Rectangle]
|
||||
arrange' (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols)
|
||||
where
|
||||
nwindows = length adjs
|
||||
ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double)
|
||||
nrows = nwindows `div` ncolumns
|
||||
nextras = nwindows - ncolumns * nrows
|
||||
(ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs
|
||||
(cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs'
|
@@ -23,7 +23,6 @@ module XMonad.Layout.HintedTile (
|
||||
|
||||
import XMonad hiding (Tall(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad
|
||||
|
||||
-- $usage
|
||||
@@ -33,21 +32,34 @@ import Control.Monad
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the HintedTile layout:
|
||||
--
|
||||
-- > myLayouts = HintedTile 1 0.1 0.5 TopLeft Tall ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
-- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc..
|
||||
-- > where
|
||||
-- > hintedTile = HintedTile nmaster delta ratio TopLeft
|
||||
-- > nmaster = 1
|
||||
-- > ratio = 1/2
|
||||
-- > delta = 3/100
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
--
|
||||
-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall,
|
||||
-- you need to disambiguate Tall. If you are replacing the
|
||||
-- built-in Tall with HintedTile, change @import Xmonad@ to
|
||||
-- @import Xmonad hiding (Tall)@.
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
|
||||
data HintedTile a = HintedTile
|
||||
{ nmaster :: Int
|
||||
, delta, frac :: Rational
|
||||
, alignment :: Alignment
|
||||
, orientation :: Orientation
|
||||
{ nmaster :: !Int
|
||||
, delta, frac :: !Rational
|
||||
, alignment :: !Alignment -- ^ Where to place windows that are smaller
|
||||
-- than their preordained rectangles.
|
||||
, orientation :: !Orientation
|
||||
} deriving ( Show, Read )
|
||||
|
||||
data Orientation = Wide | Tall
|
||||
data Orientation
|
||||
= Wide -- ^ Lay out windows similarly to Mirror tiled.
|
||||
| Tall -- ^ Lay out windows similarly to tiled.
|
||||
deriving ( Show, Read, Eq, Ord )
|
||||
|
||||
data Alignment = TopLeft | Center | BottomRight
|
||||
@@ -55,7 +67,7 @@ data Alignment = TopLeft | Center | BottomRight
|
||||
|
||||
instance LayoutClass HintedTile Window where
|
||||
doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do
|
||||
bhs <- mapM getHints w
|
||||
bhs <- mapM mkAdjust w
|
||||
let (masters, slaves) = splitAt nm bhs
|
||||
return (zip w (tiler masters slaves), Nothing)
|
||||
where
|
||||
@@ -73,39 +85,27 @@ instance LayoutClass HintedTile Window where
|
||||
|
||||
description l = show (orientation l)
|
||||
|
||||
adjBorder :: Dimension -> Dimension -> D -> D
|
||||
adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b)
|
||||
|
||||
-- | Transform a function on dimensions into one without regard for borders
|
||||
hintsUnderBorder :: (Dimension, SizeHints) -> D -> D
|
||||
hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1)
|
||||
|
||||
getHints :: Window -> X (Dimension, SizeHints)
|
||||
getHints w = withDisplay $ \d -> io $ liftM2 (,)
|
||||
(fromIntegral . wa_border_width <$> getWindowAttributes d w)
|
||||
(getWMNormalHints d w)
|
||||
|
||||
align :: Alignment -> Position -> Dimension -> Dimension -> Position
|
||||
align TopLeft p _ _ = p
|
||||
align Center p a b = p + fromIntegral (a - b) `div` 2
|
||||
align BottomRight p a b = p + fromIntegral (a - b)
|
||||
|
||||
-- Divide the screen vertically (horizontally) into n subrectangles
|
||||
divide :: Alignment -> Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle]
|
||||
divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
|
||||
divide _ _ [] _ = []
|
||||
divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h]
|
||||
where
|
||||
(w, h) = hintsUnderBorder bh (sw, sh)
|
||||
(w, h) = bh (sw, sh)
|
||||
|
||||
divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) :
|
||||
(divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
|
||||
where
|
||||
(w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs)))
|
||||
(w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs)))
|
||||
|
||||
divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) :
|
||||
(divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
|
||||
where
|
||||
(w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh)
|
||||
(w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh)
|
||||
|
||||
-- Split the screen into two rectangles, using a rational to specify the ratio
|
||||
split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])
|
||||
|
@@ -3,15 +3,15 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.IM
|
||||
-- Copyright : (c) Roman Cheplyaka
|
||||
-- Copyright : (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com>
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Roman Cheplyaka <roma@ro-che.info>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Layout suitable for workspace with multi-windowed instant messanger (like
|
||||
-- Psi or Tkabber).
|
||||
-- Layout modfier suitable for workspace with multi-windowed instant messanger
|
||||
-- (like Psi or Tkabber).
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -24,14 +24,15 @@ module XMonad.Layout.IM (
|
||||
|
||||
-- * TODO
|
||||
-- $todo
|
||||
Property(..), IM(..)
|
||||
Property(..), IM(..), withIM, gridIM,
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as S
|
||||
import Data.List
|
||||
import XMonad.Layout (splitHorizontallyBy)
|
||||
import XMonad.Layout.Grid (arrange)
|
||||
import XMonad.Layout.Grid
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Util.WindowProperties
|
||||
|
||||
-- $usage
|
||||
@@ -40,9 +41,11 @@ import XMonad.Util.WindowProperties
|
||||
-- > import XMonad.Layout.IM
|
||||
-- > import Data.Ratio ((%))
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the IM layout:
|
||||
-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer
|
||||
-- for managing your chat windows (Grid in this example, another useful choice
|
||||
-- to consider is Tabbed layout).
|
||||
--
|
||||
-- > myLayouts = IM (1%7) (ClassName "Tkabber") ||| Full ||| etc..
|
||||
-- > myLayouts = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
--
|
||||
-- Here @1%7@ is the part of the screen which your roster will occupy,
|
||||
@@ -57,18 +60,61 @@ import XMonad.Util.WindowProperties
|
||||
-- $hints
|
||||
--
|
||||
-- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace".
|
||||
--
|
||||
-- By default the roster window will appear on the left side.
|
||||
-- To place roster window on the right side, use @reflectHoriz@ from
|
||||
-- "XMonad.Layout.Reflect" module.
|
||||
|
||||
-- $todo
|
||||
-- All these items are questionable. Please let me know if you find them useful.
|
||||
-- This item are questionable. Please let me know if you find them useful.
|
||||
--
|
||||
-- * shrink\/expand
|
||||
--
|
||||
-- * allow roster placement on the right side or even on top\/bottom
|
||||
--
|
||||
-- * use arbitrary layout instead of grid
|
||||
|
||||
-- | Data type for LayoutModifier which converts given layout to IM-layout
|
||||
-- (with dedicated space for the roster and original layout for chat windows)
|
||||
data AddRoster a = AddRoster Rational Property deriving (Read, Show)
|
||||
|
||||
instance LayoutModifier AddRoster Window where
|
||||
modifyLayout (AddRoster ratio prop) = applyIM ratio prop
|
||||
modifierDescription _ = "IM"
|
||||
|
||||
-- | Modifier which converts given layout to IM-layout (with dedicated
|
||||
-- space for roster and original layout for chat windows)
|
||||
withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a
|
||||
withIM ratio prop = ModifiedLayout $ AddRoster ratio prop
|
||||
|
||||
-- | IM layout modifier applied to the Grid layout
|
||||
gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a
|
||||
gridIM ratio prop = withIM ratio prop Grid
|
||||
|
||||
-- | Internal function for adding space for the roster specified by
|
||||
-- the property and running original layout for all chat windows
|
||||
applyIM :: (LayoutClass l Window) =>
|
||||
Rational
|
||||
-> Property
|
||||
-> S.Workspace WorkspaceId (l Window) Window
|
||||
-> Rectangle
|
||||
-> X ([(Window, Rectangle)], Maybe (l Window))
|
||||
applyIM ratio prop wksp rect = do
|
||||
let stack = S.stack wksp
|
||||
let ws = S.integrate' $ stack
|
||||
let (masterRect, slaveRect) = splitHorizontallyBy ratio rect
|
||||
master <- findM (hasProperty prop) ws
|
||||
case master of
|
||||
Just w -> do
|
||||
let filteredStack = stack >>= S.filter (w /=)
|
||||
wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect
|
||||
return ((w, masterRect) : fst wrs, snd wrs)
|
||||
Nothing -> runLayout wksp rect
|
||||
|
||||
-- | Like find, but works with monadic computation instead of pure function.
|
||||
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
|
||||
findM _ [] = return Nothing
|
||||
findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }
|
||||
|
||||
-- | This is for compatibility with old configs only and will be removed in future versions!
|
||||
data IM a = IM Rational Property deriving (Read, Show)
|
||||
|
||||
instance LayoutClass IM Window where
|
||||
description _ = "IM"
|
||||
doLayout (IM r prop) rect stack = do
|
||||
@@ -79,8 +125,3 @@ instance LayoutClass IM Window where
|
||||
Just w -> (w, masterRect) : arrange slaveRect (filter (w /=) ws)
|
||||
Nothing -> arrange rect ws
|
||||
return (positions, Nothing)
|
||||
|
||||
-- | Like find, but works with monadic computation instead of pure function.
|
||||
findM :: Monad m => (a-> m Bool) -> [a] -> m (Maybe a)
|
||||
findM _ [] = return Nothing
|
||||
findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }
|
||||
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : portable
|
||||
--
|
||||
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : portable
|
||||
--
|
||||
@@ -42,22 +42,15 @@ import XMonad.Layout.Decoration ( isInStack )
|
||||
layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
|
||||
layoutHints = ModifiedLayout LayoutHints
|
||||
|
||||
-- | Expand a size by the given multiple of the border width. The
|
||||
-- multiple is most commonly 1 or -1.
|
||||
adjBorders :: Dimension -> Dimension -> D -> D
|
||||
adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW)
|
||||
|
||||
data LayoutHints a = LayoutHints deriving (Read, Show)
|
||||
|
||||
instance LayoutModifier LayoutHints Window where
|
||||
modifierDescription _ = "Hinted"
|
||||
redoLayout _ _ s xs = do
|
||||
bW <- asks (borderWidth . config)
|
||||
xs' <- mapM (applyHint bW) xs
|
||||
xs' <- mapM applyHint xs
|
||||
return (xs', Nothing)
|
||||
where
|
||||
applyHint bW (w,r@(Rectangle a b c d)) =
|
||||
withDisplay $ \disp -> do
|
||||
sh <- io $ getWMNormalHints disp w
|
||||
let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d)
|
||||
return (w, if isInStack s w then Rectangle a b c' d' else r)
|
||||
applyHint (w,r@(Rectangle a b c d)) = do
|
||||
adj <- mkAdjust w
|
||||
let (c',d') = adj (c,d)
|
||||
return (w, if isInStack s w then Rectangle a b c' d' else r)
|
||||
|
@@ -7,7 +7,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : portable
|
||||
--
|
||||
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -61,10 +61,9 @@ layoutScreens nscr l =
|
||||
(wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect
|
||||
windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
|
||||
let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs
|
||||
gaps = map (statusGap . W.screenDetail) $ v:vs
|
||||
(s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps))
|
||||
in ws { W.current = W.Screen x 0 (SD s g)
|
||||
, W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg
|
||||
s:ss = map snd wss
|
||||
in ws { W.current = W.Screen x 0 (SD s)
|
||||
, W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss
|
||||
, W.hidden = ys }
|
||||
|
||||
getWindowRectangle :: Window -> X Rectangle
|
||||
|
@@ -25,6 +25,7 @@ module XMonad.Layout.Magnifier
|
||||
magnifierOff,
|
||||
magnifiercz,
|
||||
magnifiercz',
|
||||
maximizeVertical,
|
||||
MagnifyMsg (..)
|
||||
) where
|
||||
|
||||
@@ -80,32 +81,34 @@ import XMonad.Layout.LayoutModifier
|
||||
|
||||
-- | Increase the size of the window that has focus
|
||||
magnifier :: l a -> ModifiedLayout Magnifier l a
|
||||
magnifier = ModifiedLayout (Mag 1.5 On All)
|
||||
magnifier = ModifiedLayout (Mag (1.5,1.5) On All)
|
||||
|
||||
-- | Change the size of the window that has focus by a custom zoom
|
||||
magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
|
||||
magnifiercz cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On All)
|
||||
magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All)
|
||||
|
||||
-- | Increase the size of the window that has focus, unless if it is the
|
||||
-- master window.
|
||||
magnifier' :: l a -> ModifiedLayout Magnifier l a
|
||||
magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)
|
||||
magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster)
|
||||
|
||||
-- | Magnifier that defaults to Off
|
||||
magnifierOff :: l a -> ModifiedLayout Magnifier l a
|
||||
magnifierOff = ModifiedLayout (Mag 1.5 Off All)
|
||||
magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All)
|
||||
|
||||
-- | Increase the size of the window that has focus by a custom zoom,
|
||||
-- unless if it is the master window.
|
||||
magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
|
||||
magnifiercz' cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On NoMaster)
|
||||
magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster)
|
||||
|
||||
-- | A magnifier that greatly magnifies just the vertical direction
|
||||
maximizeVertical :: l a -> ModifiedLayout Magnifier l a
|
||||
maximizeVertical = ModifiedLayout (Mag (1,1000) Off All)
|
||||
|
||||
data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )
|
||||
instance Message MagnifyMsg
|
||||
|
||||
data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show)
|
||||
|
||||
type Zoom = Double
|
||||
data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show)
|
||||
|
||||
data Toggle = On | Off deriving (Read, Show)
|
||||
data MagnifyMaster = All | NoMaster deriving (Read, Show)
|
||||
@@ -117,10 +120,11 @@ instance LayoutModifier Magnifier Window where
|
||||
where nothing _ _ wrs = return (wrs, Nothing)
|
||||
|
||||
handleMess (Mag z On t) m
|
||||
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On t)
|
||||
| Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On t)
|
||||
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t)
|
||||
| Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t)
|
||||
| Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t)
|
||||
| Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t)
|
||||
where addto (x,y) i = (x+i,y+i)
|
||||
handleMess (Mag z Off t) m
|
||||
| Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t)
|
||||
| Just Toggle <- fromMessage m = return . Just $ (Mag z On t)
|
||||
@@ -136,18 +140,19 @@ unlessMaster :: NewLayout a -> NewLayout a
|
||||
unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
|
||||
else mainmod r s wrs
|
||||
|
||||
applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a)
|
||||
applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]
|
||||
-> X ([(Window, Rectangle)], Maybe a)
|
||||
applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)
|
||||
let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)]
|
||||
| otherwise = (w,wr) : ws
|
||||
return (reverse $ foldr mag [] wrs, Nothing)
|
||||
|
||||
magnify :: Double -> Rectangle -> Rectangle
|
||||
magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h'
|
||||
magnify :: (Double, Double) -> Rectangle -> Rectangle
|
||||
magnify (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h'
|
||||
where x' = x - fromIntegral (w' - w) `div` 2
|
||||
y' = y - fromIntegral (h' - h) `div` 2
|
||||
w' = round $ fromIntegral w * zoom
|
||||
h' = round $ fromIntegral h * zoom
|
||||
w' = round $ fromIntegral w * zoomx
|
||||
h' = round $ fromIntegral h * zoomy
|
||||
|
||||
fit :: Rectangle -> Rectangle -> Rectangle
|
||||
fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'
|
||||
|
110
XMonad/Layout/Master.hs
Normal file
110
XMonad/Layout/Master.hs
Normal file
@@ -0,0 +1,110 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.Master
|
||||
-- Copyright : (c) Lukas Mai
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : <l.mai@web.de>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A layout that adds a distinguished master window to a base layout.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.Master (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
mastered,
|
||||
Master
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.StackSet
|
||||
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.Master
|
||||
--
|
||||
-- and add something like
|
||||
--
|
||||
-- > mastered (1/100) (1/2) $ Grid
|
||||
--
|
||||
-- to your layouts. This will use the left half of your screen for a master
|
||||
-- window and let Grid manage the right half.
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
|
||||
--
|
||||
-- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and
|
||||
-- 'XMonad.Layout.Expand' messages.
|
||||
|
||||
mastered :: (LayoutClass l a)
|
||||
=> Rational -- ^ @delta@, the ratio of the screen to resize by
|
||||
-> Rational -- ^ @frac@, what portion of the screen to reserve for the master window
|
||||
-> l a -- ^ the layout to use for the remaining windows
|
||||
-> Master l a
|
||||
mastered d f b = Master d f' b
|
||||
where
|
||||
f' = min 1 . max 0 $ f
|
||||
|
||||
data Master l a =
|
||||
Master{
|
||||
delta :: Rational,
|
||||
frac :: Rational,
|
||||
base :: l a
|
||||
} deriving (Show, Read, Eq, Ord)
|
||||
|
||||
extractMaster :: Stack a -> (a, Maybe (Stack a))
|
||||
extractMaster (Stack x ls rs) = case reverse ls of
|
||||
[] -> (x, differentiate rs)
|
||||
(m : ls') -> (m, Just $ Stack x (reverse ls') rs)
|
||||
|
||||
area :: Rectangle -> Dimension
|
||||
area r = rect_width r * rect_height r
|
||||
|
||||
chop :: D -> Rectangle -> Rectangle
|
||||
chop (w, h) (Rectangle rx ry rw rh) =
|
||||
let
|
||||
r' = maximumBy (comparing area)
|
||||
[ Rectangle rx (ry + fromIntegral h) rw (rh - h)
|
||||
, Rectangle (rx + fromIntegral w) ry (rw - w) rh]
|
||||
in
|
||||
r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' }
|
||||
|
||||
instance (LayoutClass l Window) => LayoutClass (Master l) Window where
|
||||
description m = "Master " ++ description (base m)
|
||||
handleMessage m msg
|
||||
| Just Shrink <- fromMessage msg =
|
||||
return . Just $ m{ frac = max 0 $ frac m - delta m }
|
||||
| Just Expand <- fromMessage msg =
|
||||
return . Just $ m{ frac = min 1 $ frac m + delta m }
|
||||
| otherwise =
|
||||
fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg
|
||||
runLayout ws rect = do
|
||||
(f, ws', rect') <- case fmap extractMaster $ stack ws of
|
||||
Nothing ->
|
||||
return (id, ws, rect)
|
||||
Just (x, Nothing) -> do
|
||||
f <- mkAdjust x
|
||||
let
|
||||
(w', h') = f (rect_width rect, rect_height rect)
|
||||
xr = rect{ rect_width = w', rect_height = h' }
|
||||
return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0)
|
||||
Just (x, Just st) -> do
|
||||
f <- mkAdjust x
|
||||
let
|
||||
d@(w', h') = f (scale $ rect_width rect, rect_height rect)
|
||||
xr = rect{ rect_width = w', rect_height = h' }
|
||||
return (((x, xr) :), ws{ stack = Just st }, chop d rect)
|
||||
(y, l) <- runLayout ws'{ layout = base m } rect'
|
||||
return (f y, fmap (\x -> m{ base = x }) l)
|
||||
where
|
||||
m = layout ws
|
||||
scale = round . (* frac m) . fromIntegral
|
@@ -15,7 +15,6 @@
|
||||
-- currently focused window occupy the whole screen (\"zoom in\") then undo
|
||||
-- the transformation (\"zoom out\").
|
||||
|
||||
|
||||
module XMonad.Layout.MultiToggle (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
@@ -24,7 +23,8 @@ module XMonad.Layout.MultiToggle (
|
||||
(??),
|
||||
EOT(..),
|
||||
single,
|
||||
mkToggle
|
||||
mkToggle,
|
||||
mkToggle1
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -46,18 +46,10 @@ import Data.Maybe
|
||||
-- undo the current layout transformer, pass the message on to the base
|
||||
-- layout, then reapply the transformer.
|
||||
--
|
||||
-- To use this module, you first have to define the transformers that you
|
||||
-- want to be handled by @MultiToggle@. For example, if the transformer is
|
||||
-- 'XMonad.Layout.Mirror':
|
||||
--
|
||||
-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)
|
||||
-- > instance Transformer MIRROR Window where
|
||||
-- > transform _ x k = k (Mirror x)
|
||||
--
|
||||
-- @MIRROR@ can be any identifier (it has to start with an uppercase letter,
|
||||
-- of course); I've chosen an all-uppercase version of the transforming
|
||||
-- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@
|
||||
-- at the beginning of your file to be able to derive "Data.Typeable".
|
||||
-- To use this module, you need some data types which represent
|
||||
-- transformers; for some commonly used transformers (including
|
||||
-- MIRROR, NOBORDERS, and FULL used in the examples below) you can
|
||||
-- simply import "XMonad.Layout.MultiToggle.Instances".
|
||||
--
|
||||
-- Somewhere else in your file you probably have a definition of @layout@;
|
||||
-- the default looks like this:
|
||||
@@ -77,17 +69,7 @@ import Data.Maybe
|
||||
-- (That should be part of your key bindings.) When you press @mod-x@, the
|
||||
-- active layout is mirrored. Another @mod-x@ and it's back to normal.
|
||||
--
|
||||
-- It's also possible to stack @MultiToggle@s. Let's define a few more
|
||||
-- transformers ('XMonad.Layout.NoBorders.noBorders' is in
|
||||
-- "XMonad.Layout.NoBorders"):
|
||||
--
|
||||
-- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable)
|
||||
-- > instance Transformer NOBORDERS Window where
|
||||
-- > transform _ x k = k (noBorders x)
|
||||
-- >
|
||||
-- > data FULL = FULL deriving (Read, Show, Eq, Typeable)
|
||||
-- > instance Transformer FULL Window where
|
||||
-- > transform _ x k = k Full
|
||||
-- It's also possible to stack @MultiToggle@s. For example:
|
||||
--
|
||||
-- @
|
||||
-- layout = id
|
||||
@@ -100,6 +82,20 @@ import Data.Maybe
|
||||
-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily
|
||||
-- maximize windows, in addition to being able to rotate layouts and remove
|
||||
-- window borders.
|
||||
--
|
||||
-- You can also define your own transformers by creating a data type
|
||||
-- which is an instance of the 'Transformer' class. For example, here
|
||||
-- is the definition of @MIRROR@:
|
||||
--
|
||||
-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)
|
||||
-- > instance Transformer MIRROR Window where
|
||||
-- > transform _ x k = k (Mirror x)
|
||||
--
|
||||
-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the
|
||||
-- beginning of your file (ghc 6.8 only; with ghc 6.6 you can use
|
||||
-- @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ instead) to be able to
|
||||
-- derive "Data.Typeable".
|
||||
--
|
||||
|
||||
-- | A class to identify custom transformers (and look up transforming
|
||||
-- functions by type).
|
||||
@@ -157,6 +153,11 @@ instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where
|
||||
mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a
|
||||
mkToggle ts l = MultiToggle l (EL l) Nothing id ts
|
||||
|
||||
-- | Construct a @MultiToggle@ layout from a single transformer and a base
|
||||
-- layout.
|
||||
mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a
|
||||
mkToggle1 t = mkToggle (single t)
|
||||
|
||||
-- | Marks the end of a transformer list.
|
||||
data EOT = EOT deriving (Read, Show)
|
||||
data HCons a b = HCons a b deriving (Read, Show)
|
||||
|
40
XMonad/Layout/MultiToggle/Instances.hs
Normal file
40
XMonad/Layout/MultiToggle/Instances.hs
Normal file
@@ -0,0 +1,40 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
-- above is for compatibility with GHC 6.6.
|
||||
{- LANGUAGE TypeSynonymInstances, DeriveDataTypeable -}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.MultiToggle.Instances
|
||||
-- Copyright : (c) 2008 Brent Yorgey
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : <byorgey@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Some convenient common instances of the
|
||||
-- 'XMonad.Layout.MultiToggle.Transformer' class, for use with
|
||||
-- "XMonad.Layout.MultiToggle".
|
||||
|
||||
module XMonad.Layout.MultiToggle.Instances (
|
||||
StdTransformers(..)
|
||||
) where
|
||||
|
||||
import XMonad.Layout.MultiToggle
|
||||
|
||||
import XMonad
|
||||
import XMonad.Layout.NoBorders
|
||||
|
||||
data StdTransformers = FULL -- ^ switch to Full layout
|
||||
| NBFULL -- ^ switch to Full with no borders
|
||||
| MIRROR -- ^ Mirror the current layout.
|
||||
| NOBORDERS -- ^ Remove borders.
|
||||
| SMARTBORDERS -- ^ Apply smart borders.
|
||||
deriving (Read, Show, Eq, Typeable)
|
||||
|
||||
instance Transformer StdTransformers Window where
|
||||
transform FULL _ k = k Full
|
||||
transform NBFULL _ k = k (noBorders Full)
|
||||
transform MIRROR x k = k (Mirror x)
|
||||
transform NOBORDERS x k = k (noBorders x)
|
||||
transform SMARTBORDERS x k = k (smartBorders x)
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -75,13 +75,13 @@ data SmartBorder a = SmartBorder [a] deriving (Read, Show)
|
||||
instance LayoutModifier SmartBorder Window where
|
||||
unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
|
||||
|
||||
redoLayout (SmartBorder s) _ _ wrs = do
|
||||
redoLayout (SmartBorder s) _ st wrs = do
|
||||
wset <- gets windowset
|
||||
let
|
||||
let managedwindows = W.integrate st
|
||||
screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset
|
||||
ws = tiled ++ floating
|
||||
tiled = case wrs of
|
||||
[(w, _)] | singleton screens -> [w]
|
||||
tiled = case filter (`elem` managedwindows) $ map fst wrs of
|
||||
[w] | singleton screens -> [w]
|
||||
_ -> []
|
||||
floating =
|
||||
[ w |
|
||||
|
@@ -10,18 +10,23 @@
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Configure layouts on a per-workspace basis.
|
||||
-- Configure layouts on a per-workspace basis: use layouts and apply
|
||||
-- layout modifiers selectively, depending on the workspace.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.PerWorkspace
|
||||
( -- * Usage
|
||||
-- $usage
|
||||
onWorkspace, onWorkspaces
|
||||
PerWorkspace,
|
||||
onWorkspace, onWorkspaces,
|
||||
modWorkspace, modWorkspaces
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Layout.LayoutModifier
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
-- $usage
|
||||
@@ -31,12 +36,15 @@ import Data.Maybe (fromMaybe)
|
||||
--
|
||||
-- and modifying your layoutHook as follows (for example):
|
||||
--
|
||||
-- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo".
|
||||
-- > layoutHook = modWorkspace "baz" m1 $ -- apply layout modifier m1 to all layouts on workspace "baz"
|
||||
-- > onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo".
|
||||
-- > onWorkspaces ["bar","6"] l2 $ -- layout l2 will be used on workspaces "bar" and "6".
|
||||
-- > l3 -- layout l3 will be used on all other workspaces.
|
||||
--
|
||||
-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts,
|
||||
-- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@
|
||||
-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated
|
||||
-- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText
|
||||
-- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a
|
||||
-- function of type @(l a -> ModifiedLayout lm l a)@.
|
||||
--
|
||||
-- In another scenario, suppose you wanted to have layouts A, B, and C
|
||||
-- available on all workspaces, except that on workspace foo you want
|
||||
@@ -52,7 +60,7 @@ onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
|
||||
-> (l1 a) -- ^ layout to use on the matched workspace
|
||||
-> (l2 a) -- ^ layout to use everywhere else
|
||||
-> PerWorkspace l1 l2 a
|
||||
onWorkspace wsId l1 l2 = PerWorkspace [wsId] False l1 l2
|
||||
onWorkspace wsId = onWorkspaces [wsId]
|
||||
|
||||
-- | Specify one layout to use on a particular set of workspaces, and
|
||||
-- another to use on all other workspaces.
|
||||
@@ -63,6 +71,25 @@ onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
|
||||
-> PerWorkspace l1 l2 a
|
||||
onWorkspaces wsIds l1 l2 = PerWorkspace wsIds False l1 l2
|
||||
|
||||
-- | Specify a layout modifier to apply to a particular workspace; layouts
|
||||
-- on all other workspaces will remain unmodified.
|
||||
modWorkspace :: (LayoutClass l a)
|
||||
=> WorkspaceId -- ^ tag of the workspace to match
|
||||
-> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching workspace
|
||||
-> l a -- ^ the base layout
|
||||
-> PerWorkspace (ModifiedLayout lm l) l a
|
||||
modWorkspace wsId = modWorkspaces [wsId]
|
||||
|
||||
-- | Specify a layout modifier to apply to a particular set of
|
||||
-- workspaces; layouts on all other workspaces will remain
|
||||
-- unmodified.
|
||||
modWorkspaces :: (LayoutClass l a)
|
||||
=> [WorkspaceId] -- ^ tags of the workspaces to match
|
||||
-> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching workspaces
|
||||
-> l a -- ^ the base layout
|
||||
-> PerWorkspace (ModifiedLayout lm l) l a
|
||||
modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l
|
||||
|
||||
-- | Structure for representing a workspace-specific layout along with
|
||||
-- a layout for all other workspaces. We store the tags of workspaces
|
||||
-- to be matched, and the two layouts. We save the layout choice in
|
||||
@@ -97,3 +124,4 @@ mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->
|
||||
PerWorkspace l1 l2 a
|
||||
mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' =
|
||||
(\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf'
|
||||
|
||||
|
@@ -1,95 +0,0 @@
|
||||
{-# OPTIONS -fglasgow-exts #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.ScratchWorkspace
|
||||
-- Copyright : (c) Braden Shepherdson, David Roundy 2008
|
||||
-- License : BSD-style (as xmonad)
|
||||
--
|
||||
-- Maintainer : Braden.Shepherdson@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
|
||||
module XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) where
|
||||
|
||||
import Data.List ( partition )
|
||||
import Control.Monad ( guard )
|
||||
|
||||
import XMonad
|
||||
import XMonad.Core
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
hiddenRect :: Rectangle
|
||||
hiddenRect = Rectangle (-1) (-1) 0 0
|
||||
|
||||
scratchName :: String
|
||||
scratchName = "*scratch*"
|
||||
|
||||
-- This module uses an ugly hack, which is to create a special screen for
|
||||
-- the scratch workspace. This screen is then moved onto a visible area or
|
||||
-- away when you ask for the scratch workspace to be shown or hidden.
|
||||
|
||||
-- This is a workaround for the fact that we don't have anything like
|
||||
-- proper support for hierarchical workspaces, so I use the only hierarchy
|
||||
-- we've got, which is at the screen level.
|
||||
|
||||
toggleScratchWorkspace :: LayoutClass l Int => l Int -> X ()
|
||||
toggleScratchWorkspace l =
|
||||
do s <- gets windowset
|
||||
defaultl <- asks (layoutHook . config)
|
||||
srs <- withDisplay getCleanedScreenInfo
|
||||
if length srs == 1 + length (W.visible s)
|
||||
then -- we don't yet have a scratch screen!
|
||||
if scratchName `W.tagMember` s
|
||||
then return () -- We'll just bail out of scratchName already exists...
|
||||
else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect (0,0,0,0))
|
||||
scratch = W.Workspace scratchName defaultl Nothing
|
||||
s' = s { W.visible = scratchscreen: W.visible s }
|
||||
modify $ \st -> st { windowset = s' }
|
||||
refresh
|
||||
else -- We've already got a scratch (we think)
|
||||
if length srs /= length (W.visible s)
|
||||
then -- Something is odd... too many screens are visible! Do nothing.
|
||||
return ()
|
||||
else -- Yes, it does seem there's a scratch screen already
|
||||
case partition ((/= -1) . W.screen) $ W.current s : W.visible s of
|
||||
(others@(c:vs),[scratchscreen]) ->
|
||||
if screenRect (W.screenDetail scratchscreen) == hiddenRect
|
||||
then -- we're hidden now, so let's display ourselves
|
||||
do let r = screenRect $ W.screenDetail c
|
||||
(rs,_) <- runLayout (W.Workspace "" l (Just $ W.Stack 0 [1] [])) r
|
||||
let (r0, r1) = case rs of
|
||||
[(0,ra),(1,rb)] -> (ra,rb)
|
||||
[(1,ra),(0,rb)] -> (rb,ra)
|
||||
[(1,ra)] -> (r,ra)
|
||||
[(0,ra)] -> (ra,r)
|
||||
_ -> (r,r)
|
||||
s' = s { W.current = setrect r0 scratchscreen,
|
||||
W.visible = setrect r1 c : vs }
|
||||
modify $ \st -> st { windowset = s' }
|
||||
refresh
|
||||
else -- we're visible, so now we want to hide
|
||||
do ml <- handleMessage (W.layout $ W.workspace scratchscreen) (SomeMessage Hide)
|
||||
let scratchscreen' = case ml of
|
||||
Nothing -> scratchscreen
|
||||
Just l' -> scratchscreen
|
||||
{ W.workspace =
|
||||
(W.workspace scratchscreen) { W.layout = l' } }
|
||||
mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratchscreen
|
||||
let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr)
|
||||
r' <- pickRect (W.screen scr) srs
|
||||
Just $ setrect r' scr
|
||||
pickRect _ [z] = Just z
|
||||
pickRect i (z:zs) | i < 1 = Just z
|
||||
| otherwise = pickRect (i-1) zs
|
||||
pickRect _ [] = Nothing
|
||||
case mapM modscr others of
|
||||
Just (c':vs') ->
|
||||
do let s' = s { W.current = c',
|
||||
W.visible = setrect hiddenRect scratchscreen' : vs' }
|
||||
modify $ \st -> st { windowset = s' }
|
||||
refresh
|
||||
_ -> return () -- weird error!
|
||||
_ -> -- Something is odd... there doesn't seem to *really* be a scratch screen...
|
||||
return ()
|
||||
where setrect :: Rectangle -> W.Screen i l a sid ScreenDetail -> W.Screen i l a sid ScreenDetail
|
||||
setrect x scr = scr {W.screenDetail = (W.screenDetail scr) {screenRect = x}}
|
@@ -54,7 +54,7 @@ data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show)
|
||||
|
||||
data SWNConfig =
|
||||
SWNC { swn_font :: String -- ^ Font name
|
||||
, swn_bgcolor :: String -- ^ Backgorund color
|
||||
, swn_bgcolor :: String -- ^ Background color
|
||||
, swn_color :: String -- ^ String color
|
||||
, swn_fade :: Rational -- ^ Time in seconds of the name visibility
|
||||
} deriving (Read, Show)
|
||||
|
@@ -10,7 +10,9 @@
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A layout modifier for adding simple decorations to the windows of a
|
||||
-- given layout.
|
||||
-- given layout. The decorations are in the form of ion-like tabs
|
||||
-- for window titles.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.SimpleDecoration
|
||||
|
@@ -62,9 +62,10 @@ simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll
|
||||
|
||||
data SimpleFloat a = SF Dimension deriving (Show, Read)
|
||||
instance LayoutClass SimpleFloat Window where
|
||||
doLayout (SF i) sc (S.Stack w l r) = do wrs <- mapM (getSize i sc) (w : reverse l ++ r)
|
||||
return (wrs, Nothing)
|
||||
description _ = "Float"
|
||||
doLayout (SF i) sc (S.Stack w l r) = do
|
||||
wrs <- mapM (getSize i sc) (w : reverse l ++ r)
|
||||
return (wrs, Nothing)
|
||||
|
||||
getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle)
|
||||
getSize i (Rectangle rx ry _ _) w = do
|
||||
|
64
XMonad/Layout/SimplestFloat.hs
Normal file
64
XMonad/Layout/SimplestFloat.hs
Normal file
@@ -0,0 +1,64 @@
|
||||
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.SimplestFloat
|
||||
-- Copyright : (c) 2008 Jussi Mäki
|
||||
-- License : BSD-style (see xmonad/LICENSE)
|
||||
--
|
||||
-- Maintainer : joamaki@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A basic floating layout like SimpleFloat but without the decoration.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.SimplestFloat
|
||||
( -- * Usage:
|
||||
-- $usage
|
||||
simplestFloat
|
||||
, SimplestFloat
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as S
|
||||
import XMonad.Layout.WindowArranger
|
||||
import XMonad.Layout.LayoutModifier
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your
|
||||
-- @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.SimplestFloat
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the SimplestFloat layout:
|
||||
--
|
||||
-- > myLayouts = simplestFloat ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
|
||||
-- | A simple floating layout where every window is placed according
|
||||
-- to the window's initial attributes.
|
||||
simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a
|
||||
simplestFloat = (windowArrangeAll $ SF)
|
||||
|
||||
data SimplestFloat a = SF deriving (Show, Read)
|
||||
instance LayoutClass SimplestFloat Window where
|
||||
doLayout SF sc (S.Stack w l r) = do wrs <- mapM (getSize sc) (w : reverse l ++ r)
|
||||
return (wrs, Nothing)
|
||||
description _ = "SimplestFloat"
|
||||
|
||||
getSize :: Rectangle -> Window -> X (Window,Rectangle)
|
||||
getSize (Rectangle rx ry _ _) w = do
|
||||
d <- asks display
|
||||
bw <- asks (borderWidth . config)
|
||||
wa <- io $ getWindowAttributes d w
|
||||
let x = max rx $ fi $ wa_x wa
|
||||
y = max ry $ fi $ wa_y wa
|
||||
wh = (fi $ wa_width wa) + (bw * 2)
|
||||
ht = (fi $ wa_height wa) + (bw * 2)
|
||||
return (w, Rectangle x y wh ht)
|
||||
where
|
||||
fi x = fromIntegral x
|
@@ -6,7 +6,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
64
XMonad/Layout/StackTile.hs
Normal file
64
XMonad/Layout/StackTile.hs
Normal file
@@ -0,0 +1,64 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.StackTile
|
||||
-- Copyright : (c) Rickard Gustafsson <acura@allyourbase.se>
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Rickard Gustafsson <acura@allyourbase.se>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A stacking layout, like dishes but with the ability to resize master pane.
|
||||
-- Moastly usefull on small screens.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.StackTile (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
StackTile(..)
|
||||
) where
|
||||
|
||||
import XMonad hiding (tile)
|
||||
import qualified XMonad.StackSet as W
|
||||
import Control.Monad
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.StackTile
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the StackTile layout:
|
||||
--
|
||||
-- > myLayouts = StackTile 1 (3/100) (1/2) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
--
|
||||
data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read)
|
||||
|
||||
instance LayoutClass StackTile a where
|
||||
pureLayout (StackTile nmaster _ frac) r s = zip ws rs
|
||||
where ws = W.integrate s
|
||||
rs = tile frac r nmaster (length ws)
|
||||
|
||||
pureMessage (StackTile nmaster delta frac) m =
|
||||
msum [fmap resize (fromMessage m)
|
||||
,fmap incmastern (fromMessage m)]
|
||||
|
||||
where resize Shrink = StackTile nmaster delta (max 0 $ frac-delta)
|
||||
resize Expand = StackTile nmaster delta (min 1 $ frac+delta)
|
||||
incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac
|
||||
|
||||
description _ = "StackTile"
|
||||
|
||||
tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
|
||||
tile f r nmaster n = if n <= nmaster || nmaster == 0
|
||||
then splitHorizontally n r
|
||||
else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
|
||||
where (r1,r2) = splitVerticallyBy f r
|
@@ -18,7 +18,9 @@ module XMonad.Layout.Tabbed
|
||||
( -- * Usage:
|
||||
-- $usage
|
||||
simpleTabbed, tabbed, addTabs
|
||||
, simpleTabbedAlways, tabbedAlways, addTabsAlways
|
||||
, simpleTabbedBottom, tabbedBottom, addTabsBottom
|
||||
, simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways
|
||||
, Theme (..)
|
||||
, defaultTheme
|
||||
, TabbedDecoration (..)
|
||||
@@ -51,6 +53,10 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
--
|
||||
-- The default Tabbar behaviour is to hide it when only one window is open
|
||||
-- on the workspace. To have it always shown, use one of the layouts or
|
||||
-- modifiers ending in "Always".
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
@@ -64,10 +70,9 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
--
|
||||
-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..
|
||||
|
||||
-- | A tabbed layout with the default xmonad Theme. Here's a screen
|
||||
-- shot:
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/simpleTabbed.png>
|
||||
-- Layouts
|
||||
|
||||
-- | A tabbed layout with the default xmonad Theme.
|
||||
--
|
||||
-- This is a minimal working configuration:
|
||||
--
|
||||
@@ -75,48 +80,92 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
-- > import XMonad.Layout.DecorationMadness
|
||||
-- > main = xmonad defaultConfig { layoutHook = simpleTabbed }
|
||||
simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
simpleTabbed = decoration shrinkText defaultTheme Tabbed Simplest
|
||||
simpleTabbed = tabbed shrinkText defaultTheme
|
||||
|
||||
simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
simpleTabbedAlways = tabbedAlways shrinkText defaultTheme
|
||||
|
||||
-- | A bottom-tabbed layout with the default xmonad Theme.
|
||||
simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
simpleTabbedBottom = decoration shrinkText defaultTheme TabbedBottom Simplest
|
||||
simpleTabbedBottom = tabbedBottom shrinkText defaultTheme
|
||||
|
||||
-- | A bottom-tabbed layout with the default xmonad Theme.
|
||||
simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme
|
||||
|
||||
-- | A layout decorated with tabs and the possibility to set a custom
|
||||
-- shrinker and a custom theme.
|
||||
tabbed :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbed s c = decoration s c Tabbed Simplest
|
||||
-- shrinker and theme.
|
||||
tabbed :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbed s c = addTabs s c Simplest
|
||||
|
||||
tabbedAlways :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbedAlways s c = addTabsAlways s c Simplest
|
||||
|
||||
-- | A layout decorated with tabs at the bottom and the possibility to set a custom
|
||||
-- shrinker and a custom theme.
|
||||
tabbedBottom :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbedBottom s c = decoration s c TabbedBottom Simplest
|
||||
-- shrinker and theme.
|
||||
tabbedBottom :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbedBottom s c = addTabsBottom s c Simplest
|
||||
|
||||
tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
|
||||
tabbedBottomAlways s c = addTabsBottomAlways s c Simplest
|
||||
|
||||
-- Layout Modifiers
|
||||
|
||||
-- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout.
|
||||
addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
addTabs s c l = decoration s c Tabbed l
|
||||
addTabs = createTabs WhenPlural Top
|
||||
|
||||
addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
addTabsAlways = createTabs Always Top
|
||||
|
||||
-- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout.
|
||||
addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
addTabsBottom s c l = decoration s c TabbedBottom l
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
addTabsBottom = createTabs WhenPlural Bottom
|
||||
|
||||
data TabbedDecoration a = Tabbed | TabbedBottom deriving (Read, Show)
|
||||
addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
|
||||
-> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
addTabsBottomAlways = createTabs Always Bottom
|
||||
|
||||
|
||||
-- Tab creation abstractions. Internal use only.
|
||||
|
||||
-- Create tabbar when required at the given location with the given
|
||||
-- shrinker and theme to the supplied layout.
|
||||
createTabs ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> TabbarLocation -> s
|
||||
-> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a
|
||||
createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l
|
||||
|
||||
data TabbarLocation = Top | Bottom deriving (Read,Show)
|
||||
|
||||
data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq)
|
||||
|
||||
data TabbedDecoration a = Tabbed TabbarLocation TabbarShown deriving (Read, Show)
|
||||
|
||||
instance Eq a => DecorationStyle TabbedDecoration a where
|
||||
describeDeco Tabbed = "Tabbed"
|
||||
describeDeco TabbedBottom = "Tabbed Bottom"
|
||||
describeDeco (Tabbed Top _ ) = "Tabbed"
|
||||
describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom"
|
||||
decorationMouseDragHook _ _ _ = return ()
|
||||
pureDecoration ds _ ht _ s wrs (w,r@(Rectangle x y wh hh)) =
|
||||
if length ws <= 1
|
||||
then Nothing
|
||||
else Just $ case ds of
|
||||
Tabbed -> Rectangle nx y wid (fi ht)
|
||||
TabbedBottom -> Rectangle nx (y+fi(hh-ht)) wid (fi ht)
|
||||
pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh))
|
||||
= if ((sh == Always && numWindows > 0) || numWindows > 1)
|
||||
then Just $ case lc of
|
||||
Top -> upperTab
|
||||
Bottom -> lowerTab
|
||||
else Nothing
|
||||
where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s)
|
||||
loc i = x + fi ((wh * fi i) `div` max 1 (fi $ length ws))
|
||||
wid = fi $ maybe x (\i -> loc (i+1) - loc i) $ w `elemIndex` ws
|
||||
nx = maybe x loc $ w `elemIndex` ws
|
||||
shrink ds (Rectangle _ _ _ dh) (Rectangle x y w h) = case ds of
|
||||
Tabbed -> Rectangle x (y + fi dh) w (h - dh)
|
||||
TabbedBottom -> Rectangle x y w (h - dh)
|
||||
upperTab = Rectangle nx y wid (fi ht)
|
||||
lowerTab = Rectangle nx (y+fi(hh-ht)) wid (fi ht)
|
||||
numWindows = length ws
|
||||
shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h)
|
||||
= case loc of
|
||||
Top -> Rectangle x (y + fi dh) w (h - dh)
|
||||
Bottom -> Rectangle x y w (h - dh)
|
||||
|
@@ -41,7 +41,7 @@ import Control.Monad
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
|
||||
data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read)
|
||||
data ThreeCol a = ThreeCol !Int !Rational !Rational deriving (Show,Read)
|
||||
|
||||
instance LayoutClass ThreeCol a where
|
||||
doLayout (ThreeCol nmaster _ frac) r =
|
||||
|
@@ -7,7 +7,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : portable
|
||||
--
|
||||
|
@@ -3,10 +3,10 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.TwoPane
|
||||
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -1,5 +1,8 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
|
||||
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.WindowArranger
|
||||
|
@@ -7,7 +7,7 @@
|
||||
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : Devin Mullins <me@twifkak.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -32,6 +32,8 @@ import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Util.Invisible
|
||||
import XMonad.Util.XUtils
|
||||
|
||||
import XMonad.Hooks.ManageDocks (Direction(..))
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
@@ -67,7 +69,6 @@ data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeab
|
||||
instance Typeable a => Message (MoveWindowToWindow a)
|
||||
|
||||
data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable )
|
||||
data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded )
|
||||
instance Message Navigate
|
||||
|
||||
data WNConfig =
|
||||
@@ -92,7 +93,7 @@ navigateBrightness f | f > 1 = navigateBrightness 1
|
||||
navigateBrightness f = defaultWNConfig { brightness = Just f }
|
||||
|
||||
defaultWNConfig :: WNConfig
|
||||
defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
|
||||
defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
|
||||
|
||||
data NavigationState a = NS Point [(a,Rectangle)]
|
||||
|
||||
@@ -126,10 +127,10 @@ instance LayoutModifier WindowNavigation Window where
|
||||
wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $
|
||||
filter ((/=w) . fst) origwrs
|
||||
wnavigable = nub $ concatMap
|
||||
(\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L]
|
||||
(\d -> truncHead $ navigable d pt wrs) [U,D,R,L]
|
||||
wnavigablec = nub $ concatMap
|
||||
(\d -> map (\(win,_) -> (win,dirc d)) $
|
||||
truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L]
|
||||
truncHead $ navigable d pt wrs) [U,D,R,L]
|
||||
wothers = case state of Just (NS _ wo) -> map fst wo
|
||||
_ -> []
|
||||
mapM_ (sc nbc) (wothers \\ map fst wnavigable)
|
||||
@@ -138,7 +139,7 @@ instance LayoutModifier WindowNavigation Window where
|
||||
|
||||
handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
|
||||
| Just (Go d) <- fromMessage m =
|
||||
case sortby d $ filter (inr d pt . snd) wrs of
|
||||
case navigable d pt wrs of
|
||||
[] -> return Nothing
|
||||
((w,r):_) -> do modify focusWindowHere
|
||||
return $ Just $ Left $ WindowNavigation conf $ I $ Just $
|
||||
@@ -154,7 +155,7 @@ instance LayoutModifier WindowNavigation Window where
|
||||
has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)
|
||||
|
||||
| Just (Swap d) <- fromMessage m =
|
||||
case sortby d $ filter (inr d pt . snd) wrs of
|
||||
case navigable d pt wrs of
|
||||
[] -> return Nothing
|
||||
((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st
|
||||
swapw y x | x == w = y
|
||||
@@ -170,7 +171,7 @@ instance LayoutModifier WindowNavigation Window where
|
||||
windows $ W.modify' swap
|
||||
return Nothing
|
||||
| Just (Move d) <- fromMessage m =
|
||||
case sortby d $ filter (inr d pt . snd) wrs of
|
||||
case navigable d pt wrs of
|
||||
[] -> return Nothing
|
||||
((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)
|
||||
return $ do st <- mst
|
||||
@@ -183,6 +184,9 @@ instance LayoutModifier WindowNavigation Window where
|
||||
handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
|
||||
handleMessOrMaybeModifyIt _ _ = return Nothing
|
||||
|
||||
navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
|
||||
navigable d pt = sortby d . filter (inr d pt . snd)
|
||||
|
||||
truncHead :: [a] -> [a]
|
||||
truncHead (x:_) = [x]
|
||||
truncHead [] = []
|
||||
|
@@ -7,7 +7,7 @@
|
||||
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -43,6 +43,7 @@ module XMonad.Prompt
|
||||
, uniqSort
|
||||
, decodeInput
|
||||
, encodeOutput
|
||||
, historyCompletion
|
||||
) where
|
||||
|
||||
import XMonad hiding (config, io)
|
||||
@@ -51,10 +52,12 @@ import XMonad.Util.Font
|
||||
import XMonad.Util.XSelection (getSelection)
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Control.Applicative ((<$>))
|
||||
import Data.Char
|
||||
import Data.Bits ((.&.))
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import Data.Set (fromList, toList)
|
||||
@@ -74,17 +77,17 @@ type XP = StateT XPState IO
|
||||
|
||||
data XPState =
|
||||
XPS { dpy :: Display
|
||||
, rootw :: Window
|
||||
, win :: Window
|
||||
, screen :: Rectangle
|
||||
, rootw :: !Window
|
||||
, win :: !Window
|
||||
, screen :: !Rectangle
|
||||
, complWin :: Maybe Window
|
||||
, complWinDim :: Maybe ComplWindowDim
|
||||
, completionFunction :: String -> IO [String]
|
||||
, gcon :: GC
|
||||
, fontS :: XMonadFont
|
||||
, xptype :: XPType
|
||||
, gcon :: !GC
|
||||
, fontS :: !XMonadFont
|
||||
, xptype :: !XPType
|
||||
, command :: String
|
||||
, offset :: Int
|
||||
, offset :: !Int
|
||||
, history :: [History]
|
||||
, config :: XPConfig
|
||||
}
|
||||
@@ -96,11 +99,13 @@ data XPConfig =
|
||||
, fgHLight :: String -- ^ Font color of a highlighted completion entry
|
||||
, bgHLight :: String -- ^ Background color of a highlighted completion entry
|
||||
, borderColor :: String -- ^ Border color
|
||||
, promptBorderWidth :: Dimension -- ^ Border width
|
||||
, promptBorderWidth :: !Dimension -- ^ Border width
|
||||
, position :: XPPosition -- ^ Position: 'Top' or 'Bottom'
|
||||
, height :: Dimension -- ^ Window height
|
||||
, historySize :: Int -- ^ The number of history entries to be saved
|
||||
, height :: !Dimension -- ^ Window height
|
||||
, historySize :: !Int -- ^ The number of history entries to be saved
|
||||
, defaultText :: String -- ^ The text by default in the prompt line
|
||||
, autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it,
|
||||
-- and delay by x microseconds
|
||||
} deriving (Show, Read)
|
||||
|
||||
data XPType = forall p . XPrompt p => XPT p
|
||||
@@ -169,6 +174,7 @@ defaultXPConfig =
|
||||
, height = 18
|
||||
, historySize = 256
|
||||
, defaultText = []
|
||||
, autoComplete = Nothing
|
||||
}
|
||||
|
||||
type ComplFunction = String -> IO [String]
|
||||
@@ -301,6 +307,25 @@ completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})
|
||||
-- some other event: go back to main loop
|
||||
completionHandle _ k e = handle k e
|
||||
|
||||
tryAutoComplete :: XP Bool
|
||||
tryAutoComplete = do
|
||||
ac <- gets (autoComplete . config)
|
||||
case ac of
|
||||
Just d -> do cs <- getCompletions
|
||||
case cs of
|
||||
[c] -> runCompleted c d >> return True
|
||||
_ -> return False
|
||||
Nothing -> return False
|
||||
where runCompleted cmd delay = do
|
||||
st <- get
|
||||
let new_command = nextCompletion (xptype st) (command st) [cmd]
|
||||
modify $ \s -> s { command = "autocompleting..." }
|
||||
updateWindows
|
||||
io $ threadDelay delay
|
||||
modify $ \s -> s { command = new_command }
|
||||
historyPush
|
||||
return True
|
||||
|
||||
-- KeyPresses
|
||||
|
||||
data Direction = Prev | Next deriving (Eq,Show,Read)
|
||||
@@ -308,7 +333,7 @@ data Direction = Prev | Next deriving (Eq,Show,Read)
|
||||
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
|
||||
-- commands: ctrl + ... todo
|
||||
keyPressHandle mask (ks,_)
|
||||
| mask == controlMask =
|
||||
| (mask .&. controlMask) > 0 =
|
||||
-- control sequences
|
||||
case () of
|
||||
_ | ks == xK_u -> killBefore >> go
|
||||
@@ -320,6 +345,7 @@ keyPressHandle mask (ks,_)
|
||||
| ks == xK_Left -> moveWord Prev >> go
|
||||
| ks == xK_Delete -> killWord Next >> go
|
||||
| ks == xK_BackSpace -> killWord Prev >> go
|
||||
| ks == xK_w -> killWord Prev >> go
|
||||
| ks == xK_g || ks == xK_c -> quit
|
||||
| otherwise -> eventLoop handle -- unhandled control sequence
|
||||
| ks == xK_Return = historyPush >> return ()
|
||||
@@ -340,7 +366,8 @@ keyPressHandle _ (_,s)
|
||||
| s == "" = eventLoop handle
|
||||
| otherwise = do insertString (decodeInput s)
|
||||
updateWindows
|
||||
eventLoop handle
|
||||
completed <- tryAutoComplete
|
||||
unless completed $ eventLoop handle
|
||||
|
||||
-- KeyPress and State
|
||||
|
||||
@@ -778,3 +805,15 @@ breakAtSpace s
|
||||
-- | Sort a list and remove duplicates.
|
||||
uniqSort :: Ord a => [a] -> [a]
|
||||
uniqSort = toList . fromList
|
||||
|
||||
-- | 'historyCompletion' provides a canned completion function much like
|
||||
-- getShellCompl; you pass it to mkXPrompt, and it will make completions work
|
||||
-- from the query history stored in ~/.xmonad/history.
|
||||
historyCompletion :: ComplFunction
|
||||
historyCompletion = \x -> liftM (filter $ isInfixOf x) readHistoryIO
|
||||
|
||||
-- We need to define this locally because there is no function with the type "XP a -> IO a", and
|
||||
-- 'getHistory' is uselessly of the type "XP [String]".
|
||||
readHistoryIO :: IO [String]
|
||||
readHistoryIO = do (hist,_) <- readHistory
|
||||
return $ map command_history hist
|
72
XMonad/Prompt/AppLauncher.hs
Normal file
72
XMonad/Prompt/AppLauncher.hs
Normal file
@@ -0,0 +1,72 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Prompt.AppLauncher
|
||||
-- Copyright : (C) 2008 Luis Cabellos
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : zhen.sydow@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- A module for launch applicationes that receive parameters in the command
|
||||
-- line. The launcher call a prompt to get the parameters.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
module XMonad.Prompt.AppLauncher ( -- * Usage
|
||||
-- $usage
|
||||
launchApp
|
||||
|
||||
-- * Use case: launching gimp with file
|
||||
-- $tip
|
||||
) where
|
||||
|
||||
import XMonad (X(),MonadIO)
|
||||
import XMonad.Core (spawn)
|
||||
import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())
|
||||
import XMonad.Prompt.Shell (getShellCompl)
|
||||
|
||||
{- $usage
|
||||
This module is intended to allow the launch of the same application
|
||||
but changing the parameters using the user response. For example, when
|
||||
you want to open a image in gimp program, you can open gimp and then use
|
||||
the File Menu to open the image or you can use this module to select
|
||||
the image in the command line.
|
||||
|
||||
We use Prompt to get the user command line. This also allow to autoexpand
|
||||
the names of the files when we are writing the command line.
|
||||
-}
|
||||
|
||||
{- $tip
|
||||
|
||||
First, you need to import necessary modules. Prompt is used to get the promp
|
||||
configuration and the AppLauncher module itself.
|
||||
|
||||
> import XMonad.Prompt
|
||||
> import XMonad.Prompt.AppLauncher as AL
|
||||
|
||||
Then you can add the bindings to the applications.
|
||||
|
||||
> ...
|
||||
> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" )
|
||||
> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" )
|
||||
> ...
|
||||
|
||||
-}
|
||||
|
||||
-- A customized prompt
|
||||
data AppPrompt = AppPrompt String
|
||||
instance XPrompt AppPrompt where
|
||||
showXPrompt (AppPrompt n) = n ++ " "
|
||||
|
||||
type Application = String
|
||||
type Parameters = String
|
||||
|
||||
{- | Given an application and its parameters, launch the application. -}
|
||||
launch :: MonadIO m => Application -> Parameters -> m ()
|
||||
launch app params = spawn ( app ++ " " ++ params )
|
||||
|
||||
|
||||
{- | Get the user's response to a prompt an launch an application using the
|
||||
input as command parameters of the application.-}
|
||||
launchApp :: XPConfig -> Application -> X ()
|
||||
launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app
|
@@ -29,18 +29,18 @@ import Control.Monad (liftM2)
|
||||
import Data.Maybe
|
||||
import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions)
|
||||
|
||||
-- $usage
|
||||
-- 1. In your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Prompt
|
||||
-- > import XMonad.Prompt.RunOrRaise
|
||||
--
|
||||
-- 2. In your keybindings add something like:
|
||||
--
|
||||
-- > , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig)
|
||||
--
|
||||
-- For detailed instruction on editing the key binding see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
{- $usage
|
||||
1. In your @~\/.xmonad\/xmonad.hs@:
|
||||
|
||||
> import XMonad.Prompt
|
||||
> import XMonad.Prompt.RunOrRaise
|
||||
|
||||
2. In your keybindings add something like:
|
||||
|
||||
> , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig)
|
||||
|
||||
For detailed instruction on editing the key binding see
|
||||
"XMonad.Doc.Extending#Editing_key_bindings". -}
|
||||
|
||||
data RunOrRaisePrompt = RRP
|
||||
instance XPrompt RunOrRaisePrompt where
|
||||
@@ -61,8 +61,8 @@ open path = (io $ isNormalFile path) >>= \b ->
|
||||
getTarget x = (x,isApp x)
|
||||
|
||||
isApp :: String -> Query Bool
|
||||
isApp "firefox" = className =? "Firefox-bin"
|
||||
isApp "thunderbird" = className =? "Thunderbird-bin"
|
||||
isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox"
|
||||
isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird"
|
||||
isApp x = liftM2 (==) pid $ pidof x
|
||||
|
||||
pidof :: String -> Query Int
|
||||
|
@@ -17,6 +17,8 @@ module XMonad.Prompt.Shell
|
||||
-- $usage
|
||||
shellPrompt
|
||||
, getCommands
|
||||
, getBrowser
|
||||
, getEditor
|
||||
, getShellCompl
|
||||
, split
|
||||
, prompt
|
||||
@@ -122,3 +124,21 @@ escape (x:xs)
|
||||
|
||||
isSpecialChar :: Char -> Bool
|
||||
isSpecialChar = flip elem "\\@\"'#?$*()[]{};"
|
||||
|
||||
-- | Ask the shell environment for
|
||||
env :: String -> String -> IO String
|
||||
env variable fallthrough = getEnv variable `catch` \_ -> return fallthrough
|
||||
|
||||
{- | Ask the shell what browser the user likes. If the user hasn't defined any
|
||||
$BROWSER, defaults to returning \"firefox\", since that seems to be the most
|
||||
common X web browser.
|
||||
Note that if you don't specify a GUI browser but a textual one, that'll be a problem
|
||||
as 'getBrowser' will be called by functions expecting to be able to just execute the string
|
||||
or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\"
|
||||
or as the name of a shell script doing much the same thing. -}
|
||||
getBrowser :: IO String
|
||||
getBrowser = env "BROWSER" "firefox"
|
||||
|
||||
-- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\".
|
||||
getEditor :: IO String
|
||||
getEditor = env "EDITOR" "emacs"
|
@@ -45,6 +45,15 @@ import XMonad.Actions.WindowBringer
|
||||
-- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig)
|
||||
-- > , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig)
|
||||
--
|
||||
-- The autoComplete option is a handy complement here:
|
||||
--
|
||||
-- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto
|
||||
-- > defaultXPConfig { autoComplete = Just 500000 } )
|
||||
--
|
||||
-- The \'500000\' is the number of microseconds to pause before sending you to
|
||||
-- your new window. This is useful so that you don't accidentally send some
|
||||
-- keystrokes to the selected client.
|
||||
--
|
||||
-- For detailed instruction on editing the key binding see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
@@ -64,16 +73,14 @@ windowPromptBring c = doPrompt Bring c
|
||||
doPrompt :: WindowPrompt -> XPConfig -> X ()
|
||||
doPrompt t c = do
|
||||
a <- case t of
|
||||
Goto -> return . gotoAction =<< windowMapWith (W.tag . fst)
|
||||
Bring -> return . bringAction =<< windowMapWith snd
|
||||
wm <- windowMapWith id
|
||||
Goto -> fmap gotoAction windowMap
|
||||
Bring -> fmap bringAction windowMap
|
||||
wm <- windowMap
|
||||
mkXPrompt t c (compList wm) a
|
||||
|
||||
where
|
||||
|
||||
winAction a m = flip whenJust (windows . a) . flip M.lookup m
|
||||
gotoAction = winAction W.greedyView
|
||||
gotoAction = winAction W.focusWindow
|
||||
bringAction = winAction bringWindow
|
||||
bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
|
||||
|
||||
compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m
|
||||
|
@@ -1,10 +1,10 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Util.Dmenu
|
||||
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -35,7 +35,7 @@ import XMonad.Actions.Submap
|
||||
import qualified Data.Map as M
|
||||
import Data.List (foldl', intersperse, sortBy, groupBy, nub)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Maybe (catMaybes, isNothing, isJust, fromJust)
|
||||
import Data.Maybe
|
||||
import Control.Arrow (first, (&&&))
|
||||
|
||||
import Text.ParserCombinators.ReadP
|
||||
@@ -180,7 +180,44 @@ removeMouseBindings conf mouseBindingList =
|
||||
-- > <Insert>
|
||||
-- > <Break>
|
||||
-- > <Space>
|
||||
-- > <F1>-<F12>
|
||||
-- > <F1>-<F24>
|
||||
-- > <KP_Space>
|
||||
-- > <KP_Tab>
|
||||
-- > <KP_Enter>
|
||||
-- > <KP_F1>
|
||||
-- > <KP_F2>
|
||||
-- > <KP_F3>
|
||||
-- > <KP_F4>
|
||||
-- > <KP_Home>
|
||||
-- > <KP_Left>
|
||||
-- > <KP_Up>
|
||||
-- > <KP_Right>
|
||||
-- > <KP_Down>
|
||||
-- > <KP_Prior>
|
||||
-- > <KP_Page_Up>
|
||||
-- > <KP_Next>
|
||||
-- > <KP_Page_Down>
|
||||
-- > <KP_End>
|
||||
-- > <KP_Begin>
|
||||
-- > <KP_Insert>
|
||||
-- > <KP_Delete>
|
||||
-- > <KP_Equal>
|
||||
-- > <KP_Multiply>
|
||||
-- > <KP_Add>
|
||||
-- > <KP_Separator>
|
||||
-- > <KP_Subtract>
|
||||
-- > <KP_Decimal>
|
||||
-- > <KP_Divide>
|
||||
-- > <KP_0>
|
||||
-- > <KP_1>
|
||||
-- > <KP_2>
|
||||
-- > <KP_3>
|
||||
-- > <KP_4>
|
||||
-- > <KP_5>
|
||||
-- > <KP_6>
|
||||
-- > <KP_7>
|
||||
-- > <KP_8>
|
||||
-- > <KP_9>
|
||||
|
||||
mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
|
||||
mkKeymap c = M.fromList . mkSubmaps . readKeymap c
|
||||
@@ -205,16 +242,14 @@ op `on` f = \x y -> f x `op` f y
|
||||
-- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will
|
||||
-- be ignored.
|
||||
readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())]
|
||||
readKeymap c = catMaybes . map (maybeKeys . first (readKeySequence c))
|
||||
readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c))
|
||||
where maybeKeys (Nothing,_) = Nothing
|
||||
maybeKeys (Just k, act) = Just (k, act)
|
||||
|
||||
-- | Parse a sequence of keys, returning Nothing if there is
|
||||
-- a parse failure (no parse, or ambiguous parse).
|
||||
readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]
|
||||
readKeySequence c s = case parses s of
|
||||
[k] -> Just k
|
||||
_ -> Nothing
|
||||
readKeySequence c = listToMaybe . parses
|
||||
where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)
|
||||
|
||||
-- | Parse a sequence of key combinations separated by spaces, e.g.
|
||||
@@ -267,34 +302,71 @@ keyNames = functionKeys ++ specialKeys
|
||||
-- the associated KeySyms.
|
||||
functionKeys :: [(String, KeySym)]
|
||||
functionKeys = [ ("F" ++ show n, k)
|
||||
| (n,k) <- zip ([1..12] :: [Int]) [xK_F1..] ]
|
||||
| (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ]
|
||||
|
||||
-- | A list of special key names and their corresponding KeySyms.
|
||||
specialKeys :: [(String, KeySym)]
|
||||
specialKeys = [ ("Backspace", xK_BackSpace)
|
||||
, ("Tab" , xK_Tab )
|
||||
, ("Return" , xK_Return)
|
||||
, ("Pause" , xK_Pause)
|
||||
specialKeys = [ ("Backspace" , xK_BackSpace)
|
||||
, ("Tab" , xK_Tab)
|
||||
, ("Return" , xK_Return)
|
||||
, ("Pause" , xK_Pause)
|
||||
, ("Scroll_lock", xK_Scroll_Lock)
|
||||
, ("Sys_Req" , xK_Sys_Req)
|
||||
, ("Escape" , xK_Escape)
|
||||
, ("Esc" , xK_Escape)
|
||||
, ("Delete" , xK_Delete)
|
||||
, ("Home" , xK_Home)
|
||||
, ("Left" , xK_Left)
|
||||
, ("Up" , xK_Up)
|
||||
, ("Right" , xK_Right)
|
||||
, ("Down" , xK_Down)
|
||||
, ("L" , xK_Left)
|
||||
, ("U" , xK_Up)
|
||||
, ("R" , xK_Right)
|
||||
, ("D" , xK_Down)
|
||||
, ("Page_Up" , xK_Page_Up)
|
||||
, ("Page_Down", xK_Page_Down)
|
||||
, ("End" , xK_End)
|
||||
, ("Insert" , xK_Insert)
|
||||
, ("Break" , xK_Break)
|
||||
, ("Space" , xK_space)
|
||||
, ("Sys_Req" , xK_Sys_Req)
|
||||
, ("Escape" , xK_Escape)
|
||||
, ("Esc" , xK_Escape)
|
||||
, ("Delete" , xK_Delete)
|
||||
, ("Home" , xK_Home)
|
||||
, ("Left" , xK_Left)
|
||||
, ("Up" , xK_Up)
|
||||
, ("Right" , xK_Right)
|
||||
, ("Down" , xK_Down)
|
||||
, ("L" , xK_Left)
|
||||
, ("U" , xK_Up)
|
||||
, ("R" , xK_Right)
|
||||
, ("D" , xK_Down)
|
||||
, ("Page_Up" , xK_Page_Up)
|
||||
, ("Page_Down" , xK_Page_Down)
|
||||
, ("End" , xK_End)
|
||||
, ("Insert" , xK_Insert)
|
||||
, ("Break" , xK_Break)
|
||||
, ("Space" , xK_space)
|
||||
, ("KP_Space" , xK_KP_Space)
|
||||
, ("KP_Tab" , xK_KP_Tab)
|
||||
, ("KP_Enter" , xK_KP_Enter)
|
||||
, ("KP_F1" , xK_KP_F1)
|
||||
, ("KP_F2" , xK_KP_F2)
|
||||
, ("KP_F3" , xK_KP_F3)
|
||||
, ("KP_F4" , xK_KP_F4)
|
||||
, ("KP_Home" , xK_KP_Home)
|
||||
, ("KP_Left" , xK_KP_Left)
|
||||
, ("KP_Up" , xK_KP_Up)
|
||||
, ("KP_Right" , xK_KP_Right)
|
||||
, ("KP_Down" , xK_KP_Down)
|
||||
, ("KP_Prior" , xK_KP_Prior)
|
||||
, ("KP_Page_Up" , xK_KP_Page_Up)
|
||||
, ("KP_Next" , xK_KP_Next)
|
||||
, ("KP_Page_Down", xK_KP_Page_Down)
|
||||
, ("KP_End" , xK_KP_End)
|
||||
, ("KP_Begin" , xK_KP_Begin)
|
||||
, ("KP_Insert" , xK_KP_Insert)
|
||||
, ("KP_Delete" , xK_KP_Delete)
|
||||
, ("KP_Equal" , xK_KP_Equal)
|
||||
, ("KP_Multiply", xK_KP_Multiply)
|
||||
, ("KP_Add" , xK_KP_Add)
|
||||
, ("KP_Separator", xK_KP_Separator)
|
||||
, ("KP_Subtract", xK_KP_Subtract)
|
||||
, ("KP_Decimal" , xK_KP_Decimal)
|
||||
, ("KP_Divide" , xK_KP_Divide)
|
||||
, ("KP_0" , xK_KP_0)
|
||||
, ("KP_1" , xK_KP_1)
|
||||
, ("KP_2" , xK_KP_2)
|
||||
, ("KP_3" , xK_KP_3)
|
||||
, ("KP_4" , xK_KP_4)
|
||||
, ("KP_5" , xK_KP_5)
|
||||
, ("KP_6" , xK_KP_6)
|
||||
, ("KP_7" , xK_KP_7)
|
||||
, ("KP_8" , xK_KP_8)
|
||||
, ("KP_9" , xK_KP_9)
|
||||
]
|
||||
|
||||
-- | Given a configuration record and a list of (key sequence
|
||||
|
@@ -45,7 +45,6 @@ import Graphics.X11.Xrender
|
||||
|
||||
#if defined XFT || defined UTF8
|
||||
import Codec.Binary.UTF8.String (encodeString, decodeString)
|
||||
import Foreign.C
|
||||
#endif
|
||||
|
||||
-- Hide the Core Font/Xft switching here
|
||||
@@ -99,16 +98,15 @@ initXMF :: String -> X XMonadFont
|
||||
initXMF s =
|
||||
#ifdef XFT
|
||||
if xftPrefix `isPrefixOf` s then
|
||||
do io setupLocale
|
||||
dpy <- asks display
|
||||
do dpy <- asks display
|
||||
xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)
|
||||
return (Xft xftdraw)
|
||||
else
|
||||
#endif
|
||||
#ifdef UTF8
|
||||
(io setupLocale >> initUtf8Font s >>= (return . Utf8))
|
||||
fmap Utf8 $ initUtf8Font s
|
||||
#else
|
||||
(initCoreFont s >>= (return . Core))
|
||||
fmap Core $ initCoreFont s
|
||||
#endif
|
||||
#ifdef XFT
|
||||
where xftPrefix = "xft:"
|
||||
@@ -213,14 +211,3 @@ encodeOutput = id
|
||||
-- | Short-hand for 'fromIntegral'
|
||||
fi :: (Integral a, Num b) => a -> b
|
||||
fi = fromIntegral
|
||||
|
||||
#if defined XFT || defined UTF8
|
||||
#include <locale.h>
|
||||
foreign import ccall unsafe "locale.h setlocale"
|
||||
setlocale :: CInt -> CString -> IO CString
|
||||
|
||||
setupLocale :: IO ()
|
||||
setupLocale = withCString "" $ \s -> do
|
||||
setlocale (#const LC_ALL) s
|
||||
return ()
|
||||
#endif
|
||||
|
@@ -4,7 +4,7 @@
|
||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : David Roundy <droundy@darcs.net>
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
@@ -22,6 +22,11 @@ module XMonad.Util.NamedWindows (
|
||||
unName
|
||||
) where
|
||||
|
||||
import Prelude hiding ( catch )
|
||||
import Control.Applicative ( (<$>) )
|
||||
import Control.Exception ( bracket, catch )
|
||||
import Data.Maybe ( fromMaybe, listToMaybe )
|
||||
|
||||
import qualified XMonad.StackSet as W ( peek )
|
||||
|
||||
|
||||
@@ -40,9 +45,16 @@ instance Show NamedWindow where
|
||||
show (NW n _) = n
|
||||
|
||||
getName :: Window -> X NamedWindow
|
||||
getName w = asks display >>= \d -> do s <- io $ getClassHint d w
|
||||
n <- maybe (resName s) id `fmap` io (fetchName d w)
|
||||
return $ NW n w
|
||||
getName w = withDisplay $ \d -> do
|
||||
-- TODO, this code is ugly and convoluted -- clean it up
|
||||
let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy)
|
||||
|
||||
getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
|
||||
`catch` \_ -> getTextProperty d w wM_NAME
|
||||
|
||||
copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop
|
||||
|
||||
io $ getIt `catch` \_ -> ((`NW` w) . resName) `fmap` getClassHint d w
|
||||
|
||||
unName :: NamedWindow -> Window
|
||||
unName (NW _ w) = w
|
||||
|
@@ -25,7 +25,9 @@ module XMonad.Util.Run (
|
||||
runInTerm,
|
||||
safeRunInTerm,
|
||||
seconds,
|
||||
spawnPipe
|
||||
spawnPipe,
|
||||
|
||||
hPutStr, hPutStrLn -- re-export for convenience
|
||||
) where
|
||||
|
||||
import System.Posix.IO
|
||||
@@ -76,8 +78,7 @@ runProcessWithInputAndWait cmd args input timeout = do
|
||||
waitForProcess ph
|
||||
return ()
|
||||
|
||||
-- | Multiplies by ONE MILLION, for use with
|
||||
-- 'runProcessWithInputAndWait'.
|
||||
-- | Multiplies by ONE MILLION, for functions that take microseconds.
|
||||
--
|
||||
-- Use like:
|
||||
--
|
||||
|
@@ -10,58 +10,113 @@
|
||||
--
|
||||
-- Very handy hotkey-launched floating terminal window.
|
||||
--
|
||||
-- A tool like detach (<http://detach.sourceforge.net>) turns it
|
||||
-- into a launchpad for X apps.
|
||||
--
|
||||
-- By default, your xmonad terminal is used, and mod+s is the hotkey.
|
||||
-- The default ManageHook uses a centered, half-screen-wide,
|
||||
-- quarter-screen-tall window.
|
||||
-- The key, position and size are configurable.
|
||||
--
|
||||
-- The terminal application must support the @-title@ argument.
|
||||
-- Known supported terminals: rxvt, rxvt-unicode, xterm.
|
||||
-- Most others are likely to follow the lead set by xterm.
|
||||
--
|
||||
-- Add the following to your xmonad.hs keybindings to use the default mod+s:
|
||||
--
|
||||
-- > scratchpadSpawnDefault conf
|
||||
--
|
||||
-- Or specify your own key binding, with the action:
|
||||
--
|
||||
-- > scratchpadSpawnAction conf
|
||||
--
|
||||
-- And add one of the @scratchpadManageHook*@s to your ManageHook list.
|
||||
-- The default rectangle is half the screen wide and a quarter of the
|
||||
-- screen tall, centered.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Util.Scratchpad (
|
||||
scratchpadSpawnDefault
|
||||
,scratchpadSpawnAction
|
||||
-- * Usage
|
||||
-- $usage
|
||||
scratchpadSpawnAction
|
||||
,scratchpadSpawnActionTerminal
|
||||
,scratchpadManageHookDefault
|
||||
,scratchpadManageHook
|
||||
,scratchpadFilterOutWorkspace
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Core
|
||||
import XMonad.Hooks.ManageHelpers (doRectFloat)
|
||||
import qualified XMonad.StackSet
|
||||
import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
|
||||
|
||||
import Control.Monad (filterM)
|
||||
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
|
||||
-- $usage
|
||||
-- Bind a key to 'scratchpadSpawnAction'
|
||||
-- Pressing it will spawn the terminal, or bring it to the current
|
||||
-- workspace if it already exists.
|
||||
-- Pressing the key with the terminal on the current workspace will
|
||||
-- send it to a hidden workspace called @SP@.
|
||||
--
|
||||
-- If you already have a workspace called @SP@, it will use that.
|
||||
-- @SP@ will also appear in xmobar and dzen status bars. You can tweak your
|
||||
-- @dynamicLog@ settings to filter it out if you like.
|
||||
--
|
||||
-- A tool like detach (<http://detach.sourceforge.net>) turns it
|
||||
-- into a launchpad for X apps.
|
||||
--
|
||||
-- By default, your xmonad terminal is used.
|
||||
-- The default ManageHook uses a centered, half-screen-wide,
|
||||
-- quarter-screen-tall window.
|
||||
-- The key, position and size are configurable.
|
||||
--
|
||||
-- The terminal application must support the @-name@ argument.
|
||||
-- Known supported terminals: rxvt, rxvt-unicode, xterm.
|
||||
-- Most others are likely to follow the lead set by xterm.
|
||||
--
|
||||
-- Bind the following to a key in your xmonad.hs keybindings:
|
||||
--
|
||||
-- > scratchpadSpawnAction conf
|
||||
--
|
||||
-- Where @conf@ is the configuration.
|
||||
--
|
||||
-- And add one of the @scratchpadManageHook*@s to your ManageHook list.
|
||||
-- The default rectangle is half the screen wide and a quarter of the
|
||||
-- screen tall, centered.
|
||||
--
|
||||
|
||||
-- | Complete key binding. Pops up the terminal on mod+s.
|
||||
scratchpadSpawnDefault :: XConfig l -- ^ The configuration, to retrieve terminal and modMask
|
||||
-> ((KeyMask, KeySym), X ())
|
||||
scratchpadSpawnDefault conf = ((modMask conf, xK_s), scratchpadSpawnAction conf)
|
||||
|
||||
|
||||
-- | Action to pop up the terminal, for the user to bind to a custom key.
|
||||
scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal
|
||||
-> X ()
|
||||
scratchpadSpawnAction conf = spawn $ terminal conf ++ " -title scratchpad"
|
||||
scratchpadSpawnAction conf =
|
||||
scratchpadAction $ spawn $ terminal conf ++ " -name scratchpad"
|
||||
|
||||
|
||||
-- | Action to pop up the terminal, with a directly specified terminal.
|
||||
scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program
|
||||
-> X ()
|
||||
scratchpadSpawnActionTerminal term =
|
||||
scratchpadAction $ spawn $ term ++ " -name scratchpad"
|
||||
|
||||
|
||||
|
||||
|
||||
-- The heart of the new summon/banish terminal.
|
||||
-- The logic is thus:
|
||||
-- 1. if the scratchpad is on the current workspace, send it to the hidden one.
|
||||
-- - if the scratchpad workspace doesn't exist yet, create it first.
|
||||
-- 2. if the scratchpad is elsewhere, bring it here.
|
||||
scratchpadAction :: X () -> X ()
|
||||
scratchpadAction action = withWindowSet $ \s -> do
|
||||
filterCurrent <- filterM (runQuery scratchpadQuery)
|
||||
( (maybe [] W.integrate
|
||||
. W.stack
|
||||
. W.workspace
|
||||
. W.current) s)
|
||||
case filterCurrent of
|
||||
(x:_) -> do
|
||||
if null (filter ( (== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))
|
||||
then addHiddenWorkspace scratchpadWorkspaceTag
|
||||
else return ()
|
||||
windows (W.shiftWin scratchpadWorkspaceTag x)
|
||||
[] -> do
|
||||
filterAll <- filterM (runQuery scratchpadQuery) (W.allWindows s)
|
||||
case filterAll of
|
||||
(x:_) -> windows (W.shiftWin (W.currentTag s) x)
|
||||
[] -> action -- run the provided action to spawn it.
|
||||
|
||||
|
||||
-- factored out since it appears in several places
|
||||
scratchpadWorkspaceTag :: String
|
||||
scratchpadWorkspaceTag = "SP"
|
||||
|
||||
-- factored out since this is common to both the ManageHook and the action
|
||||
scratchpadQuery :: Query Bool
|
||||
scratchpadQuery = resource =? "scratchpad"
|
||||
|
||||
|
||||
-- | The ManageHook, with the default rectangle:
|
||||
-- Half the screen wide, a quarter of the screen tall, centered.
|
||||
@@ -69,13 +124,22 @@ scratchpadManageHookDefault :: ManageHook
|
||||
scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect
|
||||
|
||||
|
||||
-- | The ManageHook, with a user-specified StackSet.RationalRect.
|
||||
scratchpadManageHook :: XMonad.StackSet.RationalRect -- ^ User-specified screen rectangle.
|
||||
-- | The ManageHook, with a user-specified StackSet.RationalRect,
|
||||
-- eg.
|
||||
--
|
||||
-- > scratchpadManageHook (W.RationalRect 0.25 0.375 0.5 0.25)
|
||||
scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle.
|
||||
-> ManageHook
|
||||
scratchpadManageHook rect = title =? "scratchpad" --> doRectFloat rect
|
||||
scratchpadManageHook rect = scratchpadQuery --> doRectFloat rect
|
||||
|
||||
|
||||
scratchpadDefaultRect :: XMonad.StackSet.RationalRect
|
||||
scratchpadDefaultRect = XMonad.StackSet.RationalRect 0.25 0.375 0.5 0.25
|
||||
-- | Transforms a workspace list containing the SP workspace into one that
|
||||
-- doesn't contain it. Intended for use with logHooks.
|
||||
scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]
|
||||
scratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag)
|
||||
|
||||
|
||||
scratchpadDefaultRect :: W.RationalRect
|
||||
scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25
|
||||
|
||||
|
||||
|
@@ -26,10 +26,11 @@ import qualified XMonad.StackSet as W
|
||||
-- In contrast to ManageHook properties, these are instances of Show and Read,
|
||||
-- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM"
|
||||
|
||||
-- | Property constructors are quite self-explaining.
|
||||
-- | Most of the property constructors are quite self-explaining.
|
||||
data Property = Title String
|
||||
| ClassName String
|
||||
| Resource String
|
||||
| Role String -- ^ WM_WINDOW_ROLE property
|
||||
| And Property Property
|
||||
| Or Property Property
|
||||
| Not Property
|
||||
@@ -43,6 +44,7 @@ hasProperty :: Property -> Window -> X Bool
|
||||
hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w
|
||||
hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w
|
||||
hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w
|
||||
hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE"
|
||||
hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 }
|
||||
hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 }
|
||||
hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 }
|
||||
|
@@ -1,10 +1,10 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Util.WorkspaceCompare
|
||||
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>
|
||||
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
|
@@ -1,5 +1,5 @@
|
||||
name: xmonad-contrib
|
||||
version: 0.7
|
||||
version: 0.8
|
||||
homepage: http://xmonad.org/
|
||||
synopsis: Third party extensions for xmonad
|
||||
description:
|
||||
@@ -20,7 +20,7 @@ category: System
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Spencer Janssen
|
||||
maintainer: sjanssen@cse.unl.edu
|
||||
maintainer: spencerjanssen@gmail.com
|
||||
extra-source-files: README scripts/generate-configs scripts/run-xmonad.sh
|
||||
scripts/xinitrc scripts/xmonad-acpi.c
|
||||
scripts/xmonad-clock.c tests/test_SwapWorkspaces.hs
|
||||
@@ -57,7 +57,7 @@ library
|
||||
extensions: ForeignFunctionInterface
|
||||
cpp-options: -DUTF8
|
||||
|
||||
build-depends: mtl, unix, X11>=1.4.1, xmonad==0.7
|
||||
build-depends: mtl, unix, X11>=1.4.1, xmonad>=0.8, xmonad<0.9
|
||||
ghc-options: -Wall
|
||||
|
||||
if flag(testing)
|
||||
@@ -70,6 +70,7 @@ library
|
||||
XMonad.Actions.Commands
|
||||
XMonad.Actions.ConstrainedResize
|
||||
XMonad.Actions.CopyWindow
|
||||
XMonad.Actions.CycleRecentWS
|
||||
XMonad.Actions.CycleSelectedLayouts
|
||||
XMonad.Actions.CycleWS
|
||||
XMonad.Actions.DeManage
|
||||
@@ -84,6 +85,7 @@ library
|
||||
XMonad.Actions.MouseResize
|
||||
XMonad.Actions.NoBorders
|
||||
XMonad.Actions.PerWorkspaceKeys
|
||||
XMonad.Actions.Plane
|
||||
XMonad.Actions.Promote
|
||||
XMonad.Actions.RotSlaves
|
||||
XMonad.Actions.Search
|
||||
@@ -94,22 +96,31 @@ library
|
||||
XMonad.Actions.TagWindows
|
||||
XMonad.Actions.UpdatePointer
|
||||
XMonad.Actions.Warp
|
||||
XMonad.Actions.WindowNavigation
|
||||
XMonad.Actions.WindowGo
|
||||
XMonad.Actions.WindowBringer
|
||||
XMonad.Config.Sjanssen
|
||||
XMonad.Config.Dons
|
||||
XMonad.Config.Arossato
|
||||
XMonad.Config.Desktop
|
||||
XMonad.Config.Droundy
|
||||
XMonad.Config.Gnome
|
||||
XMonad.Config.Kde
|
||||
XMonad.Config.PlainConfig
|
||||
XMonad.Config.Sjanssen
|
||||
XMonad.Config.Xfce
|
||||
XMonad.Hooks.DynamicHooks
|
||||
XMonad.Hooks.DynamicLog
|
||||
XMonad.Hooks.EventHook
|
||||
XMonad.Hooks.EwmhDesktops
|
||||
XMonad.Hooks.FadeInactive
|
||||
XMonad.Hooks.ManageDocks
|
||||
XMonad.Hooks.ManageHelpers
|
||||
XMonad.Hooks.Script
|
||||
XMonad.Hooks.SetWMName
|
||||
XMonad.Hooks.ServerMode
|
||||
XMonad.Hooks.UrgencyHook
|
||||
XMonad.Hooks.XPropManage
|
||||
XMonad.Layout.Accordion
|
||||
XMonad.Layout.BoringWindows
|
||||
XMonad.Layout.Circle
|
||||
XMonad.Layout.Combo
|
||||
XMonad.Layout.Decoration
|
||||
@@ -117,7 +128,9 @@ library
|
||||
XMonad.Layout.Dishes
|
||||
XMonad.Layout.DragPane
|
||||
XMonad.Layout.DwmStyle
|
||||
XMonad.Layout.Gaps
|
||||
XMonad.Layout.Grid
|
||||
XMonad.Layout.HintedGrid
|
||||
XMonad.Layout.HintedTile
|
||||
XMonad.Layout.IM
|
||||
XMonad.Layout.LayoutCombinators
|
||||
@@ -126,9 +139,11 @@ library
|
||||
XMonad.Layout.LayoutScreens
|
||||
XMonad.Layout.MagicFocus
|
||||
XMonad.Layout.Magnifier
|
||||
XMonad.Layout.Master
|
||||
XMonad.Layout.Maximize
|
||||
XMonad.Layout.MosaicAlt
|
||||
XMonad.Layout.MultiToggle
|
||||
XMonad.Layout.MultiToggle.Instances
|
||||
XMonad.Layout.Named
|
||||
XMonad.Layout.NoBorders
|
||||
XMonad.Layout.PerWorkspace
|
||||
@@ -136,13 +151,13 @@ library
|
||||
XMonad.Layout.ResizableTile
|
||||
XMonad.Layout.ResizeScreen
|
||||
XMonad.Layout.Roledex
|
||||
XMonad.Layout.ScratchWorkspace
|
||||
XMonad.Layout.Simplest
|
||||
XMonad.Layout.SimpleDecoration
|
||||
XMonad.Layout.SimpleFloat
|
||||
XMonad.Layout.Spiral
|
||||
XMonad.Layout.Square
|
||||
XMonad.Layout.ShowWName
|
||||
XMonad.Layout.StackTile
|
||||
XMonad.Layout.Tabbed
|
||||
XMonad.Layout.TabBarDecoration
|
||||
XMonad.Layout.ThreeColumns
|
||||
@@ -151,9 +166,11 @@ library
|
||||
XMonad.Layout.WindowArranger
|
||||
XMonad.Layout.WindowNavigation
|
||||
XMonad.Layout.WorkspaceDir
|
||||
XMonad.Layout.SimplestFloat
|
||||
XMonad.Prompt.Directory
|
||||
XMonad.Prompt
|
||||
XMonad.Prompt.AppendFile
|
||||
XMonad.Prompt.AppLauncher
|
||||
XMonad.Prompt.Input
|
||||
XMonad.Prompt.Email
|
||||
XMonad.Prompt.Layout
|
||||
|
Reference in New Issue
Block a user