packages feed

DescriptiveKeys (empty) → 0.0.3

raw patch · 4 files changed

+320/−0 lines, 4 filesdep +basedep +containersdep +xmonadsetup-changed

Dependencies added: base, containers, xmonad, xmonad-contrib

Files

+ DescriptiveKeys.cabal view
@@ -0,0 +1,32 @@+Name:               DescriptiveKeys+Version:            0.0.3+License:            BSD3+License-File:       LICENSE+Author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+Maintainer:         Tony Morris+Synopsis:           A library for specifying xmonad key bindings with functionality.+Category:           System+Description:        A library for specifying xmonad key bindings with search and help functions.+Homepage:           https://bitbucket.org/dibblego/descriptive-keys/+Cabal-version:      >= 1.2+Build-Type:         Simple++Flag small_base+  Description:      Choose the new, split-up base package.++Library+  Build-Depends:+                      base < 5 && >= 3+                    , xmonad+                    , xmonad-contrib+                    , containers++  GHC-Options:+                    -Wall++  Hs-Source-Dirs:+                    src++  Exposed-Modules:+                      XMonad.Config.DescriptiveKeys+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2011 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ src/XMonad/Config/DescriptiveKeys.hs view
@@ -0,0 +1,258 @@+-- | Specify your key-bindings with a description and zero or more tags,+-- then add a key-binding to search through them.+module XMonad.Config.DescriptiveKeys+(+-- * Usage+-- $usage+-- * Description+  Description(..)+, DescriptiveKey(..)+, defaultDescriptiveKey+-- * `DescriptiveKeys` data structure+, DescriptiveKeys+, descriptiveKeys+, wKeys+, setDescriptiveKeys+-- * Tags+, Tag(..)+, Tags+, allTags+, SearchTags(..)+, defaultSearchTags+, filterTags+-- * Pretty-printing the key description+, DescriptiveKeysPP(..)+, defaultDescriptiveKeysPP+-- * The prompt text when searching+, SearchTextPrompt(..)+, defaultSearchTextPrompt+-- * The action to take to describe the keys+, DescribeKeys(..)+, defaultDescribeKeys+-- * Configuration+, HelpPromptConfig(..)+, helpPrompt+, helpPromptAndSet+, defaultHelpPromptAndSet+) where++import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Foldable as F+import XMonad+import XMonad.Prompt+import XMonad.Prompt.Input+import Data.Bits+import Data.List++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Config.DescriptiveKeys+--+--+-- Create an instance of `DescriptiveKeys` by annotating key-bindings with a description and list of tags.+--+-- >     myDescriptiveKeys = wKeys $ \c -> [(modMask c, xk_z, spawn "xclock"), "opens xclock", ["open", "xclock"]+--+-- Modify your `XConfig` with a configuration combinator. Following is the simplest.+--+-- >     myXConfig = defaultHelpPromptAndSet myDescriptiveKeys myXPConfig xConfig+--+-- This will set the keys property of the `XConfig` and a key-binding of mod-F1 to search.++-- | Wraps a string to create a tag.+newtype Tag =+  Tag String+  deriving (Eq, Ord, Show)++-- | A set of tags.+type Tags =+  S.Set Tag++-- | Wraps an optional string to denote a description for a key-binding.+newtype Description =+  Description (Maybe String)+  deriving (Eq, Ord, Show)++-- | The data structure that denotes an annotated key-binding.+data DescriptiveKey =+  DescriptiveKey {+    mask        :: ButtonMask+  , sym         :: KeySym+  , action      :: X ()+  , description :: Description+  , tags        :: Tags+  }++-- | A default key-binding that has no description or tags.+defaultDescriptiveKey ::+  ButtonMask+  -> KeySym+  -> X ()+  -> DescriptiveKey+defaultDescriptiveKey m s a =+  DescriptiveKey m s a (Description Nothing) S.empty++-- | A list of descriptive key-bindings that have access to the `XConfig`.+newtype DescriptiveKeys =+  DescriptiveKeys (XConfig Layout -> [DescriptiveKey])++-- | Construct a list of descriptive key-bindings.+descriptiveKeys ::+  (XConfig Layout -> [DescriptiveKey])+  -> DescriptiveKeys+descriptiveKeys =+  DescriptiveKeys++-- | Construct a list of descriptive key-bindings by specifying the description as a string+-- and the tags as a list of strings.+wKeys ::+  (XConfig Layout -> [(KeyMask, KeySym, X(), String, [String])])+  -> DescriptiveKeys+wKeys z =+  descriptiveKeys (fmap (\(m, s, a, d, t) -> DescriptiveKey m s a (Description (Just d)) (S.fromList (fmap Tag t))) . z)++-- | Sets the `keys` property of the given `XConfig` with the given descriptive key-bindings.+setDescriptiveKeys ::+  DescriptiveKeys+  -> XConfig l+  -> XConfig l+setDescriptiveKeys k l =+  let rawKeys (DescriptiveKeys d) = F.foldl' (\p (DescriptiveKey m s a _ _) -> M.insert (m, s) a p) M.empty . d+  in l { keys = rawKeys k }++-- | Returns all the tags for a given list of key-bindings.+allTags ::+  XConfig Layout+  -> DescriptiveKeys+  -> Tags+allTags l (DescriptiveKeys k) =+  S.unions (fmap tags (k l))++-- | How to produce a set of tags from a string, which will likely come from user-input.+newtype SearchTags =+  SearchTags {+    searchTags :: String -> Tags+  }++-- | Splits a string by spaces to produce a set of tags.+defaultSearchTags ::+  SearchTags+defaultSearchTags =+  SearchTags (S.fromList . fmap Tag . words)++-- | Removes all descriptive key-bindings that are not in the given set of tags.+filterTags ::+  Tags+  -> DescriptiveKeys+  -> DescriptiveKeys+filterTags t z@(DescriptiveKeys k) =+  if S.null t+    then z+    else DescriptiveKeys (\l -> filter (\(DescriptiveKey _ _ _ _ u) -> not (S.null (S.intersection t u))) $ k l)++-- | A pretty-printer for descriptive key-bindings.+data DescriptiveKeysPP =+  DescriptiveKeysPP ([DescriptiveKey] -> String)++-- | A plain-text pretty-printer that takes particular care of mod/mask keys and spacing.+defaultDescriptiveKeysPP ::+  DescriptiveKeysPP+defaultDescriptiveKeysPP =+  DescriptiveKeysPP (unlines . fmap (\(DescriptiveKey m s _ d _) ->+                       let pick n str = if n .&. complement m == 0 then str else ""+                           mk = concatMap (++"-") . filter (not . null) . map (uncurry pick) $+                               [+                                 (mod1Mask,    "mod")+                               , (mod2Mask,    "mod")+                               , (mod3Mask,    "mod")+                               , (mod4Mask,    "mod")+                               , (mod5Mask,    "mod")+                               , (controlMask, "cntrl")+                               , (shiftMask,   "shift")+                               ]+                           space g = g ++ replicate (16 - length g) ' '+                       in space (mk ++ keysymToString s) ++ case d of+                                                              Description Nothing  -> ""+                                                              Description (Just e) -> "    " ++ e))++-- | The prompt text when searching+newtype SearchTextPrompt =+  SearchTextPrompt String+  deriving (Eq, Ord, Show)++-- | The default search prompt, @Search key-bindings@+defaultSearchTextPrompt ::+  SearchTextPrompt+defaultSearchTextPrompt =+  SearchTextPrompt "Search key-bindings"++-- | The action to take to describe key-bindings from a string user-input.+newtype DescribeKeys =+  DescribeKeys {+    describeKeys :: String -> X ()+  }++-- | A default that opens @xmessage@ and uses the default pretty-printer.+defaultDescribeKeys ::+  DescriptiveKeys+  -> XConfig Layout+  -> DescribeKeys+defaultDescribeKeys k l =+  let dk (DescriptiveKeys g) = g+      pp (DescriptiveKeysPP p) = p+      j s = dk (filterTags (searchTags defaultSearchTags s) k) l+  in DescribeKeys (\z -> spawn ("xmessage \"" ++ pp defaultDescriptiveKeysPP (j z) ++ "\""))++-- | The attributes required to do the final configuration of the descriptive key-bindings.+data HelpPromptConfig =+  HelpPromptConfig {+    descriptiveHelp :: DescriptiveKeys      -- ^ The descriptive key-bindings.+  , xpConfigHelp    :: XPConfig             -- ^ The `XPConfig` that is used.+  , keyHelp         :: (ButtonMask, KeySym) -- ^ The key-binding to prompt the user to search.+  , searchTextHelp  :: SearchTextPrompt     -- ^ The search text prompt.+  , describeHelp    :: DescribeKeys         -- ^ The action to take after string user-input.+  }++-- | Sets the help prompt on the given `XPConfig`.+helpPrompt ::+  (XConfig Layout -> HelpPromptConfig)+  -> XConfig l+  -> XConfig l+helpPrompt f c =+  c {+    keys = \d -> let HelpPromptConfig ks xpc ms (SearchTextPrompt stp) (DescribeKeys describek) = f d+                     compl s = return $ filter (isPrefixOf s) . fmap (\(Tag t) -> t) $ S.toList (allTags d ks)+                 in M.insert ms (inputPromptWithCompl xpc stp compl ?+ describek) (keys c d)+   }++-- | Sets the help prompt on the given `XPConfig` and sets the `keys` attribute.+helpPromptAndSet ::+  DescriptiveKeys+  -> XPConfig+  -> (ButtonMask, KeySym)+  -> SearchTextPrompt+  -> (XConfig Layout -> DescribeKeys)+  -> XConfig l+  -> XConfig l+helpPromptAndSet k c m s d =+  helpPrompt (\l -> HelpPromptConfig {+    descriptiveHelp = k+  , xpConfigHelp    = c+  , keyHelp         = m+  , searchTextHelp  = s+  , describeHelp    = d l+  }) .+  setDescriptiveKeys k++-- | Sets the help prompt on the given `XPConfig` and sets the `keys` attribute with a default+-- key-binding of mod-F1, default search text prompt and using @xmessage@ to provide the descriptive response.+defaultHelpPromptAndSet ::+  DescriptiveKeys+  -> XPConfig+  -> XConfig l+  -> XConfig l+defaultHelpPromptAndSet k c =+  helpPromptAndSet k c (mod4Mask, xK_F1) defaultSearchTextPrompt (defaultDescribeKeys k)