{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Window
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Operations on 'Window's, in the emacs sense of the word.

module Yi.Window where

import Data.Binary         (Binary (..))
import Data.Default        (Default (def))
import Data.Typeable       (Typeable)
import Yi.Buffer.Basic     (BufferRef, WindowRef)
import Yi.JumpList         (JumpList)
import Yi.Region           (Region, emptyRegion)
import Yi.Utils            (makeLensesWithSuffix)

------------------------------------------------------------------------
-- | A window onto a buffer.

data Window = Window
    { Window -> Bool
isMini    :: !Bool -- ^ regular or mini window?
    , Window -> BufferRef
bufkey    :: !BufferRef -- ^ the buffer this window opens to
    , Window -> [BufferRef]
bufAccessList :: ![BufferRef]
      -- ^ list of last accessed buffers (former bufKeys). Last
      -- accessed one is first element
    , Window -> Int
height    :: !Int -- ^ height of the window (in number of screen
                       -- lines displayed)
    , Window -> Int
width     :: !Int -- ^ width of the window (in number of chars)
    , Window -> Region
winRegion :: !Region -- ^ view area. note that the top point is
                          -- also available as a buffer mark.
    , Window -> WindowRef
wkey      :: !WindowRef -- ^ identifier for the window (for UI sync)
    -- This is required for accurate scrolling.
    -- Scrolling depends on the actual number of buffer
    -- lines displayed. Line wrapping changes that number
    -- relative to the height so we can't use height for that
    -- purpose.
    , Window -> Int
actualLines :: !Int
      -- ^ The actual number of buffer lines displayed. Taking into
      -- account line wrapping
    , Window -> JumpList
jumpList :: !JumpList
    } deriving (Typeable)

makeLensesWithSuffix "A" ''Window

instance Binary Window where
    put :: Window -> Put
put (Window Bool
mini BufferRef
bk [BufferRef]
bl Int
_w Int
_h Region
_rgn WindowRef
key Int
lns JumpList
jl) =
        Bool -> Put
forall t. Binary t => t -> Put
put Bool
mini Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferRef -> Put
forall t. Binary t => t -> Put
put BufferRef
bk Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [BufferRef] -> Put
forall t. Binary t => t -> Put
put [BufferRef]
bl Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WindowRef -> Put
forall t. Binary t => t -> Put
put WindowRef
key Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
lns Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JumpList -> Put
forall t. Binary t => t -> Put
put JumpList
jl
    get :: Get Window
get = Bool
-> BufferRef
-> [BufferRef]
-> Int
-> Int
-> Region
-> WindowRef
-> Int
-> JumpList
-> Window
Window (Bool
 -> BufferRef
 -> [BufferRef]
 -> Int
 -> Int
 -> Region
 -> WindowRef
 -> Int
 -> JumpList
 -> Window)
-> Get Bool
-> Get
     (BufferRef
      -> [BufferRef]
      -> Int
      -> Int
      -> Region
      -> WindowRef
      -> Int
      -> JumpList
      -> Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get
  (BufferRef
   -> [BufferRef]
   -> Int
   -> Int
   -> Region
   -> WindowRef
   -> Int
   -> JumpList
   -> Window)
-> Get BufferRef
-> Get
     ([BufferRef]
      -> Int -> Int -> Region -> WindowRef -> Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BufferRef
forall t. Binary t => Get t
get Get
  ([BufferRef]
   -> Int -> Int -> Region -> WindowRef -> Int -> JumpList -> Window)
-> Get [BufferRef]
-> Get
     (Int -> Int -> Region -> WindowRef -> Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [BufferRef]
forall t. Binary t => Get t
get
                   Get
  (Int -> Int -> Region -> WindowRef -> Int -> JumpList -> Window)
-> Get Int
-> Get (Int -> Region -> WindowRef -> Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0 Get (Int -> Region -> WindowRef -> Int -> JumpList -> Window)
-> Get Int
-> Get (Region -> WindowRef -> Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0 Get (Region -> WindowRef -> Int -> JumpList -> Window)
-> Get Region -> Get (WindowRef -> Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Region -> Get Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
emptyRegion
                   Get (WindowRef -> Int -> JumpList -> Window)
-> Get WindowRef -> Get (Int -> JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get WindowRef
forall t. Binary t => Get t
get Get (Int -> JumpList -> Window)
-> Get Int -> Get (JumpList -> Window)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (JumpList -> Window) -> Get JumpList -> Get Window
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get JumpList
forall t. Binary t => Get t
get


-- | Get the identification of a window.
winkey :: Window -> (Bool, BufferRef)
winkey :: Window -> (Bool, BufferRef)
winkey Window
w = (Window -> Bool
isMini Window
w, Window -> BufferRef
bufkey Window
w)

instance Show Window where
    show :: Window -> String
show Window
w = String
"Window to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BufferRef -> String
forall a. Show a => a -> String
show (Window -> BufferRef
bufkey Window
w)
             -- ++ "{" ++ show (tospnt w) ++ "->" ++ show (bospnt w) ++ "}"
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Window -> Int
height Window
w) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Eq Window where
    == :: Window -> Window -> Bool
(==) Window
w1 Window
w2 = Window -> WindowRef
wkey Window
w1 WindowRef -> WindowRef -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> WindowRef
wkey Window
w2

{-
-- | Is a given point within tospnt / bospnt?
pointInWindow :: Point -> Window -> Bool
pointInWindow point win = tospnt win <= point && point <= bospnt win
-}

-- | Return a "fake" window onto a buffer.
dummyWindow :: BufferRef -> Window
dummyWindow :: BufferRef -> Window
dummyWindow BufferRef
b = Bool
-> BufferRef
-> [BufferRef]
-> Int
-> Int
-> Region
-> WindowRef
-> Int
-> JumpList
-> Window
Window Bool
False BufferRef
b [] Int
0 Int
0 Region
emptyRegion WindowRef
forall a. Default a => a
def Int
0 JumpList
forall a. Maybe a
Nothing