twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 00:20:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

make workspace tag not need to be a Num.

Browse Source 
This change also removes the barely used 'size' field, and replaces
it with a tagMember predicate.  The idea is to move towards the ability
to make the workspace tag be a String, which by default might be "1".."9",
but could also be customized to be something meaningful to the user.
This commit is contained in:
David Roundy 2007-06-14 14:07:09 +00:00
parent a2c5aa3612
commit dbd58faffe
3 changed files with 63 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Main.hs
View File

@ -52,7 +52,7 @@ main = do
let winset | ("--resume" : s : _) <- args
, [(x, "")] <- reads s = x
| otherwise = new (fromIntegral workspaces) (fromIntegral $ length xinesc)
| otherwise = new [0..fromIntegral workspaces-1] (fromIntegral $ length xinesc)
safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x,xs)
cf = XConf

48
StackSet.hs
View File

@ -23,7 +23,7 @@ module StackSet (
-- $stackOperations
peek, index, integrate, integrate', differentiate,
focusUp, focusDown,
focusWindow, member, findIndex,
focusWindow, tagMember, member, findIndex,
-- * Modifying the stackset
-- $modifyStackset
insertUp, delete, filter,
@ -104,6 +104,13 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- needs to be well defined. Particular in relation to 'insert' and
-- 'delete'.
--
import Prelude hiding (filter)
import Data.Maybe (listToMaybe)
import qualified Data.List as L (delete,find,genericSplitAt,filter)
import qualified Data.Map as M (Map,insert,delete,empty)
-- |
-- API changes from xmonad 0.1:
-- StackSet constructor arguments changed. StackSet workspace window screen
--
@ -145,8 +152,7 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- Xinerama screens, and those workspaces not visible anywhere.
data StackSet i a sid =
StackSet { size :: !i -- ^ number of workspaces
, current :: !(Screen i a sid) -- ^ currently focused workspace
StackSet { current :: !(Screen i a sid) -- ^ currently focused workspace
, visible :: [Screen i a sid] -- ^ non-focused workspaces, visible in xinerama
, hidden :: [Workspace i a] -- ^ workspaces not visible anywhere
, floating :: M.Map a RationalRect -- ^ floating windows
@ -198,19 +204,20 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- ---------------------------------------------------------------------
-- $construction
-- | /O(n)/. Create a new stackset, of empty stacks, of size 'n', with
-- 'm' physical screens. 'm' should be less than or equal to 'n'.
-- The workspace with index '0' will be current.
-- | /O(n)/. Create a new stackset, of empty stacks, with given tags, with
-- 'm' physical screens. 'm' should be less than or equal to the number of
-- workspace tags. The first workspace in the list will be current.
--
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
new :: (Integral i, Integral s) => i -> s -> StackSet i a s
new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty
| otherwise = abort "non-positive arguments to StackSet.new"
where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Nothing : [ Workspace i Nothing | i <- [1 ..n-1]]
new :: Integral s => [i] -> s -> StackSet i a s
new (wid:wids) m | m > 0 = StackSet cur visi unseen M.empty
where (seen,unseen) = L.genericSplitAt m $ Workspace wid Nothing : [ Workspace i Nothing | i <- wids]
(cur:visi) = [ Screen i s | (i,s) <- zip seen [0..] ]
-- now zip up visibles with their screen id
new _ _ = abort "non-positive argument to StackSet.new"
-- |
-- /O(w)/. Set focus to the workspace with index \'i\'.
@ -220,9 +227,10 @@ new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty
-- becomes the current screen. If it is in the visible list, it becomes
-- current.
view :: (Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
view :: (Eq a, Eq s, Eq i) => i -> StackSet i a s -> StackSet i a s
view i s
| i < 0 && i >= size s || i == tag (workspace (current s)) = s -- out of bounds or current
| not (elem i $ map tag $ workspaces s)
|| i == tag (workspace (current s)) = s -- out of bounds or current
| Just x <- L.find ((i==).tag.workspace) (visible s)
-- if it is visible, it is just raised
@ -356,6 +364,16 @@ focusWindow w s | Just w == peek s = s
n <- findIndex w s
return $ until ((Just w ==) . peek) focusUp (view n s)
-- | Get a list of all workspaces in the StackSet.
workspaces :: StackSet i a s -> [Workspace i a]
workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s
-- | Is the given tag present in the StackSet?
tagMember :: Eq i => i -> StackSet i a s -> Bool
tagMember t = elem t . map tag . workspaces
-- |
-- Finding if a window is in the stackset is a little tedious. We could
-- keep a cache :: Map a i, but with more bookkeeping.
@ -370,7 +388,7 @@ member a s = maybe False (const True) (findIndex a s)
-- if the window is not in the StackSet.
findIndex :: Eq a => a -> StackSet i a s -> Maybe i
findIndex a s = listToMaybe
[ tag w | w <- workspace (current s) : map workspace (visible s) ++ hidden s, has a (stack w) ]
[ tag w | w <- workspaces s, has a (stack w) ]
where has _ Nothing = False
has x (Just (Stack t l r)) = x `elem` (t : l ++ r)
@ -464,7 +482,7 @@ swapMaster = modify' $ \c -> case c of
-- element on the current stack, the original stackSet is returned.
--
shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))]
shift n s = if and [n >= 0,n `tagMember` s, n /= tag (workspace (current s))]
then maybe s go (peek s) else s
where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
-- ^^ poor man's state monad :-)

71
tests/Properties.hs
View File

@ -71,7 +71,7 @@ fromList (o,m,fs,xs) =
let s = view o $
foldr (\(i,ys) s ->
foldr insertUp (view i s) ys)
(new (genericLength xs) m) (zip [0..] xs)
(new [0..genericLength xs-1] m) (zip [0..] xs)
in foldr (\f t -> case f of
Nothing -> t
Just i -> foldr (const focusUp) t [0..i] ) s fs
@ -81,7 +81,7 @@ fromList (o,m,fs,xs) =
--
-- Just generate StackSets with Char elements.
--
type T = StackSet Int Char Int
type T = StackSet (NonNegative Int) Char Int
-- Useful operation, the non-local workspaces
hidden_spaces x = map workspace (visible x) ++ hidden x
@ -103,7 +103,6 @@ hidden_spaces x = map workspace (visible x) ++ hidden x
invariant (s :: T) = and
-- no duplicates
[ noDuplicates
, accurateSize
-- all this xinerama stuff says we don't have the right structure
-- , validScreens
@ -116,8 +115,6 @@ invariant (s :: T) = and
| w <- workspace (current s) : map workspace (visible s) ++ hidden s
, t <- maybeToList (stack w)] :: [Char]
noDuplicates = nub ws == ws
calculatedSize = length (visible s) + length (hidden s) + 1 -- +1 is for current
accurateSize = calculatedSize == size s
-- validScreens = monotonic . sort . M. . (W.current s : W.visible : W$ s
@ -135,10 +132,10 @@ prop_invariant = invariant
-- and check other ops preserve invariants
prop_empty_I (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m ->
invariant $ new (fromIntegral n) m
invariant $ new [0..fromIntegral n-1] m
prop_view_I (n :: NonNegative Int) (x :: T) =
fromIntegral n < size x ==> invariant $ view (fromIntegral n) x
n `tagMember` x ==> invariant $ view (fromIntegral n) x
prop_focusUp_I (n :: NonNegative Int) (x :: T) =
invariant $ foldr (const focusUp) x [1..n]
@ -166,41 +163,39 @@ prop_swap_right_I (n :: NonNegative Int) (x :: T) =
invariant $ foldr (const swapDown) x [1..n]
prop_shift_I (n :: NonNegative Int) (x :: T) =
fromIntegral n < size x ==> invariant $ shift (fromIntegral n) x
n `tagMember` x ==> invariant $ shift (fromIntegral n) x
-- ---------------------------------------------------------------------
-- 'new'
-- empty StackSets have no windows in them
prop_empty (n :: Positive Int)
(m :: Positive Int) =
prop_empty (NonEmptyNubList ns) (m :: Positive Int) =
all (== Nothing) [ stack w | w <- workspace (current x)
: map workspace (visible x) ++ hidden x ]
where x = new (fromIntegral n) (fromIntegral m) :: T
where x = new ns (fromIntegral m) :: T
-- empty StackSets always have focus on workspace 0
prop_empty_current (n :: Positive Int)
(m :: Positive Int) = tag (workspace $ current x) == 0
where x = new (fromIntegral n) (fromIntegral m) :: T
-- empty StackSets always have focus on first workspace
prop_empty_current (NonEmptyNubList ns) (m :: Positive Int) = tag (workspace $ current x) == head ns
where x = new ns (fromIntegral m) :: T
-- no windows will be a member of an empty workspace
prop_member_empty i (n :: Positive Int) (m :: Positive Int)
= member i (new (fromIntegral n) (fromIntegral m) :: T) == False
prop_member_empty i (NonEmptyNubList ns) (m :: Positive Int)
= member i (new ns (fromIntegral m) :: T) == False
-- ---------------------------------------------------------------------
-- viewing workspaces
-- view sets the current workspace to 'n'
prop_view_current (x :: T) (n :: NonNegative Int) = i < size x ==>
prop_view_current (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
tag (workspace $ current (view i x)) == i
where
i = fromIntegral n
-- view *only* sets the current workspace, and touches Xinerama.
-- no workspace contents will be changed.
prop_view_local (x :: T) (n :: NonNegative Int) = i < size x ==>
prop_view_local (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
workspaces x == workspaces (view i x)
where
workspaces a = sortBy (\s t -> tag s `compare` tag t) $
@ -209,22 +204,18 @@ prop_view_local (x :: T) (n :: NonNegative Int) = i < size x ==>
i = fromIntegral n
-- view should result in a visible xinerama screen
-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i < size x ==>
-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
-- M.member i (screens (view i x))
-- where
-- i = fromIntegral n
-- view is idempotent
prop_view_idem (x :: T) r =
let i = fromIntegral $ r `mod` sz
sz = size x
in view i (view i x) == (view i x)
prop_view_idem (x :: T) (i :: NonNegative Int) = i `tagMember` x ==> view i (view i x) == (view i x)
-- view is reversible, though shuffles the order of hidden/visible
prop_view_reversible r (x :: T) = normal (view n (view i x)) == normal x
prop_view_reversible (i :: NonNegative Int) (x :: T) =
i `tagMember` x ==> normal (view n (view i x)) == normal x
where n = tag (workspace $ current x)
sz = size x
i = fromIntegral $ r `mod` sz
-- normalise workspace list
normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
@ -329,8 +320,8 @@ prop_findIndex (x :: T) =
-- 'insert'
-- inserting a item into an empty stackset means that item is now a member
prop_insert_empty i (n :: Positive Int) (m :: Positive Int) = member i (insertUp i x)
where x = new (fromIntegral n) (fromIntegral m) :: T
prop_insert_empty i (NonEmptyNubList ns) (m :: Positive Int) = member i (insertUp i x)
where x = new ns (fromIntegral m) :: T
-- insert should be idempotent
prop_insert_idem i (x :: T) = insertUp i x == insertUp i (insertUp i x)
@ -343,10 +334,9 @@ prop_insert_local (x :: T) i = not (member i x) ==> hidden_spaces x == hidden_sp
-- Inserting a (unique) list of items into an empty stackset should
-- result in the last inserted element having focus.
prop_insert_peek (n :: Positive Int) (m :: Positive Int) (NonEmptyNubList is) =
prop_insert_peek (NonEmptyNubList ns) (m :: Positive Int) (NonEmptyNubList is) =
peek (foldr insertUp x is) == Just (head is)
where
x = new (fromIntegral n) (fromIntegral m) :: T
where x = new ns (fromIntegral m) :: T
-- insert >> delete is the identity, when i `notElem` .
-- Except for the 'master', which is reset on insert and delete.
@ -357,11 +347,11 @@ prop_insert_delete n x = not (member n x) ==> delete n (insertUp n y) == (y :: T
-- otherwise, we don't have a rule for where master goes.
-- inserting n elements increases current stack size by n
prop_size_insert is (n :: Positive Int) (m :: Positive Int) =
prop_size_insert is (NonEmptyNubList ns) (m :: Positive Int) =
size (foldr insertUp x ws ) == (length ws)
where
ws = nub is
x = new (fromIntegral n) (fromIntegral m) :: T
x = new ns (fromIntegral m) :: T
size = length . index
@ -438,15 +428,13 @@ prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
-- shift is fully reversible on current window, when focus and master
-- are the same. otherwise, master may move.
prop_shift_reversible (r :: Int) (x :: T) =
let i = fromIntegral $ r `mod` sz
sz = size y
n = tag (workspace $ current y)
in case peek y of
Nothing -> True
Just _ -> normal ((view n . shift n . view i . shift i) y) == normal y
prop_shift_reversible i (x :: T) =
i `tagMember` x ==> case peek y of
Nothing -> True
Just _ -> normal ((view n . shift n . view i . shift i) y) == normal y
where
y = swapMaster x
n = tag (workspace $ current y)
------------------------------------------------------------------------
-- some properties for layouts:
@ -700,7 +688,6 @@ instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
arbitrary = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
coarbitrary = undefined
type Positive a = NonZero (NonNegative a)
newtype NonZero a = NonZero a