gsmenu 3.0 → 3.1
raw patch · 6 files changed
+100/−337 lines, 6 filesdep ~X11dep ~parsecdep ~sindresetup-changed
Dependency ranges changed: X11, parsec, sindre
Files
- Main.hs +93/−99
- README +0/−26
- Setup.hs +0/−58
- gsmenu.1 +0/−110
- gsmenu.cabal +7/−8
- gsmenu_path +0/−36
Main.hs view
@@ -28,7 +28,6 @@ textExtents) import qualified Graphics.X11.Xft as Xft -import Control.Applicative import Control.Monad import Control.Monad.Reader import Control.Monad.State.Lazy@@ -37,7 +36,6 @@ import Data.List import Data.Maybe import Data.Ord (comparing)-import Data.Traversable (traverse) import Data.Word (Word8) import qualified Data.Map as M import qualified Data.Text as T@@ -61,10 +59,10 @@ , "<Left> || <C-b> { grid.west(); next }" , "<Up> || <C-p> { grid.north(); next }" , "<Down> || <C-n> { grid.south(); next }"- , "<Return> { foo = grid.selected; print foo[\"value\"]; exit }"+ , "<Return> { if (grid.selected) { print grid.selected [\"value\"] }; exit }" , "<C-s> { grid.next(); next }" , "<C-r> { grid.prev(); next }"- , "BEGIN { foo = grid.selected; if (foo) { label.label = foo[\"name\"] } }"+ , "BEGIN { if (grid.selected) { label.label = grid.selected[\"name\"] } }" , "grid.selected->changed(from, to) { if (to) { label.label = to[\"name\"] } }" ] classMap' = M.insert "Grid" mkGrid classMap @@ -78,26 +76,36 @@ instance Show Element where show = show . elementName +instance Mold Element where+ mold = const Nothing+ unmold e = Dict $ M.fromList+ [ (unmold "name", unmold $ elementName e)+ , (unmold "subnames", dict $ elementSubnames e)+ , (unmold "tags", dict $ elementTags e)+ , (unmold "value", unmold $ elementValue e)]+ where dict = Dict . M.fromList . zip (map Number [0..]) . map unmold+ data DisplayedElement = DisplayedElement { displayedName :: String , displayedSubnames :: [String] , displayedElement :: Element } deriving (Show) -match :: T.Text -> Element -> Bool-match f e = (T.toCaseFold f `T.isInfixOf`) `any`- map T.toCaseFold (elementName e : elementSubnames e ++ elementTags e)+matchEl :: T.Text -> Element -> Bool+matchEl pat e = matchEl' `all` T.words (T.toCaseFold pat)+ where es = map T.toCaseFold (elementName e : elementSubnames e ++ elementTags e)+ matchEl' w = (isJust . match w) `any` es type TwoDPos = (Integer, Integer) type TwoDElement = (TwoDPos, DisplayedElement) -diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]+diamondLayer :: Integral a => a -> [(a, a)] diamondLayer 0 = [(0,0)] diamondLayer n = concat [ zip [0..] [n,n-1..1] , zip [n,n-1..1] [0,-1..] , zip [0,-1..] [-n..(-1)] , zip [-n..(-1)] [0,1..] ] -diamond :: (Enum a, Num a) => [(a, a)]+diamond :: Integral a => [(a, a)] diamond = concatMap diamondLayer [0..] diamondRestrict :: Integer -> Integer -> [TwoDPos]@@ -149,16 +157,9 @@ , gridRect :: Rectangle } -selection :: Grid -> Value-selection g = maybe falsity (asDict . displayedElement)- $ M.lookup (position grid) $ elements grid+selection :: Grid -> Maybe Element+selection g = liftM displayedElement $ M.lookup (position grid) $ elements grid where grid = gridElementMap g- asDict e = Dict $ M.fromList- [ (unmold "name", unmold $ elementName e)- , (unmold "subnames", dict $ elementSubnames e)- , (unmold "tags", dict $ elementTags e)- , (unmold "value", unmold $ elementValue e)]- dict = Dict . M.fromList . zip (map Number [0..]) . map unmold gridBox :: Drawer -> Element -> SindreX11M DisplayedElement gridBox d e@Element { elementName = text, elementSubnames = subs } = do@@ -193,8 +194,8 @@ then sw ns else return n -recomputeMap :: Drawer -> ObjectM Grid SindreX11M ()-recomputeMap d = do+recomputeMap :: X11Field Grid (Maybe Element) -> Drawer -> ObjectM Grid SindreX11M ()+recomputeMap sel d = changingField sel $ do Rectangle _ _ rwidth rheight <- gets gridRect oldpos <- gets $ position . gridElementMap let restriction ss cs = (ss/cs-1)/2 :: Double@@ -202,33 +203,29 @@ restrictY = floor $ restriction (fi rheight) cellHeight coords = diamondRestrict restrictX restrictY buildGrid = traverse (back . gridBox d) . M.fromList . zip coords- oldsel <- gets selection elmap <- buildGrid =<< gets gridSelElems let grid = gridFromMap elmap (0,0) modify $ \s -> s { gridElementMap = grid { position = bestpos oldpos $ map fst $ gridToList grid } }- newsel <- gets selection- when (oldsel /= newsel) $- changed "selected" oldsel newsel- where bestpos _ [] = (0,0)- bestpos oldpos l = minimumBy (closeTo oldpos) l- closeTo orig p1 p2 | dist orig p1 > dist orig p2 = GT- | dist orig p2 > dist orig p1 = LT- | otherwise = comparing (dist (0,0)) p1 p2- dist (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2)+ where bestpos _ [] = (0,0)+ bestpos oldpos l = minimumBy (closeTo oldpos) l+ closeTo orig p1 p2 | dist orig p1 > dist orig p2 = GT+ | dist orig p2 > dist orig p1 = LT+ | otherwise = comparing (dist (0,0)) p1 p2+ dist (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2) needRecompute :: ObjectM Grid SindreX11M () needRecompute = do modify $ \s -> s { gridRect = Rectangle 0 0 0 0 } fullRedraw -updateRect :: Rectangle -> Drawer -> ObjectM Grid SindreX11M ()-updateRect r1 d = do r2 <- gets gridRect- unless (r1 == r2) $ do- modify $ \s -> s { gridRect = r1 }- recomputeMap d+updateRect :: X11Field Grid (Maybe Element) -> Rectangle -> Drawer -> ObjectM Grid SindreX11M ()+updateRect sel r1 d = do r2 <- gets gridRect+ unless (r1 == r2) $ do+ modify $ \s -> s { gridRect = r1 }+ recomputeMap sel d methInsert :: T.Text -> ObjectM Grid SindreX11M () methInsert vs = case partitionEithers $ parser vs of@@ -238,7 +235,7 @@ modify $ \s -> s { gridElems = gridElems s ++ els' , gridSelElems = gridSelElems s ++- filter (match $ gridFilter s) els' }+ filter (matchEl $ gridFilter s) els' } needRecompute where parser = map parseElement . T.lines @@ -259,21 +256,20 @@ , gridElems = [] , gridSelElems = [] } -methFilter :: T.Text -> ObjectM Grid SindreX11M ()-methFilter f = do changeFields [("selected", unmold . selection)] $ \s ->- return s { gridSelElems = filter (match f) $ gridElems s }- needRecompute+methFilter :: X11Field Grid (Maybe Element) -> T.Text -> ObjectM Grid SindreX11M ()+methFilter sel f = changingField sel $ do+ modify $ \s -> s { gridSelElems = filter (matchEl f) $ gridElems s }+ needRecompute -methNext :: ObjectM Grid SindreX11M ()-methPrev :: ObjectM Grid SindreX11M ()+methNext :: X11Field Grid (Maybe Element) -> ObjectM Grid SindreX11M ()+methPrev :: X11Field Grid (Maybe Element) -> ObjectM Grid SindreX11M () (methNext, methPrev) = (circle next, circle prev)- where circle f = do changeFields [("selected", unmold . selection)] $ \s ->- case gridElementMap s of- elems@ElementGrid{position=(x,y)} ->- return s { gridElementMap =- fromMaybe elems $ f x y elems- }- redraw+ where circle f sel = changingField sel $ do+ elems@ElementGrid{position=(x,y)} <- gets gridElementMap+ modify $ \s -> s { gridElementMap =+ fromMaybe elems $ f x y elems+ }+ redraw next (-1) y | y >= 0 = south <=< south <=< east next x y = case (compare x 0, compare y 0) of (EQ, EQ) -> south@@ -295,45 +291,56 @@ (GT, LT) -> east <=< south (GT, _) -> south <=< west -move :: (ElementGrid -> Maybe ElementGrid) -> ObjectM Grid SindreX11M ()-move d = do changeFields [("selected", unmold . selection)] $ \s ->- return s { gridElementMap = fromMaybe (gridElementMap s)- $ d $ gridElementMap s- }- redraw+move :: X11Field Grid (Maybe Element)+ -> (ElementGrid -> Maybe ElementGrid) -> ObjectM Grid SindreX11M ()+move sel d = changingField sel $ do+ modify $ \s -> s { gridElementMap = fromMaybe (gridElementMap s)+ $ d $ gridElementMap s+ }+ redraw -instance Object SindreX11M Grid where- fieldSetI _ _ = return $ Number 0- fieldGetI "selected" = selection <$> get- fieldGetI "elements" = Dict <$> M.fromList <$>- zip (map Number [1..]) <$>- map (unmold . elementValue) <$> gridSelElems <$> get- fieldGetI _ = return $ Number 0- callMethodI "insert" = function methInsert- callMethodI "removeValue" = function methRemoveByValue- callMethodI "removeName" = function methRemoveByName- callMethodI "clear" = function methClear- callMethodI "filter" = function methFilter- callMethodI "next" = function methNext- callMethodI "prev" = function methPrev- callMethodI "north" = function $ move north- callMethodI "south" = function $ move south- callMethodI "west" = function $ move west- callMethodI "east" = function $ move east- callMethodI m = fail $ "Unknown method '" ++ m ++ "'"+mkGrid :: Constructor SindreX11M+mkGrid wn [] = do+ visual <- visualOpts wn+ let grid = Grid { gridElems = []+ , gridSelElems = []+ , gridFilter = T.empty+ , gridElementMap = emptyGrid+ , gridVisual = visual+ , gridRect = Rectangle 0 0 0 0+ }+ return $ newWidget grid methods [field sel, field elms]+ (const $ return ()) composeI (drawI visual)+ where methods = M.fromList+ [ ("insert", function methInsert)+ , ("removeValue", function methRemoveByValue)+ , ("removeName", function methRemoveByName)+ , ("clear", function methClear)+ , ("filter", function $ methFilter sel)+ , ("next", function $ methNext sel)+ , ("prev", function $ methPrev sel)+ , ("north", function $ move sel north)+ , ("south", function $ move sel south)+ , ("west", function $ move sel west)+ , ("east", function $ move sel east)]+ sel = ReadOnlyField "selected" $ gets selection+ elms = ReadOnlyField "elements" $+ Dict <$> M.fromList <$>+ zip (map Number [1..]) <$>+ map (unmold . elementValue) <$> gets gridSelElems+ composeI = return (Unlimited, Unlimited)+ drawI visual = drawing visual $ \r d fd -> do+ updateRect sel r d+ elems <- gets gridElementMap+ let update (p,e) x y cw ch = do+ d' <- io $ (`setBgColor` elementBg (displayedElement e)) <=<+ (`setFgColor` elementFg (displayedElement e)) $ d+ let drawbox | p == position elems = drawWinBox fd+ | otherwise = drawWinBox d'+ drawbox e x y cw ch+ back $ updatingBoxes update r elems+mkGrid _ _ = error "Grids do not have children" -instance Widget SindreX11M Grid where- composeI = return (Unlimited, Unlimited)- drawI = drawing gridVisual $ \r d fd -> do- updateRect r d- elems <- gets gridElementMap- let update (p,e) x y cw ch = do- d' <- io $ (`setBgColor` elementBg (displayedElement e)) <=<- (`setFgColor` elementFg (displayedElement e)) $ d- let drawbox | p == position elems = drawWinBox fd- | otherwise = drawWinBox d'- drawbox e x y cw ch- back $ updatingBoxes update r elems updatingBoxes :: (TwoDElement -> Position -> Position@@ -369,19 +376,6 @@ drawText (drawerFgColor d) (drawerFont d) x' voff theight _ <- putline y' $ displayedName e zipWithM_ putline ys subs--mkGrid :: Constructor SindreX11M-mkGrid r [] = do- visual <- visualOpts r- return $ NewWidget- Grid { gridElems = []- , gridSelElems = []- , gridFilter = T.empty- , gridElementMap = emptyGrid- , gridVisual = visual- , gridRect = Rectangle 0 0 0 0- }-mkGrid _ _ = error "Grids do not have children" parseElement :: T.Text -> Either String (SindreX11M Element) parseElement = parseKV textelement
− README
@@ -1,26 +0,0 @@-`gsmenu` - a generic visual menu-================================--`gsmenu` is a program that reads a list of entries from standard input-(one per line) and provides a visual, grid-based interface from which-the user can select one, with either mouse or keyboard. The manual-page contains full documentation.--Installation---------------Assuming a working Cabal install, just do 'cabal install'. Any-missing dependencies will automatically be downloaded and installed.-You may have to perform a 'cabal update' first to ensure that your-package list is up to date.--Inspiration--------------This program is mostly a port of the GridSelect contrib for XMonad by-Clemens Fruhwirth.--Bugs-------Please report any found bugs to the maintainer at <athas@sigkill.dk>.
− Setup.hs
@@ -1,58 +0,0 @@-#!/usr/bin/env runhaskell--import Distribution.Simple.Setup (CopyDest(..),ConfigFlags(..),BuildFlags(..),- CopyFlags(..),RegisterFlags(..),InstallFlags(..),- defaultRegisterFlags,fromFlagOrDefault,Flag(..),- defaultCopyFlags)-import Distribution.Simple-import Distribution.Simple.LocalBuildInfo- (LocalBuildInfo(..),absoluteInstallDirs)-import Distribution.Simple.Configure (configCompilerAux)-import Distribution.PackageDescription (PackageDescription(..))-import Distribution.Simple.InstallDirs- (InstallDirs(..))-import Distribution.Simple.Program - (Program(..),ConfiguredProgram(..),ProgramConfiguration(..),- ProgramLocation(..),simpleProgram,lookupProgram,- rawSystemProgramConf)-import Distribution.Simple.Utils-import Distribution.Verbosity-import Data.Char (isSpace, showLitChar)-import Data.List (isSuffixOf,isPrefixOf)-import Data.Maybe (listToMaybe,isJust)-import Data.Version-import Control.Monad (when,unless)-import Text.ParserCombinators.ReadP (readP_to_S)-import System.Exit-import System.IO (hGetContents,hClose,hPutStr,stderr)-import System.IO.Error (try)-import System.Process (runInteractiveProcess,waitForProcess)-import System.Posix-import System.Directory-import System.Info (os)-import System.FilePath--main = defaultMainWithHooks gsmenuHooks-gsmenuHooks = simpleUserHooks { postInst = gsmenuPostInst- , postCopy = gsmenuPostCopy }--gsmenu = "gsmenu"--isWindows :: Bool-isWindows = os == "mingw" -- XXX--gsmenuPostInst a (InstallFlags { installPackageDB = db, installVerbosity = v }) pd lbi =- do gsmenuPostCopy a (defaultCopyFlags { copyDest = Flag NoCopyDest, copyVerbosity = v }) pd lbi--gsmenuPostCopy a (CopyFlags { copyDest = cdf, copyVerbosity = vf }) pd lbi =- do let v = fromFlagOrDefault normal vf- cd = fromFlagOrDefault NoCopyDest cdf- dirs = absoluteInstallDirs pd lbi cd- bin = combine (bindir dirs)- when (not isWindows) $ do- copyFileVerbose v ("gsmenu_path") (bin "gsmenu_path")- fs <- getFileStatus (bin "gsmenu")- setFileMode (bin "gsmenu_path") $ fileMode fs- putStrLn $ "Installing manpage in " ++ mandir dirs- createDirectoryIfMissing True $ mandir dirs `combine` "man1"- copyFileVerbose v ("gsmenu.1") (mandir dirs `combine` "man1" `combine` "gsmenu.1")
@@ -1,110 +0,0 @@-.TH GSMENU 1 gsmenu\-4.0-.SH NAME-gsmenu \- grid menu-.SH SYNOPSIS-.nh-gsmenu-[Sindre options...]-.SH DESCRIPTION-.SS Overview-gsmenu is a generic grid menu for X11, originally a port of the-GridSelect contrib for XMonad. Now it is a program built on-Sindre. It displays elements as a grid of rectangular cells. gsmenu-always uses the display indicated in the DISPLAY environment variable.-.SS Options-No options are accepted apart from those provided by-.IR sindre (1).-.SH USAGE-gsmenu reads a list of newline-separated elements from standard input-and presents them in a grid. Each element has a foreground and a-background colour, as well as a name (what will be visible on the-screen) and a list of tags that are used only for filtering.-.SS INPUT FORMAT-The standard Sindre key-value format is used. Each line takes the-form of key-value pairs, with the key being a sequence of-alphanumerics, followed by an equals sign, followed by a value in-double quotes (double-quotes can be embedded by doubling-them). For example, an element might be--.nf-name="foo" bg="red"-.fi--And a list-value can be given by simply writing more double-quoted-strings (this also showcases double quote-escaping):--.nf-name="quote ""this"" please" tags="bar" "baz" bg="red"-.fi--The following keys are defined:-.TP-.B name-The string that will be displayed in the grid. The value can also be-a list, in which case each part of the list will be printed as a line-by itself (note that there will probably not be room for more than two-lines). Also, only the first line will count as the "name" as far as-selection output is concerned.-.TP-.B fg-The foreground (text) colour of the element (#RGB, #RRGGBB, and color-names are supported).-.TP-.B bg-The background colour of the element (#RGB, #RRGGBB, and color-names are supported).-.TP-.B tags-A list of tags of the element, used when filtering.-.TP-.B value-Instead of the name, print the value of this key when the element is-selected. If a list, a newline is printed after every element but the-last.-.SS INTERACTION-When the user moves focus to an element and presses Return, that-element is selected and is printed to standard output and gsmenu-terminates. Elements can also be selected by clicking on them with-the mouse. Additionally, the following keyboard commands are-recognised:-.TP-.B Any printable character-Appends the character to the text in the input field. This works as a filter:-only items containing this text (possibly in a tag) will be displayed.-.TP-.B Backspace-Remove the last character in the input field, or if empty, open the-topmost filter for editing.-.TP-.B Left/Right/Up/Down (CTRL\-b/CTRL-f/CTRL\-p/CTRL\-n)-Move focus in the grid.-.TP-.B CTRL\-a-Set focus to the leftmost element in the row.-.TP-.B CTRL\-e-Set focus to the rightmost element in the row.-.TP-.B CTRL\-s-Focus on the next element following a spiral path from the center.-.TP-.B CTRL\-r-Focus on the previous element following a spiral path from the center.-.TP-.B CTRL\-w-Remove the topmost filter, if any.-.TP-.B Escape, CTRL\-c, CTRL\-g-Cancel selection and exit gsmenu.-.SH EXIT STATUS-gsmenu returns a-.B 0-exit status on success,-.B 1-if there was an internal problem, and-.B 2-if the user cancelled.-.SH SEE ALSO-.IR sindre (1),-.IR dmenu (1),-.IR xmonad (1)
@@ -1,28 +1,27 @@+cabal-version: 2.4 name: gsmenu-version: 3.0+version: 3.1 homepage: http://sigkill.dk/programs/gsmenu synopsis: A visual generic menu description: Grid-oriented element selection inspired by XMonadContrib's GridSelect. category: Tools-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Troels Henriksen maintainer: athas@sigkill.dk-cabal-version: >= 1.6-build-type: Custom source-repository head type: git location: git@github.com:Athas/gsmenu.git executable gsmenu- build-depends: X11>=1.5.0.0 && < 1.6, mtl, base==4.*,- containers, parsec==3.*, sindre>=0.2, text, permute+ build-depends: X11>=1.5.0.0, mtl, base==4.*,+ containers, parsec>=3, sindre>=0.6, text, permute main-is: Main.hs ghc-options: -funbox-strict-fields -Wall - ghc-prof-options: -prof -auto-all -rtsopts- extensions: CPP+ ghc-prof-options: -rtsopts+ default-language: Haskell2010
@@ -1,36 +0,0 @@-#!/bin/sh-CACHE=$HOME/.gsmenu_cache-IFS=:--uptodate() {- test -f "$CACHE" &&- for dir in $PATH- do- test ! $dir -nt "$CACHE" || return 1- done-}--if ! uptodate-then- for dir in $PATH- do- tags=""- IFS=/- for part in $dir- do- tags="\"$part\" ${tags}"- done- if [ ${tags} != '' ]- then- tags="tags=$tags"- fi- cd "$dir" &&- for file in *- do- test -x "$file" && echo "name=\"$(echo $file|sed 's/"/""/g')\" \"$dir\" $tags"- done- done | sort | uniq > "$CACHE".$$ &&- mv "$CACHE".$$ "$CACHE"-fi--cat "$CACHE"