diff --git a/GSMenu/Pick.hs b/GSMenu/Pick.hs --- a/GSMenu/Pick.hs +++ b/GSMenu/Pick.hs @@ -32,6 +32,8 @@ import Codec.Binary.UTF8.String (decodeString) +import Control.Concurrent + import Data.Maybe import Data.Bits import Data.Char @@ -226,17 +228,12 @@ x' = fi (x+fi cp) :: Position y' = y+(fi ch-fi sheight-fi theight) `div` 2 + fi theight :: Position ys = scanl1 (+) $ map ((+y') . fi) sheights - putline f voff s = do + putline f voff s = stopText dpy f (cw-fi (2*cp)) s >>= printStringXMF dpy win f (ep_textgc ep) fg bg x' voff _ <- putline font y' text zipWithM_ (putline subfont) ys subs' -drawBoxMask :: Display -> GC -> Pixmap -> Position - -> Position -> Dimension -> Dimension -> IO () -drawBoxMask dpy gc pm x y w h = - fillRectangle dpy pm gc x y w h - getGC :: Drawable -> String -> TwoD a GC getGC d fg = do dpy <- asks td_display @@ -276,7 +273,7 @@ , ep_maskgc = maskgc , ep_unmaskgc = unmaskgc } <- asks td_elempane io $ fillRectangle dpy pm maskgc 0 0 pw ph - let drawbox _ x y w h = io $ drawBoxMask dpy unmaskgc pm x y (w+1) (h+1) + let drawbox _ x y w h = io $ fillRectangle dpy pm unmaskgc x y (w+1) (h+1) updatingBoxes drawbox els io $ xshapeCombineMask dpy win shapeBounding 0 0 pm shapeSet redrawElements els @@ -387,13 +384,12 @@ move :: TwoDPosition -> TwoD a () move (dx, dy) = do - state <- get - elmap <- elementMap - let (ox, oy) = td_curpos state - newPos = (ox+dx, oy+dy) + (ox, oy) <- gets td_curpos + elmap <- elementMap + let newPos = (ox+dx, oy+dy) newSelectedEl = findInElementMap newPos elmap when (isJust newSelectedEl) $ do - put state { td_curpos = newPos } + modify $ \s -> s { td_curpos = newPos } redrawElements (catMaybes [ findInElementMap (ox, oy) elmap , newSelectedEl]) @@ -481,7 +477,9 @@ handle :: (KeySym, String) -> Event -> TwoD a (Maybe a) handle (ks,s) (KeyEvent {ev_event_type = t, ev_state = m }) - | t == keyPress && ks == xK_Escape = return Nothing + | t == keyPress && + (ks == xK_Escape || (m' == controlMask && elem ks [xK_g, xK_c])) + = return Nothing | t == keyPress && ks == xK_Return = selectAt =<< gets td_curpos | t == keyPress = do @@ -498,8 +496,8 @@ cw <- asks (gp_cellwidth . td_gpconfig) w <- asks (ep_width . td_elempane) h <- asks (ep_height . td_elempane) - let gridX = fi $ (fi x - (w - cw) `div` 2) `div` cw - gridY = fi $ (fi y - (h - ch) `div` 2) `div` ch + let gridX = (fi x - (fi w - fi cw) `div` 2) `div` fi cw + gridY = (fi y - (fi h - fi ch) `div` 2) `div` fi ch selectAt (gridX, gridY) | otherwise = eventLoop @@ -602,6 +600,17 @@ mapM_ (freeGC dpy) [bggc, fgc] sync dpy False +grabInput :: Display -> Window -> IO GrabStatus +grabInput dpy win = do + grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none + grab (1000 :: Int) + where grab 0 = return alreadyGrabbed + grab n = do status <- grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime + if status /= grabSuccess + then threadDelay 1000 >> grab (n-1) + else return status + + -- | Brings up a 2D grid of elements in the center of the screen, and one can -- select an element with cursors keys. The selected element is returned. gpick :: Display -> Screen -> Rectangle -> GPConfig a @@ -613,10 +622,9 @@ ep@ElemPane { ep_win = win } <- mkElemPane dpy screen rect $ gp_bordercolor gpconfig tp <- mkTextPane dpy screen rect gpconfig - status <- grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime - grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none - font <- initXMF dpy (gp_font gpconfig) - subfont <- initXMF dpy (gp_subfont gpconfig) + status <- grabInput dpy win + font <- initXMF dpy (gp_font gpconfig) + subfont <- initXMF dpy (gp_subfont gpconfig) if status /= grabSuccess then return $ Left "Could not establish keyboard grab" else do let restriction ss cs = (ss/fi (cs gpconfig)-1)/2 :: Double diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2010 Troels Henriksen +Copyright (c) 2010-2011 Troels Henriksen Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -11,7 +11,7 @@ -- ----------------------------------------------------------------------------- -module Main () where +module Main (main) where import Control.Applicative import Control.Monad @@ -63,7 +63,7 @@ (_, nonopts, errs) -> do mapM_ (hPutStrLn stderr . ("Junk argument: " ++)) nonopts usage <- usageStr - hPutStrLn stderr $ concat errs ++ usage + hPutStr stderr $ concat errs ++ usage exitFailure runWithCfg :: AppConfig String -> IO () @@ -146,19 +146,10 @@ return $ usageInfo header options versionStr :: String -versionStr = "2.0" +versionStr = "2.1-dev" options :: [GSMenuOption a] -options = [ Option "h" (NoArg $ \_ -> do - hPutStrLn stderr =<< usageStr - exitSuccess) - "Display this help screen." - , Option "v" (NoArg $ \_ -> do - hPutStrLn stderr ("gsmenu " ++ versionStr ++ ".") - hPutStrLn stderr "Copyright (C) Troels Henriksen." - exitSuccess) - "Print version number." - , Option "c" +options = [ Option "c" (NoArg (\cfg -> return $ cfg { cfg_complex = True })) "Use complex input format." , Option "e" diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -54,5 +54,5 @@ fs <- getFileStatus (bin "gsmenu") setFileMode (bin "gsmenu_path") $ fileMode fs putStrLn $ "Installing manpage in " ++ mandir dirs - createDirectoryIfMissing True $ mandir dirs + createDirectoryIfMissing True $ mandir dirs `combine` "man1" copyFileVerbose v ("gsmenu.1") (mandir dirs `combine` "man1" `combine` "gsmenu.1") diff --git a/gsmenu.1 b/gsmenu.1 --- a/gsmenu.1 +++ b/gsmenu.1 @@ -1,4 +1,4 @@ -.TH GSMENU 1 gsmenu\-2.0 +.TH GSMENU 1 gsmenu\-2.1 .SH NAME gsmenu \- grid menu .SH SYNOPSIS @@ -133,7 +133,7 @@ .TP .B CTRL\-o Solidify the current input as an inverse filter, meaning that only -nonmatches will pass +nonmatches will pass. .TP .B CTRL\-a Set focus to the leftmost element in the row. @@ -150,8 +150,8 @@ .B CTRL\-w Remove the topmost filter, if any. .TP -.B Escape -Cancel selection and exit gsmenu +.B Escape, CTRL\-c, CTRL\-g +Cancel selection and exit gsmenu. .SH EXIT STATUS gsmenu returns a .B 0 diff --git a/gsmenu.cabal b/gsmenu.cabal --- a/gsmenu.cabal +++ b/gsmenu.cabal @@ -1,5 +1,5 @@ name: gsmenu -version: 2.0 +version: 2.1 homepage: http://sigkill.dk/programs/gsmenu synopsis: A visual generic menu description: