├── .dir-locals.el ├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── i3status.conf ├── src ├── .ghci ├── Data │ └── Time │ │ └── Zone.hs ├── DevelMain.hs ├── Main.hs └── XMonad │ ├── Suave.hs │ └── Suave │ ├── Types.hs │ ├── View.hs │ └── Window.hs ├── stack.yaml └── xmonad-chrisdone.cabal /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((haskell-mode . ((haskell-process-use-ghci . t)))) 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | cabal-dev 2 | dist 3 | TAGS 4 | .hsenv/ 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c)2011, Chris Done 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Chris Done nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Screenshot](http://i.imgur.com/l804Oah.png) 2 | 3 | My panel is written in Haskell using Webkit and GTK+ for the window and the display, with XMonad handling the layout properly. 4 | 5 | The panel displays things of interest to myself: 6 | 7 | * Disk usage. 8 | * Battery life. 9 | * CPU temperature. 10 | * Load. 11 | * Volume. 12 | * Real (non-cache) memory usage. 13 | * My currently clocked in hours of work (of total 8:00). 14 | * How many keys I've pressed today. 15 | * The current time in my time zone (CET/CEST) and the time in PST and EST time zones. 16 | 17 | ## Setup 18 | 19 | Much like other people's Emacs configurations, my XMonad configuration is rather hard to setup. It uses GTK+ and Webkit which are both hard to install and finicky on some systems. It also uses a custom i3status config (included), and my own script for getting memory usage (`mem-use.sh`) and it also reads from `~/Log/dita.log` (which uses [Dita](https://github.com/chrisdone/dita)) for typing information. 20 | 21 | I provide no help or support in getting it to run, but there's no reason for me to keep the repo hidden either. 22 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /i3status.conf: -------------------------------------------------------------------------------- 1 | general { 2 | output_format = "none" 3 | colors = false 4 | interval = 10 5 | } 6 | 7 | order += "disk /" 8 | order += "battery 0" 9 | order += "cpu_temperature 0" 10 | order += "load" 11 | order += "volume master" 12 | order += "wireless wlan0" 13 | 14 | volume master { 15 | format = " %volume" 16 | device = "default" 17 | mixer = "Master" 18 | mixer_idx = 0 19 | } 20 | 21 | disk / { 22 | format = " %used/%total" 23 | } 24 | 25 | wireless wlan0 { 26 | format_up = " %quality %ip" 27 | format_down = "" 28 | } 29 | 30 | ethernet eth0 { 31 | format_up = "Eth: %ip (%speed)" 32 | format_down = "" 33 | } 34 | 35 | battery 0 { 36 | format = " %percentage %remaining %emptytime" 37 | path = "/sys/class/power_supply/BAT%d/uevent" 38 | } 39 | 40 | run_watch DHCP { 41 | pidfile = "/var/run/dhclient*.pid" 42 | } 43 | 44 | run_watch VPN { 45 | pidfile = "/var/run/vpnc/pid" 46 | } 47 | 48 | time { 49 | format = "%Y-%m-%d %H:%M:%S " 50 | } 51 | 52 | load { 53 | format = " %5min" 54 | } 55 | 56 | cpu_temperature 0 { 57 | format = " %degrees °C" 58 | path = "/sys/devices/platform/coretemp.0/temp1_input" 59 | } 60 | -------------------------------------------------------------------------------- /src/.ghci: -------------------------------------------------------------------------------- 1 | :set -i../dist/build/autogen 2 | -------------------------------------------------------------------------------- /src/Data/Time/Zone.hs: -------------------------------------------------------------------------------- 1 | -- | Get time zones. 2 | 3 | module Data.Time.Zone where 4 | 5 | import Data.Time.Format 6 | import Data.Time.LocalTime 7 | import System.Locale 8 | 9 | -- | Get the time zone by name. 10 | getZone :: String -> Maybe TimeZone 11 | getZone zone = 12 | case parseTime defaultTimeLocale "%F%T%Z" ("2000-01-0100:00:00" ++ zone) of 13 | Just (ZonedTime _ timeZone) -> Just timeZone 14 | _ -> 15 | Nothing 16 | -------------------------------------------------------------------------------- /src/DevelMain.hs: -------------------------------------------------------------------------------- 1 | -- | For updating XMonad. 2 | 3 | module DevelMain where 4 | 5 | import Control.Concurrent 6 | import Foreign.Store 7 | import Main 8 | import System.Process 9 | 10 | -- | Start or restart xmonad. 11 | update = 12 | do callCommand "killall xmonad" 13 | forkIO (callCommand "dist/build/xmonad/xmonad") 14 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -Wall #-} 2 | 3 | -- | Chris Done's XMonad program. 4 | 5 | module Main where 6 | 7 | import Control.Monad 8 | import qualified Data.Map as M 9 | import XMonad 10 | import XMonad.Actions.DeManage (demanage) 11 | import XMonad.Config.Gnome (gnomeConfig) 12 | import XMonad.Hooks.EwmhDesktops (ewmh) 13 | import XMonad.Hooks.FadeInactive (fadeInactiveLogHook) 14 | import XMonad.Util.Run 15 | 16 | -- | Main entry point. 17 | main :: IO () 18 | main = do 19 | xmonad (ewmh gnomeConfig 20 | { terminal = "gnome-terminal" 21 | , modMask = mod4Mask 22 | , focusFollowsMouse = False 23 | , borderWidth = 0 24 | , logHook = fadeInactiveLogHook 0xbbbbbbbb 25 | , keys = newKeys 26 | }) 27 | where newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) 28 | myKeys (XConfig{modMask=modm}) = 29 | [((modm,xK_d),withFocused demanage) 30 | ,((modm,xK_b),liftIO (void (spawnPipe "chromium-browser")))] 31 | -------------------------------------------------------------------------------- /src/XMonad/Suave.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# OPTIONS -Wall #-} 3 | 4 | -- | A suave borderless webkit-based panel. 5 | 6 | module XMonad.Suave 7 | (xmonadSuave 8 | ,suaveStart 9 | ,suaveLayout 10 | ,suaveStartupHook 11 | ,suaveManageHook) 12 | where 13 | 14 | import XMonad.Suave.Types 15 | import XMonad.Suave.Window 16 | 17 | import Control.Concurrent 18 | import Control.Monad 19 | import Data.Monoid 20 | import Graphics.UI.Gtk (mainGUI) 21 | import Graphics.UI.Gtk (windowResize) 22 | import qualified Graphics.X11.Types as X11 (Window) 23 | import XMonad hiding (Window) 24 | import XMonad.Layout.Gaps 25 | import XMonad.Layout.LayoutModifier 26 | import XMonad.StackSet 27 | 28 | -- | Launch XMonad with the Suave panel. 29 | xmonadSuave :: (LayoutClass l X11.Window, Read (l X11.Window)) => (Suave -> XConfig l) -> IO () 30 | xmonadSuave f = do 31 | s <- suaveStart 32 | void (forkIO (xmonad (f s))) 33 | mainGUI 34 | 35 | -- | Setup the right panel layout for Suave. 36 | suaveLayout :: ModifiedLayout Gaps (Choose Tall Full) a 37 | suaveLayout = gaps [(U,40)] (Tall 1 (3/100) (1/2) ||| Full) 38 | 39 | -- | Set the position of the Suave panel. 40 | suaveStartupHook :: Suave -> X () 41 | suaveStartupHook (Suave suave) = withWindowSet $ \stackset -> do 42 | liftIO (windowResize suave 43 | (head (map (fromIntegral . rect_width . screenRect . screenDetail) 44 | (screens stackset))) 45 | 40) 46 | 47 | -- | Ignore the Suave window as a panel. 48 | suaveManageHook :: Query (Endo WindowSet) 49 | suaveManageHook = composeAll [ title =? suaveWindowTitle --> doIgnore] 50 | -------------------------------------------------------------------------------- /src/XMonad/Suave/Types.hs: -------------------------------------------------------------------------------- 1 | -- | All types of the project. 2 | 3 | module XMonad.Suave.Types where 4 | 5 | import Graphics.UI.Gtk 6 | 7 | -- | Suave instance. 8 | newtype Suave = Suave Window 9 | 10 | -- | Suave port for the server. 11 | suavePort :: Int 12 | suavePort = 8888 13 | -------------------------------------------------------------------------------- /src/XMonad/Suave/View.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE NoImplicitPrelude #-} 3 | 4 | -- | View for the client. 5 | 6 | module XMonad.Suave.View where 7 | 8 | import Data.Monoid 9 | import Prelude (($),return) 10 | import Text.Blaze 11 | import Text.Blaze.Html5 12 | import Text.Blaze.Html5.Attributes hiding (span,style) 13 | import Text.Blaze.Internal 14 | 15 | -- | View for the panel. 16 | page :: Html 17 | page = 18 | do docType 19 | html $ 20 | do head $ 21 | do theme 22 | body $ 23 | do rhs 24 | 25 | -- | CSS theme. 26 | theme :: Html 27 | theme = 28 | do link ! 29 | href "http://netdna.bootstrapcdn.com/font-awesome/4.0.3/css/font-awesome.css" ! 30 | rel "stylesheet" 31 | style $ 32 | mconcat ["body {" 33 | ,"font-size: 22px;" 34 | ,"font-family: ubuntu;" 35 | ,"background: #ff0000;" 36 | ,"color: #bbbbbb;" 37 | ,"height: 40px;" 38 | ,"overflow: hidden;" 39 | ,"padding: 0.3em;" 40 | ,"margin: 0;" 41 | ,"text-shadow: -0.08em -0.08em 0.01em #292929;" 42 | ,"background: -webkit-linear-gradient(top, #444, #333) no-repeat #333;" 43 | ,"-webkit-touch-callout: none;" 44 | ,"-webkit-user-select: none;" 45 | ,"-khtml-user-select: none;" 46 | ,"-moz-user-select: none;" 47 | ,"-ms-user-select: none;" 48 | ,"user-select: none;" 49 | ,"cursor: default;" 50 | ,"}" 51 | ,".indicator {" 52 | ,"margin-right: 0.5em; visibility:visible" 53 | ,"}" 54 | ,".ip { display: none }" 55 | ,"#wifi:hover .ip { display: inline }" 56 | ,"#date {" 57 | ,"color: #888" 58 | ,"}" 59 | ,"#date .bold {" 60 | ,"color: #bbbbbb;" 61 | ,"}" 62 | ,"#date *:hover {" 63 | ,"color: #fff" 64 | ,"}" 65 | ,"#rhs {" 66 | ,"float: right;" 67 | ,"}" 68 | ,"#center {" 69 | ,"text-align:center; position: absolute; top:0;left:0;bottom:0;right:0; line-height: 40px" 70 | ,"}" 71 | ,"#lhs,#rhs{" 72 | ,"visibility:hidden" 73 | ,"}" 74 | ,"#power-off {" 75 | ,"cursor: pointer;" 76 | ,"}" 77 | ,"#power-off:hover {" 78 | ,"color: #fff;" 79 | ,"}" 80 | ,"#kbd { margin-left: 1em}"] 81 | 82 | -- | Right-hand size. 83 | rhs :: Html 84 | rhs = 85 | do span !# "lhs" $ 86 | do span !# "i3" $ 87 | return () 88 | span !# "center" $ 89 | do span !# "clockin" $ 90 | return () 91 | span !# "rhs" $ 92 | do span !. "indicator" !# "date" $ 93 | return () 94 | 95 | -- | Class names. 96 | (!.) :: Attributable h 97 | => h -> AttributeValue -> h 98 | span !. value = span ! class_ value 99 | 100 | -- | Class names. 101 | (!#) :: Attributable h 102 | => h -> AttributeValue -> h 103 | span !# value = span ! id value 104 | -------------------------------------------------------------------------------- /src/XMonad/Suave/Window.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ExtendedDefaultRules #-} 3 | 4 | -- | The client window (webkit). 5 | 6 | module XMonad.Suave.Window where 7 | 8 | import Clockin 9 | import Control.Concurrent 10 | import Control.Exception (try,SomeException) 11 | import Control.Monad 12 | import Control.Monad.Fix 13 | import Data.Maybe 14 | import qualified Data.Text as T 15 | import Data.Text.Lazy (unpack,Text) 16 | import qualified Data.Text.Lazy as LT 17 | import qualified Data.Text.Lazy.IO as T 18 | import Data.Time 19 | import Data.Monoid 20 | import Data.Time.Zone 21 | import Formatting 22 | import Formatting.Time 23 | import Graphics.UI.Gtk hiding (LayoutClass) 24 | import Graphics.UI.Gtk.WebKit.DOM.Document 25 | import Graphics.UI.Gtk.WebKit.DOM.HTMLElement 26 | import Graphics.UI.Gtk.WebKit.Types hiding (Text) 27 | import Graphics.UI.Gtk.WebKit.WebView 28 | import Paths_xmonad_chrisdone 29 | import System.IO 30 | import System.Locale 31 | import System.Process 32 | import Text.Blaze.Html.Renderer.Text 33 | import XMonad.Suave.Types 34 | import XMonad.Suave.View 35 | 36 | -- | Start up a Suave panel. 37 | suaveStart :: IO (Suave) 38 | suaveStart = 39 | do void initGUI 40 | window <- windowNew 41 | vContainer <- vBoxNew False 0 42 | scrolledWindow <- 43 | scrolledWindowNew Nothing Nothing 44 | scrolledWindowSetPolicy scrolledWindow PolicyNever PolicyNever 45 | webview <- webViewNew 46 | set window [containerChild := vContainer,windowTitle := suaveWindowTitle] 47 | boxPackStart vContainer scrolledWindow PackGrow 0 48 | set scrolledWindow [containerChild := webview] 49 | Just document <- webViewGetDomDocument webview 50 | Just body <- documentGetBody document 51 | htmlElementSetInnerHTML body 52 | (unpack (renderHtml page)) 53 | Just i3 <- 54 | fmap (fmap castToHTMLElement) 55 | (documentGetElementById document "i3") 56 | Just date <- 57 | fmap (fmap castToHTMLElement) 58 | (documentGetElementById document "date") 59 | Just clockin <- 60 | fmap (fmap castToHTMLElement) 61 | (documentGetElementById document "clockin") 62 | void (forkIO (fix (\loop -> 63 | do postGUISync (void (try (updateUI i3 date clockin) :: IO (Either SomeException ()))) 64 | threadDelay (1000 * 1000) 65 | loop))) 66 | void (onDestroy window mainQuit) 67 | void (widgetShowAll window) 68 | return (Suave window) 69 | 70 | -- | Update the contents of the panel. 71 | updateUI :: HTMLElement -> HTMLElement -> HTMLElement -> IO () 72 | updateUI i3 date clockin = 73 | do status <- i3status 74 | mem <- readProcessLine "mem-use.sh" 75 | htmlElementSetInnerHTML i3 76 | (unpack status ++ " " ++ mem ++ "") 77 | now <- getZonedTime 78 | htmlElementSetInnerHTML date 79 | (dateDisplays now) 80 | config <- getClockinConfig 81 | entries <- readClockinEntries config 82 | now <- 83 | fmap zonedTimeToLocalTime getZonedTime 84 | let desc = 85 | onelinerStatus now 86 | (clockinStatus config now entries) 87 | keys <- keyboardStats 88 | htmlElementSetInnerHTML clockin 89 | (" " ++ T.unpack desc ++ 90 | " " ++ 91 | keys) 92 | 93 | -- | Get key press count. 94 | keyboardStats :: IO String 95 | keyboardStats = 96 | do d <- getCurrentTime 97 | keys <- fmap read (readProcessLine (cmd d)) 98 | return (formatToString (commas) 99 | (keys :: Int)) 100 | where cmd d = 101 | formatToString 102 | ("grep '^" % 103 | (year <> month <> dayOfMonth) % 104 | "' ~/Logs/dita.log | wc -l") 105 | d 106 | 107 | dateDisplays now = 108 | unwords [timeAtZone (zoneOf "PST") now 109 | ,"/" 110 | ,timeAtZone (zoneOf "EST") now 111 | ,"/" 112 | -- ,timeAtZone (zoneOf "IST") now -- not needed presently, IST=CEST 113 | -- ,"/" 114 | ,bold (formatTime defaultTimeLocale "%a %d %b" now) 115 | ,bold (timeAtZone this now)] 116 | where bold x = "" ++ x ++ "" 117 | this = zonedTimeZone now 118 | timeAndZone = 119 | formatTime defaultTimeLocale "%H:%M %Z (UTC%z)" 120 | timeAtZone zone t = 121 | timeAndZone 122 | (utcToZonedTime zone 123 | (zonedTimeToUTC t)) 124 | zoneOf name = 125 | fromMaybe (error ("Unable to get zone for " ++ name)) 126 | (getZone name) 127 | 128 | -- | Get the output from i3status. 129 | i3status :: IO Text 130 | i3status = 131 | do fp <- getDataFileName "i3status.conf" 132 | (inp,out,err,pid) <- 133 | runInteractiveCommand ("i3status -c " ++ show fp) 134 | line <- T.hGetLine out 135 | hClose out 136 | hClose inp 137 | hClose err 138 | terminateProcess pid 139 | return line 140 | 141 | -- | Read a process line. 142 | readProcessLine :: String -> IO String 143 | readProcessLine cmd = 144 | do (inp,out,err,pid) <- 145 | runInteractiveCommand cmd 146 | line <- T.hGetLine out 147 | hClose out 148 | hClose inp 149 | hClose err 150 | terminateProcess pid 151 | return (LT.unpack line) 152 | 153 | -- | Window title of the Suave panel. 154 | suaveWindowTitle :: String 155 | suaveWindowTitle = "xmonad-suave-panel" 156 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: 5 | - xmonad-0.11.1 6 | - xmonad-contrib-0.11.4 7 | - X11-xft-0.3.1 8 | - utf8-string-0.3.8 9 | resolver: lts-3.0 10 | -------------------------------------------------------------------------------- /xmonad-chrisdone.cabal: -------------------------------------------------------------------------------- 1 | Name: xmonad-chrisdone 2 | Version: 0.1 3 | Synopsis: My xmonad. 4 | Description: My xmonad configuration. 5 | License: BSD3 6 | License-file: LICENSE 7 | Author: Chris Done 8 | Maintainer: chrisdone@gmail.com 9 | Category: Desktop 10 | Build-type: Simple 11 | Cabal-version: >=1.2 12 | 13 | Executable xmonad 14 | Ghc-options: -threaded -O2 15 | Hs-source-dirs: src 16 | Main-is: Main.hs 17 | Build-depends: text >= 0.11.2.0, 18 | time >= 1.4.0.0, 19 | old-locale >= 1.0.0.0, 20 | process >= 1.1.0.0, 21 | base >= 4 && <5, 22 | xmonad >= 0.9, 23 | xmonad-contrib >= 0.9, 24 | containers >= 0.3 25 | --------------------------------------------------------------------------------