[Xmonad] Patch: auto float windows with specific window class
hints
Stefan O'Rear
stefanor at cox.net
Wed Jun 27 13:28:42 EDT 2007
On Wed, Jun 27, 2007 at 11:08:11PM +0600, lucky wrote:
> Hi.
> first patch introduces XGetClassHints for x11-extras,
> the second patch -- simple dwm-like hack: auto-floating windows with
> specific class names.
>
> i'm not a haskell programmer, review it carefully. :)
I'm not an XMonad committer, so I can't apply this. :) But I am a
Haskell programmer.
> diff -rN -u old-X11-extras/Graphics/X11/Xlib/Extras.hsc new-X11-extras/Graphics/X11/Xlib/Extras.hsc
> --- old-X11-extras/Graphics/X11/Xlib/Extras.hsc 2007-06-27 12:14:40.000000000 +0600
> +++ new-X11-extras/Graphics/X11/Xlib/Extras.hsc 2007-06-27 12:14:40.000000000 +0600
> @@ -908,6 +908,36 @@
> xGetWMNormalHints d w sh supplied_return
> peek sh
>
> +
> +data ClassHint = ClassHint
> + { resName :: String
> + , resClass :: String
> + }
> +
> +instance Storable ClassHint where
> + sizeOf _ = #{size XClassHint}
> +
> + -- I really hope this is right too :) :
> + alignment _ = alignment (undefined :: CInt)
> +
> + peek p = do
> + p_res_name <- (#{peek XClassHint, res_name} p) :: IO CString
> + p_res_class <- (#{peek XClassHint, res_class} p) :: IO CString
> + res_name <- peekCString p_res_name
> + res_class <- peekCString p_res_class
> + xFree p_res_name
> + xFree p_res_class
> + return $ ClassHint res_name res_class
> +
> +getClassHint :: Display -> Window -> IO ClassHint
> +getClassHint d w
> + = alloca $ \ p -> do
> + xGetClassHint d w p
> + peek p
> +
> +foreign import ccall unsafe "XlibExtras.h XGetClassHint"
> + xGetClassHint :: Display -> Window -> Ptr ClassHint -> IO Status
> +
> ------------------------------------------------------------------------
> -- Keysym Macros
> --
This patch looks good, but it appears to be a unified diff; Darcs has
built-in support for sending patches that makes them a bit easier to
merge, and also preserves attribution.
$ mkdir ~/.darcs
$ echo 'My Name <my at email>' > ~/.darcs/author
$ darcs record
<answer y for each patch hunk you want to send>
<enter a description line>
$ darcs send
<select the patch>
$
> --- old-xmonad/Operations.hs 2007-06-27 22:50:18.000000000 +0600
> +++ new-xmonad/Operations.hs 2007-06-27 22:50:18.000000000 +0600
> @@ -38,6 +38,8 @@
>
> import qualified Data.Traversable as T
>
> +import Text.Regex.Posix
> +
> -- ---------------------------------------------------------------------
> -- |
> -- Window manager operations
> @@ -56,9 +58,12 @@
> -- lose the default sizing.
>
> sh <- io $ getWMNormalHints d w
> + -- float windows with specific class name
> + cs <- io $ getClassHint d w
> + let isFloatByClass = resClass cs =~ "panel|Gajim" :: Bool
> let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
> isTransient <- isJust `liftM` io (getTransientForHint d w)
> - if isFixedSize || isTransient
> + if isFixedSize || isTransient || isFloatByClass
> then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }
> float w -- \^^ now go the refresh.
> else windows $ W.insertUp w
>
> --- old-xmonad/xmonad.cabal 2007-06-27 22:50:18.000000000 +0600
> +++ new-xmonad/xmonad.cabal 2007-06-27 22:50:18.000000000 +0600
> @@ -18,7 +18,7 @@
> license-file: LICENSE
> author: Spencer Janssen
> maintainer: sjanssen at cse.unl.edu
> -build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0
> +build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, regex-posix>=0.71
> extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in
> Config.hs-boot util/GenerateManpage.hs man/xmonad.1 man/xmonad.html
This one is a bit worrisome. The code is good, more of design issues;
what if I want to float a different set of windows? Everything the user
might want to edit should be in Config.hs. Also, they probably will not
look favorably upon a regex-posix dependency.
I would propose a different change:
in Operations.hs
> modify $ \s -> s { windowset = W.insertUp w (windowset s) }
> newWindowHook w
> refresh
in Config.hs
> newWindowHook :: Window -> X ()
> -- sample : auto-float if transient, fixed size, or a panel/gajim
> newWindowHook = do
> sh <- io $ getWMNormalHints d w
> cs <- io $ getClassHint d w
>
> isTransient <- isJust `liftM` io (getTransientForHint d w)
> let isFloatByClass = resClass cs `elem` ["panel", "Gajim"]
> let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
>
> when (isFixedSize || isTransient || isFloatByClass) $ float w
in Config.hs-boot
> newWindowHook :: Window -> X ()
Also note my use of list searching to replace regexes.
--Stefan
More information about the Xmonad
mailing list