diff --git a/DescriptiveKeys.cabal b/DescriptiveKeys.cabal new file mode 100644 --- /dev/null +++ b/DescriptiveKeys.cabal @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/src/XMonad/Config/DescriptiveKeys.hs b/src/XMonad/Config/DescriptiveKeys.hs new file mode 100644 --- /dev/null +++ b/src/XMonad/Config/DescriptiveKeys.hs @@ -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)