Hierarchify

darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz

7 files changed, 569 insertions, 0 deletions

diff --git a/XMonad/Prompt/Directory.hs b/XMonad/Prompt/Directory.hs
new file mode 100644
index 0000000..1ceaab8
--- /dev/null
+++ b/XMonad/Prompt/Directory.hs
@@ -0,0 +1,43 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Directory
+-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy
+-- License     :  BSD3
+-- 
+-- Maintainer  :  droundy@darcs.net
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A directory prompt for XMonad
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Directory (
+                             -- * Usage
+                             -- $usage
+                             directoryPrompt
+                              ) where
+
+import XMonad
+import XMonad.Prompt
+import XMonad.Util.Run ( runProcessWithInput )
+
+-- $usage
+-- For an example usage see "XMonad.Layout.WorkspaceDir"
+
+data Dir = Dir String
+
+instance XPrompt Dir where
+    showXPrompt (Dir x) = x
+
+directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
+directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job
+
+getDirCompl :: String -> IO [String]
+getDirCompl s = (filter notboring . lines) `fmap`
+                runProcessWithInput "/bin/bash" [] ("compgen -A directory " ++ s ++ "\n")
+
+notboring :: String -> Bool
+notboring ('.':'.':_) = True
+notboring ('.':_) = False
+notboring _ = True
diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs
new file mode 100644
index 0000000..5a9f4ef
--- /dev/null
+++ b/XMonad/Prompt/Man.hs
@@ -0,0 +1,107 @@
+{-# OPTIONS_GHC -Wall #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Man
+-- Copyright   :  (c) 2007 Valery V. Vorotyntsev
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  valery.vv@gmail.com
+-- Stability   :  unstable
+-- Portability :  non-portable (uses \"manpath\" and \"bash\")
+--
+-- A manual page prompt for XMonad window manager.
+--
+-- TODO
+--
+--   * narrow completions by section number, if the one is specified
+--     (like @\/etc\/bash_completion@ does)
+--
+--   * test with QuickCheck
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Man (
+                                -- * Usage
+                                -- $usage
+                                manPrompt
+                               , getCommandOutput
+                               ) where
+
+import XMonad
+import XMonad.Prompt
+import XMonad.Util.Run
+import XMonad.Prompt.Shell (split)
+
+import System.Directory
+import System.Process
+import System.IO
+
+import qualified Control.Exception as E
+import Control.Monad
+import Data.List
+import Data.Maybe
+
+-- $usage
+-- 1. In Config.hs add:
+--
+-- > import XMonad.Prompt.ManPrompt
+--
+-- 2. In your keybindings add something like:
+--
+-- >     , ((modMask, xK_F1), manPrompt defaultXPConfig) -- mod-f1 %! Query for manual page to be displayed
+
+-- %import XMonad.Prompt.XPrompt
+-- %import XMonad.Prompt.ManPrompt
+-- %keybind , ((modMask, xK_F1), manPrompt defaultXPConfig)
+
+data Man = Man
+
+instance XPrompt Man where
+    showXPrompt Man = "Manual page: "
+
+-- | Query for manual page to be displayed.
+manPrompt :: XPConfig -> X ()
+manPrompt c = mkXPrompt Man c manCompl $ runInTerm . (++) "man "
+
+manCompl :: String -> IO [String]
+manCompl str | '/' `elem` str = do
+  -- XXX It may be better to use readline instead of bash's compgen...
+  lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ str ++ "'")
+             | otherwise      = do
+  mp <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return []
+  let sects    = ["man" ++ show n | n <- [1..9 :: Int]]
+      dirs     = [d ++ "/" ++ s | d <- split ':' mp, s <- sects]
+      stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse
+  mans <- forM dirs $ \d -> do
+            exists <- doesDirectoryExist d
+            if exists
+              then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`
+                   getDirectoryContents d
+              else return []
+  mkComplFunFromList (uniqSort $ concat mans) str
+
+-- | Run a command using shell and return its output.
+--
+-- XXX merge with 'Run.runProcessWithInput'?
+--
+--   * update documentation of the latter (there is no 'Maybe' in result)
+--
+--   * ask \"gurus\" whether @evaluate (length ...)@ approach is
+--     better\/more idiomatic
+getCommandOutput :: String -> IO String
+getCommandOutput s = do
+  (pin, pout, perr, ph) <- runInteractiveCommand s
+  hClose pin
+  output <- hGetContents pout
+  E.evaluate (length output)
+  hClose perr
+  waitForProcess ph
+  return output
+
+stripSuffixes :: Eq a => [[a]] -> [a] -> [a]
+stripSuffixes sufs fn =
+    head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn]
+
+rstrip :: Eq a => [a] -> [a] -> Maybe [a]
+rstrip suf lst
+    | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst
+    | otherwise            = Nothing
diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs
new file mode 100644
index 0000000..dfbfb09
--- /dev/null
+++ b/XMonad/Prompt/Shell.hs
@@ -0,0 +1,127 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Shell
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A shell prompt for XMonad
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Shell(
+                             -- * Usage
+                             -- $usage
+                             shellPrompt
+                             , getShellCompl
+                             , split
+                             , prompt
+                             , safePrompt
+                              ) where
+
+import System.Environment
+import Control.Monad
+import Data.List
+import System.Directory
+import System.IO
+import XMonad.Util.Run
+import XMonad
+import XMonad.Prompt
+
+-- $usage
+--
+-- 1. In Config.hs add:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.Shell
+--
+-- 2. In your keybindings add something like:
+--
+-- >   , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
+--
+
+-- %import XMonad.Prompt
+-- %import XMonad.Prompt.ShellPrompt
+-- %keybind , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
+
+data Shell = Shell
+
+instance XPrompt Shell where
+    showXPrompt Shell = "Run: "
+
+shellPrompt :: XPConfig -> X ()
+shellPrompt c = do
+    cmds <- io $ getCommands
+    mkXPrompt Shell c (getShellCompl cmds) spawn
+
+-- | See safe and unsafeSpawn. prompt is an alias for safePrompt;
+-- safePrompt and unsafePrompt work on the same principles, but will use
+-- XPrompt to interactively query the user for input; the appearance is
+-- set by passing an XPConfig as the second argument. The first argument
+-- is the program to be run with the interactive input.
+-- You would use these like this:
+--
+-- >     , ((modMask,               xK_b     ), safePrompt "firefox" greenXPConfig)
+-- >     , ((modMask .|. shiftMask, xK_c     ), prompt ("xterm" ++ " -e") greenXPConfig)
+--
+-- Note that you want to use safePrompt for Firefox input, as Firefox
+-- wants URLs, and unsafePrompt for the XTerm example because this allows
+-- you to easily start a terminal executing an arbitrary command, like
+-- 'top'.
+prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()
+prompt = unsafePrompt
+safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
+    where run = safeSpawn c
+unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
+    where run a = unsafeSpawn $ c ++ " " ++ a
+
+getShellCompl :: [String] -> String -> IO [String]
+getShellCompl cmds s | s == "" || last s == ' ' = return []
+                     | otherwise                = do
+    f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n")
+    return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s
+
+commandCompletionFunction :: [String] -> String -> [String]
+commandCompletionFunction cmds str | '/' `elem` str = []
+                                   | otherwise      = filter (isPrefixOf str) cmds
+
+getCommands :: IO [String]
+getCommands = do
+    p  <- getEnv "PATH" `catch` const (return [])
+    let ds = split ':' p
+        fp d f = d ++ "/" ++ f
+    es <- forM ds $ \d -> do
+        exists <- doesDirectoryExist d
+        if exists
+            then getDirectoryContents d >>= filterM (isExecutable . fp d)
+            else return []
+    return . uniqSort . concat $ es
+
+isExecutable :: FilePath ->IO Bool
+isExecutable f = do
+    fe <- doesFileExist f
+    if fe
+        then fmap executable $ getPermissions f
+        else return False
+
+split :: Eq a => a -> [a] -> [[a]]
+split _ [] = []
+split e l =
+    f : split e (rest ls)
+        where
+          (f,ls) = span (/=e) l
+          rest s | s == []   = []
+                 | otherwise = tail s
+
+escape :: String -> String
+escape []       = ""
+escape (' ':xs) = "\\ " ++ escape xs
+escape (x:xs)
+    | isSpecialChar x = '\\' : x : escape xs
+    | otherwise       = x : escape xs
+
+isSpecialChar :: Char -> Bool
+isSpecialChar =  flip elem "\\@\"'#?$*()[]{};"
diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs
new file mode 100644
index 0000000..9194b27
--- /dev/null
+++ b/XMonad/Prompt/Ssh.hs
@@ -0,0 +1,104 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Ssh
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A ssh prompt for XMonad
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Ssh(
+                             -- * Usage
+                             -- $usage
+                             sshPrompt
+                              ) where
+
+import XMonad
+import XMonad.Util.Run
+import XMonad.Prompt
+
+import System.Directory
+import System.Environment
+
+import Control.Monad
+import Data.List
+import Data.Maybe
+
+-- $usage
+-- 1. In Config.hs add:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.SshPrompt
+--
+-- 2. In your keybindings add something like:
+--
+-- >   , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig)
+--
+
+-- %import XMonad.Prompt
+-- %import XMonad.Prompt.SshPrompt
+-- %keybind , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig)
+
+data Ssh = Ssh
+
+instance XPrompt Ssh where
+    showXPrompt Ssh = "SSH to: "
+
+sshPrompt :: XPConfig -> X ()
+sshPrompt c = do
+  sc <- io $ sshComplList
+  mkXPrompt Ssh c (mkComplFunFromList sc) ssh
+
+ssh :: String -> X ()
+ssh s = runInTerm ("ssh " ++ s)
+
+sshComplList :: IO [String]
+sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal
+
+sshComplListLocal :: IO [String]
+sshComplListLocal = do
+  h <- getEnv "HOME"
+  sshComplListFile $ h ++ "/.ssh/known_hosts"
+
+sshComplListGlobal :: IO [String]
+sshComplListGlobal = do
+  env <- getEnv "SSH_KNOWN_HOSTS" `catch` (\_ -> return "/nonexistent")
+  fs <- mapM fileExists [ env
+                        , "/usr/local/etc/ssh/ssh_known_hosts"
+                        , "/usr/local/etc/ssh_known_hosts"
+                        , "/etc/ssh/ssh_known_hosts"
+                        , "/etc/ssh_known_hosts"
+                        ]
+  case catMaybes fs of
+    []    -> return []
+    (f:_) -> sshComplListFile' f
+
+sshComplListFile :: String -> IO [String]
+sshComplListFile kh = do
+  f <- doesFileExist kh
+  if f then sshComplListFile' kh
+       else return []
+
+sshComplListFile' :: String -> IO [String]
+sshComplListFile' kh = do
+  l <- readFile kh
+  return $ map (takeWhile (/= ',') . concat . take 1 . words)
+         $ filter nonComment
+         $ lines l
+
+fileExists :: String -> IO (Maybe String)
+fileExists kh = do
+  f <- doesFileExist kh
+  if f then return $ Just kh
+       else return Nothing
+
+nonComment :: String -> Bool
+nonComment []      = False
+nonComment ('#':_) = False
+nonComment ('|':_) = False -- hashed, undecodeable
+nonComment _       = True
diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs
new file mode 100644
index 0000000..2c017ee
--- /dev/null
+++ b/XMonad/Prompt/Window.hs
@@ -0,0 +1,89 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Window
+-- Copyright   :  Devin Mullins <me@twifkak.com>
+--                Andrea Rossato <andrea.rossato@unibz.it>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Devin  Mullins <me@twifkak.com>
+--                Andrea Rossato <andrea.rossato@unibz.it>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- xprompt operations to bring windows to you, and bring you to windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Window
+    (
+    -- * Usage
+    -- $usage 
+    windowPromptGoto,
+    windowPromptBring
+    ) where
+
+import qualified Data.Map as M
+import Data.List
+
+import qualified XMonad.StackSet as W
+import XMonad
+import XMonad.Operations (windows)
+import XMonad.Prompt
+import XMonad.Actions.WindowBringer
+
+-- $usage
+-- WindowPrompt brings windows to you and you to windows.
+-- That is to say, it pops up a prompt with window names, in case you forgot
+-- where you left your XChat.
+--
+-- Place in your Config.hs:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.WindowPrompt
+--
+-- and in the keys definition:
+--
+-- > , ((modMask .|. shiftMask, xK_g     ), windowPromptGoto  defaultXPConfig)
+-- > , ((modMask .|. shiftMask, xK_b     ), windowPromptBring defaultXPConfig)
+
+-- %import XMonad.Prompt
+-- %import XMonad.Prompt.WindowPrompt
+-- %keybind , ((modMask .|. shiftMask, xK_g     ), windowPromptGoto  defaultXPConfig)
+-- %keybind , ((modMask .|. shiftMask, xK_b     ), windowPromptBring defaultXPConfig)
+
+
+data WindowPrompt = Goto | Bring
+instance XPrompt WindowPrompt where 
+    showXPrompt Goto  = "Go to window:  "
+    showXPrompt Bring = "Bring me here:  "
+
+windowPromptGoto, windowPromptBring :: XPConfig -> X ()
+windowPromptGoto  c = doPrompt Goto  c
+windowPromptBring c = doPrompt Bring c
+
+-- | Pops open a prompt with window titles. Choose one, and you will be
+-- taken to the corresponding workspace.
+doPrompt :: WindowPrompt -> XPConfig -> X ()
+doPrompt t c = do
+  a <- case t of
+         Goto  -> return . gotoAction  =<< windowMapWith (W.tag . fst)                     
+         Bring -> return . bringAction =<< windowMapWith snd
+  wm <- windowMapWith id
+  mkXPrompt t c (compList wm) a
+
+    where
+
+      winAction a m    = flip whenJust (windows . a) . flip M.lookup m . unescape   
+      gotoAction       = winAction W.greedyView
+      bringAction      = winAction bringWindow
+      bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
+
+      compList m s = return . filter (isPrefixOf s) . map (escape . fst) . M.toList $ m
+
+      escape []       = []
+      escape (' ':xs) = "\\ " ++ escape xs
+      escape (x  :xs) = x : escape xs
+
+      unescape []            = []
+      unescape ('\\':' ':xs) = ' ' : unescape xs
+      unescape (x:xs)        = x   : unescape xs
diff --git a/XMonad/Prompt/Workspace.hs b/XMonad/Prompt/Workspace.hs
new file mode 100644
index 0000000..c05ead0
--- /dev/null
+++ b/XMonad/Prompt/Workspace.hs
@@ -0,0 +1,45 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Workspace
+-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy
+-- License     :  BSD3
+-- 
+-- Maintainer  :  droundy@darcs.net
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A directory prompt for XMonad
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Workspace (
+                             -- * Usage
+                             -- $usage
+                             workspacePrompt
+                              ) where
+
+import Control.Monad.State ( gets )
+import Data.List ( sort )
+import XMonad hiding ( workspaces )
+import XMonad.Prompt
+import XMonad.StackSet ( workspaces, tag )
+
+-- $usage
+-- You can use this module with the following in your Config.hs file:
+-- 
+-- > import XMonad.Prompt.WorkspacePrompt
+--
+-- >   , ((modMask .|. shiftMask, xK_m     ), workspacePrompt myXPConfig (windows . W.shift))
+
+data Wor = Wor String
+
+instance XPrompt Wor where
+    showXPrompt (Wor x) = x
+
+workspacePrompt :: XPConfig -> (String -> X ()) -> X ()
+workspacePrompt c job = do ws <- gets (workspaces . windowset)
+                           let ts = sort $ map tag ws
+                           mkXPrompt (Wor "") c (mkCompl ts) job
+
+mkCompl :: [String] -> String -> IO [String]
+mkCompl l s = return $ filter (\x -> take (length s) x == s) l
diff --git a/XMonad/Prompt/XMonad.hs b/XMonad/Prompt/XMonad.hs
new file mode 100644
index 0000000..5effbe4
--- /dev/null
+++ b/XMonad/Prompt/XMonad.hs
@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.XMonad
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+-- 
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A prompt for running XMonad commands
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.XMonad (
+                             -- * Usage
+                             -- $usage
+                             xmonadPrompt,
+                             xmonadPromptC
+                              ) where
+
+import XMonad
+import XMonad.Prompt
+import XMonad.Actions.Commands (defaultCommands, runCommand')
+
+-- $usage
+--
+-- in Config.hs add:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.XMonad
+--
+-- in you keybindings add:
+--
+-- >   , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig)
+--
+
+-- %import XMonad.Prompt
+-- %import XMonad.Prompt.XMonad
+-- %keybind , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig)
+
+data XMonad = XMonad
+
+instance XPrompt XMonad where
+    showXPrompt XMonad = "XMonad: "
+
+xmonadPrompt :: XPConfig -> X ()
+xmonadPrompt c = do
+    cmds <- defaultCommands
+    mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand'
+
+-- xmonad prompt with custom command list
+xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()
+xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand'