yi-frontend-pango-0.13.7/art/0000755000000000000000000000000013120261666014121 5ustar0000000000000000yi-frontend-pango-0.13.7/src/0000755000000000000000000000000013120261666014122 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/0000755000000000000000000000000013120261666014503 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/Config/0000755000000000000000000000000013120261666015710 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/Config/Default/0000755000000000000000000000000013120261666017274 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/Frontend/0000755000000000000000000000000013120261666016262 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/Frontend/Pango/0000755000000000000000000000000013120261666017326 5ustar0000000000000000yi-frontend-pango-0.13.7/src/Yi/Config/Default/Pango.hs0000644000000000000000000000042313120261666020673 0ustar0000000000000000module Yi.Config.Default.Pango (configurePango) where import Lens.Micro.Platform ((.=)) import Yi.Frontend.Pango (start) import Yi.Config.Lens (startFrontEndA) import Yi.Config.Simple (ConfigM) configurePango :: ConfigM () configurePango = startFrontEndA .= startyi-frontend-pango-0.13.7/src/Yi/Frontend/Pango.hs0000644000000000000000000010415313120261666017666 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Frontend.Pango -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module defines a user interface implemented using gtk2hs and -- pango for direct text rendering. module Yi.Frontend.Pango (start, startGtkHook) where import Control.Applicative import Control.Concurrent import Control.Exception (catch, SomeException) import Lens.Micro.Platform hiding (set, from) import Control.Monad hiding (forM_, mapM_, forM, mapM) import Data.Foldable import Data.IORef import qualified Data.List.PointedList as PL (moveTo) import qualified Data.List.PointedList.Circular as PL import qualified Data.Map as M import Data.Maybe import Data.Monoid import Data.Text (unpack, Text) import qualified Data.Text as T import Data.Traversable import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk hiding (Region, Window, Action , Point, Style, Modifier, on) import qualified Graphics.UI.Gtk.Gdk.EventM as EventM import qualified Graphics.UI.Gtk.Gdk.GC as Gtk import Graphics.UI.Gtk.Gdk.GC hiding (foreground) import Prelude hiding (error, elem, mapM_, foldl, concat, mapM) import System.Glib.GError import Yi.Buffer import Yi.Config import Yi.Debug import Yi.Editor import Yi.Event import Yi.Keymap import Yi.Layout(DividerPosition, DividerRef) import Yi.Monad import qualified Yi.Rope as R import Yi.Style import Yi.Tab import Yi.Types (fontsizeVariation, attributes) import qualified Yi.UI.Common as Common import Yi.Frontend.Pango.Control (keyTable) import Yi.Frontend.Pango.Layouts import Yi.Frontend.Pango.Utils import Yi.String (showT) import Yi.UI.TabBar import Yi.UI.Utils import Yi.Utils import Yi.Window -- We use IORefs in all of these datatypes for all fields which could -- possibly change over time. This ensures that no 'UI', 'TabInfo', -- 'WinInfo' will ever go out of date. data UI = UI { uiWindow :: Gtk.Window , uiNotebook :: SimpleNotebook , uiStatusbar :: Statusbar , tabCache :: IORef TabCache , uiActionCh :: Action -> IO () , uiConfig :: UIConfig , uiFont :: IORef FontDescription , uiInput :: IMContext } type TabCache = PL.PointedList TabInfo -- We don't need to know the order of the windows (the layout manages -- that) so we might as well use a map type WindowCache = M.Map WindowRef WinInfo data TabInfo = TabInfo { coreTabKey :: TabRef , layoutDisplay :: LayoutDisplay , miniwindowPage :: MiniwindowDisplay , tabWidget :: Widget , windowCache :: IORef WindowCache , fullTitle :: IORef Text , abbrevTitle :: IORef Text } instance Show TabInfo where show t = show (coreTabKey t) data WinInfo = WinInfo { coreWinKey :: WindowRef , coreWin :: IORef Window , shownTos :: IORef Point , lButtonPressed :: IORef Bool , insertingMode :: IORef Bool , inFocus :: IORef Bool , winLayoutInfo :: MVar WinLayoutInfo , winMetrics :: FontMetrics , textview :: DrawingArea , modeline :: Label , winWidget :: Widget -- ^ Top-level widget for this window. } data WinLayoutInfo = WinLayoutInfo { winLayout :: !PangoLayout, tos :: !Point, bos :: !Point, bufEnd :: !Point, cur :: !Point, buffer :: !FBuffer, regex :: !(Maybe SearchExp) } instance Show WinInfo where show w = show (coreWinKey w) instance Ord EventM.Modifier where x <= y = fromEnum x <= fromEnum y mkUI :: UI -> Common.UI Editor mkUI ui = Common.dummyUI { Common.main = main , Common.end = const end , Common.suspend = windowIconify (uiWindow ui) , Common.refresh = refresh ui , Common.layout = doLayout ui , Common.reloadProject = const reloadProject } updateFont :: UIConfig -> IORef FontDescription -> IORef TabCache -> Statusbar -> FontDescription -> IO () updateFont cfg fontRef tc status font = do maybe (return ()) (fontDescriptionSetFamily font) (configFontName cfg) writeIORef fontRef font widgetModifyFont status (Just font) tcs <- readIORef tc forM_ tcs $ \tabinfo -> do wcs <- readIORef (windowCache tabinfo) forM_ wcs $ \wininfo -> do withMVar (winLayoutInfo wininfo) $ \WinLayoutInfo{winLayout} -> layoutSetFontDescription winLayout (Just font) -- This will cause the textview to redraw widgetModifyFont (textview wininfo) (Just font) widgetModifyFont (modeline wininfo) (Just font) askBuffer :: Window -> FBuffer -> BufferM a -> a askBuffer w b f = fst $ runBuffer w b f -- | Initialise the ui start :: UIBoot start = startGtkHook (const $ return ()) -- | Initialise the ui, calling a given function -- on the Gtk window. This could be used to -- set additional callbacks, adjusting the window -- layout, etc. startGtkHook :: (Gtk.Window -> IO ()) -> UIBoot startGtkHook userHook cfg ch outCh ed = catch (startNoMsgGtkHook userHook cfg ch outCh ed) (\(GError _dom _code msg) -> fail $ unpack msg) startNoMsgGtkHook :: (Gtk.Window -> IO ()) -> UIBoot startNoMsgGtkHook userHook cfg ch outCh ed = do logPutStrLn "startNoMsgGtkHook" void unsafeInitGUIForThreadedRTS win <- windowNew ico <- loadIcon "yi+lambda-fat-32.png" vb <- vBoxNew False 1 -- Top-level vbox im <- imMulticontextNew imContextSetUsePreedit im False -- handler for preedit string not implemented -- Yi.Buffer.Misc.insertN for atomic input? let imContextCommitS :: Signal IMContext (String -> IO ()) imContextCommitS = imContextCommit im `on` imContextCommitS $ mapM_ (\k -> ch [Event (KASCII k) []]) set win [ windowDefaultWidth := 700 , windowDefaultHeight := 900 , windowTitle := ("Yi" :: T.Text) , windowIcon := Just ico , containerChild := vb ] win `on` deleteEvent $ io $ mainQuit >> return True win `on` keyPressEvent $ handleKeypress ch im paned <- hPanedNew tabs <- simpleNotebookNew panedAdd2 paned (baseWidget tabs) status <- statusbarNew -- Allow multiple lines in statusbar, GitHub issue #478 statusbarGetMessageArea status >>= containerGetChildren >>= \case [w] -> labelSetSingleLineMode (castToLabel w) False _ -> return () -- statusbarGetContextId status "global" set vb [ containerChild := paned , containerChild := status , boxChildPacking status := PackNatural ] fontRef <- fontDescriptionNew >>= newIORef let actionCh = outCh . return tc <- newIORef =<< newCache ed actionCh let watchFont = (fontDescriptionFromString ("Monospace 10" :: T.Text) >>=) watchFont $ updateFont (configUI cfg) fontRef tc status -- I think this is the correct place to put it... userHook win -- use our magic threads thingy -- http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/ void $ timeoutAddFull (yield >> return True) priorityDefaultIdle 50 widgetShowAll win let ui = UI win tabs status tc actionCh (configUI cfg) fontRef im -- Keep the current tab focus up to date let move n pl = fromMaybe pl (PL.moveTo n pl) runAction = uiActionCh ui . makeAction -- why does this cause a hang without postGUIAsync? simpleNotebookOnSwitchPage (uiNotebook ui) $ \n -> postGUIAsync $ runAction ((%=) tabsA (move n) :: EditorM ()) return (mkUI ui) main :: IO () main = logPutStrLn "GTK main loop running" >> mainGUI -- | Clean up and go home end :: IO () end = mainQuit -- | Modify GUI and the 'TabCache' to reflect information in 'Editor'. updateCache :: UI -> Editor -> IO () updateCache ui e = do cache <- readIORef $ tabCache ui -- convert to a map for convenient lookups let cacheMap = mapFromFoldable . fmap (\t -> (coreTabKey t, t)) $ cache -- build the new cache cache' <- forM (e ^. tabsA) $ \tab -> case M.lookup (tkey tab) cacheMap of Just t -> updateTabInfo e ui tab t >> return t Nothing -> newTab e ui tab -- store the new cache writeIORef (tabCache ui) cache' -- update the GUI simpleNotebookSet (uiNotebook ui) =<< forM cache' (\t -> (tabWidget t,) <$> readIORef (abbrevTitle t)) -- | Modify GUI and given 'TabInfo' to reflect information in 'Tab'. updateTabInfo :: Editor -> UI -> Tab -> TabInfo -> IO () updateTabInfo e ui tab tabInfo = do -- update the window cache wCacheOld <- readIORef (windowCache tabInfo) wCacheNew <- mapFromFoldable <$> forM (tab ^. tabWindowsA) (\w -> case M.lookup (wkey w) wCacheOld of Just wInfo -> updateWindow e ui w wInfo >> return (wkey w, wInfo) Nothing -> (wkey w,) <$> newWindow e ui w) writeIORef (windowCache tabInfo) wCacheNew -- TODO update renderer, etc? let lookupWin w = wCacheNew M.! w -- set layout layoutDisplaySet (layoutDisplay tabInfo) . fmap (winWidget . lookupWin) . tabLayout $ tab -- set minibox miniwindowDisplaySet (miniwindowPage tabInfo) . fmap (winWidget . lookupWin . wkey) . tabMiniWindows $ tab -- set focus setWindowFocus e ui tabInfo . lookupWin . wkey . tabFocus $ tab updateWindow :: Editor -> UI -> Window -> WinInfo -> IO () updateWindow e _ui win wInfo = do writeIORef (inFocus wInfo) False -- see also 'setWindowFocus' writeIORef (coreWin wInfo) win writeIORef (insertingMode wInfo) (askBuffer win (findBufferWith (bufkey win) e) $ use insertingA) setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO () setWindowFocus e ui t w = do win <- readIORef (coreWin w) let bufferName = shortIdentString (length $ commonNamePrefix e) $ findBufferWith (bufkey win) e ml = askBuffer win (findBufferWith (bufkey win) e) $ getModeLine (T.pack <$> commonNamePrefix e) im = uiInput ui writeIORef (inFocus w) True -- see also 'updateWindow' update (textview w) widgetIsFocus True update (modeline w) labelText ml writeIORef (fullTitle t) bufferName writeIORef (abbrevTitle t) (tabAbbrevTitle bufferName) drawW <- catch (fmap Just $ widgetGetDrawWindow $ textview w) (\(_ :: SomeException) -> return Nothing) imContextSetClientWindow im drawW imContextFocusIn im getWinInfo :: UI -> WindowRef -> IO WinInfo getWinInfo ui ref = let tabLoop [] = error "Yi.UI.Pango.getWinInfo: window not found" tabLoop (t:ts) = do wCache <- readIORef (windowCache t) case M.lookup ref wCache of Just w -> return w Nothing -> tabLoop ts in readIORef (tabCache ui) >>= (tabLoop . toList) -- | Make the cache from the editor and the action channel newCache :: Editor -> (Action -> IO ()) -> IO TabCache newCache e actionCh = mapM (mkDummyTab actionCh) (e ^. tabsA) -- | Make a new tab, and populate it newTab :: Editor -> UI -> Tab -> IO TabInfo newTab e ui tab = do t <- mkDummyTab (uiActionCh ui) tab updateTabInfo e ui tab t return t -- | Make a minimal new tab, without any windows. -- This is just for bootstrapping the UI; 'newTab' should normally -- be called instead. mkDummyTab :: (Action -> IO ()) -> Tab -> IO TabInfo mkDummyTab actionCh tab = do ws <- newIORef M.empty ld <- layoutDisplayNew layoutDisplayOnDividerMove ld (handleDividerMove actionCh) mwp <- miniwindowDisplayNew tw <- vBoxNew False 0 set tw [containerChild := baseWidget ld, containerChild := baseWidget mwp, boxChildPacking (baseWidget ld) := PackGrow, boxChildPacking (baseWidget mwp) := PackNatural] ftRef <- newIORef "" atRef <- newIORef "" return (TabInfo (tkey tab) ld mwp (toWidget tw) ws ftRef atRef) -- | Make a new window. newWindow :: Editor -> UI -> Window -> IO WinInfo newWindow e ui w = do let b = findBufferWith (bufkey w) e f <- readIORef (uiFont ui) ml <- labelNew (Nothing :: Maybe Text) widgetModifyFont ml (Just f) set ml [ miscXalign := 0.01 ] -- so the text is left-justified. -- allow the modeline to be covered up, horizontally widgetSetSizeRequest ml 0 (-1) v <- drawingAreaNew widgetModifyFont v (Just f) widgetAddEvents v [Button1MotionMask] widgetModifyBg v StateNormal . mkCol False . Yi.Style.background . baseAttributes . configStyle $ uiConfig ui sw <- scrolledWindowNew Nothing Nothing scrolledWindowAddWithViewport sw v scrolledWindowSetPolicy sw PolicyAutomatic PolicyNever box <- if isMini w then do prompt <- labelNew (Just $ miniIdentString b) widgetModifyFont prompt (Just f) hb <- hBoxNew False 1 set hb [ containerChild := prompt, containerChild := sw, boxChildPacking prompt := PackNatural, boxChildPacking sw := PackGrow] return (castToBox hb) else do vb <- vBoxNew False 1 set vb [ containerChild := sw, containerChild := ml, boxChildPacking ml := PackNatural] return (castToBox vb) tosRef <- newIORef (askBuffer w b (use . markPointA =<< fromMark <$> askMarks)) context <- widgetCreatePangoContext v layout <- layoutEmpty context layoutRef <- newMVar (WinLayoutInfo layout 0 0 0 0 (findBufferWith (bufkey w) e) Nothing) language <- contextGetLanguage context metrics <- contextGetMetrics context f language ifLButton <- newIORef False imode <- newIORef False focused <- newIORef False winRef <- newIORef w layoutSetFontDescription layout (Just f) -- stops layoutGetText crashing (as of gtk2hs 0.10.1) layoutSetText layout T.empty let ref = wkey w win = WinInfo { coreWinKey = ref , coreWin = winRef , winLayoutInfo = layoutRef , winMetrics = metrics , textview = v , modeline = ml , winWidget = toWidget box , shownTos = tosRef , lButtonPressed = ifLButton , insertingMode = imode , inFocus = focused } updateWindow e ui w win v `on` buttonPressEvent $ handleButtonClick ui ref v `on` buttonReleaseEvent $ handleButtonRelease ui win v `on` scrollEvent $ handleScroll ui win -- todo: allocate event rather than configure? v `on` configureEvent $ handleConfigure ui v `on` motionNotifyEvent $ handleMove ui win void $ v `onExpose` render ui win -- also redraw when the window receives/loses focus uiWindow ui `on` focusInEvent $ io (widgetQueueDraw v) >> return False uiWindow ui `on` focusOutEvent $ io (widgetQueueDraw v) >> return False -- todo: consider adding an 'isDirty' flag to WinLayoutInfo, -- so that we don't have to recompute the Attributes when focus changes. return win refresh :: UI -> Editor -> IO () refresh ui e = do postGUIAsync $ do contextId <- statusbarGetContextId (uiStatusbar ui) ("global" :: T.Text) statusbarPop (uiStatusbar ui) contextId void $ statusbarPush (uiStatusbar ui) contextId $ T.intercalate " " $ statusLine e updateCache ui e -- The cursor may have changed since doLayout cache <- readIORef $ tabCache ui forM_ cache $ \t -> do wCache <- readIORef (windowCache t) forM_ wCache $ \w -> do updateWinInfoForRendering e ui w widgetQueueDraw (textview w) -- | Record all the information we need for rendering. -- -- This information is kept in an MVar so that the PangoLayout and -- tos/bos/buffer are in sync. updateWinInfoForRendering :: Editor -> UI -> WinInfo -> IO () updateWinInfoForRendering e _ui w = modifyMVar_ (winLayoutInfo w) $ \wli -> do win <- readIORef (coreWin w) return $! wli{buffer=findBufferWith (bufkey win) e,regex=currentRegex e} -- | Tell the 'PangoLayout' what colours to draw, and draw the 'PangoLayout' -- and the cursor onto the screen render :: UI -> WinInfo -> t -> IO Bool render ui w _event = withMVar (winLayoutInfo w) $ \WinLayoutInfo{winLayout=layout,tos,bos,cur,buffer=b,regex} -> do -- read the information win <- readIORef (coreWin w) -- add color attributes. let picture = askBuffer win b $ attributesPictureAndSelB sty regex (mkRegion tos bos) sty = configStyle $ uiConfig ui picZip = zip picture $ drop 1 (fst <$> picture) <> [bos] strokes = [ (start',s,end') | ((start', s), end') <- picZip , s /= emptyAttributes ] rel p = fromIntegral (p - tos) allAttrs = concat $ do (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes let atr x = x (rel p1) (rel p2) if' p x y = if p then x else y return [ atr AttrForeground $ mkCol True fg , atr AttrBackground $ mkCol False bg , atr AttrStyle $ if' itlc StyleItalic StyleNormal , atr AttrUnderline $ if' udrl UnderlineSingle UnderlineNone , atr AttrWeight $ if' bd WeightBold WeightNormal ] layoutSetAttributes layout allAttrs drawWindow <- widgetGetDrawWindow $ textview w gc <- gcNew drawWindow -- see Note [PangoLayout width] -- draw the layout drawLayout drawWindow gc 1 0 layout -- calculate the cursor position im <- readIORef (insertingMode w) -- check focus, and decide whether we want a wide cursor bufferFocused <- readIORef (inFocus w) uiFocused <- Gtk.windowHasToplevelFocus (uiWindow ui) let focused = bufferFocused && uiFocused wideCursor = case configCursorStyle (uiConfig ui) of AlwaysFat -> True NeverFat -> False FatWhenFocused -> focused FatWhenFocusedAndInserting -> focused && im (PangoRectangle (succ -> curX) curY curW curH, _) <- layoutGetCursorPos layout (rel cur) -- tell the input method imContextSetCursorLocation (uiInput ui) $ Rectangle (round curX) (round curY) (round curW) (round curH) -- paint the cursor gcSetValues gc (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground . baseAttributes . configStyle $ uiConfig ui , Gtk.lineWidth = if wideCursor then 2 else 1 }) -- tell the renderer if im then -- if we are inserting, we just want a line drawLine drawWindow gc (round curX, round curY) (round $ curX + curW, round $ curY + curH) -- we aren't inserting, we want a rectangle around the current character else do PangoRectangle (succ -> chx) chy chw chh <- layoutIndexToPos layout (rel cur) drawRectangle drawWindow gc False (round chx) (round chy) (if chw > 0 then round chw else 8) (round chh) return True doLayout :: UI -> Editor -> IO Editor doLayout ui e = do updateCache ui e tabs <- readIORef $ tabCache ui f <- readIORef (uiFont ui) dims <- fold <$> mapM (getDimensionsInTab ui f e) tabs let e' = (tabsA %~ fmap (mapWindows updateWin)) e updateWin w = case M.lookup (wkey w) dims of Nothing -> w Just (wi,h,rgn) -> w { width = wi, height = h, winRegion = rgn } -- Don't leak references to old Windows let forceWin x w = height w `seq` winRegion w `seq` x return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA) -- | Width, Height getDimensionsInTab :: UI -> FontDescription -> Editor -> TabInfo -> IO (M.Map WindowRef (Int,Int,Region)) getDimensionsInTab ui f e tab = do wCache <- readIORef (windowCache tab) forM wCache $ \wi -> do (wid, h) <- widgetGetSize $ textview wi win <- readIORef (coreWin wi) let metrics = winMetrics wi lineHeight = ascent metrics + descent metrics charWidth = max (approximateCharWidth metrics) (approximateDigitWidth metrics) width = round $ fromIntegral wid / charWidth - 1 height = round $ fromIntegral h / lineHeight b0 = findBufferWith (bufkey win) e rgn <- shownRegion ui f wi b0 return (width, height, rgn) shownRegion :: UI -> FontDescription -> WinInfo -> FBuffer -> IO Region shownRegion ui f w b = modifyMVar (winLayoutInfo w) $ \wli -> do (tos, cur, bos, bufEnd) <- updatePango ui f w b (winLayout wli) return (wli{tos,cur=clampTo tos bos cur,bos,bufEnd}, mkRegion tos bos) where clampTo lo hi x = max lo (min hi x) -- during scrolling, cur might not lie between tos and bos, -- so we clamp it to avoid Pango errors {-| == Note [PangoLayout width] We start rendering the PangoLayout one pixel from the left of the rendering area, which means a few +/-1 offsets in Pango rendering and point lookup code. The reason for this is to support the "wide cursor", which is 2 pixels wide. If we started rendering the PangoLayout directly from the left of the rendering area instead of at a 1-pixel offset, then the "wide cursor" would only be half-displayed when the cursor is at the beginning of the line, and would then be a "thin cursor". An alternative would be to special-case the wide cursor rendering at the beginning of the line, and draw it one pixel to the right of where it "should" be. I haven't tried this out to see how it looks. Reiner -} -- we update the regex and the buffer to avoid holding on to potential garbage. -- These will be overwritten with correct values soon, in -- updateWinInfoForRendering. updatePango :: UI -> FontDescription -> WinInfo -> FBuffer -> PangoLayout -> IO (Point, Point, Point, Point) updatePango ui font w b layout = do (width_', height') <- widgetGetSize $ textview w let width' = max 0 (width_' - 1) -- see Note [PangoLayout width] fontDescriptionToStringT :: FontDescription -> IO Text fontDescriptionToStringT = fontDescriptionToString -- Resize (and possibly copy) the currently used font. curFont <- case fromIntegral <$> configFontSize (uiConfig ui) of Nothing -> return font Just defSize -> fontDescriptionGetSize font >>= \case Nothing -> fontDescriptionSetSize font defSize >> return font Just currentSize -> let fsv = fontsizeVariation $ attributes b newSize = max 1 (fromIntegral fsv + defSize) in if newSize == currentSize then return font else do -- This seems like it would be very expensive but I'm -- justifying it with that it only gets ran once per font -- size change. If the font size stays the same, we only -- enter this once per layout. We're effectivelly copying -- the default font for each layout that changes. An -- alternative would be to assign each buffer its own font -- but that seems a pain to maintain and if the user never -- changes font sizes, it's a waste of memory. nf <- fontDescriptionCopy font fontDescriptionSetSize nf newSize return nf oldFont <- layoutGetFontDescription layout oldFontStr <- maybe (return Nothing) (fmap Just . fontDescriptionToStringT) oldFont newFontStr <- Just <$> fontDescriptionToStringT curFont when (oldFontStr /= newFontStr) $ layoutSetFontDescription layout (Just curFont) win <- readIORef (coreWin w) let [width'', height''] = fmap fromIntegral [width', height'] metrics = winMetrics w lineHeight = ascent metrics + descent metrics charWidth = max (approximateCharWidth metrics) (approximateDigitWidth metrics) winw = max 1 $ floor (width'' / charWidth) winh = max 1 $ floor (height'' / lineHeight) maxChars = winw * winh conf = uiConfig ui (tos, size, point, text) = askBuffer win b $ do from <- use . markPointA =<< fromMark <$> askMarks rope <- streamB Forward from p <- pointB bufEnd <- sizeB let content = takeContent conf maxChars . fst $ R.splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') return (from, bufEnd, p, R.toText $ addNL content) if configLineWrap conf then wrapToWidth layout WrapAnywhere width'' else do (Rectangle px _py pwidth _pheight, _) <- layoutGetPixelExtents layout widgetSetSizeRequest (textview w) (px+pwidth) (-1) -- optimize for cursor movement oldText <- layoutGetText layout when (oldText /= text) (layoutSetText layout text) (_, bosOffset, _) <- layoutXYToIndex layout width'' (fromIntegral winh * lineHeight - 1) return (tos, point, tos + fromIntegral bosOffset + 1, size) -- | This is a hack that makes this renderer not suck in the common -- case. There are two scenarios: we're line wrapping or we're not -- line wrapping. This function already assumes that the contents -- given have all the possible lines we can fit on the screen. -- -- If we are line wrapping then the most text we'll ever need to -- render is precisely the number of characters that can fit on the -- screen. If that's the case, that's precisely what we do, truncate -- up to the point where the text would be off-screen anyway. -- -- If we aren't line-wrapping then we can't simply truncate at the max -- number of characters: lines might be really long, but considering -- we're not truncating, we should still be able to see every single -- line that can fit on screen up to the screen bound. This suggests -- that we could simply render each line up to the bound. While this -- does work wonders for performance and would work regardless whether -- we're wrapping or not, currently our implementation of the rest of -- the module depends on all characters used being set into the -- layout: if we cut some text off, painting strokes on top or going -- to the end makes for strange effects. So currently we have no -- choice but to render all characters in the visible lines. If you -- have really long lines, this will kill the performance. -- -- So here we implement the hack for the line-wrapping case. Once we -- fix stroke painting &c, this distinction can be removed and we can -- simply snip at the screen boundary whether we're wrapping or not -- which actually results in great performance in the end. Until that -- happens, only the line-wrapping case doesn't suck. Fortunately it -- is the default. takeContent :: UIConfig -> Int -> R.YiString -> R.YiString takeContent cf cl t = if configLineWrap cf then R.take cl t else t -- | Wraps the layout according to the given 'LayoutWrapMode', using -- the specified width. -- -- In contrast to the past, it actually implements wrapping properly -- which was previously broken. wrapToWidth :: PangoLayout -> LayoutWrapMode -> Double -> IO () wrapToWidth l wm w = do layoutGetWrap l >>= \wr -> case (wr, wm) of -- No Eq instance… (WrapWholeWords, WrapWholeWords) -> return () (WrapAnywhere, WrapAnywhere) -> return () (WrapPartialWords, WrapPartialWords) -> return () _ -> layoutSetWrap l wm layoutGetWidth l >>= \case Just x | x == w -> return () _ -> layoutSetWidth l (Just w) reloadProject :: IO () reloadProject = return () mkCol :: Bool -- ^ is foreground? -> Yi.Style.Color -> Gtk.Color mkCol True Default = Color 0 0 0 mkCol False Default = Color maxBound maxBound maxBound mkCol _ (RGB x y z) = Color (fromIntegral x * 256) (fromIntegral y * 256) (fromIntegral z * 256) -- * GTK Event handlers -- | Process GTK keypress if IM fails handleKeypress :: ([Event] -> IO ()) -- ^ Event dispatcher (Yi.Core.dispatch) -> IMContext -> EventM EKey Bool handleKeypress ch im = do gtkMods <- eventModifier gtkKey <- eventKeyVal ifIM <- imContextFilterKeypress im let char = keyToChar gtkKey modsWithShift = M.keys $ M.filter (`elem` gtkMods) modTable mods | isJust char = filter (/= MShift) modsWithShift | otherwise = modsWithShift key = case char of Just c -> Just $ KASCII c Nothing -> M.lookup (keyName gtkKey) keyTable case (ifIM, key) of (True, _ ) -> return () (_, Nothing) -> logPutStrLn $ "Event not translatable: " <> showT key (_, Just k ) -> io $ ch [Event k mods] return True -- | Map Yi modifiers to GTK modTable :: M.Map Modifier EventM.Modifier modTable = M.fromList [ (MShift, EventM.Shift ) , (MCtrl, EventM.Control) , (MMeta, EventM.Alt ) , (MSuper, EventM.Super ) , (MHyper, EventM.Hyper ) ] -- | Same as Gtk.on, but discards the ConnectId on :: object -> Signal object callback -> callback -> IO () on widget signal handler = void $ Gtk.on widget signal handler handleButtonClick :: UI -> WindowRef -> EventM EButton Bool handleButtonClick ui ref = do (x, y) <- eventCoordinates click <- eventClick button <- eventButton io $ do w <- getWinInfo ui ref point <- pointToOffset (x, y) w let focusWindow = focusWindowE ref runAction = uiActionCh ui . makeAction runAction focusWindow win <- io $ readIORef (coreWin w) let selectRegion tu = runAction $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ moveTo point >> regionOfB tu >>= setSelectRegionB case (click, button) of (SingleClick, LeftButton) -> do io $ writeIORef (lButtonPressed w) True runAction $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ do m <- selMark <$> askMarks markPointA m .= point moveTo point setVisibleSelection False (DoubleClick, LeftButton) -> selectRegion unitWord (TripleClick, LeftButton) -> selectRegion Line _ -> return () return True handleButtonRelease :: UI -> WinInfo -> EventM EButton Bool handleButtonRelease ui w = do (x, y) <- eventCoordinates button <- eventButton io $ do point <- pointToOffset (x, y) w disp <- widgetGetDisplay $ textview w cb <- clipboardGetForDisplay disp selectionPrimary case button of MiddleButton -> pasteSelectionClipboard ui w point cb LeftButton -> setSelectionClipboard ui w cb >> writeIORef (lButtonPressed w) False _ -> return () return True handleScroll :: UI -> WinInfo -> EventM EScroll Bool handleScroll ui w = do scrollDirection <- eventScrollDirection xy <- eventCoordinates io $ do ifPressed <- readIORef $ lButtonPressed w -- query new coordinates let editorAction = withCurrentBuffer $ scrollB $ case scrollDirection of ScrollUp -> negate configAmount ScrollDown -> configAmount _ -> 0 -- Left/right scrolling not supported configAmount = configScrollWheelAmount $ uiConfig ui uiActionCh ui (EditorA editorAction) when ifPressed $ selectArea ui w xy return True handleConfigure :: UI -> EventM EConfigure Bool handleConfigure ui = do -- trigger a layout -- why does this cause a hang without postGUIAsync? io $ postGUIAsync $ uiActionCh ui (makeAction (return () :: EditorM())) return False -- allow event to be propagated handleMove :: UI -> WinInfo -> EventM EMotion Bool handleMove ui w = eventCoordinates >>= (io . selectArea ui w) >> return True handleDividerMove :: (Action -> IO ()) -> DividerRef -> DividerPosition -> IO () handleDividerMove actionCh ref pos = actionCh (makeAction (setDividerPosE ref pos)) -- | Convert point coordinates to offset in Yi window pointToOffset :: (Double, Double) -> WinInfo -> IO Point pointToOffset (x,y) w = withMVar (winLayoutInfo w) $ \WinLayoutInfo{winLayout,tos,bufEnd} -> do im <- readIORef (insertingMode w) -- see Note [PangoLayout width] (_, charOffsetX, extra) <- layoutXYToIndex winLayout (max 0 (x-1)) y return $ min bufEnd (tos + fromIntegral (charOffsetX + if im then extra else 0)) selectArea :: UI -> WinInfo -> (Double, Double) -> IO () selectArea ui w (x,y) = do p <- pointToOffset (x,y) w let editorAction = do txt <- withCurrentBuffer $ do moveTo p setVisibleSelection True readRegionB =<< getSelectRegionB setRegE txt uiActionCh ui (makeAction editorAction) -- drawWindowGetPointer (textview w) -- be ready for next message. pasteSelectionClipboard :: UI -> WinInfo -> Point -> Clipboard -> IO () pasteSelectionClipboard ui w p cb = do win <- io $ readIORef (coreWin w) let cbHandler :: Maybe R.YiString -> IO () cbHandler Nothing = return () cbHandler (Just txt) = uiActionCh ui $ EditorA $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ do pointB >>= setSelectionMarkPointB moveTo p insertN txt clipboardRequestText cb (cbHandler . fmap R.fromText) -- | Set selection clipboard contents to current selection setSelectionClipboard :: UI -> WinInfo -> Clipboard -> IO () setSelectionClipboard ui _w cb = do -- Why uiActionCh doesn't allow returning values? selection <- newIORef mempty let yiAction = do txt <- withCurrentBuffer $ fmap R.toText . readRegionB =<< getSelectRegionB :: YiM T.Text io $ writeIORef selection txt uiActionCh ui $ makeAction yiAction txt <- readIORef selection unless (T.null txt) $ clipboardSetText cb txt yi-frontend-pango-0.13.7/src/Yi/Frontend/Pango/Control.hs0000644000000000000000000007673413120261666021323 0ustar0000000000000000{-# LANGUAGE RecordWildCards, ScopedTypeVariables, MultiParamTypeClasses , DeriveDataTypeable, OverloadedStrings , GeneralizedNewtypeDeriving, FlexibleContexts #-} -- this module isn't finished, and there's heaps of warnings. {-# OPTIONS_GHC -w #-} -- | -- Module : Yi.Frontend.Pango.Control -- License : GPL module Yi.Frontend.Pango.Control ( Control(..) , ControlM(..) , Buffer(..) , View(..) , Iter(..) , startControl , runControl , controlIO , liftYi , getControl , newBuffer , newView , getBuffer , setBufferMode , withCurrentBuffer , setText , getText , keyTable ) where import Data.Text (unpack, pack, Text) import qualified Data.Text as T import Prelude hiding (concatMap, concat, foldl, elem, mapM_) import Control.Exception (catch) import Control.Monad hiding (mapM_, forM_) import Control.Monad.Reader hiding (mapM_, forM_) import Control.Applicative import Lens.Micro.Platform hiding (views, Action) import Data.Foldable import Data.Maybe (maybe, fromJust, fromMaybe) import Data.Monoid import Data.IORef import Data.List (nub, filter, drop, zip, take, length) import Data.Prototype import Yi.Rope (toText, splitAtLine, YiString) import qualified Yi.Rope as R import qualified Data.Map as Map import Yi.Core (startEditor, focusAllSyntax) import Yi.Buffer import Yi.Config import Yi.Tab import Yi.Window as Yi import Yi.Editor import Yi.Event import Yi.Keymap import Yi.Monad import Yi.Style import Yi.UI.Utils import Yi.Utils import Yi.Debug import Graphics.UI.Gtk as Gtk (Color(..), PangoRectangle(..), Rectangle(..), selectionDataSetText, targetString, clipboardSetWithData, clipboardRequestText, selectionPrimary, clipboardGetForDisplay, widgetGetDisplay, onMotionNotify, drawRectangle, drawLine, layoutIndexToPos, layoutGetCursorPos, drawLayout, widgetGetDrawWindow, layoutSetAttributes, widgetGrabFocus, scrolledWindowSetPolicy, scrolledWindowAddWithViewport, scrolledWindowNew, contextGetMetrics, contextGetLanguage, layoutSetFontDescription, layoutEmpty, widgetCreatePangoContext, widgetModifyBg, drawingAreaNew, FontDescription, ScrolledWindow, FontMetrics, Language, DrawingArea, layoutXYToIndex, layoutSetText, layoutGetText, widgetSetSizeRequest, layoutGetPixelExtents, layoutSetWidth, layoutGetWidth, layoutGetFontDescription, PangoLayout, descent, ascent, widgetGetSize, widgetQueueDraw, mainQuit, signalDisconnect, ConnectId(..), PolicyType(..), StateType(..), EventMask(..), AttrOp(..), Weight(..), PangoAttribute(..), Underline(..), FontStyle(..)) import Graphics.UI.Gtk.Gdk.GC as Gtk (newGCValues, gcSetValues, gcNew, foreground) import qualified Graphics.UI.Gtk as Gtk import qualified Graphics.UI.Gtk.Gdk.Events as Gdk.Events import System.Glib.GError import Control.Monad.Reader (ask, asks, MonadReader(..)) import Control.Monad.State (ap, get, put, modify) import Control.Monad.Base import Control.Concurrent (newMVar, modifyMVar, MVar, newEmptyMVar, putMVar, readMVar, isEmptyMVar) import Data.Typeable import qualified Data.List.PointedList as PL (insertRight, withFocus, PointedList(..), singleton) import Yi.Regex ((=~), AllTextSubmatches(..)) import Yi.String (showT) import System.FilePath import qualified Yi.UI.Common as Common data Control = Control { controlYi :: Yi , tabCache :: IORef [TabInfo] , views :: IORef (Map.Map WindowRef View) } -- { config :: Config -- , editor :: Editor -- , input :: Event -> IO () -- , output :: Action -> IO () -- } data TabInfo = TabInfo { coreTab :: Tab -- , page :: VBox } instance Show TabInfo where show t = show (coreTab t) --type ControlM = YiM newtype ControlM a = ControlM { runControl'' :: ReaderT Control IO a } deriving (Monad, MonadBase IO, MonadReader Control, Typeable, Functor, Applicative) -- Helper functions to avoid issues with mismatching monad libraries controlIO :: IO a -> ControlM a controlIO = liftBase getControl :: ControlM Control getControl = ask liftYi :: YiM a -> ControlM a liftYi m = do yi <- asks controlYi liftBase $ runReaderT (runYiM m) yi --instance MonadState Editor ControlM where -- get = readRef =<< editor <$> ask -- put v = flip modifyRef (const v) =<< editor <$> ask --instance MonadEditor ControlM where -- askCfg = config <$> ask -- withEditor f = do -- r <- asks editor -- cfg <- asks config -- liftBase $ controlUnsafeWithEditor cfg r f startControl :: Config -> ControlM () -> IO () startControl config main = startEditor (config { startFrontEnd = start main } ) Nothing runControl' :: ControlM a -> MVar Control -> IO (Maybe a) runControl' m yiMVar = do empty <- isEmptyMVar yiMVar if empty then return Nothing else do yi <- readMVar yiMVar result <- runControl m yi return $ Just result -- runControl :: ControlM a -> Yi -> IO a -- runControl m yi = runReaderT (runYiM m) yi runControl :: ControlM a -> Control -> IO a runControl f = runReaderT (runControl'' f) -- runControlEditor f yiMVar = yiMVar runAction :: Action -> ControlM () runAction action = do out <- liftYi $ asks yiOutput liftBase $ out MustRefresh [action] -- | Test 2 mkUI :: IO () -> MVar Control -> Common.UI Editor mkUI main yiMVar = Common.dummyUI { Common.main = main , Common.end = \_ -> void $ runControl' end yiMVar , Common.suspend = void $ runControl' suspend yiMVar , Common.refresh = \e -> void $ runControl' (refresh e) yiMVar , Common.layout = \e -> fmap (fromMaybe e) $ runControl' (doLayout e) yiMVar , Common.reloadProject = \f -> void $ runControl' (reloadProject f) yiMVar } start :: ControlM () -> UIBoot start main cfg ch outCh ed = catch (startNoMsg main cfg ch outCh ed) (\(GError _dom _code msg) -> fail $ unpack msg) makeControl :: MVar Control -> YiM () makeControl controlMVar = do controlYi <- ask tabCache <- liftBase $ newIORef [] views <- liftBase $ newIORef Map.empty liftBase $ putMVar controlMVar Control{..} startNoMsg :: ControlM () -> UIBoot startNoMsg main config input output ed = do control <- newEmptyMVar let wrappedMain = do output [makeAction $ makeControl control] void (runControl' main control) return (mkUI wrappedMain control) end :: ControlM () end = do liftBase $ putStrLn "Yi Control End" liftBase mainQuit suspend :: ControlM () suspend = do liftBase $ putStrLn "Yi Control Suspend" return () {-# ANN refresh ("HLint: ignore Redundant do" :: String) #-} refresh :: Editor -> ControlM () refresh e = do --contextId <- statusbarGetContextId (uiStatusbar ui) "global" --statusbarPop (uiStatusbar ui) contextId --statusbarPush (uiStatusbar ui) contextId $ intercalate " " $ statusLine e updateCache e -- The cursor may have changed since doLayout viewsRef <- asks views vs <- liftBase $ readIORef viewsRef forM_ (Map.elems vs) $ \v -> do let b = findBufferWith (viewFBufRef v) e -- when (not $ null $ b ^. pendingUpdatesA) $ do -- sig <- readIORef (renderer w) -- signalDisconnect sig -- writeRef (renderer w) -- =<< (textview w `onExpose` render e ui b (wkey (coreWin w))) liftBase $ widgetQueueDraw (drawArea v) doLayout :: Editor -> ControlM Editor doLayout e = do liftBase $ putStrLn "Yi Control Do Layout" updateCache e cacheRef <- asks tabCache tabs <- liftBase $ readIORef cacheRef dims <- concat <$> mapM (getDimensionsInTab e) tabs let e' = (tabsA %~ fmap (mapWindows updateWin)) e updateWin w = case find (\(ref,_,_,_) -> (wkey w == ref)) dims of Nothing -> w Just (_, wi, h,rgn) -> w { width = wi , height = h , winRegion = rgn } -- Don't leak references to old Windows let forceWin x w = height w `seq` winRegion w `seq` x return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA) -- | Width, Height getDimensionsInTab :: Editor -> TabInfo -> ControlM [(WindowRef,Int,Int,Region)] getDimensionsInTab e tab = do viewsRef <- asks views vs <- liftBase $ readIORef viewsRef foldlM (\a w -> case Map.lookup (wkey w) vs of Just v -> do (wi, h) <- liftBase $ widgetGetSize $ drawArea v let lineHeight = ascent (metrics v) + descent (metrics v) charWidth = Gtk.approximateCharWidth $ metrics v b0 = findBufferWith (viewFBufRef v) e rgn <- shownRegion e v b0 let ret= (windowRef v, round $ fromIntegral wi / charWidth, round $ fromIntegral h / lineHeight, rgn) return $ a <> [ret] Nothing -> return a) [] (coreTab tab ^. tabWindowsA) shownRegion :: Editor -> View -> FBuffer -> ControlM Region shownRegion e v b = do (tos, _, bos) <- updatePango e v b (layout v) return $ mkRegion tos bos updatePango :: Editor -> View -> FBuffer -> PangoLayout -> ControlM (Point, Point, Point) updatePango e v b layout = do (width', height') <- liftBase $ widgetGetSize $ drawArea v font <- liftBase $ layoutGetFontDescription layout --oldFont <- layoutGetFontDescription layout --oldFontStr <- maybe (return Nothing) -- (fmap Just . fontDescriptionToString) oldFont --newFontStr <- Just <$> fontDescriptionToString font --when (oldFontStr /= newFontStr) -- (layoutSetFontDescription layout (Just font)) let win = findWindowWith (windowRef v) e [width'', height''] = map fromIntegral [width', height'] lineHeight = ascent (metrics v) + descent (metrics v) winh = max 1 $ floor (height'' / lineHeight) (tos, point, text) = askBuffer win b $ do from <- (use . markPointA) =<< fromMark <$> askMarks rope <- streamB Forward from p <- pointB let content = fst $ splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') return (from, p, R.toText $ addNL content) config <- liftYi askCfg if configLineWrap $ configUI config then do oldWidth <- liftBase $ layoutGetWidth layout when (oldWidth /= Just width'') $ liftBase $ layoutSetWidth layout $ Just width'' else do (Rectangle px _py pwidth _pheight, _) <- liftBase $ layoutGetPixelExtents layout liftBase $ widgetSetSizeRequest (drawArea v) (px+pwidth) (-1) -- optimize for cursor movement oldText <- liftBase $ layoutGetText layout when (oldText /= text) $ liftBase $ layoutSetText layout text (_, bosOffset, _) <- liftBase $ layoutXYToIndex layout width'' (fromIntegral winh * lineHeight - 1) return (tos, point, tos + fromIntegral bosOffset + 1) updateCache :: Editor -> ControlM () updateCache e = do let tabs = e ^. tabsA cacheRef <- asks tabCache cache <- liftBase $ readIORef cacheRef cache' <- syncTabs e (toList $ PL.withFocus tabs) cache liftBase $ writeIORef cacheRef cache' syncTabs :: Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo] syncTabs e (tfocused@(t,focused):ts) (c:cs) | t == coreTab c = do when focused $ setTabFocus c -- let vCache = views c (:) <$> syncTab e c t <*> syncTabs e ts cs | t `elem` map coreTab cs = do removeTab c syncTabs e (tfocused:ts) cs | otherwise = do c' <- insertTabBefore e t c when focused $ setTabFocus c' return (c':) `ap` syncTabs e ts (c:cs) syncTabs e ts [] = mapM (\(t,focused) -> do c' <- insertTab e t when focused $ setTabFocus c' return c') ts syncTabs _ [] cs = mapM_ removeTab cs >> return [] syncTab :: Editor -> TabInfo -> Tab -> ControlM TabInfo syncTab e tab ws = -- TODO Maybe do something here return tab setTabFocus :: TabInfo -> ControlM () setTabFocus t = -- TODO this needs to set the tab focus with callback -- but only if the tab focus has changed return () askBuffer :: Yi.Window -> FBuffer -> BufferM a -> a askBuffer w b f = fst $ runBuffer w b f setWindowFocus :: Editor -> TabInfo -> View -> ControlM () setWindowFocus e t v = do let bufferName = shortIdentString (length $ commonNamePrefix e) $ findBufferWith (viewFBufRef v) e window = findWindowWith (windowRef v) e ml = askBuffer window (findBufferWith (viewFBufRef v) e) $ getModeLine (T.pack <$> commonNamePrefix e) -- TODO -- update (textview w) widgetIsFocus True -- update (modeline w) labelText ml -- update (uiWindow ui) windowTitle $ bufferName <> " - Yi" -- update (uiNotebook ui) (notebookChildTabLabel (page t)) -- (tabAbbrevTitle bufferName) return () removeTab :: TabInfo -> ControlM () removeTab t = -- TODO this needs to close the views in the tab with callback return () removeView :: TabInfo -> View -> ControlM () removeView tab view = -- TODO this needs to close the view with callback return () -- | Make a new tab. newTab :: Editor -> Tab -> ControlM TabInfo newTab e ws = do let t' = TabInfo { coreTab = ws } -- cache <- syncWindows e t' (toList $ PL.withFocus ws) [] return t' -- { views = cache } {-# ANN insertTabBefore ("HLint: ignore Redundant do" :: String) #-} insertTabBefore :: Editor -> Tab -> TabInfo -> ControlM TabInfo insertTabBefore e ws c = do -- Just p <- notebookPageNum (uiNotebook ui) (page c) -- vb <- vBoxNew False 1 -- notebookInsertPage (uiNotebook ui) vb "" p -- widgetShowAll $ vb newTab e ws {-# ANN insertTab ("HLint: ignore Redundant do" :: String) #-} insertTab :: Editor -> Tab -> ControlM TabInfo insertTab e ws = do -- vb <- vBoxNew False 1 -- notebookAppendPage (uiNotebook ui) vb "" -- widgetShowAll $ vb newTab e ws {- insertWindowBefore :: Editor -> TabInfo -> Yi.Window -> WinInfo -> IO WinInfo insertWindowBefore e ui tab w _c = insertWindow e ui tab w insertWindowAtEnd :: Editor -> UI -> TabInfo -> Window -> IO WinInfo insertWindowAtEnd e ui tab w = insertWindow e ui tab w insertWindow :: Editor -> UI -> TabInfo -> Window -> IO WinInfo insertWindow e ui tab win = do let buf = findBufferWith (bufkey win) e liftBase $ do w <- newWindow e ui win buf set (page tab) $ [ containerChild := widget w , boxChildPacking (widget w) := if isMini (coreWin w) then PackNatural else PackGrow ] let ref = (wkey . coreWin) w textview w `onButtonRelease` handleClick ui ref textview w `onButtonPress` handleClick ui ref textview w `onScroll` handleScroll ui ref textview w `onConfigure` handleConfigure ui ref widgetShowAll (widget w) return w -} reloadProject :: FilePath -> ControlM () reloadProject _ = return () controlUnsafeWithEditor :: Config -> MVar Editor -> EditorM a -> IO a controlUnsafeWithEditor cfg r f = modifyMVar r $ \e -> do let (e',a) = runEditor cfg f e -- Make sure that the result of runEditor is evaluated before -- replacing the editor state. Otherwise, we might replace e -- with an exception-producing thunk, which makes it impossible -- to look at or update the editor state. -- Maybe this could also be fixed by -fno-state-hack flag? -- TODO: can we simplify this? e' `seq` a `seq` return (e', a) data Buffer = Buffer { fBufRef :: BufferRef } data View = View { viewFBufRef :: BufferRef , windowRef :: WindowRef , drawArea :: DrawingArea , layout :: PangoLayout , language :: Language , metrics :: FontMetrics , scrollWin :: ScrolledWindow , shownTos :: IORef Point , winMotionSignal :: IORef (Maybe (ConnectId DrawingArea)) } data Iter = Iter { iterFBufRef :: BufferRef , point :: Point } newBuffer :: BufferId -> R.YiString -> ControlM Buffer newBuffer id text = do fBufRef <- liftYi . withEditor . newBufferE id $ text return Buffer{..} newView :: Buffer -> FontDescription -> ControlM View newView buffer font = do control <- ask config <- liftYi askCfg let viewFBufRef = fBufRef buffer newWindow <- fmap (\w -> w { height=50 , winRegion = mkRegion (Point 0) (Point 2000) }) $ liftYi $ withEditor $ newWindowE False viewFBufRef let windowRef = wkey newWindow liftYi $ withEditor $ do windowsA %= PL.insertRight newWindow e <- get put $ focusAllSyntax e drawArea <- liftBase drawingAreaNew liftBase . widgetModifyBg drawArea StateNormal . mkCol False . Yi.Style.background . baseAttributes . configStyle $ configUI config context <- liftBase $ widgetCreatePangoContext drawArea layout <- liftBase $ layoutEmpty context liftBase $ layoutSetFontDescription layout (Just font) language <- liftBase $ contextGetLanguage context metrics <- liftBase $ contextGetMetrics context font language liftBase $ layoutSetText layout ("" :: Text) scrollWin <- liftBase $ scrolledWindowNew Nothing Nothing liftBase $ do scrolledWindowAddWithViewport scrollWin drawArea scrolledWindowSetPolicy scrollWin PolicyAutomatic PolicyNever initialTos <- liftYi . withEditor . withGivenBufferAndWindow newWindow viewFBufRef $ (use . markPointA) =<< fromMark <$> askMarks shownTos <- liftBase $ newIORef initialTos winMotionSignal <- liftBase $ newIORef Nothing let view = View {..} liftBase $ Gtk.widgetAddEvents drawArea [KeyPressMask] liftBase $ Gtk.set drawArea [Gtk.widgetCanFocus := True] liftBase $ drawArea `Gtk.onKeyPress` \event -> do putStrLn $ "Yi Control Key Press = " <> show event runControl (runAction $ makeAction $ do focusWindowE windowRef switchToBufferE viewFBufRef) control result <- processEvent (yiInput $ controlYi control) event widgetQueueDraw drawArea return result liftBase $ drawArea `Gtk.onButtonPress` \event -> do widgetGrabFocus drawArea runControl (handleClick view event) control liftBase $ drawArea `Gtk.onButtonRelease` \event -> runControl (handleClick view event) control liftBase $ drawArea `Gtk.onScroll` \event -> runControl (handleScroll view event) control liftBase $ drawArea `Gtk.onExpose` \event -> do (text, allAttrs, debug, tos, rel, point, inserting) <- runControl (liftYi $ withEditor $ do window <- findWindowWith windowRef <$> get (%=) buffersA (fmap (clearSyntax . clearHighlight)) let winh = height window let tos = max 0 (regionStart (winRegion window)) let bos = regionEnd (winRegion window) let rel p = fromIntegral (p - tos) withGivenBufferAndWindow window viewFBufRef $ do -- tos <- getMarkPointB =<< fromMark <$> askMarks rope <- streamB Forward tos point <- pointB inserting <- use insertingA modeNm <- gets (withMode0 modeName) -- let (tos, point, text, picture) = do runBu -- from <- getMarkPointB =<< fromMark <$> askMarks -- rope <- streamB Forward from -- p <- pointB let content = fst $ splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') sty = configStyle $ configUI config -- attributesPictureAndSelB sty (currentRegex e) -- (mkRegion tos bos) -- return (from, p, addNL $ Rope.toString content, -- picture) let text = R.toText $ addNL content picture <- attributesPictureAndSelB sty Nothing (mkRegion tos bos) -- add color attributes. let picZip = zip picture $ drop 1 (fst <$> picture) <> [bos] strokes = [ (start',s,end') | ((start', s), end') <- picZip , s /= emptyAttributes ] rel p = fromIntegral (p - tos) allAttrs = concat $ do (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes let atr x = x (rel p1) (rel p2) if' p x y = if p then x else y return [ atr AttrForeground $ mkCol True fg , atr AttrBackground $ mkCol False bg , atr AttrStyle $ if' itlc StyleItalic StyleNormal , atr AttrUnderline $ if' udrl UnderlineSingle UnderlineNone , atr AttrWeight $ if' bd WeightBold WeightNormal ] return (text, allAttrs, (picture, strokes, modeNm, window, tos, bos, winh), tos, rel, point, inserting)) control -- putStrLn $ "Setting Layout Attributes " <> show debug layoutSetAttributes layout allAttrs -- putStrLn "Done Stting Layout Attributes" dw <- widgetGetDrawWindow drawArea gc <- gcNew dw oldText <- layoutGetText layout when (text /= oldText) $ layoutSetText layout text drawLayout dw gc 0 0 layout liftBase $ writeIORef shownTos tos -- paint the cursor (PangoRectangle curx cury curw curh, _) <- layoutGetCursorPos layout (rel point) PangoRectangle chx chy chw chh <- layoutIndexToPos layout (rel point) gcSetValues gc (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground . baseAttributes . configStyle $ configUI config }) if inserting then drawLine dw gc (round curx, round cury) (round $ curx + curw, round $ cury + curh) else drawRectangle dw gc False (round chx) (round chy) (if chw > 0 then round chw else 8) (round chh) return True liftBase $ widgetGrabFocus drawArea tabsRef <- asks tabCache ts <- liftBase $ readIORef tabsRef -- TODO: the Tab idkey should be assigned using -- Yi.Editor.newRef. But we can't modify that here, since our -- access to 'Yi' is readonly. liftBase $ writeIORef tabsRef (TabInfo (makeTab1 0 newWindow):ts) viewsRef <- asks views vs <- liftBase $ readIORef viewsRef liftBase $ writeIORef viewsRef $ Map.insert windowRef view vs return view where clearHighlight fb = -- if there were updates, then hide the selection. let h = view highlightSelectionA fb us = view pendingUpdatesA fb in highlightSelectionA .~ (h && null us) $ fb {-# ANN setBufferMode ("HLint: ignore Redundant do" :: String) #-} setBufferMode :: FilePath -> Buffer -> ControlM () setBufferMode f buffer = do let bufRef = fBufRef buffer -- adjust the mode tbl <- liftYi $ asks (modeTable . yiConfig) contents <- liftYi $ withGivenBuffer bufRef elemsB let header = R.toString $ R.take 1024 contents hmode = case header =~ ("\\-\\*\\- *([^ ]*) *\\-\\*\\-" :: String) of AllTextSubmatches [_,m] -> T.pack m _ -> "" Just mode = find (\(AnyMode m)-> modeName m == hmode) tbl <|> find (\(AnyMode m)-> modeApplies m f contents) tbl <|> Just (AnyMode emptyMode) case mode of AnyMode newMode -> do -- liftBase $ putStrLn $ show (f, modeName newMode) liftYi $ withEditor $ do withGivenBuffer bufRef $ do setMode newMode modify clearSyntax switchToBufferE bufRef -- withEditor focusAllSyntax withBuffer :: Buffer -> BufferM a -> ControlM a withBuffer Buffer{fBufRef = b} f = liftYi $ withGivenBuffer b f getBuffer :: View -> Buffer getBuffer view = Buffer {fBufRef = viewFBufRef view} setText :: Buffer -> YiString -> ControlM () setText b text = withBuffer b $ do r <- regionOfB Document replaceRegionB r text getText :: Buffer -> Iter -> Iter -> ControlM Text getText b Iter{point = p1} Iter{point = p2} = fmap toText . withBuffer b . readRegionB $ mkRegion p1 p2 mkCol :: Bool -- ^ is foreground? -> Yi.Style.Color -> Gtk.Color mkCol True Default = Color 0 0 0 mkCol False Default = Color maxBound maxBound maxBound mkCol _ (RGB x y z) = Color (fromIntegral x * 256) (fromIntegral y * 256) (fromIntegral z * 256) handleClick :: View -> Gdk.Events.Event -> ControlM Bool handleClick view event = do control <- ask -- (_tabIdx,winIdx,w) <- getWinInfo ref <$> readIORef (tabCache ui) logPutStrLn $ "Click: " <> showT (Gdk.Events.eventX event, Gdk.Events.eventY event, Gdk.Events.eventClick event) -- retrieve the clicked offset. (_,layoutIndex,_) <- io $ layoutXYToIndex (layout view) (Gdk.Events.eventX event) (Gdk.Events.eventY event) tos <- liftBase $ readIORef (shownTos view) let p1 = tos + fromIntegral layoutIndex let winRef = windowRef view -- maybe focus the window -- logPutStrLn $ "Clicked inside window: " <> show view -- let focusWindow = do -- TODO: check that tabIdx is the focus? -- (%=) windowsA (fromJust . PL.move winIdx) liftBase $ case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> do cid <- onMotionNotify (drawArea view) False $ \event -> runControl (handleMove view p1 event) control writeIORef (winMotionSignal view) $ Just cid _ -> do maybe (return ()) signalDisconnect =<< readIORef (winMotionSignal view) writeIORef (winMotionSignal view) Nothing case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> runAction . EditorA $ do -- b <- gets $ (bkey . findBufferWith (viewFBufRef view)) -- focusWindow window <- findWindowWith winRef <$> get withGivenBufferAndWindow window (viewFBufRef view) $ do moveTo p1 setVisibleSelection False -- (Gdk.Events.SingleClick, _) -> runAction focusWindow (Gdk.Events.ReleaseClick, Gdk.Events.MiddleButton) -> do disp <- liftBase $ widgetGetDisplay (drawArea view) cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary let cbHandler :: Maybe R.YiString -> IO () cbHandler Nothing = return () cbHandler (Just txt) = runControl (runAction . EditorA $ do window <- findWindowWith winRef <$> get withGivenBufferAndWindow window (viewFBufRef view) $ do pointB >>= setSelectionMarkPointB moveTo p1 insertN txt) control liftBase $ clipboardRequestText cb (cbHandler . fmap R.fromText) _ -> return () liftBase $ widgetQueueDraw (drawArea view) return True handleScroll :: View -> Gdk.Events.Event -> ControlM Bool handleScroll view event = do let editorAction = withCurrentBuffer $ vimScrollB $ case Gdk.Events.eventDirection event of Gdk.Events.ScrollUp -> -1 Gdk.Events.ScrollDown -> 1 _ -> 0 -- Left/right scrolling not supported runAction $ EditorA editorAction liftBase $ widgetQueueDraw (drawArea view) return True handleMove :: View -> Point -> Gdk.Events.Event -> ControlM Bool handleMove view p0 event = do logPutStrLn $ "Motion: " <> showT (Gdk.Events.eventX event, Gdk.Events.eventY event) -- retrieve the clicked offset. (_,layoutIndex,_) <- liftBase $ layoutXYToIndex (layout view) (Gdk.Events.eventX event) (Gdk.Events.eventY event) tos <- liftBase $ readIORef (shownTos view) let p1 = tos + fromIntegral layoutIndex let editorAction = do txt <- withCurrentBuffer $ if p0 /= p1 then Just <$> do m <- selMark <$> askMarks markPointA m .= p0 moveTo p1 setVisibleSelection True readRegionB =<< getSelectRegionB else return Nothing maybe (return ()) setRegE txt runAction $ makeAction editorAction -- drawWindowGetPointer (textview w) -- be ready for next message. -- Relies on uiActionCh being synchronous selection <- liftBase $ newIORef "" let yiAction = do txt <- withCurrentBuffer (readRegionB =<< getSelectRegionB) :: YiM R.YiString liftBase $ writeIORef selection txt runAction $ makeAction yiAction txt <- liftBase $ readIORef selection disp <- liftBase $ widgetGetDisplay (drawArea view) cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary liftBase $ clipboardSetWithData cb [(targetString,0)] (\0 -> void (selectionDataSetText $ R.toText txt)) (return ()) liftBase $ widgetQueueDraw (drawArea view) return True processEvent :: ([Event] -> IO ()) -> Gdk.Events.Event -> IO Bool processEvent ch ev = do -- logPutStrLn $ "Gtk.Event: " <> show ev -- logPutStrLn $ "Event: " <> show (gtkToYiEvent ev) case gtkToYiEvent ev of Nothing -> logPutStrLn $ "Event not translatable: " <> showT ev Just e -> ch [e] return True gtkToYiEvent :: Gdk.Events.Event -> Maybe Event gtkToYiEvent (Gdk.Events.Key {Gdk.Events.eventKeyName = key , Gdk.Events.eventModifier = evModifier , Gdk.Events.eventKeyChar = char}) = (\k -> Event k $ nub $ notMShift $ concatMap modif evModifier) <$> key' where (key',isShift) = case char of Just c -> (Just $ KASCII c, True) Nothing -> (Map.lookup key keyTable, False) modif Gdk.Events.Control = [MCtrl] modif Gdk.Events.Alt = [MMeta] modif Gdk.Events.Shift = [MShift] modif _ = [] notMShift | isShift = filter (/= MShift) | otherwise = id gtkToYiEvent _ = Nothing -- | Map GTK long names to Keys keyTable :: Map.Map Text Key keyTable = Map.fromList [("Down", KDown) ,("Up", KUp) ,("Left", KLeft) ,("Right", KRight) ,("Home", KHome) ,("End", KEnd) ,("BackSpace", KBS) ,("Delete", KDel) ,("Page_Up", KPageUp) ,("Page_Down", KPageDown) ,("Insert", KIns) ,("Escape", KEsc) ,("Return", KEnter) ,("Tab", KTab) ,("ISO_Left_Tab", KTab) ] yi-frontend-pango-0.13.7/src/Yi/Frontend/Pango/Layouts.hs0000644000000000000000000003417613120261666021335 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Frontend.Pango.Layouts -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Provides abstract controls which implement 'Yi.Layout.Layout's and -- which manage the minibuffer. -- -- The implementation strategy is to first construct the layout -- managers @WeightedStack@ (implementing the 'Stack' constructor) and -- @SlidingPair@ (implementing the 'Pair' constructor), and then -- construct 'LayoutDisplay' as a tree of these, mirroring the -- structure of 'Layout'. module Yi.Frontend.Pango.Layouts ( -- * Getting the underlying widget WidgetLike(..), -- * Window layout LayoutDisplay, layoutDisplayNew, layoutDisplaySet, layoutDisplayOnDividerMove, -- * Miniwindow layout MiniwindowDisplay, miniwindowDisplayNew, miniwindowDisplaySet, -- * Tabs SimpleNotebook, simpleNotebookNew, simpleNotebookSet, simpleNotebookOnSwitchPage, -- * Utils update, ) where import Control.Applicative import Control.Arrow (first) import Control.Monad hiding (mapM, forM) import Data.Foldable (toList) import Data.IORef import qualified Data.List.PointedList as PL import qualified Data.Text as T import Data.Traversable import Graphics.UI.Gtk as Gtk hiding(Orientation, Layout) import Prelude hiding (mapM) import Yi.Layout(Orientation(..), RelativeSize, DividerPosition, Layout(..), DividerRef) class WidgetLike w where -- | Extracts the main widget. This is the widget to be added to the GUI. baseWidget :: w -> Widget ----------------------- The WeightedStack type {- | A @WeightedStack@ is like a 'VBox' or 'HBox', except that we may specify the ratios of the areas of the child widgets (so this implements the 'Stack' constructor of 'Yi.Layout.Layout'. Essentially, we implement this layout manager from scratch, by implementing the 'sizeRequest' and 'sizeAllocate' signals by hand (see the 'Container' documentation for details, and http://www.ibm.com/developerworks/linux/library/l-widget-pygtk/ for an example in Python). Ideally, we would directly subclass the abstract class 'Container', but Gtk2hs doesn't directly support this. Instead, we start off with the concrete class 'Fixed', and just override its layout behaviour. -} newtype WeightedStack = WS Fixed deriving(GObjectClass, ObjectClass, WidgetClass,ContainerClass) type StackDescr = [(Widget, RelativeSize)] weightedStackNew :: Orientation -> StackDescr -> IO WeightedStack weightedStackNew o s = do when (any ((<= 0) . snd) s) $ error "Yi.Frontend.Pango.WeightedStack.WeightedStack: all weights must be positive" l <- fixedNew set l (fmap ((containerChild :=) . fst) s) void $ Gtk.on l sizeRequest (doSizeRequest o s) void $ Gtk.on l sizeAllocate (relayout o s) return (WS l) -- | Requests the smallest size so that each widget gets its requested size doSizeRequest :: Orientation -> StackDescr -> IO Requisition doSizeRequest o s = let (requestAlong, requestAcross) = case o of Horizontal -> (\(Requisition w _) -> fromIntegral w, \(Requisition _ h) -> h) Vertical -> (\(Requisition _ h) -> fromIntegral h, \(Requisition w _) -> w) totalWeight = sum . fmap snd $ s reqsize (request, relSize) = requestAlong request / relSize sizeAlong widgetRequests = totalWeight * (maximum . fmap reqsize $ widgetRequests) sizeAcross widgetRequests = maximum . fmap (requestAcross . fst) $ widgetRequests mkRequisition wr = case o of Horizontal -> Requisition (round $ sizeAlong wr) (sizeAcross wr) Vertical -> Requisition (sizeAcross wr) (round $ sizeAlong wr) swreq (w, relSize) = (,relSize) <$> widgetSizeRequest w in boundRequisition =<< mkRequisition <$> mapM swreq s -- | Bounds the given requisition to not exceed screen dimensions boundRequisition :: Requisition -> IO Requisition boundRequisition r@(Requisition w h) = do mscr <- screenGetDefault case mscr of Just scr -> Requisition <$> (min w <$> screenGetWidth scr) <*> (min h <$> screenGetHeight scr) Nothing -> return r -- | Position the children appropriately for the given width and height relayout :: Orientation -> StackDescr -> Rectangle -> IO () relayout o s (Rectangle x y width height) = let totalWeight = sum . fmap snd $ s totalSpace = fromIntegral $ case o of Horizontal -> width Vertical -> height wtMult = totalSpace / totalWeight calcPosition pos (widget, wt) = (pos + wt * wtMult, (pos, wt * wtMult, widget)) widgetToRectangle (round -> pos, round -> size, widget) = case o of Horizontal -> (Rectangle pos y size height, widget) Vertical -> (Rectangle x pos width size, widget) startPosition = fromIntegral $ case o of Horizontal -> x Vertical -> y widgetPositions = fmap widgetToRectangle (snd (mapAccumL calcPosition startPosition s)) in forM_ widgetPositions $ \(rect, widget) -> widgetSizeAllocate widget rect ------------------------------------------------------- SlidingPair {-| 'SlidingPair' implements the 'Pair' constructor. Most of what is needed is already implemented by the 'HPaned' and 'VPaned' classes. The main feature added by 'SlidingPair' is that the divider position, *as a fraction of the available space*, remains constant even when resizing. -} newtype SlidingPair = SP Paned deriving(GObjectClass, ObjectClass, WidgetClass, ContainerClass) slidingPairNew :: (WidgetClass w1, WidgetClass w2) => Orientation -> w1 -> w2 -> DividerPosition -> (DividerPosition -> IO ()) -> IO SlidingPair slidingPairNew o w1 w2 pos handleNewPos = do p <- case o of Horizontal -> toPaned <$> hPanedNew Vertical -> toPaned <$> vPanedNew panedPack1 p w1 True True panedPack2 p w2 True True {- We want to catch the sizeAllocate signal. If this event is called, two things could have happened: the size could have changed; or the slider could have moved. We want to correct the slider position, but only if the size has changed. Furthermore, if the size only changes in the direction /orthogonal/ to the slider, then there is also no need to correct the slider position. -} posRef <- newIORef pos sizeRef <- newIORef 0 void $ Gtk.on p sizeAllocate $ \(Rectangle _ _ w h) -> do oldSz <- readIORef sizeRef oldPos <- readIORef posRef let sz = case o of Horizontal -> w Vertical -> h writeIORef sizeRef sz when (sz /= 0) $ if sz == oldSz then do -- the slider was moved; store its new position sliderPos <- get p panedPosition let newPos = fromIntegral sliderPos / fromIntegral sz writeIORef posRef newPos when (oldPos /= newPos) $ handleNewPos newPos else -- the size was changed; restore the slider position and -- save the new position set p [ panedPosition := round (oldPos * fromIntegral sz) ] return (SP p) ----------------------------- LayoutDisplay -- | A container implements 'Layout's. data LayoutDisplay = LD { mainWidget :: Bin, implWidget :: IORef (Maybe LayoutImpl), dividerCallbacks :: IORef [DividerRef -> DividerPosition -> IO ()] } -- | Tree mirroring 'Layout', which holds the layout widgets for 'LayoutDisplay' data LayoutImpl = SingleWindowI { singleWidget :: Widget } | StackI { orientationI :: Orientation, winsI :: [(LayoutImpl, RelativeSize)], stackWidget :: WeightedStack } | PairI { orientationI :: Orientation, pairFstI :: LayoutImpl, pairSndI :: LayoutImpl, divRefI :: DividerRef, pairWidget :: SlidingPair } --- construction layoutDisplayNew :: IO LayoutDisplay layoutDisplayNew = do cbRef <- newIORef [] implRef <- newIORef Nothing box <- toBin <$> alignmentNew 0 0 1 1 return (LD box implRef cbRef) -- | Registers a callback to a divider changing position. (There is -- currently no way to unregister.) layoutDisplayOnDividerMove :: LayoutDisplay -> (DividerRef -> DividerPosition -> IO ()) -> IO () layoutDisplayOnDividerMove ld cb = modifyIORef (dividerCallbacks ld) (cb:) --- changing the layout -- | Sets the layout to the given schema. -- -- * it is permissible to add or remove widgets in this process. -- -- * as an optimisation, this function will first check whether the -- layout has actually changed (so the caller need not be concerned -- with this) -- -- * will run 'widgetShowAll', and hence will show the underlying widgets too layoutDisplaySet :: LayoutDisplay -> Layout Widget -> IO () layoutDisplaySet ld lyt = do mimpl <- readIORef (implWidget ld) let applyLayout = do impl' <- buildImpl (runCb $ dividerCallbacks ld) lyt widgetShowAll (outerWidget impl') set (mainWidget ld) [containerChild := outerWidget impl'] writeIORef (implWidget ld) (Just impl') case mimpl of Nothing -> applyLayout Just impl -> unless (sameLayout impl lyt) $ do unattachWidgets (toContainer $ mainWidget ld) impl applyLayout runCb :: IORef [DividerRef -> DividerPosition -> IO ()] -> DividerRef -> DividerPosition -> IO () runCb cbRef dRef dPos = readIORef cbRef >>= mapM_ (\cb -> cb dRef dPos) buildImpl :: (DividerRef -> DividerPosition -> IO ()) -> Layout Widget -> IO LayoutImpl buildImpl cb = go where go (SingleWindow w) = return (SingleWindowI w) go (s@Stack{}) = do impls <- forM (wins s) $ \(lyt,relSize) -> (,relSize) <$> go lyt ws <- weightedStackNew (orientation s) (first outerWidget <$> impls) return (StackI (orientation s) impls ws) go (p@Pair{}) = do w1 <- go (pairFst p) w2 <- go (pairSnd p) sp <- slidingPairNew (orientation p) (outerWidget w1) (outerWidget w2) (divPos p) (cb $ divRef p) return $ PairI (orientation p) w1 w2 (divRef p) sp -- | true if the displayed layout agrees with the given schema, other -- than divider positions sameLayout :: LayoutImpl -> Layout Widget -> Bool sameLayout (SingleWindowI w) (SingleWindow w') = w == w' sameLayout (s@StackI{}) (s'@Stack{}) = orientationI s == orientation s' && length (winsI s) == length (wins s') && and (zipWith (\(impl, relSize) (layout, relSize') -> relSize == relSize' && sameLayout impl layout) (winsI s) (wins s')) sameLayout (p@PairI{}) (p'@Pair{}) = orientationI p == orientation p' && divRefI p == divRef p' && sameLayout (pairFstI p) (pairFst p') && sameLayout (pairSndI p) (pairSnd p') sameLayout _ _ = False -- removes all widgets from the layout unattachWidgets :: Container -> LayoutImpl -> IO () unattachWidgets parent (SingleWindowI w) = containerRemove parent w unattachWidgets parent s@StackI{} = do containerRemove parent (stackWidget s) mapM_ (unattachWidgets (toContainer $ stackWidget s) . fst) (winsI s) unattachWidgets parent p@PairI{} = do containerRemove parent (pairWidget p) mapM_ (unattachWidgets (toContainer $ pairWidget p)) [pairFstI p, pairSndI p] -- extract the main widget from the tree outerWidget :: LayoutImpl -> Widget outerWidget s@SingleWindowI{} = singleWidget s outerWidget s@StackI{} = toWidget . stackWidget $ s outerWidget p@PairI{} = toWidget . pairWidget $ p instance WidgetLike LayoutDisplay where baseWidget = toWidget . mainWidget ---------------- MiniwindowDisplay data MiniwindowDisplay = MD { mwdMainWidget :: VBox, mwdWidgets :: IORef [Widget] } miniwindowDisplayNew :: IO MiniwindowDisplay miniwindowDisplayNew = do vb <- vBoxNew False 1 wsRef <- newIORef [] return (MD vb wsRef) instance WidgetLike MiniwindowDisplay where baseWidget = toWidget . mwdMainWidget miniwindowDisplaySet :: MiniwindowDisplay -> [Widget] -> IO () miniwindowDisplaySet mwd ws = do curWs <- readIORef (mwdWidgets mwd) -- we could be more careful here, and only remove the widgets which we need to. when (ws /= curWs) $ do forM_ curWs $ containerRemove (mwdMainWidget mwd) forM_ ws $ \w -> boxPackEnd (mwdMainWidget mwd) w PackNatural 0 widgetShowAll $ mwdMainWidget mwd writeIORef (mwdWidgets mwd) ws ---------------------- SimpleNotebook data SimpleNotebook = SN { snMainWidget :: Notebook, snTabs :: IORef (Maybe (PL.PointedList (Widget, T.Text))) } instance WidgetLike SimpleNotebook where baseWidget = toWidget . snMainWidget -- | Constructs an empty notebook simpleNotebookNew :: IO SimpleNotebook simpleNotebookNew = do nb <- notebookNew ts <- newIORef Nothing return (SN nb ts) -- | Sets the tabs simpleNotebookSet :: SimpleNotebook -> PL.PointedList (Widget, T.Text) -> IO () simpleNotebookSet sn ts = do curTs <- readIORef (snTabs sn) let nb = snMainWidget sn tsList = toList ts curTsList = maybe [] toList curTs -- the common case is no change at all when (curTs /= Just ts) $ do -- update the tabs, if they have changed when (fmap fst curTsList /= fmap fst tsList) $ do forM_ curTsList $ const (notebookRemovePage nb (-1)) forM_ tsList $ uncurry (notebookAppendPage nb) -- now update the titles if they have changed forM_ tsList $ \(w,s) -> update nb (notebookChildTabLabel w) s -- now set the focus p <- notebookPageNum nb (fst $ PL._focus ts) maybe (return ()) (update nb notebookPage) p -- write the new status writeIORef (snTabs sn) (Just ts) -- display! widgetShowAll nb -- | The 'onSwitchPage' callback simpleNotebookOnSwitchPage :: SimpleNotebook -> (Int -> IO ()) -> IO () simpleNotebookOnSwitchPage sn = void . (snMainWidget sn `on` switchPage) ------------------- Utils -- Only set an attribute if has actually changed. -- This makes setting window titles much faster. update :: (Eq a) => o -> ReadWriteAttr o a a -> a -> IO () update w attr val = do oldVal <- get w attr when (val /= oldVal) $ set w [attr := val] yi-frontend-pango-0.13.7/src/Yi/Frontend/Pango/Utils.hs0000644000000000000000000000122113120261666020756 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Random GTK utils module Yi.Frontend.Pango.Utils where import Control.Exception (catch, throw) import Data.Text (append) import Paths_yi_frontend_pango import System.FilePath import Graphics.UI.Gtk import System.Glib.GError loadIcon :: FilePath -> IO Pixbuf loadIcon fpath = do iconfile <- getDataFileName $ "art" fpath icoProject <- catch (pixbufNewFromFile iconfile) (\(GError dom code msg) -> throw $ GError dom code $ msg `append` " -- use the yi_datadir environment variable to" `append` " specify an alternate location") pixbufAddAlpha icoProject (Just (0,255,0)) yi-frontend-pango-0.13.7/art/c-source.png0000644000000000000000000000030513120261666016345 0ustar0000000000000000PNG  IHDR  XDgAMA a0PLTEO&I@IDATcU  J_|``#?h~{90G}C1!IENDB`yi-frontend-pango-0.13.7/art/dependencies.png0000644000000000000000000000032713120261666017257 0ustar0000000000000000PNG  IHDRygAMA a0PLTEO&IRIDATM 0˺tvү4^2#$R:(&ynZ[T 0ZP1'{Y"YJ x !AlňIENDB`yi-frontend-pango-0.13.7/art/exposed-file-module.png0000644000000000000000000000032513120261666020476 0ustar0000000000000000PNG  IHDR  XDgAMA a0PLTEO&IPIDAT-!0DA\jj\#.Wq(~3b>+\-tn˝BR~]B GW\F2yB恱IENDB`yi-frontend-pango-0.13.7/art/exposed-module.png0000644000000000000000000000037613120261666017567 0ustar0000000000000000PNG  IHDR /yssRGBgAMA a cHRMz&u0`:pQ<|IDAT(S}R ?DuKX渡x޷uwVog=Arڄ O &hFU@x$ikWZ[P {n 2x 9{&H&8ݾyp IENDB`yi-frontend-pango-0.13.7/art/h-source.png0000644000000000000000000000031113120261666016347 0ustar0000000000000000PNG  IHDR  XDgAMA a0PLTEO&IDIDATcU  DH9DDa| ?ᷗ Ba{IENDB`yi-frontend-pango-0.13.7/art/hidden-file-module.png0000644000000000000000000000034513120261666020264 0ustar0000000000000000PNG  IHDR]RgAMA a0PLTEO&I`IDAT-10 CQo ^[ֈ{pnf OO1<S  G l?VSxv$P cm` _yux mJ ) IENDB`yi-frontend-pango-0.13.7/art/hidden-module.png0000644000000000000000000000033013120261666017341 0ustar0000000000000000PNG  IHDR /ysgAMA aIDAT(S} }?ub`0s {?\ݟXF&И#0{?`DjEC *n૔@r 4cu&CU-RZFj2 t89b-ZPB; 3uIENDB`yi-frontend-pango-0.13.7/art/hs-source-folder.png0000644000000000000000000000032013120261666020003 0ustar0000000000000000PNG  IHDRygAMA a0PLTEO&IKIDATcX V@ ۷/` Ȩ D.SقY0,8n4IENDB`yi-frontend-pango-0.13.7/art/license-file.png0000644000000000000000000000032613120261666017167 0ustar0000000000000000PNG  IHDR  XDgAMA a0PLTEO&IQIDATcU  D?|;޾L.s?|v(r`:jD&C IENDB`yi-frontend-pango-0.13.7/art/package.png0000644000000000000000000000030213120261666016215 0ustar0000000000000000PNG  IHDR]RgAMA a0PLTEO&I=IDATcX @d w (`X}}}CWGDdL@U @ iKC 9IENDB`yi-frontend-pango-0.13.7/art/plain-folder.png0000644000000000000000000000027613120261666017210 0ustar0000000000000000PNG  IHDRygAMA a0PLTEO&I9IDATcX V@ ۷/` ȨrE0@vA;/ϢIENDB`yi-frontend-pango-0.13.7/art/project.png0000644000000000000000000000040513120261666016274 0ustar0000000000000000PNG  IHDRbxsRGBgAMA a cHRMz&u0`:pQ<IDAT(SR  ӟe !7nb՝=!`W4D!QcՏv q,t *bY A"xJ=>˩z%NV\niܨtCXҹGIENDB`yi-frontend-pango-0.13.7/art/setup-script.png0000644000000000000000000000036513120261666017275 0ustar0000000000000000PNG  IHDR]RgAMA a0PLTEO&IpIDAT-1 0MO.*`O,.ݙCESJp`LMEQb>T}̋`S&T)w0*kA7pw\׉1AIENDB`yi-frontend-pango-0.13.7/art/text-file.png0000644000000000000000000000026713120261666016535 0ustar0000000000000000PNG  IHDR  XDgAMA a0PLTEO&I2IDATcU  Jttg'A)CPrԁIENDB`yi-frontend-pango-0.13.7/art/yi+lambda-fat-128.png0000644000000000000000000005425513120261666017557 0ustar0000000000000000PNG  IHDRbKGDC pHYsHHFk> vpAg01WIDATx]u@T~.4( vbbvwwww\ʵ[PT D@fyߧW/ ?rΜ9gޙy!_С'#"4bE$5KbאI\dywI\v$%q~ZHKI|XQb޳]-̲{Trew _Nt@b'g$!qItu`7JHb'jn9H1 /+C{]mhB1$nު%M=e+է9 V|9"qБؾ򿳻FēJ3IbgB$@`Ğ%8M#t6Xo#n'qo·N8 z|!SoJqĪ'+t'͑ [K|&,_)jH\6IܑsU:Ev;cY\qo 1ϗ9`D&uQ%Oe{ξ_)(qZָF"=Igq/+H2_z՛dP9H'ޖ<ކst[Ca@BD`ţ*) <=)\ftBesT9\-;PԤ*jI3λ/=ȡNz{/G\8w22+N>SR{·C$~\d~9`0g t}~H4%5l~^(ɪ |pc=V_vqf! ۩hю)̐{j(v@#s}Re+5 g]}tv:\;R}t_e9oUUVɋ>;(TC^O$.9Ő^mx[EʤNV2RNܖolk֢@%TC3_OJm) =ƔZo=t5G'XD]kUPxf߸Pm |u@1bJ~Ģ5UPҭږ(r$#v_I%VGsA|5[f?D"PhWHF+- oʢQ5QNz\]H)ʞB aq c0*/뷞hn V] 7Ż݀@euj ۬\r6%RB)]m5RhKG;;3+ȳ0‹9aل.Wǿ̠WUGP!xwD7+=z~|LɧݦP*j?#IWbEQ ?& ~] *:b2`m:Ǫbj;rPeX2x)NE-JH@V ttG9zJ̩OwK|)Fl+!ª{eCtJm2Nޞ J4bIGYNd֭H֙\$M$k9L &eqEVYCd|)HDnFlkcl-+TRlM U{5o=0mx3n @xJ2f;.D`sHܖ:8<(rR'<e}a[!șznOXGLcÐ#_ B{@Zά; ePk* ^!+ڳNlffIj!_ x;Kn/^,t m==l|(qfvo!kGJ>4{"Gd"MJ_t?gcmcML 'fɽ$bb#|mg7/_zh|Hx}㣑@лykU4B&B+[@G%αFdr@ēɀ@/,949{ʛqT^eCqˁ؄INq޺Oaǁ @A۾oW" D'-1*evgKh02;/'%x9O[}o>,f{5,J0!Cs튷dyV3jEՎ[&>Q z+ g"6H<> qp1VM EKAQOh>RM5ri[$ );>3܄ue# '`Қ`\3p (I'TXr]q؝ޏ1;rYJi<ffK@pjy),@ue٨'q}mFJ\Ψ^82_S6g~Fkh@B~7Hy W\&mNJA|VN[|ڵz( gk }@[Pm)qUw]89{-tV505`(>*lt_ l['}];M|YSzW<=)hŽ_X6?5rZxlz6{=`oM :u*=/\?߀PUTky?I\ 1\ů貝/Ll;(]utLz09Ŀ8t ITHV kj1NkE;_Np:,S@12x X\wx^F D@"$+4ec7rDx>U9G6Y.Iz$(i& 7Tb>&؅ϩd/ E/i{SAa8dw2q浴a ޾{ú+/xU 8m9Kķ'>=pF]`l}٬+;\[U_ _0??\hB+_ܧjTMJ:*V[F@Mf$nKyT\ -Keqœ|p0;agw5{@:S{q-c4;+Q P6#jl<6ѪӀ^ UNq6efS翙S%=4Y/g/# Fw}_'*I9Zm2/Wy˕j;*;Ul nTlR U H ~y" ADD=P>bM@ؚЫ Aqr@Ha~';G ?~ELAn`e~*?T8{7" 9"穱F`휏9֖]s7Ks^s]r'9\ZyHs&9c:#BSKroÞl(H& s[X9JN~sZ\G6_~)<L:IY k@a:rB?+q)jIIZvbvh@@^4w$Rb[)$(G_eY e6C:uz^l[)t H49JO{]p }vOs{h53cB>󹩨fqrvh ”eIУ\qǀ̃/XFyzy*MVy/˽ 0cȦwrsEf^^U~aY@ 32yEŃf1zl6-gԐ#eS[GZH Mxꩡ&0ɦn]OS>ϢFm2}["ΠI @4drPSeAʕ w@ў+ۈCW՛AsFកiEYS{O&e9w=bn @w)%E6y \t0y)G@BǴs3= &Oǔ{9?7rviB(I .`-Rا=T8%įiMe*LDH3x(f2?-[b3GG$&r-~B1S2Ѥӥ^3F0gv$?r9 < ?M( ^cq6[2Xϥg.OVM#ϗEr?pFI) ZICT:. ݿj?tt('c9ѡkޗP{=y0oz%96xsH~qdm;.07&,/+&,Ķb= HvI6Nfńqw]bY"vϟ"$H,.-9 C 8_aW*UtX]§ ve GSo',irC;>T(BÚ01l:8e>S\l4 Ǫ{񲸍H1rKvkƃo瀰Ja>_ujvYǃ}{K'eįh.e/!Gdd'0f^ZU}TC|O(or?ߖ_Fz/bAWP b<8/޼^u자ŋ(8dϔhF[[kC滒$nCi$^EփK8v|0ӗ5^**+p$'bVs") ',ɺB'v(HM͔E!JAWbĆgH5Y-W %P-S&:3u{pynKF̛}dZ(#gD2 T6t6c;t[\yaKtJO\w މzS["N,8Y '$^OTVbJjB+ra;ф(&9Q?ʗo1ceV2ϐ=Oр"Dw# o&"`Y&q\>z[GtcfNy0pU@A@Qg$@'\ֲBe@V]M>V<rw@VJ'Sp[ڲ-"K vVRmHjnejk62 q(B"??`nti%)Mʤ|U׉\paGI댨pJf@eQmn O^k̦rؼ )X0mja餳Y4]|9tiuN2SX3g)%؁p{s~/H`x!.x.37P"@4 PoN)Ȑ\w>MȎoo*JR mdN*قSM>y,9&o|4ջX,]-BÅ.Ciu<|E) C /;mt}0@>FN`1[D^DНw`,`rɤ:@+_'Eg#/\e[6ȲyQ⦵$*4=M#G=%v* %tB-O+lH6njs[^),)O#܁{|_G10>'ޕ~qЭ3Iy(8pryp.[(ݠC!qVrw~@`QrDq([ΏA!SyEo*4Cqs);o% ֑J[;)T>OɃw5)$v8Nc>iP)YdC1T)7u?"ϦVC#3S'X>~IbF_RA o:$o6iޱ(a3 d$# ZI/RTh9MxR&FکؿoOEJ1'#<0AmWZm`+ s~iʔqcfMȞ+ބ@Ҟ $Um2| (BZJG?}㔟 ޤg@Sqؤ ?4IhEEO>j}%k,,_su6FziRn>o"xމ*TP! SW t+|NؗvWb 0|uONq8ML 3w)oBs 0`$0\=3$ 1Q壗dFyv#7uhS_M%RBi :zjȞOr/A7> qbbɀpN+$"/:Wl+^Phñ=BFjnUBcBMzJt%f$ ţHRm_FHߎ<4/G.UH0ω&Rh46*_v>&|zhW1/[Bwa_e5 ,!mchnۮ_ 3dx dN0@$wi#Ru͘~Qӓ]*`J 7'v Ya)oKf ?n @Hyx`so;ۍu馷 }  -|'D2Ƞ`sf  #3s|g Kܒ\MaWGnd]C;JxHVFbT*Q1΍?0u&e~ E{y\kJi;ad.Ta'lMꍩvmwoE<|HEʫdNNs6N+fx `Sf l ꬱpn /dy>@&A&(a d=ddS- AY uf E "(=e:BtDH14hoVlCNJ/${s[ZAƑ`)8Ñ(ULMZJ*[Pɹ3P$y0F'ӌ%k#<xE^LG|z G>7Q.oJ}b!CpakT*f)>bcm1@$",n2] N'Bq k`vC[@%uN}RtII\i=%)))gn3?)35nQTLx#LFt1Ki#t%%B6ZjDm1(զj.:J?em!t*]jl(YVU6'a%[Swk1 :b~~O D*xgIYvUD.HpC5 "39 疼:C 5ӻ x/; au&@ˆ:j9y##f [d0= pT'_K+mԺu;G:p8rTN̛eؓ\L䍾}ҩN+ۓ#9xtɵfղ Q.*Zy^A=_5.غ#ONV-":C:k(p}>"ە;@2EԞPz`&co]y!7O 7 A~BLfr @mVX)- !1OW뮎4{)X+Z ~OgMC\KZM'3u r)Z.LK2 GAtbBif=goP _qљޕhWx0ţߤ`kI?I|Oa-TW^sЃ6c[f, "lN_u1fXUI\sĕc.sӑ@_?L)@Oޠ\ 0,7n_ȿ1RJ̷pY@$r;)00I4Ym(}6Aq!s+fHD}apZ9+G1^ ^zQN=mɏ'^/u Xof %9$aWȤRZU%J]eM?_|kqc? s&Gc0,^L|p wpG2]XBY /vp~a%ߑ3(2 D! O3_";\d9B)Q9xܠ=|l)h$J5f rg+ $GaKC|yiAu?//]= _\|T)@<#nQ?qL񈳑؄s-9kgg,q)hgёBɥ9N;GNJ»V6ZZ"BAa?+ӿQ/B Ex@sbVo^hyC:aq=(WdddO7!_gby˾iZ8n~û A<;]՗KqX>/Hg% q8gpfSG8"Me.?r%-Umռ7pp++>Wߍ~<ii,?+YA|wSbSJmNց"-Mʆp'aHQ@O ) 7Xekd`4ҲPPA5v67mxzEM|P>;rSiyqr}m*?~6ԇ[+?emh"ZTDtt"l2I;nT>H/jt?J2vB<'VT> elkIVCC_'ʰ*  :a@$'>`*$&BN6]Ƚno+iʪXޑučh]R^NOdK ,TFVgm s;մ 0 ́_T<|OH  vT\t#}/?tm:FF#$6AQ=me .EZ~Koz J#}i.Pe@-=q8P=\_5"+K܂<cd^_mV'zw' B>l[ ]Di wz7Fݸ1R1MH r3FWA6tj%DfW%eۊ['XȷC@i- ?i:m;Ӿ)Q~!g8 ?+u\=)4f8e]UadׄgGa i< I9YmLܷppX*@Y=IU/%EFk H['IɕNU,?E[\7>Y3]h 4׫0И}ofzV5P`;+fq{a':=2)%HRsgX-t ~S} J}dl8UqW,|oV =y \`6F+T^/}?zwy@^9걓Ak{&ϼ&\ѕ) h &.q}M\JʧmYdVV0fl7'Eͱ>8j klu5]r۬5qj `n~KɡcC8 Ɵ)q'@i?yvlL)*-xvN08ղa<ƒ[fgeڴ_S| ?K0H5aF|(\~g =ht샮OI߅}ؖ=;^β |iϥJHJFT9ٯQs`d$۫SnrunCrRàӭ[)URWvNS,,6OC Ϟ1[cpכV w^o!=M*м][y{(mmp]s5مsvڐO攖YN$c 6QP? /0I[cbC l$['Nv4û:]A*xFow.80w>mZ1sN<,ƅ' XV4[T ҁT>))]mv~B֒?s蒒v39"uղ$V|dI]L]۝Lj\r';:s7^c0/>+?]_JyHh,kUm)`m<< ; 'J.#"R@+䬬*rMDY~}yZQ'Ea=--O- ,=9Y,48 q!h įE=S{U,VA.-3vPaʛ`yYt>"pMa㣹_:$A{%ϦL `(,aP@ ;v1.JI "n[rE5 Hhk QXQPeP^hU5ֺ,iYY#JpBp`VvmLh:o璘0^ EG|dH ZҭjM֤[{7-.EDW!o$-X?6-k06`,Z$Hpm|jcC^ys@i?p+Q"m#[4OWsYc<pF;]L@۞5q@!Gܜ뉧}z&3(U rlva}R9 W': 8*l;xmr@K~Ogu<Vx{&@(\Tp_S@%R>IQLJ4-3fu|Иe@N2"K)0 }5SR) o,H.o.fۚ*_~z֘;=;詓^#OSOl-@^NF#|5񵀎N;b"m}vâģU(mQ6etpǷ ~a@eO. dTM?ǟEwc1f ȪWZRDVV>R`O|F)OS&gW4j5``od1PQ5M+t))ω>Ҏ؇D@9 5{;q-[q Il:;K/q;=z'VY#%k>ApS|Jڃ2&YNc{EcuѴ:3)>f&}Hc's@,#UOaH~4hFe*DGD*?0G ]VN,ǩIr@ cP|4MA4|6~S{3򆀓eYc@OfPPJ+<4#=kD}ȯ(FAZ'~2_pu ~Q^ݗžlA@ RYK:^ݘi-Xn"4J-˳tХz|Gq(UW鷠 !A/x Zzjm_ þKqouN{q\_lH̕X#֟zv`1`UQN'G!bU1@# OiNوS{a)fĆi G'=t>T~w9Wgo4/$-=Xi r!nu|,ɹ(CFw8ÐY@䁕 9K܄VTnي*:b @'y8j5n=\] `e @JvT'r}C*Vc3&s]񪩵 6 ,D^u,fFj99m}A[P ~OLIHsg>4 +'Z_pjx`$  >ORk]J҇2<#Mx*YRIWҒ䔆]Fu ?:F+=eJ#9R+ T]<[R.6=L{ge/jtӮ)PVs62$Xv$n!b`'{gcc4h8;6/^4c;s[2w=R&b k/R$AKrGi^WrYKNھA> 꼬7vֳWBEt$k@%=OS0nYOjӸyUȨf4Bos:&rʴ7[L 5,UZuײH@%|Jqx[} 9)UDx=[׽U^|#}V ?Қ(Z*ӄWh׎/dIN Y+:ctjwYn5|i@~XSePGl.w|*2H蒮/)sQ>cPtWAF1Or+XV+Ж^Y:a`SF]&@WY vOx{,רMihQi,ϭG+K}2_ ZjP4{qMGQF܄r1N'Iaj״ЗHd Es1[cÛ;vl9HN(PCֿJUbeSuE GH!;R95NlOz{ {i% ;4)3`]` ˫W4~p$Vۖ- IbQRj=OpN/KGMt:DJV4 ʜ+JAgGtkĭ)uW= B?2wN'Oim!U `븍'nq;y|+'l:Îs2R{/q%#J_s:/IJr*|"(ɚ]aGڰ h9I@%d/d@"߉ V% 2[_?` HAE+otJ1iIMzwiGpXG1@AQW(JY]e$ܠMAT9o.\&z_8 a2d4chOwg:;UQFTJ(鑲7Ow3(:΢1XsKOQ/q gح{H$NߓcO콽PMUfݮ۔Q&|g!Aߛ;B_zx_o:=J3Ek"R/JčhEoJ+}76u9%PSyN%vUb-0i^)cZE_v42x637RS$GƗG{ ^0/;&5s%Ǟ:D)0+0OY,BL8yN-$u k@:zmYJbZ]jiXVkm*2BpׂJ){#0μb>]#kTcZ?^sʋ 64.kےxڜ&yjyMp}[H"ǡ%tt*LG*im)`lш>]g?[mh~ء''XG,.. /=H1<B}lmRj,U'G:=U)q7:/)'=)edn-走3p_"[mW)onϭ(q]2n c 4LD :>OhO ~P iQRÄ@p햹Oiᖬ`/"(*SB+VÛ5g&ɞ't6ewG!Ck!m)EزG]XvE>ϵwΣNfzBo/P+l[ $N.X_|n/J[z-k+{SCP([;UItsģWKQFgz6*%$wS˷}A㻒Mf3pHnlhb70e8e =vv\|I]'jT6SyN+tF鷹pK).XP*$V:;:2AXw#pxqK,<͕e1l%Y9seCI /ˮ>3ߕx x0bPH!)aK?\`JGmj)d$!GQ)kzTdqc/D6:r򣲾( ^Cuoۡ&a?=VOXEfrEnKZsW[+7@ HS 1:@E/W>ԝٰjdvpŖ5E jj䫐V]kF-; O=EN(Gkdz4S{^0b>@6)Q7 B!"D֕dD<=Rno `s17bHsM6\ZaƘV&{52<ˉ-02Z. 0>O{^|uL0Z`laf QCæ̜{أXšR:76 tGGtŔejNCaY 3r3rCf yt7"/F _΀[;;N)V9/{CHfɿ:ozB]n>;{|j;<n`hY,Nid5NS̔a4#ǡ-]fF FL`S^@FZ:=l>ܑYco({Cq_oJFv>uɮFLSn|rA3ɡ9MX8h-u>~<pX ͸}5drD0)<ߞ)6JPb}ZhtFPVdgo aKRn8 |$o{Q;WaS1Q[3XuzBЦBXOo>?n|ފuw oV^u:Wtic\ФSN_'ULkSx1_Lmo7%α$WZ3%J.(bF@NO<09)BiQ09uhA S _) *ӝlPj'Y*RtJxCN ܭaR='cIV8^[??pd\Kw! qo iGJ-\zV[pglƞ=|Rc%03W?'=#S0WR&W޶FTw~P8cpHqz0'Eɧےt(l&Ի~p >"D%nv}^qǁ71'= ,w]Ӿj1RV)sl`Iuvj&O$ǹ0'\fNGH90# COkķ#:o7uC# &l[?Zt&tB?h;#́{,j |]DcJV W zITlCZ{GΝ>q%28oL,f^_p/53);l腴B/: LW >%Ky#ƕrY>?3e@]7 טj?)==YP'D6oFi!ˉJX-#&En~dCg*V/:wQΦR'!o~0q gaGS 0`"Pe@3-<!^@:+ii s@5 ZxuEQ;n ԺUcˀe^"xQ%R <= 3 p{J {U⎤M')kYķGSxf+ ce?Y!@;r{I*lVv?h2앖~[|:վ(|omb;+-`G GM/%W?^5C7@┄V2 w\N* _b S]d 7vD*-@)yƍ\ξ8{ZVі]~t2v$8yڅY4%3Gc2 5q,/{g>- o5Pϵmu]}rp,xǵL DSѫ9i+]7]27 ҔyiS=_[( L~2˃tiIa5sgKAEATdiRIHQ(""^0V`3; :Hژ!_gЫ\m8PVqL4oc|/e%er%N֩B~{&wK,3Ȥ߅VGSftxFm;:VvLrrIDg(S6}FM&!kذb>^Xټ=<$$!_绠`Ty@?'RZ;Za( ̌ K۟('e٣2CĽ9;tDZdmF22 s$~GGst9D@T2.GV}_>>N4Һ -|oymIƅ,8 ė߽/T#3qdՔ60R_e8@;^ZCk>'>:tEXtcomment Created with Inkscape (http://www.inkscape.org/) IENDB`yi-frontend-pango-0.13.7/art/yi+lambda-fat-16.png0000644000000000000000000000271313120261666017463 0ustar0000000000000000PNG  IHDROc#"bKGDC pHYsHHFk> vpAg\ƭIDATHǭkTWg7!(!j(PA҆X jD(*- BlURZтp@>@ C!l?XmΝ._T44+MXMP6H͸Cj#$F LF-$s.M^+"D(!1ڎ ekLڂ4d, 0FW#9|:AgJ_+L:fN;y^G\ܯ듅a)Lc)oځ׬)+ Ilǯ'\sǗzp3{d^O9^ UP2F'ETK8Msv:{ 0j]PW@ݭO&q ezQ)xX00['M8t9%CL_Tp9{- p~A^n`̣œ&u+6 cgm'Fnp8"2QZJp^X~ikE.nj#rl"-px|øQs'bφZh?Fs& qܽP."AZgd}XE/ my.Vnda!~*UjH2v ҎQ)&Ta=/HENa]1Q׮gB$·!%-)ONVy3h_](k%O3Fʀ^lS7yD9-W=RӶ6D:D9E83bĎ..WM{w|(#ah z,~ȁoeINPk~_MRt؟{z1PkҽkuG2p h`A+~)D!ǵ/e:tEXtcomment Created with Inkscape (http://www.inkscape.org/) IENDB`yi-frontend-pango-0.13.7/art/yi+lambda-fat-32.png0000644000000000000000000000742113120261666017462 0ustar0000000000000000PNG  IHDR #ꦷbKGDC pHYsHHFk> vpAg VIDAThřy\.u/n"ML{2JIeT(Te 1dd*4eV*2"W֌҆6{;^?g;y>|D32bZ_" 0Gc 2m>nNi)Doڸ=<7MXmC6S|0.ap+ :&L3%>k1 e1h" u^o/$TK dZǭAߵTW|ѭqa>'uWUؔ^0}mX'zH5'RӪ$&\8{?na]{ wZLa\  d>izаY^8nj1.;E"IOf z?)KH7`cB_oM?PAx_fiZhe\^ 5CfNx 12ezrykQ@#3~UXfY $tQMuh4R`IzԞ"!.vh#Cpwfq*|k ?SM;20X *WN|D浈0B:E^0[k@X.[dѓQ8Gjčӣ|x4!ѥ1VF/Ĥi w57uv^FP,]+F %T5rr[EA_:AYU۹ nߥsqžqII^Uh߭eL1^nj4;)> PnjIImDz1# Z}[/4ƋmFn<1*ryǓR Г{wף-f|7[WƚNt[v / 5+ ;͔͉0ףN} -{wyЛϊg(6հTI4IE@opRV^24D&lOM BrB5 _jQl ,zRC]iNSe3N^~vsu'p Ms}GKW F<,9U.aGMxEy=a }Y}Q O!7:TCƝE&+$ʩ` #k 5DtW'_<PxhY)Ƚ]+)^V$zNo>nޚ>W\ZచN8Жþ®c{v)8:[C]Ȯd# ҘTt3d,wk׃3we)Q8k3"hUԊpUtueVǜ$QcKǶ_g\&y}̪@",u4 xo%p@B&<^(jJ+Smvl_laDtDZ sBp(9u^ |LwcSҊ-N^,O_}I.S+^"u3 B 2ÎJX%yB8t3+)wQIˮ\1=,1b%gߎ >2Nd~6 _$PfwL Y%z-8e/"nιЊkJ__ ~eVfwӉߞa0m2os?uOhT>~J;Vm}Mkhf(<uj @^?q(;zԫv^qG&skE\+%V(+=@LT%ܖ2RVTcJmطQ=Rc D|T;J ܋Yia?ߟǍDZtqX?^ en"%[?D TuYƴܠ:' ވ_{66},ۉ8#;؋u xs!qfrjܑZ>dЍ1ܝr?YvM\QbSܐQaFE0;-hH/mǣ[6HŝS..@rn-龘 X4Fn.! ݬA}D&Q===e](\T@hfڴIobZ 61  &ԤGueaΆGDaR^0QBuhPQ/=ũ[S@BJ*uvŜue SJW-G<v GO}w U;?04^6d޲ ;r]£]¤i ^vYdqE\rz죉V6\vĸT3mVzIB?y?7tb2I,ʩlrDeMJV3:] hf{'}C΍Nm402rfY[iUFSb2NRSS[#& Zv3-)R9W >zхXN&qfEF&]dg5췛$c&tT=5RxUZ3weO&ut[ʵWJt¨/C..pA1Ce}F@.ɕ5_QX{Rao8%)Vn)kh%:tEXtcomment Created with Inkscape (http://www.inkscape.org/) IENDB`yi-frontend-pango-0.13.7/art/yi+lambda-fat-64.png0000644000000000000000000002362513120261666017473 0ustar0000000000000000PNG  IHDR@@bKGDC pHYsHHFk> vpAg@@`&IDATx}g@3]zAbņ{oJ5jwi Q@TEva&?_ؙs;z7&tE]: *\@60_$` xڹ% s8W/=o xuJ+ |'&:?o'@ ! S = #|k[~Í8DqkU@E:\pJ(v&y W# '\'`|]7 \&h{ yw;%\k `5) Z̜))\OA U<~ȇ'alZ_8נּdG>E?j=$_r@ޒ<~@bހ"7G;MDD}n#w@)JQR5mKX;뎀 |x. b_$?J*\@C_] KFt4nh4{Ѳ: %#-7@C:HA\~|;3i`[5}m64~ PcFQXO\\ܐؒ{"Лo]n x$6KWҸ}1 Ќc-Jq@[%` )[', `l&hCfɣnnRj&G;kf6q_wOuD"傹@a7WNW_r@^(Z?p /tc=`_>y (nZ/n?IoWoXP6nUV]Ӎse@MYzYu.*וhJoMع'ynN} 叴7le${'Nn:PP.bN*Sj ݼj% fj)W G& k+{6M PFEʕW5](:`'/[`eQdm :toľ N0 Ja1ސF 2`2b^@ؑwv?q`uz%Uk̴8vuuT7Psy朧=}d3DxIVj}-SrG,4ҳdܧ}bܬosu:ܒ# g#neG;mZ̎bO92ّ@fżژZ}t%Pk]M lBZ͛M0*2Yt~榯4^_'Ko!v0 oڮV\TZc>,6V5<9o. `՘!+_8 PPD{={p}UCAfl M>w@iܾe:l@-f". Q`=7;OΗ*/q@϶<$& 222^J]K&cID:f>l>׈ DL"!QsLBnYjn3م5'Jm̘N0DD.`̘pў1?XTKe8;*pV(&`AS%K#Y.;4"`:POo Oȁ4njvԝ+,F֜ Tk(ڢ{E2BS&='nNH9Ts*_sdKxGW@65*sEvҥs/k+]fVclyOxƎg,`/<ǀ1S -;ΫLvƸW~]IZe|izJvvi)`T0Dn|3|qydKtoT~̦M >8`E~deP4d&PP<@ȝ#+ т{y9b= +oGH r8'.`dAtZqߝy(c/| cMXl\i&JhZ'@zē]6X'(Kl*Yʘ SU1&#$a:{eG.`]Kѿ $QC"ߤj T uHY4>Pa߂/4iuЏ FXqF>=[j(cU/A檌k/:yak^xLҨT:@E}[oLJR:qt 7 P|JJul;mwՇZ5սbGkb[T =|>\?w۸`Jw7/jQRusq#l>}>K'@.%}zS*2-)ZWDˑF ´uyrƣEu]LcbAlb#`8l9ڲn윌Nh4HEY%;ͥ/A "z- Ma%Y9+@ZL,WMn-#y>mfUtGi|;~, p7 q=9o@\4ȏw9y1y.W!l>/cv6^"_R8*sFc1yذ| <*->,m^'~6>t*vc?9;!9ďe6+cvW 2k50 S1!DJh7\) ,^7'י6gK6λzFT1Vu^Ɍia k W>xT|N.fa͙OS:ˀ2u#Ȫ6RG}Z͓LAu`\mInq0N9 =jP/;K% Spa򵀪)\T#92qSԝE+<|(R¿%OU>IԠܐ2=6Q{v=)l}*FAB:0>G]#& >U9f@sf1CCHKbV Iҥ{h>-ϘcR&W)gPEߖ8kb+{3c0YZ:of|yώsfnoEߖo,Mt !{):$]J- '%DT7dmیPn+u-OYߓύcc"K ]r+5Zkgi߀pV?Yg;x4$x2>Rx&0,]f~ȋ%!hӇc>"r\}LD$ێg3zNqtw2 ؆A.IN-`] ]<船7FvaYWf WfUj&Pmu u\7v%RWy{G6uE`5WN:Ytp@7sq7I[C}A*H' *^A>^pmf ȥ~)ɀHr4xiР]s:GuDaf'A Y /W-+4YY3_ Fwj~ij: սj#y{-tuothiP< ;DqK9%(wPݑ(6I-FO_nrb7PYUjېLgp:d<J_aU \_ ` 1yKE]?"6tFZX^Rx w9~mN&28ɟ :I$C-PHG d˶0S#1jG]3yM9{"M^* 9*efcNYϘ`=$)9tY!U] PvOime7rպ/4jɻ}4K;=uZMw,jd kʈ#GRƉ%2̩oy⩒QG8[[kK?NɘoXw[c'R!Gc*ؘJM7<@_ شw^5k()Z}ؼfVoL'ܜcYa.a`La)FN0XAQW$;txaV๮OkjEw+ @?*nh]?^quYn>:PZ*MT b0,.v@椌c*OZz(g?ǔ iiK^#<[v]6o2&)eVc=.?شOc xs:Ө@6p0ޖh!.,ޘX<@q1#A>Y/K a9R~a^N`hq7OXS#hпp:1F.*撖/elJ -7p֌I_g׶i;G?~N4!:=.mI~1r QŇÁh8<8vc)ǜ#Zˮ_<XbB7廉 fhD/DgCUCBryG%myvv57>\;x+oGJb,`BG:VY_pcUjr[+$o/.Qcr,$"s\)Y-SUrkv~zD3{nMXr10;<𢓢( cwF1e߮ 6s ~WH̑ºCIQ_ۮ}ÀEs,OߢQ)02,c[&y1z:ckr]^yRe3(}'iB텲qQ\La꨽6,y=S.Qg.yrw`jƎ\Y̘_ӐF|f<W AϜ*(L.\ 鼊&c XW_׎ow~_s-yGw2;gU;*bSyz9z+#~xp0I4Z6'K.,NU^P-uֲ+ N:RoDb)hv @K,X VEu=ԠF*kO>|'PBW1s'>9΅?hRR͍瀨Oow~+8W3\tyi3e22>i]Ra]Yδ^S5FL"'X )fmg3!ƻI|UY;?PN;A1"i̋iCb[ǸF ul~xѓ!@vK5M)<hw_N.^EdQ⻝a4Okж 0I<|3c=U*Ie`ﶲS̵ y(;hTY[O5:lc/ڣ~~@.Y0*1sJ/+Ԁ-r4cZ6ϹgO,:edfyݭQChk]Q ? p͏1@ d 8.D &91}%@= ؅vq&7A;6dN﮼^w&Vv1îU2^f:h/*o])(oN{#l6H8JH)hrPCYK'LTNm1P3`J@ >dɜ Dn> QX6RI|vtJǗc,~?Z N_[̽{0ukɎ@&Enj>J|Fbrɒ*rT؊C%\E)#(m}}w'7ͼ.@P6\eRAbP&eFiYvS*޹1<ݺA+`tF>]Oo&DkYK4t1'0f7Sgljig=KUꅲ%If=q(ؽؾ7?1e, Z0˥n]uZ(I4P$A.,; E.I>4?ZuA@ʚգ7 h@~ңT OU J|$$-Hؾ=߅*J[}kjiCT#|:wKuZ|zNL @)~פ9pc%:}\Fq}ET$f?rJ SroJySk{M`s|U?܀ZM[tj"4~TZѪ_RB ]sw,T"*z11 IդVVY:EpzKD;7 R*%٘AY9}Cu֮^ƚ=mս#cj2c-gޝ z\ϳPf{bp2Pz#[ 2ȿ1nc[*-W16Au<̏zƏapE [O}-9i>}! Lpto 9+m&y>T'[!TqPR,u ej 1fV[co^Gͪ_l fM"Eߚ2**K x[ .1iI3K1sKytj9mWF߽[kJ]^7Ѐt^uLĚULzzG%ӄ5DO)uo$IG/!7Ʋ/tH O7 xc5IGuo#Pӷ5kcf͗5}aN;<vZF7n/YlW]z;wⳎ&ğbNIw2 RjAftZ@$gOEvm8Kew(̛W #o]pܹ 9EJ@J/}%yU@%~+{W\~~"Y=?]n&L ڴ7MrƧ4ĿTFJ>E^dJYx&yhQDڰk 8TyKo*RB+fSXvUJ⊽E dɵ6sNw Q1B[@[;dzfbU1|,qJNp%Ї>gL.몴cI5? + %UUЅ_?;j_R"%e#iC ,%/W/Jj (*'.T+UL8=dOhc;0Y{ЭO?Z8;ܳ-aYgu+Қ afD" Fw8NЍ'h?9pJ.-H]KD?uSyE//>b_Y@1Qx$7sv|!h[KA [O~;3- ? 9{ɠ},Vv9ge1YI \KɊ#(XZLkHճ' 5Du4 H4Qx*l>D*h%A%AB لl7\7BҩNҩ|Xkuwn([-Vhuo3P-p^3qc}ҖIUE>}*sK'TIe}]fM!WQ```fІgpK0=%[XmV=|aA1$~N$M?U :tEXtcomment Created with Inkscape (http://www.inkscape.org/) IENDB`yi-frontend-pango-0.13.7/art/yi+lambda-fat.pdf0000644000000000000000000001431213120261666017222 0ustar0000000000000000%PDF-1.3 % 0 0 obj << /Length 23 /Filter /FlateDecode >> stream x+TT(c}\C|@1 endstream endobj 1 0 obj << /Type /Pages /MediaBox [0 0 612 792] /Count 1 /Kids [ << /Type /Page /Parent 1 0 R /Resources << /ProcSet [ /PDF ] /XObject << /Fm1 2 0 R >> >> /Contents 0 0 R /MediaBox [0 0 204.8 204.8] >> ] >> endobj 2 0 obj << /Length 4785 /Type /XObject /Subtype /Form /FormType 1 /BBox [0 0 204.8 204.8] /Resources << /ProcSet [ /PDF ] /ColorSpace << /Cs1 [ /ICCBased 3 0 R ] >> >> /Filter /FlateDecode >> stream xmKrHD\Wg+5ȬFAY߬A;rPzBu;_3?.,ﯻ;1םwJi{~5:fuy'giםgRiy~Yi>XRJ+oY/cygLs6yg9xקTlJ|bٍb)3]?8%>Xo~ц?IS+_:y&}\{p^ck,RS[Ʈy-lw<3s2doR_zҮpEߞ<5+=R|/\o!t=[i@\|3yݞs8^y~/v3*^ĩ^UXij= %ލ3젧=.|o"ƺ!R@E˃hf|™3|59*' jY 3ɑJy,Q= he4,/ I:a9Gaմ+EP@ 4#psȆs R AId22HWq'9A#"͵A-Sz,P]]?\dAo}ӁcUIROS5*iq`3|_ ֿ{1,9%Telbzt ܴ-Zu)onű`,|T%KڜPpr@N;/QTxC>Lk !͖W*DY!ʀدdJ 򬋸m;Mޯ"2oId' S憯!yұ"4qfB.sκz8Plcq O柧H2@6gk}XcyB[ YwuWbi');4k?syKe.|uB@rXHoԇA1't\$_h k|[`v&Q+,n]tO<P!n|wj;U&Μ`7'=K4Y2[zh?BU6,::vgtQn8>@Df3!)!mZD)*A;_) {٬Mr#Y-?a*yb<5c2"fx7<+|KwT+d.e QwZ$otbw;xHL-|o'sX%48ZSҰ[r؝@uGqD$608h,y6Tgf5FDͬߵ^Ф4X|Ԇ{ jHeC31Kb-ꆵ;0=wAv,9^H\Au$X)wV AOˈeL'^/;8f,D[Mn)u 9g;P.!UK/3- ؗ׊F֨R Ĺ*z0G@ a[ ڿ4 E,a)IǏ=+J:\ڨEy96_[ TPfN[PﯕmZP*^u+"L >Ԁ@g)ɧi럎yӶ!d=6mSY_:{g+ Mq}6UQ[>`)ݎŒCXw\|yjSe_`ۙǖJd_6JWYۥ )w&k(t VV k; եO,vY=)* z/!9z(_##5s/M:ba6gP@Z&5ׁy2 ;F[`]ΖwzT?GaVӐq6Ck'2j'mz`%Ť[ZHDt+-' 2wXRL JOzQ#-tCaR[NZ!j%K@c?|w-;M'w}FZr AG5,ˊd=˜ؚBdθlњdE~5D<0S.gmTGBdxhZtsgR:2tL5, >{!I#]S*wt* P l4ē?ӐcvuxB769huJWag;%1wȏ|d_<{ 7D D jgc a<LWT((qJ|_ )! hj0U +F=JX60PCx˕Vƒ-:Q5{fBLTR$i %XkDrDa(Ƙ93:ڂ%~šcR~1uǴ  m e|A5@|ek9%8l"1RӋ?i+bqb]2Hы;ki%WFg9mvb.bMRe7E_k`GleX@fu.iǴJټ{PMAРY_`u"〾LiW|0J&Vr$fnYCu>JrIمJ vZbX+B+gկS"/ صZVt(::*M b+W0%e.IpHjSEw9l.BOMab),܈Ps NhMDЍ84hSi%P;0_t|sW"/#4(KAnkis(uÓ3ԥ΢ /^,1Z1ƴؒ 9 PSxaNJ+ ԲC `v#K`wtʶR`S}Bi $-(֒Ecy*9Q>('aw8B+2̂L \: r195r˥9+|:F^=. K'8+wcAe 4h"c3:3N/˦^ jܨMg) )==ǩ@1^}ͨr^,L`AUFKDxz˖ ]-O5>S>] $}iF?0/ָ| :8Gv=Zsg3Yo˱1IX u+7ǡFz>*K*8X>\/2 ڣY8"xboz5 DFo~BW/49 5;V\0{-O*wXfL24o)Jp)9dXtow܃8n uD1kYb۫Ny,©q[t]a-F kYG3fM.rĽStZے X>x:ˌlO#%ǧHvh+cAd\m݌J/UB+ӂg`{sF _ӟ#3(Xk+y\΍6* CθTS`9 7{;LH/׉sj0ޅbp]kP4u9taɤr!R;e+ ;}9čcN9N}`.1zCblou}1lmg VG͝2b׬ 3,ɏ#`ŀKd-Ș7z :3e6c0 =_#iH8})&n I1?߲Lkҿ%@,Գwn:h/K޼8mzs@ 3!R~ ƶ7v=uVd9fJaQHq}#>*xqo_aً=V?xg`ü;ZLcOGX>#sFx*Xѣ̛#DV|/RS@i -P;|ʡ??snPD(d!^9k{1I=P!WH%:p^&}P6$F0x"EH9bkw~ht endstream endobj 3 0 obj << /Length 706 /N 3 /Alternate /DeviceRGB /Filter /FlateDecode >> stream x}OHQǿ%Be&RNW`oʶkξn%B.A1XI:b]"(73ڃ73{@](mzy(;>7PA+Xf$vlqd}䜛] UƬxiO:bM1Wg>q[ 2M'"()Y'ld4䗉2'&Sg^}8&w֚, \V:kݤ;iR;;\u?V\\C9u(JI]BSs_ QP5Fz׋G%t{3qWD0vz \}\$um+٬C;X9:Y^gB,\ACioci]g(L;z9AnI ꭰ4Iݠx#{zwAj}΅Q=8m (o{1cd5Ugҷtlaȱi"\.5汔^8tph0k!~D Thd6챖:>f&mxA4L&%kiĔ?Cqոm&/By#Ց%i'W:XlErr'=_ܗ)i7Ҭ,F|Nٮͯ6rm^ UHW5;?Ͱh endstream endobj 4 0 obj << /Type /Catalog /Pages 1 0 R >> endobj xref 0 5 0000000022 00000 n 0000000116 00000 n 0000000330 00000 n 0000005332 00000 n 0000006137 00000 n trailer << /Size 5 /Root 4 0 R >> startxref 6186 %%EOF yi-frontend-pango-0.13.7/Setup.hs0000644000000000000000000000012613120261666014766 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-frontend-pango-0.13.7/yi-frontend-pango.cabal0000644000000000000000000000323513121266603017657 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: yi-frontend-pango version: 0.13.7 synopsis: Pango frontend for Yi editor category: Yi homepage: https://github.com/yi-editor/yi#readme bug-reports: https://github.com/yi-editor/yi/issues maintainer: Yi developers license: GPL-2 build-type: Simple cabal-version: >= 1.10 data-files: art/c-source.png art/dependencies.png art/exposed-file-module.png art/exposed-module.png art/h-source.png art/hidden-file-module.png art/hidden-module.png art/hs-source-folder.png art/license-file.png art/package.png art/plain-folder.png art/project.png art/setup-script.png art/text-file.png art/yi+lambda-fat-128.png art/yi+lambda-fat-16.png art/yi+lambda-fat-32.png art/yi+lambda-fat-64.png art/yi+lambda-fat.pdf source-repository head type: git location: https://github.com/yi-editor/yi library hs-source-dirs: src ghc-options: -Wall -ferror-spans build-depends: base >= 4.8 && < 5 , containers , filepath , glib >= 0.13 && < 0.14 , gtk >= 0.13 && < 0.15 , microlens-platform , mtl , oo-prototypes , pango >= 0.13 && < 0.14 , pointedlist , text , transformers-base , yi-core , yi-language , yi-rope exposed-modules: Yi.Config.Default.Pango Yi.Frontend.Pango Yi.Frontend.Pango.Control other-modules: Yi.Frontend.Pango.Layouts Yi.Frontend.Pango.Utils Paths_yi_frontend_pango default-language: Haskell2010