gsmenu 1.1 → 2.0
raw patch · 5 files changed
+109/−153 lines, 5 filesdep +getflag
Dependencies added: getflag
Files
- GSMenu/Pick.hs +34/−46
- Main.hs +53/−82
- gsmenu.1 +17/−20
- gsmenu.cabal +4/−4
- gsmenu_path +1/−1
GSMenu/Pick.hs view
@@ -30,6 +30,8 @@ , pop ) where +import Codec.Binary.UTF8.String (decodeString)+ import Data.Maybe import Data.Bits import Data.Char@@ -71,7 +73,7 @@ , el_tags :: [String] } -type TwoDElement a = (TwoDPosition, Element (TwoD a (Maybe a)))+type TwoDElement a = (TwoDPosition, Element a) type TwoDElementMap a = [TwoDElement a] data ElemPane = ElemPane {@@ -119,7 +121,6 @@ data FilterState a = FilterState { fl_filter :: Filter- , fl_elmap :: TwoDElementMap a , fl_elms :: [Element a] } @@ -162,16 +163,7 @@ return $ fromMaybe allelms $ fl_elms <$> listToMaybe (td_filters s) elementMap :: TwoD a (TwoDElementMap a)-elementMap = do- s <- get- elmap <- asks td_elmap- return $ fromMaybe elmap $ fl_elmap <$> listToMaybe (td_filters s)--elementGrid :: [Element a] -> TwoD a (TwoDElementMap a)-elementGrid elms = flip zip (map select elms) <$> asks td_scaffold- -select :: Element a -> Element (TwoD a (Maybe a))-select elm = elm { el_data = return $ Just $ el_data elm }+elementMap = liftM2 zip (asks td_scaffold) elements diamondLayer :: (Enum b', Num b') => b' -> [(b', b')] diamondLayer 0 = [(0,0)]@@ -192,6 +184,9 @@ findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) +textHeight :: GSMenuFont -> String -> IO Dimension+textHeight font = liftM (fi . uncurry (+)) . textExtentsXMF font+ shrinkWhile :: Monad m => ([a] -> [[a]]) -> ([a] -> m Bool) -> [a] -> m [a]@@ -203,8 +198,11 @@ then sw ns else return n -textHeight :: GSMenuFont -> String -> IO Dimension-textHeight font = liftM (fi . uncurry (+)) . textExtentsXMF font+stopText :: Display -> GSMenuFont -> Dimension -> String -> IO String+stopText dpy f mw =+ shrinkWhile (reverse . inits)+ (\n -> do size <- textWidthXMF dpy f n+ return $ size > fi mw) drawWinBox :: Window -> (String, String) -> String -> [String]@@ -225,22 +223,18 @@ (sheight, subs') = fromMaybe (0, []) $ find ((<=room) . fst) (zip sheights $ reverse $ inits sub)- stext f = shrinkWhile (reverse . inits)- (\n -> do size <- textWidthXMF dpy f n- return $ size > fi (cw-fi (2*cp)))- x' = fi (x+fi cp)- y' = fi (y+(fi ch-fi sheight-fi theight) `div` 2)- putline f voff (h, s) = do- s' <- stext f s- printStringXMF dpy win f (ep_textgc ep) fg bg x' (voff+fi h) s'- return h- _ <- putline font y' (theight, text)- foldM_ (putline subfont) (y'+fi theight) $ zip (map fi sheights) subs'+ 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+ 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 = do- setForeground dpy gc 1+drawBoxMask dpy gc pm x y w h = fillRectangle dpy pm gc x y w h getGC :: Drawable -> String -> TwoD a GC@@ -339,11 +333,9 @@ pushFilter :: Filter -> TwoD a () pushFilter f = do elms' <- apply f <$> elements- elmap <- elementGrid elms' modify $ \s -> s { td_filters = FilterState { fl_filter = f- , fl_elms = elms'- , fl_elmap = elmap } : td_filters s }+ , fl_elms = elms' } : td_filters s } popFilter :: TwoD a () popFilter =@@ -473,9 +465,14 @@ (ks,s) <- if ev_event_type ev == keyPress then lookupString $ asKeyEvent e else return (Nothing, "")- return (ks,s,ev)+ return (ks,decodeString s,ev) -- XXX, relies on s being UTF-8 encoded. handle (fromMaybe xK_VoidSymbol keysym,string) event +selectAt :: TwoDPosition -> TwoD a (Maybe a)+selectAt pos =+ lookup pos <$> elementMap >>=+ maybe eventLoop (return . Just . el_data)+ cleanMask :: KeyMask -> KeyMask cleanMask km = complement (numLockMask .|. lockMask) .&. km@@ -485,12 +482,8 @@ 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_Return = do- pos <- gets td_curpos- elmap <- elementMap- case lookup pos elmap of- Nothing -> eventLoop- Just elm -> maybe eventLoop (return . Just) =<< el_data elm+ | t == keyPress && ks == xK_Return =+ selectAt =<< gets td_curpos | t == keyPress = do keymap <- asks (gp_keymap . td_gpconfig) fromMaybe unbound $ M.lookup (m',ks) keymap@@ -501,17 +494,13 @@ handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) | t == buttonRelease = do- elmap <- elementMap ch <- asks (gp_cellheight . td_gpconfig) 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- case lookup (gridX,gridY) elmap of- Nothing -> eventLoop- Just elm ->- maybe eventLoop (return . Just) =<< el_data elm+ selectAt (gridX, gridY) | otherwise = eventLoop handle _ (ExposeEvent { ev_count = 0 }) = redrawAllElements >> eventLoop@@ -633,11 +622,10 @@ let restriction ss cs = (ss/fi (cs gpconfig)-1)/2 :: Double restrictX = floor $ restriction (fi rwidth) gp_cellwidth restrictY = floor $ restriction (fi rheight) gp_cellheight- originPosX = floor $ (gp_originFractX gpconfig - (1/2)) * 2 * fromIntegral restrictX- originPosY = floor $ (gp_originFractY gpconfig - (1/2)) * 2 * fromIntegral restrictY+ originPosX = floor $ (gp_originFractX gpconfig - (1/2)) * 2 * fi restrictX+ originPosY = floor $ (gp_originFractY gpconfig - (1/2)) * 2 * fi restrictY coords = diamondRestrict restrictX restrictY originPosX originPosY- boxelms = map select ellist- elmap = zip coords boxelms+ elmap = zip coords ellist (selectedElement, s) <- runTwoD (do updateTextInput redrawAllElements eventLoop)
Main.hs view
@@ -24,7 +24,7 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping) import Graphics.X11.Xinerama -import System.Console.GetOpt+import System.Console.GetFlag import System.Environment import System.Exit import System.IO@@ -124,12 +124,6 @@ type GSMenuOption a = OptDescr (AppConfig a -> IO (AppConfig a)) -options :: [GSMenuOption a]-options = [optHelp, optVersion, optDisplay, optComplex, optEnumResult,- optFont, optSubFont, optInputFont,- optCellHeight, optCellWidth, optCellPadding,- optOriginX, optOriginY]- inGPConfig :: (String -> GPConfig a -> GPConfig a) -> String -> AppConfig a -> IO (AppConfig a) inGPConfig f arg cfg = return $ cfg { cfg_gpconfig = f arg (cfg_gpconfig cfg) }@@ -145,87 +139,64 @@ readFloat :: (Fractional a, Read a) => String -> a readFloat = tryRead $ (++ " is not a decimal fraction.") . quote -optHelp :: GSMenuOption a-optHelp = Option "h" ["help"]- (NoArg $ \_ -> do- hPutStrLn stderr =<< usageStr- exitSuccess)- "Display this help screen."- usageStr :: IO String usageStr = do prog <- getProgName- let header = "Help for " ++ prog ++ " " ++ versionString+ let header = "Help for " ++ prog ++ " " ++ versionStr return $ usageInfo header options- -optVersion :: GSMenuOption a-optVersion = Option "v" ["version"]- (NoArg $ \_ -> do - hPutStrLn stderr ("gsmenu " ++ versionString ++ ".")- hPutStrLn stderr "Copyright (C) Troels Henriksen."- exitSuccess)- "Print version number."- -versionString :: String-versionString = "1.1"- -optDisplay :: GSMenuOption a-optDisplay = Option "d" ["display"]- (ReqArg (\arg cfg -> return $ cfg { cfg_display = arg }) "dpy" )- "Specify the X display to connect to."- -optComplex :: GSMenuOption a-optComplex = Option "c" ["complex"]- (NoArg (\cfg -> return $ cfg { cfg_complex = True }) )- "Use complex input format." -optEnumResult :: GSMenuOption a-optEnumResult = Option "e" ["enumerate"]- (NoArg (\cfg -> return $ cfg { cfg_enumerate = True }) )- "Print the result as the (zero-indexed) element number."--optCellHeight :: GSMenuOption a-optCellHeight = Option [] ["cellheight"]- (ReqArg (inGPConfig $ \arg gpc ->- gpc { gp_cellheight = readInt arg }) "height")- "The height of each element cell"--optCellWidth :: GSMenuOption a-optCellWidth = Option [] ["cellwidth"]- (ReqArg (inGPConfig $ \arg gpc ->- gpc { gp_cellwidth = readInt arg }) "width")- "The width of each element cell"--optCellPadding :: GSMenuOption a-optCellPadding = Option [] ["cellpadding"]- (ReqArg (inGPConfig $ \arg gpc ->- gpc { gp_cellpadding = readInt arg }) "padding")- "The inner padding of each element cell."--optFont :: GSMenuOption a-optFont = Option [] ["font"]- (ReqArg (inGPConfig $ \arg gpc -> gpc { gp_font = arg }) "font")- "The font used for printing names of elements."--optSubFont :: GSMenuOption a-optSubFont = Option [] ["subfont"]- (ReqArg (inGPConfig $ \arg gpc -> gpc { gp_subfont = arg}) "font")- "The font used for printing extra lines in elements."--optInputFont :: GSMenuOption a-optInputFont = Option [] ["inputfont"]- (ReqArg (inGPConfig $ \arg gpc -> gpc { gp_inputfont = arg}) "font")- "The font used for the input field."+versionStr :: String+versionStr = "2.0" -optOriginX :: GSMenuOption a-optOriginX = Option "x" []- (ReqArg (inGPConfig $ \arg gpc -> gpc { gp_originFractX = readFloat arg }) "float")- "The horizontal center of the grid, range [0,1]."- -optOriginY :: GSMenuOption a-optOriginY = Option "y" []- (ReqArg (inGPConfig $ \arg gpc -> gpc { gp_originFractY = readFloat arg }) "float")- "The vertical center of the grid, range [0,1]"+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"+ (NoArg (\cfg -> return $ cfg { cfg_complex = True }))+ "Use complex input format."+ , Option "e"+ (NoArg (\cfg -> return $ cfg { cfg_enumerate = True }))+ "Print the result as the (zero-indexed) element number."+ , Option "cellheight"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_cellheight = readInt arg }) "height")+ "The height of each element cell"+ , Option "cellwidth"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_cellwidth = readInt arg }) "width")+ "The width of each element cell"+ , Option "cellpadding"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_cellpadding = readInt arg }) "padding")+ "The inner padding of each element cell."+ , Option "font"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_font = arg }) "font")+ "The font used for printing names of elements."+ , Option "subfont"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_subfont = arg}) "font")+ "The font used for printing extra lines in elements."+ , Option "inputfont"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_inputfont = arg}) "font")+ "The font used for the input field."+ , Option "x"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_originFractX = readFloat arg }) "float")+ "The horizontal center of the grid, range [0,1]."+ , Option "y"+ (ReqArg (inGPConfig $ \arg gpc ->+ gpc { gp_originFractY = readFloat arg }) "float")+ "The vertical center of the grid, range [0,1]"+ ] parseElements :: SourceName -> String -> Either ParseError [Element a] parseElements = parse $ many element <* eof
@@ -1,32 +1,29 @@-.TH GSMENU 1 gsmenu\-1.1+.TH GSMENU 1 gsmenu\-2.0 .SH NAME gsmenu \- grid menu .SH SYNOPSIS .nh gsmenu-[\fB\-d=\fIdisplay\fR] [\fB\-c\fR] [\fB\-e\fR]-[\fB\-\-cellheight \fIheight\fR]-[\fB\-\-cellwidth \fIwidth\fR\fR]-[\fB\-\-cellpadding \fIpadding\fR]+[\fB\-cellheight \fIheight\fR]+[\fB\-cellwidth \fIwidth\fR\fR]+[\fB\-cellpadding \fIpadding\fR] [\fB\-x \fIposition\fR] [\fB\-y \fIposition\fR]-[\fB\-\-font=\fIfont\fR]-[\fB\-\-subfont=\fIfont\fR]-[\fB\-\-inputfont=\fIfont\fR]+[\fB\-font \fIfont\fR]+[\fB\-subfont \fIfont\fR]+[\fB\-inputfont \fIfont\fR] [\fB\-h\fR] [\fB\-v\fR] .SH DESCRIPTION .SS Overview gsmenu is a generic grid menu for X11, originally a port of the GridSelect contrib for XMonad. It displays elements as a grid of-rectangular cells.+rectangular cells. gsmenu always contacts the display indicated in+the DISPLAY environment variable. .SS Options .TP-.B \-d-specifies the X server to contact.-.TP .B \-c makes gsmenu accept complex input format (see below). .TP@@ -34,13 +31,13 @@ print the selected item as an index into the (0-indexed) sequence of input elements. .TP-.B \-\-cellheight+.B \-cellheight The height of each cell in pixels. .TP-.B \-\-cellwidth+.B \-cellwidth The width of each cell in pixels. .TP-.B \-\-cellpadding+.B \-cellpadding The inner text padding of each cell in pixels. .TP .B \-x@@ -50,16 +47,16 @@ .B \-y As \fB\-x\fR, but sets the vertical position. .TP-.B \-\-font+.B \-font The first line of elements is printed in this font. Both traditional X11-font-strings and XFT-fonts are accepted, the latter when prefixed with "xft:" (for example "xft:URW Bookman L-10"). .TP-.B \-\-subfont-As \-\-font, but used for secondary lines of elements.+.B \-subfont+As \-font, but used for secondary lines of elements. .TP-.B \-\-inputfont-As \-\-font, but affects the user input text field.+.B \-inputfont+As \-font, but affects the user input text field. .TP .B \-h prints command option summary to standard output, then exits.
@@ -1,6 +1,6 @@ name: gsmenu-version: 1.1-homepage: http://sigkill.dk+version: 2.0+homepage: http://sigkill.dk/programs/gsmenu synopsis: A visual generic menu description: Standalone port of XMonadContrib's GridSelect.@@ -16,10 +16,10 @@ description: Use Xft to render text executable gsmenu- build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, mtl, base==4.*, containers, parsec==3.*+ build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, mtl, base==4.*, containers, parsec==3.*, getflag, utf8-string if flag(use_xft)- build-depends: X11-xft >= 0.2, utf8-string+ build-depends: X11-xft >= 0.2 extensions: ForeignFunctionInterface cpp-options: -DXFT main-is: Main.hs
@@ -27,7 +27,7 @@ cd "$dir" && for file in * do- test -x "$file" && echo "name=\"$file\" $tags"+ test -x "$file" && echo "name=\"$(echo $file|sed 's/"/""/g')\" \"$dir\" $tags" done done | sort | uniq > "$CACHE".$$ && mv "$CACHE".$$ "$CACHE"