4Lost/nixos-config
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xmobar -> own Module

Browse Source
This commit is contained in:
4Lost
2024-03-17 22:04:06 +01:00
parent 6c7e65cb1e
commit 412a3a6526
10 changed files with 15 additions and 621 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
home/programs/xmonad/default.nix
View File

@@ -12,11 +12,5 @@
};
};
home.packages = with pkgs; [
xmobar
maim
xdotool
xorg.xmessage
cabal-install
];
home.packages = with pkgs; [ xmobar maim xdotool xorg.xmessage ghc ];
}

110
home/programs/xmonad/src/xmobar/ColorCache.hs
View File

@@ -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

85
home/programs/xmonad/src/xmobar/Commands.hs
View File

@@ -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

25
home/programs/xmonad/src/xmobar/Plugins.hs
View File

@@ -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

60
home/programs/xmonad/src/xmobar/Plugins/Audio.hs
View File

@@ -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
import Plugins
import System.Process
import GHC.Show (Show(show))
import Xmobar
-- | Color for Muted
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
data Audio = Audio String Int deriving (Read, Show)
instance Exec Audio where
alias ( Audio {}) = "audio"
run ( Audio mC umC smI shI sI mmI mI _ ) = getAudio
rate ( Audio _ _ _ _ _ _ _ r ) = r
alias (Audio _ _) = "audio"
run (Audio f _) = audio f
rate (Audio _ r) = r
audio :: String -> IO String
audio format = do
return $ show (format)

43
home/programs/xmonad/src/xmobar/Plugins/Utils.hs
View File

@@ -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

72
home/programs/xmonad/src/xmobar/Signal.hs
View File

@@ -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 ()

222
home/programs/xmonad/src/xmobar/XUtil.hsc
View File

@@ -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

7
home/programs/xmonad/src/xmobar/xmobar-custom.cabal
View File

@@ -23,10 +23,10 @@ name: xmobar-custom
version: 0.1.0.0
-- The package author(s).
author: einfischy
author: 4Lost
-- 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.
-- copyright:
@@ -42,11 +42,8 @@ executable xmobar
-- .hs or .lhs file containing the Main module.
main-is: xmobar.hs
other-modules: XUtil, Plugins.Utils
-- Other library packages from which modules are imported.
build-depends: base ^>=4.17.2.1,
X11 >= 1.6.1,
xmobar ^>=0.47.1
-- Directories containing source files.

4
home/programs/xmonad/src/xmobar/xmobar.hs
View File

@@ -17,6 +17,7 @@ config =
, fgColor = "#f5e0dc"
, 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);
@@ -47,7 +48,8 @@ config =
-- "--template", "<fc=<speakerColor>><fn=1><speakerIcon></fn></fc> <Volume>% <fc=<micColor>><fn=1><micIcon></fn></fc>"
-- , "" ""
--] 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 $ Cpu
[