Starting to implement window management language

1 files changed, 91 insertions, 36 deletions

diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index b1783cc..5caaa3b 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,44 +1,50 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
   jumpToMark,
-  swapWithMark, markToWindow
+  markToLocation,
+  moveLocationToWorkspace,
+  setAlternateWindow,
+  getAlternateWindow
   ) where
-
-import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
-import XMonad
-import XMonad.StackSet hiding (focus)
+import Data.Ord (Down(..))
+import Control.Exception
+import Control.Monad (when)
+import Control.Monad.Trans.Maybe
+import Data.Char (isAlpha, isDigit, ord)
 import Data.IORef
+import Data.List (sortOn, sort, sortBy, find)
 import Data.Map (Map)
-import Control.Monad (when)
-
+import Data.Maybe (catMaybes)
+import Data.Sequence (Seq(..))
+import Rahm.Desktop.Common
+import Rahm.Desktop.History
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
+import Rahm.Desktop.Workspaces
+import System.Environment
 import System.FilePath
 import System.IO
-import Control.Exception
-import System.Environment
+import XMonad
+import XMonad.StackSet hiding (focus)
+import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
-import Data.Sequence (Seq(..))
-
 import qualified XMonad.Util.ExtensibleState as XS
 
-import qualified Data.Map as Map
-
 {- Submodule that handles marking windows so they can be jumped back to. -}
 
-type Mark = Char
+type Mark = String
 
 data MarkState =
   MarkState {
-    markStateMap :: Map Mark Window
+    markStateMap :: Map Mark Location
+  , alternateWindow :: Maybe Window
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty
+  initialValue = MarkState Map.empty Nothing
   extensionType = PersistentExtension
 
-withMaybeFocused :: (Maybe Window -> X a) -> X a
-withMaybeFocused f = withWindowSet $ f . peek
-
 -- greedyFocus :: Window -> X ()
 -- greedyFocus win = do
 --     ws <- withWindowSet $ \ss ->
@@ -47,20 +53,34 @@ withMaybeFocused f = withWindowSet $ f . peek
 --     mapM_ (windows . greedyView . tag) ws
 --     focus win
 
+setAlternateWindow :: Window -> X ()
+setAlternateWindow win = XS.modify (\m -> m { alternateWindow = Just win }) 
+
+getAlternateWindow :: MaybeT X Window
+getAlternateWindow = MaybeT $ alternateWindow <$> XS.get
+
+withMaybeFocused :: (Maybe Window -> X a) -> X a
+withMaybeFocused f = withWindowSet $ f . peek
+
+getCurrentLocation :: X Location
+getCurrentLocation =
+  (\ws -> withMaybeFocused (return . Location ws)) =<< getCurrentWorkspace
+
+
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
+  ws <- getCurrentWorkspace
+  
   withFocused $ \win ->
     XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
-          markStateMap = Map.insert mark win ms
+          markStateMap = Map.insert mark (Location ws $ Just win) ms
         }
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just w ->  windows $ focusWindow w
+  mapM_ focusLocation $ Map.lookup mark m
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -81,16 +101,51 @@ swapWithFocused winToSwap stackSet =
           mapWindows (
             \w -> if w == winToSwap then focused else w) stackSet
 
-markToWindow :: Mark -> X (Maybe Window)
-markToWindow m = do
-  MarkState { markStateMap = mp } <- XS.get
-  return $ Map.lookup m mp
-
-swapWithMark :: Mark -> X ()
-swapWithMark mark = do
-  MarkState {markStateMap = m} <- XS.get
-
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just winToSwap -> do
-      windows $ swapWithFocused winToSwap
+moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
+moveLocationToWorkspace (Location _ (Just win)) wid =
+  windows $ shiftWin wid win
+moveLocationToWorkspace _ _ = return ()
+
+windowRect :: Window -> X (Maybe Rectangle)
+windowRect win = withDisplay $ \dpy -> (do
+  (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+  return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    `catchX` return Nothing
+
+getWindowsAndRects :: X [(Window, Rectangle)]
+getWindowsAndRects =
+  catMaybes <$> (mapM (\w -> fmap (w,) <$> windowRect w)
+    =<< withWindowSet (return . allWindows))
+
+windowLocation :: Window -> MaybeT X Location
+windowLocation win = do
+  tag <- MaybeT $ withWindowSet $ return . findTag win
+  return (Location tag (Just win))
+
+markToLocation :: Mark -> X (Maybe Location)
+markToLocation mark =
+  case mark of
+    [ch] | isAlpha ch -> Map.lookup mark . markStateMap <$> XS.get
+    "0" -> getMostRecentLocationInHistory
+    [ch] | isDigit ch -> pastHistory (ord ch - 0x30)
+    "." -> Just <$> getCurrentLocation
+    "\"" -> nextLocation
+    "'" -> lastLocation
+    "/" -> runMaybeT $ windowLocation =<< MaybeT askWindowId
+    "^" -> do
+          rects <- sortOn (\(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+    "$" -> do
+          rects <- sortOn (Down . \(_, Rectangle x _ _ _) -> x)
+                     <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+
+    "*" -> runMaybeT (windowLocation =<< masterWindow)
+
+    "@" -> runMaybeT (windowLocation =<< getAlternateWindow)
+
+    _ -> return Nothing