1 patch for repository http://code.haskell.org/xmonad-extras: Wed May 11 22:14:48 YEKST 2011 Ilya Portnov * Add module XMonad.Util.WindowPropertiesRE. It's similar to XMonad.Util.WindowProperties, but uses regular expression matching instead of exact string matching. New patches: [Add module XMonad.Util.WindowPropertiesRE. Ilya Portnov **20110511161448 Ignore-this: 50ff7624eea0b5353bdb47eef4957c8e It's similar to XMonad.Util.WindowProperties, but uses regular expression matching instead of exact string matching. ] { adddir ./XMonad/Util addfile ./XMonad/Util/WindowPropertiesRE.hs hunk ./XMonad/Util/WindowPropertiesRE.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.WindowPropertiesRE +-- Copyright : (c) 2011 Ilya Portnov +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Similar to XMonad.Util.WindowProperties, but uses regular expressions matching +-- instead of exact match. +-- +----------------------------------------------------------------------------- +module XMonad.Util.WindowPropertiesRE + (PropertyRE (..), + (~?), + propertyToQueryRE, hasPropertyRE + ) where + +import Text.Regex.Posix ((=~)) + +import XMonad + +import XMonad.Util.WindowProperties +import XMonad.Layout.LayoutBuilderP + +-- | A wrapper for X.U.WindowProperties.Property. +-- Checks using regular expression. +data PropertyRE = RE Property + deriving (Show,Read,Typeable) + +-- | Regular expressions matching for ManageHooks +(~?) :: (Functor f) => f String -> String -> f Bool +q ~? x = fmap (=~ x) q + +-- | Similar to XMonad.Util.WindowProperties.propertyToQuery, +-- but uses regexp match instead of exact match +propertyToQueryRE :: Property -> Query Bool +propertyToQueryRE (Title s) = title ~? s +propertyToQueryRE (Resource s) = resource ~? s +propertyToQueryRE (ClassName s) = className ~? s +propertyToQueryRE (Role s) = stringProperty "WM_WINDOW_ROLE" ~? s +propertyToQueryRE (Machine s) = stringProperty "WM_CLIENT_MACHINE" ~? s +propertyToQueryRE (And p1 p2) = propertyToQueryRE p1 <&&> propertyToQueryRE p2 +propertyToQueryRE (Or p1 p2) = propertyToQueryRE p1 <||> propertyToQueryRE p2 +propertyToQueryRE (Not p) = not `fmap` propertyToQueryRE p +propertyToQueryRE (Const b) = return b + +-- | Does given window have this property? +hasPropertyRE :: PropertyRE -> Window -> X Bool +hasPropertyRE (RE p) w = runQuery (propertyToQueryRE p) w + +instance Predicate PropertyRE Window where + alwaysTrue _ = RE (Const True) + checkPredicate = hasPropertyRE + hunk ./xmonad-extras.cabal 33 flag with_hlist description: Build modules depending on HList. +flag with_regex_posix + description: Build modules depending on posix-regex. + flag with_template_haskell description: Build modules depending on template haskell. hunk ./xmonad-extras.cabal 73 build-depends: libmpd >= 0.5 && < 0.6 exposed-modules: XMonad.Prompt.MPD + if flag(with_regex_posix) + build-depends: regex-posix + exposed-modules: XMonad.Util.WindowPropertiesRE + if impl(ghc >= 6.12.1) && flag(with_template_haskell) && flag(with_hlist) build-depends: template-haskell, HList >= 0.2.3 && < 0.3 exposed-modules: XMonad.Config.Alt } Context: [Bump version to 0.10 Daniel Schoepe **20110126113202 Ignore-this: 1763acca75b86faaeabb8dd8ef689cdc ] [only modify playback streams in X.A.Volume Daniel Wagner **20110103220215 Ignore-this: e21fb966ea4952a87a978f755b9c17b2 ] [TAG 0.9.2 Adam Vogt **20101024223622 Ignore-this: e9501c8ce86cd518208eb53a0b37c08 ] [Version bump Adam Vogt **20101024223539 Ignore-this: 1dad72a74bf4d75ff7a8b944fe28b2bc ] [Include historical release notes. Adam Vogt **20101024223507 Ignore-this: 1ffb5b8eed3ddf6e8bfa8f74f43795ea ] [dschoepe says that PerWindowKbdLayout doesn't work with released version Adam Vogt **20101024222828 Ignore-this: a364fa6b2cb90e2d54791a55397295d7 ] [List X.C.A.Types to appease the hackage build Adam Vogt **20101024222638 Ignore-this: 86b0cca3582372a9d4ceb33825ab4c1b ] [Re-enable X.H.PerWindowKbdLayout Daniel Schoepe **20101016221728 Ignore-this: 3b4a224b22490fe928923931ff735210 ] [Better documentation for X.P.MPD.findMatching Daniel Schoepe **20101016214144 Ignore-this: 3a1d7ed653f02bfeb6219a8fc0595c7c ] [Fixed documentation typo in X.P.MPD Daniel Schoepe **20101016210750 Ignore-this: 18cb31afb7247c09799333e6c93178f8 ] [Added description field to .cabal Daniel Schoepe **20101016210325 Ignore-this: f7c05b8ae2f71f2b94fddc4dc73c855d ] [Adjusted upper version bounds on xmonad(-contrib) Daniel Schoepe **20101016205801 Ignore-this: 62da1289c38ab0af76d164676be63714 ] [Version bump and temporarily disabled X.H.PerWindowKbdLayout for compatability release Daniel Schoepe **20101016205347 Ignore-this: 4b4012b7d74e55420d8c4df2c39806e7 Since X.H.PerWindowKbdLayout depends on features not present in the released version of xmonad, I disabled that module for releasing a compatability version that makes xmonad-extras build with the latest libmpd-haskell. ] [Make X.P.MPD's completion handle spaces correctly Daniel Schoepe **20101008142445 Ignore-this: b5cf0581e52de802e6941dc1f87c5a37 ] [Made X.P.MPD compatible with new libmpd and added a few upper version boundaries Daniel Schoepe **20101005231342 Ignore-this: 7594ee77b02853e1b3c30cdc360ea698 ] [Make Prompt.MPD work with libmpd-git Daniel Schoepe **20100213004849 Ignore-this: f90fe8961092e4cd47f29f9ebbda3e2 ] [Less pointfree for clarity X.C.A.Desktop Adam Vogt **20100804011556 Ignore-this: 3d0c39d7731ab30f3246f4d460ef245d ] [Fix bug in definition of X.C.A.Desktop.ewmh Adam Vogt **20100804011357 Ignore-this: 95ae09dcce3ad7f1450b0deee637aedf ] [X.C.A.Desktop add dzen and xmobar Adam Vogt **20100804011204 Ignore-this: f454f4b20fd8f96b930934257b072a3a ] [Add more rationale for X.C.Alt Adam Vogt **20100804011036 Ignore-this: 90b4eaeadc6ea6d4916b5380f12e76e2 ] [X.C.Alt: Added quasiquoter for Naturals and simplify exports. Adam Vogt **20100801212712 Ignore-this: 34623e573aa5956b92c930a46146340f ] [X.C.Alt Add desktop-related functions and examples for them. Adam Vogt **20100801211641 Ignore-this: 978769f9127062f6eb6cd4ef64b86f74 ] [X.C.Alt fix haddock formatting Adam Vogt **20100725135446 Ignore-this: ae6de8f20b1a3bf52927550fc8795b52 ] [Add Config.Alt, a possibly more modular way to specify sets of config options. Adam Vogt **20100725032541 Ignore-this: 3ca8bf05688736d5637cd9793945f929 ] [Added Konstantin Sobolev's PerWindowKbdLayout module Daniel Schoepe **20100510083442 Ignore-this: 515a40c9a17b1f2210713f05122f79f6 ] [Make X.Prompt.MPD compile with latest libmpd. Daniel Schoepe **20100427145811 Ignore-this: cb8d7162231d9d2530bbe222caaff92c ] [minor improvement to the X.A.Volume documentation Daniel Wagner **20091114063638 Ignore-this: 2933155463ab3090c7c1bfa1f2ddb7dd ] [TAG 0.9 release Daniel Wagner **20091112003747 Ignore-this: c6a524e7a87c28a444c1be0f27cbdda ] Patch bundle hash: 69519551105d3b379008c410cc9cf487150cc0fe