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

module Operations where

import XMonad
import qualified StackSet as W
import {-# SOURCE #-} Config (borderWidth, modMask, numlockMask)

import Data.Maybe
import Data.List            (genericIndex, intersectBy, partition, delete)
import Data.Bits            ((.|.))
import Data.Ratio
import qualified Data.Map as M

-- import System.Mem (performGC)
import Control.Monad.State
import Control.Monad.Reader
import Control.Arrow

import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras

-- ---------------------------------------------------------------------
-- Window manager operations

-- | manage. Add a new window to be managed in the current workspace.
-- Bring it into focus. If the window is already managed, nothing happens.
--
manage :: Window -> X ()
manage w = withDisplay $ \d -> do
    io $ selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
    io $ mapWindow d w
    io $ setWindowBorderWidth d w borderWidth

    -- FIXME: This is pretty awkward. We can't can't let "refresh" happen
    -- before the call to float, because that will resize the window and
    -- lose the default sizing.

    isTransient <- isJust `liftM` io (getTransientForHint d w)
    if isTransient
        then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }
                float w -- ^^ now go the refresh.
        else windows $ W.insertUp w

-- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is.
--
-- FIXME: clearFloating should be taken care of in W.delete, but if we do it
-- there, floating status is lost when moving windows between workspaces,
-- because W.shift calls W.delete.
unmanage :: Window -> X ()
unmanage w = windows $ W.sink w . W.delete w

-- | focus. focus window up or down. or swap various windows.
focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
focusUp    = windows W.focusUp
focusDown  = windows W.focusDown
swapUp     = windows W.swapUp
swapDown   = windows W.swapDown
swapMaster = windows W.swapMaster

-- | shift. Move a window to a new workspace, 0 indexed.
shift :: WorkspaceId -> X ()
shift n = withFocused hide >> windows (W.shift n)
    -- refresh will raise it if we didn't need to move it.

-- | view. Change the current workspace to workspace at offset n (0 indexed).
view :: WorkspaceId -> X ()
view = windows . W.view

-- | Modify the size of the status gap at the top of the current screen
-- Taking a function giving the current screen, and current geometry.
modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()
modifyGap f = do
    XState { windowset = ws, statusGaps = gaps } <- get
    let n       = fromIntegral $ W.screen (W.current ws)
        (a,i:b) = splitAt n gaps
    modify $ \s -> s { statusGaps = a ++ f n i : b }
    refresh

-- | Kill the currently focused client. If we do kill it, we'll get a
-- delete notify back from X.
--
-- There are two ways to delete a window. Either just kill it, or if it
-- supports the delete protocol, send a delete event (e.g. firefox)
--
kill :: X ()
kill = withDisplay $ \d -> withFocused $ \w -> do
    XConf {wmdelete = wmdelt, wmprotocols = wmprot} <- ask
    protocols <- io $ getWMProtocols d w
    io $ if wmdelt `elem` protocols
        then allocaXEvent $ \ev -> do
                setEventType ev clientMessage
                setClientMessageEvent ev w wmprot 32 wmdelt 0
                sendEvent d w False noEventMask ev
        else killClient d w >> return ()

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

-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
    old  <- gets windowset
    let new = f old
    modify (\s -> s { windowset = new })
    refresh

    -- We now go to some effort to compute the minimal set of windows to hide.
    -- The minimal set being only those windows which weren't previously hidden,
    -- which is the intersection of previously visible windows with those now hidden
    mapM_ hide . concatMap (integrate . W.stack) $
        intersectBy (\w x -> W.tag w == W.tag x)
            (map W.workspace $ W.current old : W.visible old)
            (W.hidden new)

    clearEnterEvents

    -- TODO: move this into StackSet.  This isn't exactly the usual integrate.
 where integrate W.Empty        = []
       integrate (W.Node x l r) = x : l ++ r

-- | hide. Hide a window by moving it off screen.
hide :: Window -> X ()
hide w = withDisplay $ \d -> do
    (sw,sh) <- gets dimensions
    io $ moveWindow d w sw sh

-- | refresh. Render the currently visible workspaces, as determined by
-- the StackSet. Also, set focus to the focused window.
--
-- This is our 'view' operation (MVC), in that it pretty prints our model
-- with X calls.
--
refresh :: X ()
refresh = do
    XState { windowset = ws, layouts = fls, xineScreens = xinesc, statusGaps = gaps } <- get
    d <- asks display

    -- for each workspace, layout the currently visible workspaces
    (`mapM_` (W.current ws : W.visible ws)) $ \w -> do
        let n      = W.tag (W.workspace w)
            this   = W.view n ws
            Just l = fmap fst $ M.lookup n fls
            (flt, tiled) = partition (flip M.member (W.floating ws)) (W.index this)
            (Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w)
            (gt,gb,gl,gr)           = genericIndex gaps   (W.screen w)

        -- just the tiled windows:
        -- now tile the windows on this workspace, modified by the gap
        rs <- doLayout l (Rectangle (sx + fromIntegral gl)
                                    (sy + fromIntegral gt)
                                    (sw - fromIntegral (gl + gr))
                                    (sh - fromIntegral (gt + gb))) tiled
        mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs

        -- now the floating windows:
        -- move/resize the floating windows, if there are any
        (`mapM_` flt) $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
          \(W.RationalRect rx ry rw rh) -> do
            let Rectangle px py pw ph = genericIndex xinesc (W.screen w)
            io $ tileWindow d fw (Rectangle (px + floor (toRational pw*rx))
                                            (py + floor (toRational ph*ry))
                                            (floor (toRational pw*rw))
                                            (floor (toRational ph*rh)))

        -- TODO seems fishy?
        -- Urgh. This is required because the fullscreen layout assumes that
        -- the focused window will be raised. Hmm. This is a reordering.

        -- This really doesn't work with fullscreen mode, where 
        -- focus is used to find the raised window. moving the floating
        -- layer will move focus there, so we now have forgotten the
        -- window on the top of the fullscreen
        --
        -- I think the solution must be to track the floating layer separately
        -- in its own zipper, on each workspace. And from there to
        -- handle pushing between the two.
        --
        let tiled' = case W.peek this of
                        Just x | x `elem` tiled -> x : delete x tiled
                        _ -> tiled

        io $ restackWindows d (flt ++ tiled')

    setTopFocus
    clearEnterEvents
--  io performGC -- really helps 

-- | clearEnterEvents.  Remove all window entry events from the event queue.
clearEnterEvents :: X ()
clearEnterEvents = withDisplay $ \d -> io $ do
    sync d False
    allocaXEvent $ \p -> fix $ \again -> do
        more <- checkMaskEvent d enterWindowMask p
        when more again -- beautiful<commit_msg>commented out implementation state logging. if someone has a client, we can enable this<commit_after>{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Operations.hs
-- Copyright   :  (c) <NAME> 2007
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  unstable
-- Portability :  not portable, mtl, posix
--
-----------------------------------------------------------------------------

module Operations where

import XMonad
import qualified StackSet as W
import {-# SOURCE #-} Config (borderWidth, modMask, numlockMask)

import Data.Maybe
import Data.List            (genericIndex, intersectBy, partition, delete)
import Data.Bits            ((.|.))
import Data.Ratio
import qualified Data.Map as M

import Control.Monad.State
import Control.Monad.Reader
import Control.Arrow

import System.IO
import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras

-- ---------------------------------------------------------------------
-- Window manager operations

-- | manage. Add a new window to be managed in the current workspace.
-- Bring it into focus. If the window is already managed, nothing happens.
--
manage :: Window -> X ()
manage w = withDisplay $ \d -> do
    io $ selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
    io $ mapWindow d w
    io $ setWindowBorderWidth d w borderWidth

    -- FIXME: This is pretty awkward. We can't can't let "refresh" happen
    -- before the call to float, because that will resize the window and
    -- lose the default sizing.

    isTransient <- isJust `liftM` io (getTransientForHint d w)
    if isTransient
        then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }
                float w -- ^^ now go the refresh.
        else windows $ W.insertUp w

-- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is.
--
-- FIXME: clearFloating should be taken care of in W.delete, but if we do it
-- there, floating status is lost when moving windows between workspaces,
-- because W.shift calls W.delete.
unmanage :: Window -> X ()
unmanage w = windows $ W.sink w . W.delete w

-- | focus. focus window up or down. or swap various windows.
focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
focusUp    = windows W.focusUp
focusDown  = windows W.focusDown
swapUp     = windows W.swapUp
swapDown   = windows W.swapDown
swapMaster = windows W.swapMaster

-- | shift. Move a window to a new workspace, 0 indexed.
shift :: WorkspaceId -> X ()
shift n = withFocused hide >> windows (W.shift n)
    -- refresh will raise it if we didn't need to move it.

-- | view. Change the current workspace to workspace at offset n (0 indexed).
view :: WorkspaceId -> X ()
view = windows . W.view

-- | Modify the size of the status gap at the top of the current screen
-- Taking a function giving the current screen, and current geometry.
modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()
modifyGap f = do
    XState { windowset = ws, statusGaps = gaps } <- get
    let n       = fromIntegral $ W.screen (W.current ws)
        (a,i:b) = splitAt n gaps
    modify $ \s -> s { statusGaps = a ++ f n i : b }
    refresh

-- | Kill the currently focused client. If we do kill it, we'll get a
-- delete notify back from X.
--
-- There are two ways to delete a window. Either just kill it, or if it
-- supports the delete protocol, send a delete event (e.g. firefox)
--
kill :: X ()
kill = withDisplay $ \d -> withFocused $ \w -> do
    XConf {wmdelete = wmdelt, wmprotocols = wmprot} <- ask
    protocols <- io $ getWMProtocols d w
    io $ if wmdelt `elem` protocols
        then allocaXEvent $ \ev -> do
                setEventType ev clientMessage
                setClientMessageEvent ev w wmprot 32 wmdelt 0
                sendEvent d w False noEventMask ev
        else killClient d w >> return ()

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

-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
    old  <- gets windowset
    let new = f old
    modify (\s -> s { windowset = new })
    refresh

    -- We now go to some effort to compute the minimal set of windows to hide.
    -- The minimal set being only those windows which weren't previously hidden,
    -- which is the intersection of previously visible windows with those now hidden
    mapM_ hide . concatMap (integrate . W.stack) $
        intersectBy (\w x -> W.tag w == W.tag x)
            (map W.workspace $ W.current old : W.visible old)
            (W.hidden new)

    clearEnterEvents

    -- TODO: move this into StackSet.  This isn't exactly the usual integrate.
 where integrate W.Empty        = []
       integrate (W.Node x l r) = x : l ++ r

-- | hide. Hide a window by moving it off screen.
hide :: Window -> X ()
hide w = withDisplay $ \d -> do
    (sw,sh) <- gets dimensions
    io $ moveWindow d w sw sh

-- | refresh. Render the currently visible workspaces, as determined by
-- the StackSet. Also, set focus to the focused window.
--
-- This is our 'view' operation (MVC), in that it pretty prints our model
-- with X calls.
--
refresh :: X ()
refresh = do
    XState { windowset = ws, layouts = fls, xineScreens = xinesc, statusGaps = gaps } <- get
    d <- asks display

    -- for each workspace, layout the currently visible workspaces
    (`mapM_` (W.current ws : W.visible ws)) $ \w -> do
        let n      = W.tag (W.workspace w)
            this   = W.view n ws
            Just l = fmap fst $ M.lookup n fls
            (flt, tiled) = partition (flip M.member (W.floating ws)) (W.index this)
            (Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w)
            (gt,gb,gl,gr)           = genericIndex gaps   (W.screen w)

        -- just the tiled windows:
        -- now tile the windows on this workspace, modified by the gap
        rs <- doLayout l (Rectangle (sx + fromIntegral gl)
                                    (sy + fromIntegral gt)
                                    (sw - fromIntegral (gl + gr))
                                    (sh - fromIntegral (gt + gb))) tiled
        mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs

        -- now the floating windows:
        -- move/resize the floating windows, if there are any
        (`mapM_` flt) $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
          \(W.RationalRect rx ry rw rh) -> do
            let Rectangle px py pw ph = genericIndex xinesc (W.screen w)
            io $ tileWindow d fw (Rectangle (px + floor (toRational pw*rx))
                                            (py + floor (toRational ph*ry))
                                            (floor (toRational pw*rw))
                                            (floor (toRational ph*rh)))

        -- TODO seems fishy?
        -- Urgh. This is required because the fullscreen layout assumes that
        -- the focused window will be raised. Hmm. This is a reordering.

        -- This really doesn't work with fullscreen mode, where 
        -- focus is used to find the raised window. moving the floating
        -- layer will move focus there, so we now have forgotten the
        -- window on the top of the fullscreen
        --
        -- I think the solution must be to track the floating layer separately
        -- in its own zipper, on each workspace. And from there to
        -- handle pushing between the two.
        --
        let tiled' = case W.peek this of
                        Just x | x `elem` tiled -> x : delete x tiled
                        _ -> tiled

        io $ restackWindows d (flt ++ tiled')

    setTopFocus
    clearEnterEvents
    -- withWindowSet (io . hPrint stderr) -- logging state changes!
--  io performGC -- really helps 

-- | clearEnterEvents.  Remove all window entry events from the event queue.
clearEnterEvents :: X ()
clearEnterEvents = withDisplay $ \d -> io $ do
    sync d False
    allocaXEvent $ \p -> fix $ \again -> do
        more <- checkMaskEvent d enterWindowMask p
        when more again -- beautiful
{'fraction_non_alphanumeric': 0.12884333821376281, 'fraction_numerical': 0.0019521717911176184, 'mean_word_length': 1.894244350282486, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1943687', 'n_tokens_mistral': 4653, 'n_tokens_neox': 4490, 'n_words': 1930}