Implement scalable, per-buffer fonts

This allows us to resize the fonts used in the current buffer. When a
font needs to change in certain buffer, we do a deep copy for that
layout and go from there.

Having asked around, vim doesn't seem to have a key for such a thing by
default so I'm not binding anything. In emacs keymap it's C-+ and C--
like in actual emacs loaded with gtk support.

Vty does nothing new.

Fixes #608

CHANGELOG

@@ -28,6 +28,7 @@
  * Implement C-a for CUA (#167)
  * Fix dired for directories with unicode files/dirs (#445)
  * Fix vim indenting under some circumstances (#621)
+ * Allow the font size to be changed per buffer (#608)
 
 0.9.0
 -----

yi/src/library/Yi/Buffer/Misc.hs

@@ -173,6 +173,8 @@ module Yi.Buffer.Misc
   , commitUpdateTransactionB
   , applyUpdate
   , betweenB
+  , decreaseFontSize
+  , increaseFontSize
   ) where
 
 import           Control.Applicative
@@ -303,12 +305,20 @@ instance Binary (Mode syntax) where
       n <- E.decodeUtf8 <$> get
       return (emptyMode {modeName = n})
 
+-- | Increases the font size in the buffer by specified number. What
+-- this number actually means depends on the front-end.
+increaseFontSize :: Int -> BufferM ()
+increaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs + x)
+
+-- | Decreases the font size in the buffer by specified number. What
+-- this number actually means depends on the front-end.
+decreaseFontSize :: Int -> BufferM ()
+decreaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs - x)
+
 -- | Given a buffer, and some information update the modeline
 --
 -- N.B. the contents of modelines should be specified by user, and
 -- not hardcoded.
---
-
 getModeLine :: [T.Text] -> BufferM T.Text
 getModeLine prefix = withModeB (`modeModeLine` prefix)
 
@@ -544,6 +554,7 @@ newB unique nm s =
             , pointFollowsWindow = const False
             , updateTransactionInFlight = False
             , updateTransactionAccum = []
+            , fontsizeVariation = 0
             } }
 
 epoch :: UTCTime

yi/src/library/Yi/Config/Default.hs

@@ -123,7 +123,7 @@ defaultConfig =
              [] -> error "panic: no frontend compiled in! (configure with -fvty or another frontend.)"
              ((_,f):_) -> f
          , configUI         =  UIConfig
-           { configFontSize = Nothing
+           { configFontSize = Just 10
            , configFontName = Nothing
            , configScrollWheelAmount = 4
            , configScrollStyle = Nothing

yi/src/library/Yi/Keymap/Emacs.hs

@@ -158,6 +158,8 @@ emacsKeys univArg =
          , ctrlCh 'w'           ?>>! killRegion
          , ctrlCh 'y'           ?>>! yankE
          , ctrlCh 'z'           ?>>! suspendEditor
+         , ctrlCh '+'           ?>>! repeatingArg (increaseFontSize 1)
+         , ctrlCh '-'           ?>>! repeatingArg (decreaseFontSize 1)
 
          -- All the keybindings of the form "C-M-c" where 'c' is some character
          , ctrl (metaCh 'w')    ?>>! appendNextKillE

yi/src/library/Yi/Types.hs

@@ -221,21 +221,24 @@ data Attributes = Attributes
                 , pointFollowsWindow        :: !(WindowRef -> Bool)
                 , updateTransactionInFlight :: !Bool
                 , updateTransactionAccum    :: ![Update]
+                , fontsizeVariation         :: !Int
+                  -- ^ How many points (frontend-specific) to change
+                  -- the font by in this buffer
                 } deriving Typeable
 
 
 instance Binary Yi.Types.Attributes where
     put (Yi.Types.Attributes n b u bd pc pu selectionStyle_
-         _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum) = do
+         _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum fv) = do
       let putTime (UTCTime x y) = B.put (fromEnum x) >> B.put (fromEnum y)
       B.put n >> B.put b >> B.put u >> B.put bd
       B.put pc >> B.put pu >> B.put selectionStyle_ >> B.put wm
       B.put law >> putTime lst >> B.put ro >> B.put ins >> B.put _dc
-      B.put isTransacPresent >> B.put transacAccum
+      B.put isTransacPresent >> B.put transacAccum >> B.put fv
     get = Yi.Types.Attributes <$> B.get <*> B.get <*> B.get <*>
           B.get <*> B.get <*> B.get <*> B.get <*> pure I.End <*> B.get <*> B.get
           <*> getTime <*> B.get <*> B.get <*> B.get
-          <*> pure (const False) <*> B.get <*> B.get
+          <*> pure (const False) <*> B.get <*> B.get <*> B.get
       where
         getTime = UTCTime <$> (toEnum <$> B.get) <*> (toEnum <$> B.get)
 

yi/src/library/Yi/UI/Pango.hs

@@ -54,6 +54,7 @@ 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.UI.Pango.Control (keyTable)
 #ifdef GNOME_ENABLED
@@ -145,8 +146,12 @@ updateFont :: UIConfig -> IORef FontDescription -> IORef TabCache -> Statusbar
            -> FontDescription -> IO ()
 updateFont cfg fontRef tc status font = do
     maybe (return ()) (fontDescriptionSetFamily font) (configFontName cfg)
-    maybe (return ()) (fontDescriptionSetSize font . fromIntegral)
-      (configFontSize cfg)
+    -- case configFontSize cfg of
+    --   Nothing -> return ()
+    --   Just x -> fontDescriptionGetSize font >>= \case
+    --     Nothing -> return ()
+    --     Just cs ->
+    -- maybe (return ()) (fontDescriptionSetSize font . fromIntegral)
 
     writeIORef fontRef font
     widgetModifyFont status (Just font)
@@ -638,11 +643,37 @@ updatePango ui font w b layout = do
   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 do
+        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 font
-  when (oldFontStr /= newFontStr) (layoutSetFontDescription layout (Just font))
+  newFontStr <- Just <$> fontDescriptionToStringT curFont
+
+  when (oldFontStr /= newFontStr) $
+    layoutSetFontDescription layout (Just curFont)
+
 
   win <- readIORef (coreWin w)
   let [width'', height''] = fmap fromIntegral [width', height']