xmobar -> own Module
This commit is contained in:
@@ -12,11 +12,5 @@
|
|||||||
};
|
};
|
||||||
};
|
};
|
||||||
|
|
||||||
home.packages = with pkgs; [
|
home.packages = with pkgs; [ xmobar maim xdotool xorg.xmessage ghc ];
|
||||||
xmobar
|
|
||||||
maim
|
|
||||||
xdotool
|
|
||||||
xorg.xmessage
|
|
||||||
cabal-install
|
|
||||||
];
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,110 +0,0 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module: ColorCache
|
|
||||||
-- Copyright: (c) 2012 Jose Antonio Ortega Ruiz
|
|
||||||
-- License: BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer: jao@gnu.org
|
|
||||||
-- Stability: unstable
|
|
||||||
-- Portability: unportable
|
|
||||||
-- Created: Mon Sep 10, 2012 00:27
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- Caching X colors
|
|
||||||
--
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
#if defined XFT
|
|
||||||
|
|
||||||
module ColorCache(withColors, withDrawingColors) where
|
|
||||||
|
|
||||||
import MinXft
|
|
||||||
|
|
||||||
#else
|
|
||||||
module ColorCache(withColors) where
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import Data.IORef
|
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
|
||||||
import Control.Monad.Trans (MonadIO, liftIO)
|
|
||||||
import Control.Exception (SomeException, handle)
|
|
||||||
import Graphics.X11.Xlib
|
|
||||||
|
|
||||||
data DynPixel = DynPixel Bool Pixel
|
|
||||||
|
|
||||||
initColor :: Display -> String -> IO DynPixel
|
|
||||||
initColor dpy c = handle black $ (initColor' dpy c)
|
|
||||||
where
|
|
||||||
black :: SomeException -> IO DynPixel
|
|
||||||
black = (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))
|
|
||||||
|
|
||||||
type ColorCache = [(String, Color)]
|
|
||||||
{-# NOINLINE colorCache #-}
|
|
||||||
colorCache :: IORef ColorCache
|
|
||||||
colorCache = unsafePerformIO $ newIORef []
|
|
||||||
|
|
||||||
getCachedColor :: String -> IO (Maybe Color)
|
|
||||||
getCachedColor color_name = lookup color_name `fmap` readIORef colorCache
|
|
||||||
|
|
||||||
putCachedColor :: String -> Color -> IO ()
|
|
||||||
putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c
|
|
||||||
|
|
||||||
initColor' :: Display -> String -> IO DynPixel
|
|
||||||
initColor' dpy c = do
|
|
||||||
let colormap = defaultColormap dpy (defaultScreen dpy)
|
|
||||||
cached_color <- getCachedColor c
|
|
||||||
c' <- case cached_color of
|
|
||||||
Just col -> return col
|
|
||||||
_ -> do (c'', _) <- allocNamedColor dpy colormap c
|
|
||||||
putCachedColor c c''
|
|
||||||
return c''
|
|
||||||
return $ DynPixel True (color_pixel c')
|
|
||||||
|
|
||||||
withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a
|
|
||||||
withColors d cs f = do
|
|
||||||
ps <- mapM (liftIO . initColor d) cs
|
|
||||||
f $ map (\(DynPixel _ pixel) -> pixel) ps
|
|
||||||
|
|
||||||
#ifdef XFT
|
|
||||||
|
|
||||||
type AXftColorCache = [(String, AXftColor)]
|
|
||||||
{-# NOINLINE xftColorCache #-}
|
|
||||||
xftColorCache :: IORef AXftColorCache
|
|
||||||
xftColorCache = unsafePerformIO $ newIORef []
|
|
||||||
|
|
||||||
getXftCachedColor :: String -> IO (Maybe AXftColor)
|
|
||||||
getXftCachedColor name = lookup name `fmap` readIORef xftColorCache
|
|
||||||
|
|
||||||
putXftCachedColor :: String -> AXftColor -> IO ()
|
|
||||||
putXftCachedColor name cptr =
|
|
||||||
modifyIORef xftColorCache $ \c -> (name, cptr) : c
|
|
||||||
|
|
||||||
initAXftColor' :: Display -> Visual -> Colormap -> String -> IO AXftColor
|
|
||||||
initAXftColor' d v cm c = do
|
|
||||||
cc <- getXftCachedColor c
|
|
||||||
c' <- case cc of
|
|
||||||
Just col -> return col
|
|
||||||
_ -> do c'' <- mallocAXftColor d v cm c
|
|
||||||
putXftCachedColor c c''
|
|
||||||
return c''
|
|
||||||
return c'
|
|
||||||
|
|
||||||
initAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor
|
|
||||||
initAXftColor d v cm c = handle black $ (initAXftColor' d v cm c)
|
|
||||||
where
|
|
||||||
black :: SomeException -> IO AXftColor
|
|
||||||
black = (const $ initAXftColor' d v cm "black")
|
|
||||||
|
|
||||||
withDrawingColors :: -- MonadIO m =>
|
|
||||||
Display -> Drawable -> String -> String
|
|
||||||
-> (AXftDraw -> AXftColor -> AXftColor -> IO ()) -> IO ()
|
|
||||||
withDrawingColors dpy drw fc bc f = do
|
|
||||||
let screen = defaultScreenOfDisplay dpy
|
|
||||||
colormap = defaultColormapOfScreen screen
|
|
||||||
visual = defaultVisualOfScreen screen
|
|
||||||
fc' <- initAXftColor dpy visual colormap fc
|
|
||||||
bc' <- initAXftColor dpy visual colormap bc
|
|
||||||
withAXftDraw dpy drw visual colormap $ \draw -> f draw fc' bc'
|
|
||||||
#endif
|
|
||||||
@@ -1,85 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : Xmobar.Commands
|
|
||||||
-- Copyright : (c) Andrea Rossato
|
|
||||||
-- License : BSD-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- The 'Exec' class and the 'Command' data type.
|
|
||||||
--
|
|
||||||
-- The 'Exec' class rappresents the executable types, whose constructors may
|
|
||||||
-- appear in the 'Config.commands' field of the 'Config.Config' data type.
|
|
||||||
--
|
|
||||||
-- The 'Command' data type is for OS commands to be run by xmobar
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module Commands
|
|
||||||
( Command (..)
|
|
||||||
, Exec (..)
|
|
||||||
, tenthSeconds
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Prelude
|
|
||||||
import Control.Concurrent
|
|
||||||
import Control.Exception (handle, SomeException(..))
|
|
||||||
import Data.Char
|
|
||||||
import System.Process
|
|
||||||
import System.Exit
|
|
||||||
import System.IO (hClose)
|
|
||||||
|
|
||||||
import Signal
|
|
||||||
import XUtil
|
|
||||||
|
|
||||||
class Show e => Exec e where
|
|
||||||
alias :: e -> String
|
|
||||||
alias e = takeWhile (not . isSpace) $ show e
|
|
||||||
rate :: e -> Int
|
|
||||||
rate _ = 10
|
|
||||||
run :: e -> IO String
|
|
||||||
run _ = return ""
|
|
||||||
start :: e -> (String -> IO ()) -> IO ()
|
|
||||||
start e cb = go
|
|
||||||
where go = run e >>= cb >> tenthSeconds (rate e) >> go
|
|
||||||
trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()
|
|
||||||
trigger _ sh = sh Nothing
|
|
||||||
|
|
||||||
data Command = Com Program Args Alias Rate
|
|
||||||
deriving (Show,Read,Eq)
|
|
||||||
|
|
||||||
type Args = [String]
|
|
||||||
type Program = String
|
|
||||||
type Alias = String
|
|
||||||
type Rate = Int
|
|
||||||
|
|
||||||
instance Exec Command where
|
|
||||||
alias (Com p _ a _)
|
|
||||||
| p /= "" = if a == "" then p else a
|
|
||||||
| otherwise = ""
|
|
||||||
start (Com prog args _ r) cb = if r > 0 then go else exec
|
|
||||||
where go = exec >> tenthSeconds r >> go
|
|
||||||
exec = do
|
|
||||||
(i,o,e,p) <- runInteractiveCommand (unwords (prog:args))
|
|
||||||
exit <- waitForProcess p
|
|
||||||
let closeHandles = hClose o >> hClose i >> hClose e
|
|
||||||
getL = handle (\(SomeException _) -> return "")
|
|
||||||
(hGetLineSafe o)
|
|
||||||
case exit of
|
|
||||||
ExitSuccess -> do str <- getL
|
|
||||||
closeHandles
|
|
||||||
cb str
|
|
||||||
_ -> do closeHandles
|
|
||||||
cb $ "Could not execute command " ++ prog
|
|
||||||
|
|
||||||
|
|
||||||
-- | Work around to the Int max bound: since threadDelay takes an Int, it
|
|
||||||
-- is not possible to set a thread delay grater than about 45 minutes.
|
|
||||||
-- With a little recursion we solve the problem.
|
|
||||||
tenthSeconds :: Int -> IO ()
|
|
||||||
tenthSeconds s | s >= x = do threadDelay (x * 100000)
|
|
||||||
tenthSeconds (s - x)
|
|
||||||
| otherwise = threadDelay (s * 100000)
|
|
||||||
where x = (maxBound :: Int) `div` 100000
|
|
||||||
@@ -1,25 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : Xmobar.Plugins
|
|
||||||
-- Copyright : (c) Andrea Rossato
|
|
||||||
-- License : BSD-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- This module exports the API for plugins.
|
|
||||||
--
|
|
||||||
-- Have a look at Plugins\/HelloWorld.hs
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module Plugins
|
|
||||||
( Exec (..)
|
|
||||||
, tenthSeconds
|
|
||||||
, readFileSafe
|
|
||||||
, hGetLineSafe
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Commands
|
|
||||||
import XUtil
|
|
||||||
@@ -1,56 +1,14 @@
|
|||||||
-- -----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : Plugins.Audio
|
|
||||||
-- Copyright : (c) Elias Schröter
|
|
||||||
-- License : ???
|
|
||||||
--
|
|
||||||
-- Maintainer : Elias Schröter <elias.schroeter@e.email>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : untested
|
|
||||||
--
|
|
||||||
-- A simple plugin to display the Audio status.
|
|
||||||
--
|
|
||||||
-- This plugin needs 7 parameters : The MuteColor UnMuteColor SpeakerMuteIcon SpeakerIcon MicrophoneMuteIcon MicrophoneIcon and the update rate of the plugin
|
|
||||||
-- in tenth of seconds.
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module Plugins.Audio where
|
module Plugins.Audio where
|
||||||
|
|
||||||
import Plugins
|
import Xmobar
|
||||||
import System.Process
|
|
||||||
import GHC.Show (Show(show))
|
|
||||||
|
|
||||||
-- | Color for Muted
|
data Audio = Audio String Int deriving (Read, Show)
|
||||||
type MuteColor = String
|
|
||||||
-- | Color for Unmuted
|
|
||||||
type UnMuteColor = String
|
|
||||||
-- | The Icon of the muted Speaker
|
|
||||||
type SpeakerMuteIcon = String
|
|
||||||
-- | The Icon of half volume Speaker
|
|
||||||
type SpeakerHalfIcon = String
|
|
||||||
-- | The Icon of the unmuted Speaker
|
|
||||||
type SpeakerIcon = String
|
|
||||||
-- | The Icon of the muted Microphone
|
|
||||||
type MicrophoneMuteIcon = String
|
|
||||||
-- | The Icon of the unmuted Microphone
|
|
||||||
type MicrophoneIcon = String
|
|
||||||
|
|
||||||
data Audio = Audio MuteColor UnMuteColor SpeakerMuteIcon SpeakerHalfIcon SpeakerIcon MicrophoneMuteIcon MicrophoneIcon Int deriving (Read, Show)
|
|
||||||
|
|
||||||
-- | Counts the days to a specific date from today. This function returns the number
|
|
||||||
-- of days followed by a String
|
|
||||||
cdw :: Cyear -> Cmonth -> Cday -> String -> IO String
|
|
||||||
cdw y m d s = do currentTime <- getCurrentTime
|
|
||||||
let currentDay = utctDay currentTime
|
|
||||||
let countdownDay = fromGregorian y m d
|
|
||||||
return $ show (diffDays countdownDay currentDay) ++ s
|
|
||||||
|
|
||||||
getAudio :: MuteColor -> UnMuteColor -> SpeakerMuteIcon -> SpeakerIcon -> MicrophoneMuteIcon -> MicrophoneIcon -> IO String
|
|
||||||
getAudio mC umC smI sI mmI mI = do
|
|
||||||
let status = words readProcess "pulseaudio-ctl full-status"
|
|
||||||
return $ show status
|
|
||||||
|
|
||||||
instance Exec Audio where
|
instance Exec Audio where
|
||||||
alias ( Audio {}) = "audio"
|
alias (Audio _ _) = "audio"
|
||||||
run ( Audio mC umC smI shI sI mmI mI _ ) = getAudio
|
run (Audio f _) = audio f
|
||||||
rate ( Audio _ _ _ _ _ _ _ r ) = r
|
rate (Audio _ r) = r
|
||||||
|
|
||||||
|
audio :: String -> IO String
|
||||||
|
audio format = do
|
||||||
|
return $ show (format)
|
||||||
|
|||||||
@@ -1,43 +0,0 @@
|
|||||||
------------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module: Plugins.Utils
|
|
||||||
-- Copyright: (c) 2010 Jose Antonio Ortega Ruiz
|
|
||||||
-- License: BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer: Jose A Ortega Ruiz <jao@gnu.org>
|
|
||||||
-- Stability: unstable
|
|
||||||
-- Portability: unportable
|
|
||||||
-- Created: Sat Dec 11, 2010 20:55
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- Miscellaneous utility functions
|
|
||||||
--
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
|
|
||||||
module Plugins.Utils (expandHome, changeLoop, safeHead) where
|
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Concurrent.STM
|
|
||||||
|
|
||||||
import System.Environment
|
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
|
|
||||||
expandHome :: FilePath -> IO FilePath
|
|
||||||
expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME")
|
|
||||||
expandHome p = return p
|
|
||||||
|
|
||||||
changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()
|
|
||||||
changeLoop s f = atomically s >>= go
|
|
||||||
where
|
|
||||||
go old = do
|
|
||||||
f old
|
|
||||||
go =<< atomically (do
|
|
||||||
new <- s
|
|
||||||
guard (new /= old)
|
|
||||||
return new)
|
|
||||||
|
|
||||||
safeHead :: [a] -> Maybe a
|
|
||||||
safeHead [] = Nothing
|
|
||||||
safeHead (x:_) = Just x
|
|
||||||
@@ -1,72 +0,0 @@
|
|||||||
{-# LANGUAGE DeriveDataTypeable, CPP #-}
|
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : Signal
|
|
||||||
-- Copyright : (c) Andrea Rosatto
|
|
||||||
-- : (c) Jose A. Ortega Ruiz
|
|
||||||
-- : (c) Jochen Keil
|
|
||||||
-- License : BSD-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Signal handling, including DBUS when available
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module Signal where
|
|
||||||
|
|
||||||
import Data.Typeable (Typeable)
|
|
||||||
import Control.Concurrent.STM
|
|
||||||
import Control.Exception hiding (handle)
|
|
||||||
import System.Posix.Signals
|
|
||||||
import Graphics.X11.Xlib.Types (Position)
|
|
||||||
|
|
||||||
#ifdef DBUS
|
|
||||||
import DBus (IsVariant(..))
|
|
||||||
import Control.Monad ((>=>))
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import Plugins.Utils (safeHead)
|
|
||||||
|
|
||||||
data WakeUp = WakeUp deriving (Show,Typeable)
|
|
||||||
instance Exception WakeUp
|
|
||||||
|
|
||||||
data SignalType = Wakeup
|
|
||||||
| Reposition
|
|
||||||
| ChangeScreen
|
|
||||||
| Hide Int
|
|
||||||
| Reveal Int
|
|
||||||
| Toggle Int
|
|
||||||
| TogglePersistent
|
|
||||||
| Action Position
|
|
||||||
deriving (Read, Show)
|
|
||||||
|
|
||||||
#ifdef DBUS
|
|
||||||
instance IsVariant SignalType where
|
|
||||||
toVariant = toVariant . show
|
|
||||||
fromVariant = fromVariant >=> parseSignalType
|
|
||||||
#endif
|
|
||||||
|
|
||||||
parseSignalType :: String -> Maybe SignalType
|
|
||||||
parseSignalType = fmap fst . safeHead . reads
|
|
||||||
|
|
||||||
-- | Signal handling
|
|
||||||
setupSignalHandler :: IO (TMVar SignalType)
|
|
||||||
setupSignalHandler = do
|
|
||||||
tid <- newEmptyTMVarIO
|
|
||||||
installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
|
|
||||||
installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
|
|
||||||
return tid
|
|
||||||
|
|
||||||
updatePosHandler :: TMVar SignalType -> IO ()
|
|
||||||
updatePosHandler sig = do
|
|
||||||
atomically $ putTMVar sig Reposition
|
|
||||||
return ()
|
|
||||||
|
|
||||||
changeScreenHandler :: TMVar SignalType -> IO ()
|
|
||||||
changeScreenHandler sig = do
|
|
||||||
atomically $ putTMVar sig ChangeScreen
|
|
||||||
return ()
|
|
||||||
@@ -1,222 +0,0 @@
|
|||||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XUtil
|
|
||||||
-- Copyright : (C) 2011, 2012, 2013 Jose Antonio Ortega Ruiz
|
|
||||||
-- (C) 2007 Andrea Rossato
|
|
||||||
-- License : BSD3
|
|
||||||
--
|
|
||||||
-- Maintainer : jao@gnu.org
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XUtil
|
|
||||||
( XFont
|
|
||||||
, initFont
|
|
||||||
, initCoreFont
|
|
||||||
, initUtf8Font
|
|
||||||
, textExtents
|
|
||||||
, textWidth
|
|
||||||
, printString
|
|
||||||
, newWindow
|
|
||||||
, nextEvent'
|
|
||||||
, readFileSafe
|
|
||||||
, hGetLineSafe
|
|
||||||
, io
|
|
||||||
, fi
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Concurrent
|
|
||||||
import Control.Monad.Trans
|
|
||||||
import Control.Exception (SomeException, handle)
|
|
||||||
import Foreign
|
|
||||||
import Graphics.X11.Xlib hiding (textExtents, textWidth)
|
|
||||||
import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)
|
|
||||||
import Graphics.X11.Xlib.Extras
|
|
||||||
import System.Mem.Weak ( addFinalizer )
|
|
||||||
import System.Posix.Types (Fd(..))
|
|
||||||
import System.IO
|
|
||||||
|
|
||||||
#if defined XFT || defined UTF8
|
|
||||||
# if __GLASGOW_HASKELL__ < 612
|
|
||||||
import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)
|
|
||||||
# else
|
|
||||||
import qualified System.IO as UTF8 (readFile,hGetLine)
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
#if defined XFT
|
|
||||||
import Data.List
|
|
||||||
import MinXft
|
|
||||||
import Graphics.X11.Xrender
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import ColorCache
|
|
||||||
|
|
||||||
readFileSafe :: FilePath -> IO String
|
|
||||||
#if defined XFT || defined UTF8
|
|
||||||
readFileSafe = UTF8.readFile
|
|
||||||
#else
|
|
||||||
readFileSafe = readFile
|
|
||||||
#endif
|
|
||||||
|
|
||||||
hGetLineSafe :: Handle -> IO String
|
|
||||||
#if defined XFT || defined UTF8
|
|
||||||
hGetLineSafe = UTF8.hGetLine
|
|
||||||
#else
|
|
||||||
hGetLineSafe = hGetLine
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- Hide the Core Font/Xft switching here
|
|
||||||
data XFont = Core FontStruct
|
|
||||||
| Utf8 FontSet
|
|
||||||
#ifdef XFT
|
|
||||||
| Xft AXftFont
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | When initFont gets a font name that starts with 'xft:' it switches
|
|
||||||
-- to the Xft backend Example: 'xft:Sans-10'
|
|
||||||
initFont :: Display ->String -> IO XFont
|
|
||||||
initFont d s =
|
|
||||||
#ifdef XFT
|
|
||||||
let xftPrefix = "xft:" in
|
|
||||||
if xftPrefix `isPrefixOf` s then
|
|
||||||
fmap Xft $ initXftFont d s
|
|
||||||
else
|
|
||||||
#endif
|
|
||||||
#if defined UTF8 || __GLASGOW_HASKELL__ >= 612
|
|
||||||
fmap Utf8 $ initUtf8Font d s
|
|
||||||
#else
|
|
||||||
fmap Core $ initCoreFont d s
|
|
||||||
#endif
|
|
||||||
|
|
||||||
miscFixedFont :: String
|
|
||||||
miscFixedFont = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
|
|
||||||
|
|
||||||
-- | Given a fontname returns the font structure. If the font name is
|
|
||||||
-- not valid the default font will be loaded and returned.
|
|
||||||
initCoreFont :: Display -> String -> IO FontStruct
|
|
||||||
initCoreFont d s = do
|
|
||||||
f <- handle fallBack getIt
|
|
||||||
addFinalizer f (freeFont d f)
|
|
||||||
return f
|
|
||||||
where getIt = loadQueryFont d s
|
|
||||||
fallBack :: SomeException -> IO FontStruct
|
|
||||||
fallBack = const $ loadQueryFont d miscFixedFont
|
|
||||||
|
|
||||||
-- | Given a fontname returns the font structure. If the font name is
|
|
||||||
-- not valid the default font will be loaded and returned.
|
|
||||||
initUtf8Font :: Display -> String -> IO FontSet
|
|
||||||
initUtf8Font d s = do
|
|
||||||
setupLocale
|
|
||||||
(_,_,f) <- handle fallBack getIt
|
|
||||||
addFinalizer f (freeFontSet d f)
|
|
||||||
return f
|
|
||||||
where getIt = createFontSet d s
|
|
||||||
fallBack :: SomeException -> IO ([String], String, FontSet)
|
|
||||||
fallBack = const $ createFontSet d miscFixedFont
|
|
||||||
|
|
||||||
#ifdef XFT
|
|
||||||
initXftFont :: Display -> String -> IO AXftFont
|
|
||||||
initXftFont d s = do
|
|
||||||
setupLocale
|
|
||||||
f <- openAXftFont d (defaultScreenOfDisplay d) (drop 4 s)
|
|
||||||
addFinalizer f (closeAXftFont d f)
|
|
||||||
return f
|
|
||||||
#endif
|
|
||||||
|
|
||||||
textWidth :: Display -> XFont -> String -> IO Int
|
|
||||||
textWidth _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s
|
|
||||||
textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s
|
|
||||||
#ifdef XFT
|
|
||||||
textWidth dpy (Xft xftdraw) s = do
|
|
||||||
gi <- xftTxtExtents dpy xftdraw s
|
|
||||||
return $ xglyphinfo_xOff gi
|
|
||||||
#endif
|
|
||||||
|
|
||||||
textExtents :: XFont -> String -> IO (Int32,Int32)
|
|
||||||
textExtents (Core fs) s = do
|
|
||||||
let (_,a,d,_) = Xlib.textExtents fs s
|
|
||||||
return (a,d)
|
|
||||||
textExtents (Utf8 fs) s = do
|
|
||||||
let (_,rl) = wcTextExtents fs s
|
|
||||||
ascent = fi $ - (rect_y rl)
|
|
||||||
descent = fi $ rect_height rl + (fi $ rect_y rl)
|
|
||||||
return (ascent, descent)
|
|
||||||
#ifdef XFT
|
|
||||||
textExtents (Xft xftfont) _ = do
|
|
||||||
ascent <- fi `fmap` xft_ascent xftfont
|
|
||||||
descent <- fi `fmap` xft_descent xftfont
|
|
||||||
return (ascent, descent)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
printString :: Display -> Drawable -> XFont -> GC -> String -> String
|
|
||||||
-> Position -> Position -> String -> IO ()
|
|
||||||
printString d p (Core fs) gc fc bc x y s = do
|
|
||||||
setFont d gc $ fontFromFontStruct fs
|
|
||||||
withColors d [fc, bc] $ \[fc', bc'] -> do
|
|
||||||
setForeground d gc fc'
|
|
||||||
setBackground d gc bc'
|
|
||||||
drawImageString d p gc x y s
|
|
||||||
|
|
||||||
printString d p (Utf8 fs) gc fc bc x y s =
|
|
||||||
withColors d [fc, bc] $ \[fc', bc'] -> do
|
|
||||||
setForeground d gc fc'
|
|
||||||
setBackground d gc bc'
|
|
||||||
io $ wcDrawImageString d p fs gc x y s
|
|
||||||
|
|
||||||
#ifdef XFT
|
|
||||||
printString dpy drw fs@(Xft font) _ fc bc x y s = do
|
|
||||||
(a,d) <- textExtents fs s
|
|
||||||
gi <- xftTxtExtents dpy font s
|
|
||||||
withDrawingColors dpy drw fc bc $ \draw -> \fc' -> \bc' ->
|
|
||||||
(drawXftRect draw bc' (x + 1 - fi (xglyphinfo_x gi))
|
|
||||||
(y - (a + d) + 1)
|
|
||||||
(xglyphinfo_xOff gi)
|
|
||||||
(a + d)) >>
|
|
||||||
(drawXftString draw fc' font x (y - 2) s)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
|
|
||||||
-- | Creates a window with the attribute override_redirect set to True.
|
|
||||||
-- Windows Managers should not touch this kind of windows.
|
|
||||||
newWindow :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window
|
|
||||||
newWindow dpy scr rw (Rectangle x y w h) o = do
|
|
||||||
let visual = defaultVisualOfScreen scr
|
|
||||||
attrmask = if o then cWOverrideRedirect else 0
|
|
||||||
allocaSetWindowAttributes $
|
|
||||||
\attributes -> do
|
|
||||||
set_override_redirect attributes o
|
|
||||||
createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
|
|
||||||
inputOutput visual attrmask attributes
|
|
||||||
-- | A version of nextEvent that does not block in foreign calls.
|
|
||||||
nextEvent' :: Display -> XEventPtr -> IO ()
|
|
||||||
nextEvent' d p = do
|
|
||||||
pend <- pending d
|
|
||||||
if pend /= 0
|
|
||||||
then nextEvent d p
|
|
||||||
else do
|
|
||||||
threadWaitRead (Fd fd)
|
|
||||||
nextEvent' d p
|
|
||||||
where
|
|
||||||
fd = connectionNumber d
|
|
||||||
|
|
||||||
io :: MonadIO m => IO a -> m a
|
|
||||||
io = liftIO
|
|
||||||
|
|
||||||
-- | Short-hand for 'fromIntegral'
|
|
||||||
fi :: (Integral a, Num b) => a -> b
|
|
||||||
fi = fromIntegral
|
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 612 && (defined XFT || defined UTF8)
|
|
||||||
#include <locale.h>
|
|
||||||
foreign import ccall unsafe "locale.h setlocale"
|
|
||||||
setlocale :: CInt -> CString -> IO CString
|
|
||||||
|
|
||||||
setupLocale :: IO ()
|
|
||||||
setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()
|
|
||||||
# else
|
|
||||||
setupLocale :: IO ()
|
|
||||||
setupLocale = return ()
|
|
||||||
#endif
|
|
||||||
@@ -23,10 +23,10 @@ name: xmobar-custom
|
|||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
|
||||||
-- The package author(s).
|
-- The package author(s).
|
||||||
author: einfischy
|
author: 4Lost
|
||||||
|
|
||||||
-- An email address to which users can send suggestions, bug reports, and patches.
|
-- An email address to which users can send suggestions, bug reports, and patches.
|
||||||
maintainer: accounts.codeberg@kstn.in
|
maintainer: elias.schroeter@e.email
|
||||||
|
|
||||||
-- A copyright notice.
|
-- A copyright notice.
|
||||||
-- copyright:
|
-- copyright:
|
||||||
@@ -42,11 +42,8 @@ executable xmobar
|
|||||||
-- .hs or .lhs file containing the Main module.
|
-- .hs or .lhs file containing the Main module.
|
||||||
main-is: xmobar.hs
|
main-is: xmobar.hs
|
||||||
|
|
||||||
other-modules: XUtil, Plugins.Utils
|
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base ^>=4.17.2.1,
|
build-depends: base ^>=4.17.2.1,
|
||||||
X11 >= 1.6.1,
|
|
||||||
xmobar ^>=0.47.1
|
xmobar ^>=0.47.1
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
|
|||||||
@@ -17,6 +17,7 @@ config =
|
|||||||
, fgColor = "#f5e0dc"
|
, fgColor = "#f5e0dc"
|
||||||
, commands =
|
, commands =
|
||||||
[
|
[
|
||||||
|
Run $ Audio "abc" 200
|
||||||
--Run $ Com "/bin/sh" ["-c", "Status=$(pulseaudio-ctl full-status); Volume=$(cut -d ' ' -f 1 <<<$Status); Mute=$(cut -d ' ' -f 2 <<<$Status); Microphone=$(cut -d ' ' -f 3 <<<$Status); SpeakerColor=\"#a6e3a1\"; MicColor=\"#a6e3a1\"; if [[ $Mute == \"yes\" ]]; then Symbol=\"\xf466\"; SpeakerColor=\"#f38ba8\"; elif [[ $Volume -le 50 ]]; then Symbol=\"\xf027\"; elseSymbol=\"\xf028\"; fi; if [[ $Microphone == \"yes\" ]]; then MicOut=\"\xf036d\"; MicColor=\"#f38ba8\"; else MicOut=\"\xf036c\"; fi; echo \"<fc=$SpeakerColor><fn=1>$Symbol</fn></fc> $Volume% <fc=$MicColor><fn=1>$MicOut</fn></fc>\""] "audio" 10
|
--Run $ Com "/bin/sh" ["-c", "Status=$(pulseaudio-ctl full-status); Volume=$(cut -d ' ' -f 1 <<<$Status); Mute=$(cut -d ' ' -f 2 <<<$Status); Microphone=$(cut -d ' ' -f 3 <<<$Status); SpeakerColor=\"#a6e3a1\"; MicColor=\"#a6e3a1\"; if [[ $Mute == \"yes\" ]]; then Symbol=\"\xf466\"; SpeakerColor=\"#f38ba8\"; elif [[ $Volume -le 50 ]]; then Symbol=\"\xf027\"; elseSymbol=\"\xf028\"; fi; if [[ $Microphone == \"yes\" ]]; then MicOut=\"\xf036d\"; MicColor=\"#f38ba8\"; else MicOut=\"\xf036c\"; fi; echo \"<fc=$SpeakerColor><fn=1>$Symbol</fn></fc> $Volume% <fc=$MicColor><fn=1>$MicOut</fn></fc>\""] "audio" 10
|
||||||
--Run $ Com "/bin/sh" ["-c", "Status=$(pulseaudio-ctl full-status);
|
--Run $ Com "/bin/sh" ["-c", "Status=$(pulseaudio-ctl full-status);
|
||||||
-- Volume=$(cut -d ' ' -f 1 <<<$Status);
|
-- Volume=$(cut -d ' ' -f 1 <<<$Status);
|
||||||
@@ -47,7 +48,8 @@ config =
|
|||||||
-- "--template", "<fc=<speakerColor>><fn=1><speakerIcon></fn></fc> <Volume>% <fc=<micColor>><fn=1><micIcon></fn></fc>"
|
-- "--template", "<fc=<speakerColor>><fn=1><speakerIcon></fn></fc> <Volume>% <fc=<micColor>><fn=1><micIcon></fn></fc>"
|
||||||
-- , "" ""
|
-- , "" ""
|
||||||
--] 10
|
--] 10
|
||||||
Run $ Audio "#f38ba8" "#a6e3a1" "\xf466" "\xf027" "\xf027" "\xf036d" "\xf036c" 10
|
-- Run $ Audio "#f38ba8" "#a6e3a1" "\xf466" "\xf027" "\xf027" "\xf036d" "\xf036c" 10
|
||||||
|
--Run $ Audio "<fc=#fab387><fn=1>\xf017</fn></fc> %a %d.%m.%y %H:%M" "date" 300
|
||||||
, Run $ Com "/bin/sh" ["-c", "echo \"<fc=#f9e2af><fn=1>\xf00e0</fn></fc> $(xbacklight -get)%\""] "backlight" 10
|
, Run $ Com "/bin/sh" ["-c", "echo \"<fc=#f9e2af><fn=1>\xf00e0</fn></fc> $(xbacklight -get)%\""] "backlight" 10
|
||||||
, Run $ Cpu
|
, Run $ Cpu
|
||||||
[
|
[
|
||||||
|
|||||||
Reference in New Issue
Block a user