summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Main.hs27
-rw-r--r--Xmobar.hs45
2 files changed, 39 insertions, 33 deletions
diff --git a/Main.hs b/Main.hs
index b661436..34440cd 100644
--- a/Main.hs
+++ b/Main.hs
@@ -3,12 +3,12 @@
-- Module : Xmobar.Main
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
---
+--
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
--
--- The main module of Xmobar, a text based status bar
+-- The main module of Xmobar, a text based status bar
--
-----------------------------------------------------------------------------
@@ -22,20 +22,25 @@ module Main ( -- * Main Stuff
import Xmobar
import Parsers
import Config
+import HsLocale
+import Prelude hiding (readFile)
import Data.IORef
import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
import System.Console.GetOpt
import System.Exit
import System.Environment
+import System.IO.UTF8 (readFile)
import System.Posix.Files
-- $main
-
+
-- | The main entry point
main :: IO ()
main = do
d <- openDisplay ""
+ setupLocale
args <- getArgs
(o,file) <- getOpts args
c <- case file of
@@ -49,13 +54,13 @@ main = do
civ <- newIORef c
doOpts civ o
conf <- readIORef civ
- let loadFont = loadQueryFont d . font
- fs <- catch (loadFont conf) (const $ loadFont defaultConfig)
+ let loadFont = createFontSet d . font
+ (_,_,fs) <- catch (loadFont conf) (const $ loadFont defaultConfig)
cl <- parseTemplate conf (template conf)
vars <- mapM startCommand cl
(r,w) <- createWin d fs conf
eventLoop (XConf d r w fs conf) vars
- freeFont d fs
+ freeFontSet d fs
-- | Reads the configuration files or quits with an error
readConfig :: FilePath -> IO Config
@@ -76,7 +81,7 @@ readDefaultConfig = do
if f then readConfig path else return defaultConfig
data Opts = Help
- | Version
+ | Version
| Font String
| BgColor String
| FgColor String
@@ -85,9 +90,9 @@ data Opts = Help
| AlignSep String
| Commands String
| SepChar String
- | Template String
+ | Template String
deriving Show
-
+
options :: [OptDescr Opts]
options =
[ Option ['h','?' ] ["help" ] (NoArg Help ) "This help"
@@ -104,7 +109,7 @@ options =
]
getOpts :: [String] -> IO ([Opts], [String])
-getOpts argv =
+getOpts argv =
case getOpt Permute options argv of
(o,n,[]) -> return (o,n)
(_,_,errs) -> error (concat errs ++ usage)
@@ -141,7 +146,7 @@ doOpts conf (o:oo) =
SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go
Template s -> modifyIORef conf (\c -> c { template = s }) >> go
Commands s -> case readCom s of
- Right x -> modifyIORef conf (\c -> c { commands = x }) >> go
+ Right x -> modifyIORef conf (\c -> c { commands = x }) >> go
Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1)
where readCom str =
case readStr str of
diff --git a/Xmobar.hs b/Xmobar.hs
index 4ee8772..16cc85e 100644
--- a/Xmobar.hs
+++ b/Xmobar.hs
@@ -4,12 +4,12 @@
-- Module : Xmobar
-- Copyright : (c) Andrea Rossato
-- License : BSD-style (see LICENSE)
---
+--
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
-- Stability : unstable
-- Portability : unportable
--
--- A status bar for the Xmonad Window Manager
+-- A status bar for the Xmonad Window Manager
--
-----------------------------------------------------------------------------
@@ -44,6 +44,7 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception hiding (handle)
import Data.Bits
+import Data.Char
import System.Posix.Types (Fd(..))
import Config
@@ -63,7 +64,7 @@ data XConf =
XConf { display :: Display
, rect :: Rectangle
, window :: Window
- , fontS :: FontStruct
+ , fontS :: FontSet
, config :: Config
}
@@ -75,9 +76,9 @@ runX xc f = runReaderT f xc
eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()
eventLoop xc@(XConf d _ w fs c) v = block $ do
tv <- atomically $ newTVar []
- t <- myThreadId
+ t <- myThreadId
ct <- forkIO (checker t tv "" `catch` \_ -> return ())
- go tv ct
+ go tv ct
where
-- interrupt the drawing thread every time a var is updated
checker t tvar ov = do
@@ -127,13 +128,13 @@ startCommand (com,s,ss)
-- $window
-- | The function to create the initial window
-createWin :: Display -> FontStruct -> Config -> IO (Rectangle,Window)
+createWin :: Display -> FontSet -> Config -> IO (Rectangle,Window)
createWin d fs c = do
let dflt = defaultScreen d
r:_ <- getScreenInfo d
rootw <- rootWindow d dflt
- let (_,as,ds,_) = textExtents fs []
- ht = as + ds + 2
+ let (_,rl) = wcTextExtents fs "Tg"
+ ht = rect_height rl + 2
(x,y,w,h,o) = setPosition (position c) r (fi ht)
win <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rootw x y w h o
selectInput d win (exposureMask .|. structureNotifyMask)
@@ -145,7 +146,7 @@ setPosition :: XPosition -> Rectangle -> Dimension -> (Position,Position,Dimensi
setPosition p (Rectangle rx ry rw rh) ht =
case p of
Top -> (rx , ry , rw , h , True)
- TopW L i -> (rx , ry , nw i , h , True)
+ TopW L i -> (rx , ry , nw i , h , True)
TopW R i -> (right i, ry , nw i , h , True)
TopW C i -> (center i, ry , nw i , h , True)
Bottom -> (rx , ny , rw , h , True)
@@ -185,8 +186,8 @@ updateWin :: TVar String -> X ()
updateWin v = do
xc <- ask
let (conf,rec) = (config &&& rect) xc
- [lc,rc] = if length (alignSep conf) == 2
- then alignSep conf
+ [lc,rc] = if length (alignSep conf) == 2
+ then alignSep conf
else alignSep defaultConfig
i <- io $ atomically $ readTVar v
let def = [i,[],[]]
@@ -209,7 +210,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
bgcolor <- io $ initColor d $ bgColor c
gc <- io $ createGC d w
--let's get the fonts
- io $ setFont d gc (fontFromFontStruct fs)
+-- io $ setFont d gc (fontFromFontStruct fs)
-- create a pixmap to write to and fill it with a rectangle
p <- io $ createPixmap d w wid ht
(defaultDepthOfScreen (defaultScreenOfDisplay d))
@@ -217,7 +218,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
io $ setForeground d gc bgcolor
io $ fillRectangle d p gc 0 0 wid ht
-- write to the pixmap the new string
- let strWithLenth = map (\(s,cl) -> (s,cl,textWidth fs s))
+ let strWithLenth = map (\(s,cl) -> (s,cl,wcTextEscapement fs s))
printStrings p gc fs 1 L $ strWithLenth left
printStrings p gc fs 1 R $ strWithLenth right
printStrings p gc fs 1 C $ strWithLenth center
@@ -230,16 +231,16 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
io $ sync d True
-- | An easy way to print the stuff we need to print
-printStrings :: Drawable -> GC -> FontStruct -> Position
+printStrings :: Drawable -> GC -> FontSet -> Position
-> Align -> [(String, String, Position)] -> X ()
printStrings _ _ _ _ _ [] = return ()
printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
r <- ask
let (conf,d) = (config &&& display) r
Rectangle _ _ wid ht = rect r
- (_,as,ds,_) = textExtents fontst s
+ (_,rl) = wcTextExtents fontst s
totSLen = foldr (\(_,_,len) -> (+) len) 0 sl
- valign = (fi ht + fi as - fi ds) `div` 2
+ valign = (fi ht + fi (rect_height rl)) `div` 2
remWidth = fi wid - fi totSLen
offset = case a of
C -> (remWidth + offs) `div` 2
@@ -249,14 +250,14 @@ printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
(f,',':b) -> do
fgc <- io $ initColor d f
bgc <- io $ initColor d b
- return (fgc,bgc)
+ return (fgc,bgc)
(f,_) -> do
fgc <- io $ initColor d f
bgc <- io $ initColor d (bgColor conf)
- return (fgc,bgc)
+ return (fgc,bgc)
io $ setForeground d gc fc
io $ setBackground d gc bc
- io $ drawImageString d dr gc offset valign s
+ io $ wcDrawImageString d dr fontst gc offset valign s
printStrings dr gc fontst (offs + l) a xs
{- $unmanwin
@@ -279,11 +280,11 @@ mkUnmanagedWindow :: Display
mkUnmanagedWindow dpy scr rw x y w h o = do
let visual = defaultVisualOfScreen scr
attrmask = cWOverrideRedirect
- allocaSetWindowAttributes $
+ allocaSetWindowAttributes $
\attributes -> do
set_override_redirect attributes o
- createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
- inputOutput visual attrmask attributes
+ createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
+ inputOutput visual attrmask attributes
{- $utility
Utilities