<commit_before>{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Operations.hs
-- Copyright   :  (c) <NAME> 2007
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  stable
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Operations where

import Data.List
import Data.Maybe
import Data.Bits
import qualified Data.Map as M

import Control.Monad.State
import Control.Monad.Reader
import Control.Arrow (second)

import System.Posix.Process
import System.Environment
import System.Directory

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import XMonad
import {-# SOURCE #-} Config

import qualified StackSet as W


-- ---------------------------------------------------------------------
-- Managing windows

-- | refresh. Refresh the currently focused window. Resizes to full
-- screen and raises the window.
refresh :: X ()
refresh = do
    XState { workspace = ws, layouts = fls } <- get
    XConf  { xineScreens = xinesc, display = d } <- ask -- neat, eh?

    flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do
        let sc        = genericIndex xinesc scn -- temporary coercion!
            (Just l)  = fmap fst $ M.lookup n fls
        whenJust (W.index n ws) $ \winds ->
            do wrects <- doLayout l sc winds :: X [(Window,Rectangle)]
               mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) wrects
        whenJust (W.peekStack n ws) (io . raiseWindow d)
    whenJust (W.peek ws) setFocus
    clearEnterEvents

-- | clearEnterEvents.  Remove all window entry events from the event queue.
clearEnterEvents :: X ()
clearEnterEvents = do
    d <- asks display
    io $ sync d False
    io $ allocaXEvent $ \p -> fix $ \again -> do
        more <- checkMaskEvent d enterWindowMask p
        when more again -- beautiful

------------------------------------------------------------------------

-- | switchLayout.  Switch to another layout scheme.  Switches the
-- layout of the current workspace. By convention, a window set as
-- master in Tall mode remains as master in Wide mode. When switching
-- from full screen to a tiling mode, the currently focused window
-- becomes a master. When switching back , the focused window is
-- uppermost.
--
switchLayout :: X ()
switchLayout = layout (\(x, xs) -> let xs' = xs ++ [x] in (head xs', tail xs'))

-- | Throw an (extensible) message value to the current Layout scheme,
-- possibly modifying how we layout the windows, then refresh.
--
-- TODO, this will refresh on Nothing.
--
sendMessage :: Message a => a -> X ()
sendMessage a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (SomeMessage a))

------------------------------------------------------------------------
--
-- Builtin layout algorithms:
--
--   fullscreen mode
--   tall mode
--   wide mode
-- 
-- The latter algorithms support the following operations:
--
--      Shrink
--      Expand
--

data Resize = Shrink | Expand deriving Typeable
instance Message Resize

full :: Layout
full = Layout { doLayout     = \sc ws -> return [ (w,sc) | w <- ws ]
              , modifyLayout = const Nothing } -- no changes

tall, wide :: Rational -> Rational -> Layout
wide delta frac = mirrorLayout (tall delta frac)

tall delta frac = Layout { doLayout = \r w -> return $ zip w $ tile frac r (length w)
                         , modifyLayout = fmap handler . fromMessage }

    where handler s = tall delta $ (case s of
                                    Shrink -> (-)
                                    Expand -> (+)) frac delta

-- | Mirror a rectangle
mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)

-- | Mirror a layout
mirrorLayout :: Layout -> Layout
mirrorLayout (Layout { doLayout = dl, modifyLayout = ml }) =
              Layout { doLayout = \sc w -> map (second mirrorRect) `fmap` dl (mirrorRect sc) w
                     , modifyLayout = fmap mirrorLayout . ml }

-- | tile.  Compute the positions for windows in our default tiling modes
-- Tiling algorithms in the core should satisify the constraint that
--
--  * no windows overlap
--  * no gaps exist between windows.
--
tile :: Rational -> Rectangle -> Int -> [Rectangle]
tile _ d n | n < 2 = [d]
tile f r n = r1 : split_vertically (n-1) r2
    where (r1,r2) = split_horizontally_by f r

split_vertically, split_horizontally :: Int -> Rectangle -> [Rectangle]
split_vertically n r | n < 2 = [r]
split_vertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
    split_vertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
    where smallh = sh `div` fromIntegral n
split_horizontally n r = map mirrorRect $ split_vertically n $ mirrorRect r

split_horizontally_by, split_vertically_by :: Rational -> Rectangle -> (Rectangle, Rectangle)
split_horizontally_by f (Rectangle sx sy sw sh) =
    (Rectangle sx sy leftw sh, Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
        where leftw = floor $ fromIntegral sw * f
split_vertically_by f r = (\(a,b)->(mirrorRect a,mirrorRect b)) $ split_horizontally_by f $ mirrorRect r

------------------------------------------------------------------------

-- | layout. Modify the current workspace's layout with a pure
-- function and refresh.
layout :: ((Layout, [Layout]) -> (Layout, [Layout])) -> X ()
layout f = do
    modify $ \s ->
        let n          = W.current . workspace $ s
            (Just fl)  = M.lookup n $ layouts s
        in s { layouts = M.insert n (f fl) (layouts s) }
    refresh

-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
    modify $ \s -> s { workspace = f (workspace s) }
    refresh
    -- gets workspace >>= trace . show -- log state changes to stderr

-- | hide. Hide a window by moving it offscreen.
hide :: Window -> X ()
hide w = withDisplay $ \d -> do
    (sw,sh) <- asks dimensions
    io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)

-- ---------------------------------------------------------------------
-- Window operations

-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
buttonsToGrab :: [Button]<commit_msg>Use camelCase, please.<commit_after>{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Operations.hs
-- Copyright   :  (c) <NAME> 2007
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  stable
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Operations where

import Data.List
import Data.Maybe
import Data.Bits
import qualified Data.Map as M

import Control.Monad.State
import Control.Monad.Reader
import Control.Arrow (second)

import System.Posix.Process
import System.Environment
import System.Directory

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import XMonad
import {-# SOURCE #-} Config

import qualified StackSet as W


-- ---------------------------------------------------------------------
-- Managing windows

-- | refresh. Refresh the currently focused window. Resizes to full
-- screen and raises the window.
refresh :: X ()
refresh = do
    XState { workspace = ws, layouts = fls } <- get
    XConf  { xineScreens = xinesc, display = d } <- ask -- neat, eh?

    flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do
        let sc        = genericIndex xinesc scn -- temporary coercion!
            (Just l)  = fmap fst $ M.lookup n fls
        whenJust (W.index n ws) $ \winds ->
            do wrects <- doLayout l sc winds :: X [(Window,Rectangle)]
               mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) wrects
        whenJust (W.peekStack n ws) (io . raiseWindow d)
    whenJust (W.peek ws) setFocus
    clearEnterEvents

-- | clearEnterEvents.  Remove all window entry events from the event queue.
clearEnterEvents :: X ()
clearEnterEvents = do
    d <- asks display
    io $ sync d False
    io $ allocaXEvent $ \p -> fix $ \again -> do
        more <- checkMaskEvent d enterWindowMask p
        when more again -- beautiful

------------------------------------------------------------------------

-- | switchLayout.  Switch to another layout scheme.  Switches the
-- layout of the current workspace. By convention, a window set as
-- master in Tall mode remains as master in Wide mode. When switching
-- from full screen to a tiling mode, the currently focused window
-- becomes a master. When switching back , the focused window is
-- uppermost.
--
switchLayout :: X ()
switchLayout = layout (\(x, xs) -> let xs' = xs ++ [x] in (head xs', tail xs'))

-- | Throw an (extensible) message value to the current Layout scheme,
-- possibly modifying how we layout the windows, then refresh.
--
-- TODO, this will refresh on Nothing.
--
sendMessage :: Message a => a -> X ()
sendMessage a = layout $ \x@(l, ls) -> maybe x (flip (,) ls) (modifyLayout l (SomeMessage a))

------------------------------------------------------------------------
--
-- Builtin layout algorithms:
--
--   fullscreen mode
--   tall mode
--   wide mode
-- 
-- The latter algorithms support the following operations:
--
--      Shrink
--      Expand
--

data Resize = Shrink | Expand deriving Typeable
instance Message Resize

full :: Layout
full = Layout { doLayout     = \sc ws -> return [ (w,sc) | w <- ws ]
              , modifyLayout = const Nothing } -- no changes

tall, wide :: Rational -> Rational -> Layout
wide delta frac = mirrorLayout (tall delta frac)

tall delta frac = Layout { doLayout = \r w -> return $ zip w $ tile frac r (length w)
                         , modifyLayout = fmap handler . fromMessage }

    where handler s = tall delta $ (case s of
                                    Shrink -> (-)
                                    Expand -> (+)) frac delta

-- | Mirror a rectangle
mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)

-- | Mirror a layout
mirrorLayout :: Layout -> Layout
mirrorLayout (Layout { doLayout = dl, modifyLayout = ml }) =
              Layout { doLayout = \sc w -> map (second mirrorRect) `fmap` dl (mirrorRect sc) w
                     , modifyLayout = fmap mirrorLayout . ml }

-- | tile.  Compute the positions for windows in our default tiling modes
-- Tiling algorithms in the core should satisify the constraint that
--
--  * no windows overlap
--  * no gaps exist between windows.
--
tile :: Rational -> Rectangle -> Int -> [Rectangle]
tile _ d n | n < 2 = [d]
tile f r n = r1 : splitVertically (n-1) r2
    where (r1,r2) = splitHorizontallyBy f r

splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
splitVertically n r | n < 2 = [r]
splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
    splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
    where smallh = sh `div` fromIntegral n
splitHorizontally n r = map mirrorRect $ splitVertically n $ mirrorRect r

splitHorizontallyBy, splitVerticallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy f (Rectangle sx sy sw sh) =
    (Rectangle sx sy leftw sh, Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
        where leftw = floor $ fromIntegral sw * f
splitVerticallyBy f r = (\(a,b)->(mirrorRect a,mirrorRect b)) $ splitHorizontallyBy f $ mirrorRect r

------------------------------------------------------------------------

-- | layout. Modify the current workspace's layout with a pure
-- function and refresh.
layout :: ((Layout, [Layout]) -> (Layout, [Layout])) -> X ()
layout f = do
    modify $ \s ->
        let n          = W.current . workspace $ s
            (Just fl)  = M.lookup n $ layouts s
        in s { layouts = M.insert n (f fl) (layouts s) }
    refresh

-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
    modify $ \s -> s { workspace = f (workspace s) }
    refresh
    -- gets workspace >>= trace . show -- log state changes to stderr

-- | hide. Hide a window by moving it offscreen.
hide :: Window -> X ()
hide w = withDisplay $ \d -> do
    (sw,sh) <- asks dimensions
    io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)

-- ---------------------------------------------------------------------
-- Window operations

-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
buttonsToGrab :: [Button]
{'fraction_non_alphanumeric': 0.1825065068223046, 'fraction_numerical': 0.0031548229355627417, 'mean_word_length': 1.9626168224299065, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 79, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2792482', 'n_tokens_mistral': 3661, 'n_tokens_neox': 3539, 'n_words': 1385}