mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
a5fb7e021a
* First version of DecorationEx. * Fixed most warnings. * Fix build error with ghc-9.8.1. * Fix title shrinking with text decoration. * Add convinience re-exports. * Get rid of orphan instances. * Fix a couple of warnings. * Rename X.L.DecorationEx.Types -> X.L.DecorationEx.Common * Add instance Default StandardCommand. * Fix some typos and formatting thanks to @geekosaur Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> * Fix reference to xmonad.hs See also #859 Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> * Fix reference to xmonad.hs Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> * Fix formatting Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> * Fix some typos and formatting thanks to @geekosaur Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> * Remove commented code. * Update CHANGES.md. * calcWidgetPlace is now allowed to return rectangle with any X, but that will be ignored. * More generic instance for DecorationWidget GenericWidget. * Replace explicit definition of `fi` with import from X.Prelude. thanks to @slotThe. * Move fetch-all pattern to the end of definition. thanks to @slotThe. * X.L.DecorationEx: Add screenshot --------- Co-authored-by: brandon s allbery kf8nh <allbery.b@gmail.com> Co-authored-by: Tony Zorman <soliditsallgood@mailbox.org>
117 lines
4.6 KiB
Haskell
117 lines
4.6 KiB
Haskell
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.DecorationEx.TextEngine
|
|
-- Description : Text-based window decoration engine
|
|
-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov
|
|
-- License : BSD-style (see xmonad/LICENSE)
|
|
--
|
|
-- Maintainer : portnov84@rambler.ru
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- Window decoration engine, that uses text fragments (like @"[X]"@) to indicate
|
|
-- widgets (window buttons).
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.DecorationEx.TextEngine (
|
|
textDecoration,
|
|
TextDecoration (..)
|
|
) where
|
|
|
|
import XMonad
|
|
import XMonad.Prelude
|
|
import XMonad.Layout.LayoutModifier
|
|
import XMonad.Util.Font
|
|
|
|
import XMonad.Layout.DecorationEx.LayoutModifier
|
|
import XMonad.Layout.DecorationEx.Common
|
|
import XMonad.Layout.DecorationEx.Engine
|
|
import XMonad.Layout.DecorationEx.Geometry
|
|
import XMonad.Layout.DecorationEx.Widgets
|
|
|
|
-- | Decoration engine data type
|
|
data TextDecoration widget a = TextDecoration
|
|
deriving (Show, Read)
|
|
|
|
instance (TextWidget widget, ClickHandler (GenericTheme SimpleStyle) widget)
|
|
=> DecorationEngine TextDecoration widget Window where
|
|
type Theme TextDecoration = GenericTheme SimpleStyle
|
|
type DecorationPaintingContext TextDecoration = XPaintingContext
|
|
type DecorationEngineState TextDecoration = XMonadFont
|
|
|
|
describeEngine _ = "TextDecoration"
|
|
|
|
calcWidgetPlace = calcTextWidgetPlace
|
|
|
|
paintWidget = paintTextWidget
|
|
|
|
paintDecoration = paintDecorationSimple
|
|
|
|
initializeState _ _ theme = initXMF (themeFontName theme)
|
|
releaseStateResources _ = releaseXMF
|
|
|
|
-- | Implementation of @paintWidget@ for decoration engines based on @TextDecoration@.
|
|
paintTextWidget :: (TextWidget widget,
|
|
Style (Theme engine widget) ~ SimpleStyle,
|
|
DecorationPaintingContext engine ~ XPaintingContext,
|
|
DecorationEngineState engine ~ XMonadFont,
|
|
Shrinker shrinker,
|
|
DecorationEngine engine widget Window)
|
|
=> engine widget Window
|
|
-> DecorationPaintingContext engine
|
|
-> WidgetPlace
|
|
-> shrinker
|
|
-> DrawData engine widget
|
|
-> widget
|
|
-> Bool
|
|
-> X ()
|
|
paintTextWidget engine (dpy, pixmap, gc) place shrinker dd widget _ = do
|
|
let style = ddStyle dd
|
|
rect = wpRectangle place
|
|
x = rect_x rect
|
|
y = wpTextYPosition place
|
|
str <- widgetString dd widget
|
|
str' <- if isShrinkable widget
|
|
then getShrinkedWindowName engine shrinker (ddEngineState dd) str (rect_width rect) (rect_height rect)
|
|
else return str
|
|
printStringXMF dpy pixmap (ddEngineState dd) gc (sTextColor style) (sTextBgColor style) x y str'
|
|
|
|
-- | Implementation of @calcWidgetPlace@ for decoration engines based on @TextDecoration@.
|
|
calcTextWidgetPlace :: (TextWidget widget,
|
|
DecorationEngineState engine ~ XMonadFont,
|
|
DecorationEngine engine widget Window)
|
|
=> engine widget Window
|
|
-> DrawData engine widget
|
|
-> widget
|
|
-> X WidgetPlace
|
|
calcTextWidgetPlace _ dd widget = do
|
|
str <- widgetString dd widget
|
|
let h = rect_height (ddDecoRect dd)
|
|
font = ddEngineState dd
|
|
withDisplay $ \dpy -> do
|
|
width <- fi <$> textWidthXMF dpy (ddEngineState dd) str
|
|
(a, d) <- textExtentsXMF font str
|
|
let height = a + d
|
|
y = fi $ (h - fi height) `div` 2
|
|
y0 = y + fi a
|
|
rect = Rectangle 0 y width (fi height)
|
|
return $ WidgetPlace y0 rect
|
|
|
|
-- | Add decoration to existing layout. Widgets are indicated by text fragments, like @"[+]"@.
|
|
-- Geometry is simple: a horizontal panel at the top of each window, going for the full width
|
|
-- of the window.
|
|
textDecoration :: (Shrinker shrinker)
|
|
=> shrinker -- ^ String shrinker, for example @shrinkText@
|
|
-> Theme TextDecoration StandardWidget -- ^ Decoration theme (font, colors, widgets, etc)
|
|
-> l Window -- ^ Layout to be decorated
|
|
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window
|
|
textDecoration shrinker theme = decorationEx shrinker theme TextDecoration def
|
|
|