Merge branch 'master' of github.com:jrahm/xmonad-jrahm

5 files changed, 131 insertions, 29 deletions

diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs
new file mode 100644
index 0000000..10fbe5b
--- /dev/null
+++ b/src/Internal/CornerLayout.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+-- Creates a layout, the "corner layout" that keeps the master window in the
+-- corner and the other windows go around it.
+module Internal.CornerLayout where
+
+import Data.Typeable (Typeable)
+import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage)
+import qualified XMonad.StackSet as S
+
+data Corner a = Corner Rational Rational
+  deriving (Show, Typeable, Read)
+
+instance LayoutClass Corner a where
+  pureLayout (Corner frac _) screen@(Rectangle x y w h) ss =
+    let w' = floor $ fromIntegral w * frac
+        h' = floor $ fromIntegral h * frac
+        corner = Rectangle 0 0 w' h'
+        vertRect = Rectangle (fromIntegral w') 0 (w - w') h
+        horizRect = Rectangle 0 (fromIntegral h') w' (h - h')
+        ws = S.integrate ss
+
+        vn = (length ws - 1) `div` 2
+        hn = (length ws - 1) - vn
+      in 
+        case ws of
+          [a] -> [(a, screen)]
+          [a, b] -> [
+            (a, Rectangle x y w' h),
+            (b, Rectangle (x + fromIntegral w') y (w - w') h)]
+          _ -> 
+            zip ws $ map (
+                \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $ 
+              corner :
+                (splitVert vertRect vn) ++
+                (splitHoriz horizRect hn)
+
+  pureMessage (Corner frac delta) m = fmap resize (fromMessage m)
+    where
+      resize Shrink = Corner (frac - delta) delta
+      resize Expand = Corner (frac + delta) delta
+
+splitVert :: Rectangle -> Int -> [Rectangle]
+splitVert (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle x (y + fromIntegral (step * i)) w step)
+    [0 .. i - 1]
+  where
+    i = fromIntegral i'
+    step = h `div` i
+
+splitHoriz :: Rectangle -> Int -> [Rectangle]
+splitHoriz (Rectangle x y w h) i' =
+  map
+    (\i -> Rectangle (x + fromIntegral (step * i)) y step h)
+    [0 .. i - 1]
+  where
+    step = w `div` i
+    i = fromIntegral i'
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index bc27750..d02e1f4 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -90,7 +90,7 @@ newKeys markContext =
         , ((modm              , xK_Return),     windows W.swapMaster)
         , ((modm,               xK_j),          sendMessage Shrink)
         , ((modm,               xK_k),          sendMessage Expand)
-        , ((modm .|. shiftMask, xK_r),          (void $ spawn "gmrun"))
+        , ((modm .|. shiftMask, xK_r),          sendMessage DoRotate)
         , ((modm .|. mod1Mask,  xK_l),          (void $ spawn "xsecurelock"))
         , ((modm .|. mod1Mask,  xK_s),          (void $ spawn "sudo systemctl suspend && xsecurelock"))
         , ((modm .|. shiftMask, xK_c),          kill)
diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs
index cb8c19b..632e912 100644
--- a/src/Internal/Layout.hs
+++ b/src/Internal/Layout.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 module Internal.Layout where 
 
+import Internal.CornerLayout (Corner(..))
 import Control.Arrow (second)
 import XMonad.Hooks.ManageDocks
 import XMonad.Layout.Circle
@@ -24,18 +25,20 @@ import qualified XMonad.StackSet as W
 
 myLayout =
   avoidStruts $ 
-    ModifiedLayout (Zoomable False 0.05 0.05) $
-      ModifiedLayout (Flippable False) $
-        ModifiedLayout (HFlippable False) $
-          spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-            spiral (6/7) |||
-            ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
-            ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
-            Full |||
-            Grid |||
-            Dishes 2 (1/6) |||
-            (MosaicAlt M.empty :: MosaicAlt Window) |||
-            (D.Dwindle D.R D.CW 1.5 1.1)
+    spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
+      ModifiedLayout (Zoomable False 0.05 0.05) $
+        ModifiedLayout (Flippable False) $
+          ModifiedLayout (HFlippable False) $
+            ModifiedLayout (Rotateable False) $
+              spiral (6/7) |||
+              (Corner (3/4) (3/100) :: Corner Window) |||
+              ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) |||
+              ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) |||
+              Full |||
+              Grid |||
+              Dishes 2 (1/6) |||
+              (MosaicAlt M.empty :: MosaicAlt Window) |||
+              (D.Dwindle D.R D.CW 1.5 1.1)
 
 data ModifyDescription m l a = ModifyDescription m (l a)
   deriving (Show, Read)
@@ -90,10 +93,15 @@ data Flippable a = Flippable Bool -- True if flipped
 data HFlippable a = HFlippable Bool -- True if flipped
   deriving (Show, Read)
 
+data Rotateable a = Rotateable Bool -- True if rotated
+  deriving (Show, Read)
+
 data FlipLayout = FlipLayout deriving (Typeable)
 
 data HFlipLayout = HFlipLayout deriving (Typeable)
 
+data DoRotate = DoRotate deriving (Typeable)
+
 data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
   deriving (Show, Read)
 
@@ -111,6 +119,32 @@ instance Message HFlipLayout where
 
 instance Message ZoomModifier where
 
+instance Message DoRotate where
+
+instance (Eq a) => LayoutModifier Rotateable a where
+  pureModifier (Rotateable rotate) (Rectangle _ _ sw sh) _ returned =
+    if rotate
+      then (map (second (scaleRect . mirrorRect)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      scaleRect (Rectangle x y w h) = 
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess (Rotateable rot) mess =
+    fmap (\(DoRotate) -> Rotateable (not rot)) (fromMessage mess)
+
+  modifyDescription (Rotateable rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr
+
 instance (Eq a) => LayoutModifier Flippable a where
   pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
     if flip 
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index feb5f26..3ba1eca 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -21,6 +21,9 @@ import XMonad hiding (workspaces, Screen)
 import XMonad.StackSet hiding (filter, focus)
 import qualified Data.Map as Map
 import Internal.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
 
 type WorkspaceName = Char
 newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
@@ -31,6 +34,23 @@ instance XPrompt WinPrompt where
     showXPrompt _ = "[Window] "
     commandToComplete _ = id
 
+data WorkspaceState = Current | Hidden | Visible
+
+-- Returns all the workspaces that are either visible, current or Hidden but
+-- have windows and that workspace's state.
+--
+-- In other words, filters out workspaces that have no windows and are not
+-- visible.
+--
+-- This function will sort the result by the workspace tag.
+getPopulatedWorkspaces ::
+  (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, S.Workspace i l a)]
+getPopulatedWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
+  sortBy (comparing (tag . snd)) $
+    mapMaybe (\w@(S.Workspace _ _ s) -> fmap (const (Hidden, w)) s) hi ++
+      map (\(S.Screen w _ _) -> (Visible, w)) vis ++
+        [(Current, cur)]
+
 getHorizontallyOrderedScreens ::
   StackSet wid l a ScreenId ScreenDetail ->
     [Screen wid l a ScreenId ScreenDetail]
@@ -91,7 +111,7 @@ getString = runQuery $ do
 relativeWorkspaceShift :: Selector -> X ()
 relativeWorkspaceShift (Selector selector) = do
   windows $ \ss ->
-    let tags = sort $ (tag <$> filter (isJust . stack) (workspaces ss))
+    let tags = sort $ (tag . snd <$> getPopulatedWorkspaces ss)
         from = tag $ workspace $ current ss
         to = selector from tags
     in greedyView to ss
diff --git a/src/Internal/XMobarLog.hs b/src/Internal/XMobarLog.hs
index d0ff8f8..c0aa2a7 100644
--- a/src/Internal/XMobarLog.hs
+++ b/src/Internal/XMobarLog.hs
@@ -1,5 +1,6 @@
 module Internal.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where
 
+import Control.Arrow (second)
 import Control.Monad (forM_)
 import Control.Monad.Writer (tell, execWriter)
 import Data.List (sortBy)
@@ -10,12 +11,11 @@ import System.IO (Handle, hSetEncoding, hPutStrLn, utf8)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (spawnPipe)
 import XMonad (X)
+import Internal.Lib (getPopulatedWorkspaces, WorkspaceState(..))
 
 import qualified XMonad as X
 import qualified XMonad.StackSet as S
 
-data WorkspaceState = Current | Hidden | Visible
-
 data XMobarLog = XMobarLog Handle
 
 -- The log hook for XMobar. This is a custom log hook that does not use any
@@ -39,19 +39,19 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   winset <- X.gets X.windowset
   title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
-  let wss = getWorkspaces winset
+  let wss = getPopulatedWorkspaces winset
 
   X.liftIO $ do
     hPutStrLn xmproc $ trunc 80 $ execWriter $ do
       tell layoutXpm
       tell $ "<fc=#404040> │ </fc>"
 
-      forM_ wss $ \(t, name) -> do
+      forM_ wss $ \(t, ws) -> do
         case t of
           Current -> tell "<fn=1><fc=#ff8888>"
           Visible -> tell "<fn=6><fc=#8888ff>"
           Hidden -> tell "<fn=2><fc=#888888>"
-        tell name
+        tell (S.tag ws)
         tell " </fc></fn>"
 
       tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
@@ -76,13 +76,3 @@ trunc amt str = reverse $ trunc' False amt str []
                 0 -> trunc' False 0 as acc
                 3 -> trunc' False 0 as ("..." ++ acc)
                 _ -> trunc' False (amt - 1) as (a : acc)
-
--- Returns all the workspaces with a stack on them and if that workspace is
--- Visible, Current or Hidden.
-getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)]
-getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) =
-  sortBy (comparing snd) $
-    mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $
-      map (\w -> (Hidden, w)) hi ++
-        map (\(S.Screen w _ _) -> (Visible, w)) vis ++
-          [(Current, cur)]