From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- XMonad/Prompt/Directory.hs | 43 +++++++++++++++ XMonad/Prompt/Man.hs | 107 ++++++++++++++++++++++++++++++++++++++ XMonad/Prompt/Shell.hs | 127 +++++++++++++++++++++++++++++++++++++++++++++ XMonad/Prompt/Ssh.hs | 104 +++++++++++++++++++++++++++++++++++++ XMonad/Prompt/Window.hs | 89 +++++++++++++++++++++++++++++++ XMonad/Prompt/Workspace.hs | 45 ++++++++++++++++ XMonad/Prompt/XMonad.hs | 54 +++++++++++++++++++ 7 files changed, 569 insertions(+) create mode 100644 XMonad/Prompt/Directory.hs create mode 100644 XMonad/Prompt/Man.hs create mode 100644 XMonad/Prompt/Shell.hs create mode 100644 XMonad/Prompt/Ssh.hs create mode 100644 XMonad/Prompt/Window.hs create mode 100644 XMonad/Prompt/Workspace.hs create mode 100644 XMonad/Prompt/XMonad.hs (limited to 'XMonad/Prompt') 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 +-- Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Andrea Rossato +-- 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' -- cgit v1.2.3