gsmenu 2.0 → 2.1
raw patch · 6 files changed
+38/−39 lines, 6 filessetup-changed
Files
- GSMenu/Pick.hs +27/−19
- LICENSE +1/−1
- Main.hs +4/−13
- Setup.hs +1/−1
- gsmenu.1 +4/−4
- gsmenu.cabal +1/−1
GSMenu/Pick.hs view
@@ -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
LICENSE view
@@ -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
Main.hs view
@@ -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"
Setup.hs view
@@ -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")
@@ -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
@@ -1,5 +1,5 @@ name: gsmenu-version: 2.0+version: 2.1 homepage: http://sigkill.dk/programs/gsmenu synopsis: A visual generic menu description: