<commit_before>{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.Decoration
-- Copyright   :  (c) <NAME> <<EMAIL>>
-- License     :  BSD-style (see LICENSE)
-- 
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module to be used to easily define decorations.
--
-----------------------------------------------------------------------------

module XMonadContrib.Decoration (
                                 -- * Usage
                                 -- $usage 
                                 newDecoration 
                                ) where

import Data.Bits ( (.|.) )
import Control.Monad.Reader ( asks )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )

import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo )

import XMonad
import Operations ( UnDoLayout(UnDoLayout) )

-- $usage
-- You can use this module for writing other extensions.
-- See, for instance, "XMonadContrib.Tabbed"

newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
              -> (Display -> Window -> GC -> FontStruct -> X ())
              -> X () -> Layout a -> X (Layout a)
newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do
    d <- asks display
    rt <- asks theRoot
    win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
    io $ selectInput d win $ exposureMask .|. buttonPressMask
    io $ mapWindow d win

    let hook :: SomeMessage -> X (Maybe (ModLay a))
        hook sm  | Just e <- fromMessage sm           = handle_event e >> return Nothing
                 | Just UnDoLayout == fromMessage sm  = io (destroyWindow d win) >> return (Just id)
                 | otherwise                          = return Nothing

        handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t})
            | t == buttonPress && thisw == win        = click
        handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t})
            | t == buttonPress && thisw == win        = click
        handle_event (AnyEvent {ev_window = thisw, ev_event_type = t})
            | thisw == win    && t == expose          = withGC win fn draw
            | thisw == decfor && t == propertyNotify  = withGC win fn draw
        handle_event _ = return ()

    return $ layoutModify idModDo hook l

-- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
                                       let fontname = if fn == "" 
                                                      then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
                                                      else fn
                                       font <- io $ loadQueryFont d fontname
                                       io $ setFont d gc (fontFromFontStruct font)
                                       f d w gc font
                                       io $ freeGC d gc
                                       io $ freeFont d font
<commit_msg>Tabs should stay beneath any floating window<commit_after>{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.Decoration
-- Copyright   :  (c) <NAME> <<EMAIL>>
-- License     :  BSD-style (see LICENSE)
-- 
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module to be used to easily define decorations.
--
-----------------------------------------------------------------------------

module XMonadContrib.Decoration (
                                 -- * Usage
                                 -- $usage 
                                 newDecoration 
                                ) where

import Data.Bits ( (.|.) )
import Control.Monad.Reader ( asks )
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )

import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo )

import XMonad
import Operations ( UnDoLayout(UnDoLayout) )

-- $usage
-- You can use this module for writing other extensions.
-- See, for instance, "XMonadContrib.Tabbed"

newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
              -> (Display -> Window -> GC -> FontStruct -> X ())
              -> X () -> Layout a -> X (Layout a)
newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do
    d <- asks display
    rt <- asks theRoot
    win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
    io $ selectInput d win $ exposureMask .|. buttonPressMask
    io $ mapWindow d win
    io $ restackWindows d $ decfor : [win]

    let hook :: SomeMessage -> X (Maybe (ModLay a))
        hook sm  | Just e <- fromMessage sm           = handle_event e >> return Nothing
                 | Just UnDoLayout == fromMessage sm  = io (destroyWindow d win) >> return (Just id)
                 | otherwise                          = return Nothing

        handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t})
            | t == buttonPress && thisw == win        = click
        handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t})
            | t == buttonPress && thisw == win        = click
        handle_event (AnyEvent {ev_window = thisw, ev_event_type = t})
            | thisw == win    && t == expose          = withGC win fn draw
            | thisw == decfor && t == propertyNotify  = withGC win fn draw
        handle_event _ = return ()

    return $ layoutModify idModDo hook l

-- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
                                       let fontname = if fn == "" 
                                                      then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
                                                      else fn
                                       font <- io $ loadQueryFont d fontname
                                       io $ setFont d gc (fontFromFontStruct font)
                                       f d w gc font
                                       io $ freeGC d gc
                                       io $ freeFont d font

{'fraction_non_alphanumeric': 0.14636719927645464, 'fraction_numerical': 0.0018088634308109737, 'mean_word_length': 1.3305233579206182, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 40, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3250578', 'n_tokens_mistral': 1763, 'n_tokens_neox': 1698, 'n_words': 571}