-- Author:     Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
-- 
-- Copyright (C) 2010 Andy Stewart, all rights reserved.
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE ExistentialQuantification, RankNTypes, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Manatee.Extension.Editor.SourceView where

import Control.Applicative
import Control.Concurrent.STM 
import Control.Monad
import Data.Map (Map)
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Graphics.UI.Gtk.SourceView.SourceLanguage
import Graphics.UI.Gtk.SourceView.SourceLanguageManager
import Manatee.Core.DBus
import Manatee.Core.PageFrame
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Extension.Editor.SourceBuffer
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Gtk
import Manatee.Toolkit.Gtk.Multiline
import Paths_manatee_editor
import System.FilePath
import Text.Printf

import qualified Data.Map as M
import qualified Graphics.UI.Gtk.SourceView.SourceBuffer as SB
import qualified Graphics.UI.Gtk.SourceView.SourceView as SV

data SourceView =
    SourceView {sourceViewPlugId          :: TVar PagePlugId
               ,sourceViewFrame           :: PageFrame
               ,sourceViewView            :: SV.SourceView
               ,sourceViewBuffer          :: SourceBuffer
               }
    deriving Typeable

instance PageBuffer SourceBuffer where
    pageBufferGetName           = readTVarIO . sourceBufferFilePath
    pageBufferSetName a         = writeTVarIO (sourceBufferFilePath a)
    pageBufferClient            = sourceBufferClient
    pageBufferCreateView a pId  = PageViewWrap <$> sourceViewNew a pId
    pageBufferMode              = sourceBufferMode
    pageBufferPackageName _     = fmap takeFileName getDataDir

instance PageView SourceView where
    pageViewBuffer              = PageBufferWrap . sourceViewBuffer
    pageViewPlugId              = sourceViewPlugId
    pageViewBox                 = pageFrameBox . sourceViewFrame
    pageViewScrolledWindow      = sourceViewScrolledWindow
    pageViewFocus               = widgetGrabFocus . sourceViewView
    pageViewCut                 = sourceViewCut
    pageViewCopy                = sourceViewCopy
    pageViewPaste               = sourceViewPaste
    pageViewHandleKeyAction     = sourceViewHandleKeyAction
    pageViewScrollToTop         = sourceViewScrollToTop
    pageViewScrollToBottom      = sourceViewScrollToBottom
    pageViewScrollVerticalPage  = sourceViewScrollVerticalPage
    pageViewScrollVerticalStep  = sourceViewScrollVerticalStep

-- | Internal function for create string buffer.
sourceViewNew :: SourceBuffer -> PagePlugId -> IO SourceView
sourceViewNew sb plugId = do
  -- Create plug id.
  pId <- newTVarIO plugId

  -- Create UI frame.
  pFrame <- pageFrameNewWithModeName (pageModeName $ sourceBufferMode sb)

  sourceView <- SV.sourceViewNewWithBuffer (sourceBufferBuffer sb)
  pageFrameAddChild pFrame sourceView

  -- Set default font of source view.
  fontDescr <- fontDescriptionFromString "Monospace"
  widgetModifyFont sourceView (Just fontDescr)

  let sv = SourceView pId pFrame sourceView sb

  -- Load syntax highlight.
  sourceViewSyntaxHighlight sv

  -- Customize setup.
  SV.sourceViewSetHighlightCurrentLine sourceView True      -- highlight current line.
  SV.sourceViewSetInsertSpacesInsteadOfTabs sourceView True -- use space instead tabs
  SV.sourceViewSetShowLineNumbers sourceView True           -- show line number
  textViewSetCursorVisible sourceView True                  -- make cursor visible

  -- Update status after expose.
  sourceViewView sv `afterExposeRect` \ _ -> do
    sourceViewDisplayPositionStatus sv -- display position
    sourceViewDisplayPercentStatus sv  -- display percent

  -- Handle selection mark.
  sourceViewHandleSelectionMark sv

  return sv

-- | Get text buffer.
sourceViewGetTextBuffer :: SourceView -> IO TextBuffer 
sourceViewGetTextBuffer = textViewGetBuffer . sourceViewView

-- | Get source buffer.
sourceViewGetSourceBuffer :: SourceView -> IO SB.SourceBuffer
sourceViewGetSourceBuffer sb = 
    SB.castToSourceBuffer <$> sourceViewGetTextBuffer sb

-- | Get buffer content.
sourceViewGetText :: SourceView -> IO String
sourceViewGetText = textViewGetText . sourceViewView

-- | Get current line.
sourceViewGetLine :: SourceView -> IO Int
sourceViewGetLine = textViewGetLine . sourceViewView

-- | Get line count.
sourceViewGetLineCount :: SourceView -> IO Int
sourceViewGetLineCount = textViewGetLineCount . sourceViewView

-- | Get current column.
sourceViewGetColumn :: SourceView -> IO Int
sourceViewGetColumn = textViewGetColumn . sourceViewView

-- | Display position information.
sourceViewDisplayPositionStatus :: SourceView -> IO ()
sourceViewDisplayPositionStatus sb = 
  liftM2 (printf "Pos (%d, %d)") (sourceViewGetLine sb) (sourceViewGetColumn sb)
         >>= pageFrameUpdateStatusbar (sourceViewFrame sb) "Pos"

-- | Display percent information.
sourceViewDisplayPercentStatus :: SourceView -> IO ()
sourceViewDisplayPercentStatus sv = do
  line <- sourceViewGetLine sv
  lineCount <- sourceViewGetLineCount sv
  pageFrameUpdateStatusbar (sourceViewFrame sv) "Percent" ("(" ++ show (floor (i2d (line * 100) / i2d lineCount)) ++ "%)")
  
-- | Handle selection mark.
sourceViewHandleSelectionMark :: SourceView -> IO ()  
sourceViewHandleSelectionMark sv = do
  -- Get source view.
  let sourceView = sourceViewView sv 

  -- Cancel selection when button press.
  onButtonPress sourceView (\_ -> textViewCancelSelectionMark sourceView >> return False)

  -- Update selection iter after buffer changed.
  buffer <- textViewGetBuffer sourceView
  onBufferChanged buffer (textBufferUpdateSelectionIter buffer)

  -- Apply selection iter when focus in.
  onFocusIn sourceView (\_ -> sourceViewApplySelectionMark sv >> return False)

  return ()

-- | Get string buffer language.
sourceViewGetLanguage :: SourceView -> IO (Maybe SourceLanguage)
sourceViewGetLanguage buffer = 
    SB.sourceBufferGetLanguage
        =<< sourceViewGetSourceBuffer buffer

-- | Set string buffer language.
sourceViewSetLanguage :: SourceView -> SourceLanguage -> IO ()
sourceViewSetLanguage buffer language = 
    (<=<) (`SB.sourceBufferSetLanguage` Just language) sourceViewGetSourceBuffer buffer

-- | Syntax highlight with file name.
sourceViewSyntaxHighlight :: SourceView -> IO ()
sourceViewSyntaxHighlight view = do
  lm <- sourceLanguageManagerNew
  name <- sourceViewName view
  (_, lang) <- sourceLanguageForFilename lm (Just name)
  lang ?>= sourceViewSetLanguage view

-- | Save buffer.
sourceViewSave :: SourceView -> IO ()
sourceViewSave a = do
  filepath <- sourceViewName a
  string <- sourceViewGetText a
  writeFile filepath string
  name <- sourceViewName a
  pageFrameShowOutputbar (sourceViewFrame a) ("Save " ++ name) Nothing

-- | Get buffer name.
sourceViewName :: SourceView -> IO String
sourceViewName = 
  pageBufferGetName . sourceViewBuffer

-- | Undo.
sourceViewUndo :: SourceView -> IO ()
sourceViewUndo a = do
  sb <- sourceViewGetSourceBuffer a
  ifM (SB.sourceBufferGetCanUndo sb)
          (do
            SB.sourceBufferUndo sb
            pageFrameShowOutputbar (sourceViewFrame a) "Undo!" Nothing)
          (pageFrameShowOutputbar (sourceViewFrame a) "No further undo information." Nothing)

-- | Redo.
sourceViewRedo :: SourceView -> IO ()
sourceViewRedo a = do
  sb <- sourceViewGetSourceBuffer a
  ifM (SB.sourceBufferGetCanRedo sb)
          (do
            SB.sourceBufferRedo sb
            pageFrameShowOutputbar (sourceViewFrame a) "Redo!" Nothing)
          (pageFrameShowOutputbar (sourceViewFrame a) "No further redo information." Nothing)

-- | String view wrap user action for undo/redo.
sourceViewWrapAction :: SourceView -> IO () -> IO ()  
sourceViewWrapAction  = textViewWrapAction . sourceViewView

-- | Newline.
sourceViewNewline :: SourceView -> IO ()  
sourceViewNewline = textViewNewLine . sourceViewView

-- | Open newline below.
sourceViewOpenNewlineBelow :: SourceView -> IO ()
sourceViewOpenNewlineBelow a = 
    textViewOpenNewlineBelow (sourceViewView a) (sourceViewScrolledWindow a)

-- | Open newline above.
sourceViewOpenNewlineAbove :: SourceView -> IO ()
sourceViewOpenNewlineAbove a = 
    textViewOpenNewlineAbove (sourceViewView a) (sourceViewScrolledWindow a)

-- | Select all.
sourceViewSelectAll :: SourceView -> IO ()
sourceViewSelectAll = textViewSelectAll . sourceViewView

-- | Delete.
sourceViewDelete :: SourceView -> IO ()
sourceViewDelete view = 
  textViewDelete (sourceViewView view) True True  >> return ()

-- | Cut.
sourceViewCut :: SourceView -> IO Bool
sourceViewCut view = do
  textViewCut $ sourceViewView view
  return True

-- | Copy.
sourceViewCopy :: SourceView -> IO Bool
sourceViewCopy view = do
  textViewCopy $ sourceViewView view
  return True

-- | Paste.
sourceViewPaste :: SourceView -> IO Bool
sourceViewPaste view = do
  textViewPaste $ sourceViewView view
  return True

-- | Forward line.
sourceViewForwardLine :: SourceView -> IO ()
sourceViewForwardLine a = do
    textViewForwardLine (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Backward line.
sourceViewBackwardLine :: SourceView -> IO ()
sourceViewBackwardLine a = do
    textViewBackwardLine (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Forward char.
sourceViewForwardChar :: SourceView -> IO ()
sourceViewForwardChar a = do
    textViewForwardChar (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Backward char.
sourceViewBackwardChar :: SourceView -> IO ()
sourceViewBackwardChar a = do
    textViewBackwardChar (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Forward word.
sourceViewForwardWord :: SourceView -> IO ()
sourceViewForwardWord a = do
    textViewForwardWord (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Backward word.
sourceViewBackwardWord :: SourceView -> IO ()
sourceViewBackwardWord a = do
    textViewBackwardWord (sourceViewView a) (sourceViewScrolledWindow a)
    sourceViewApplySelectionMark a

-- | Begin.
sourceViewScrollToTop :: SourceView -> IO ()
sourceViewScrollToTop a = do 
  textViewBegin (sourceViewView a) (sourceViewScrolledWindow a)
  sourceViewApplySelectionMark a

-- | End.
sourceViewScrollToBottom :: SourceView -> IO ()
sourceViewScrollToBottom a = do 
  textViewEnd (sourceViewView a) (sourceViewScrolledWindow a)
  sourceViewApplySelectionMark a

-- | Smart home.
sourceViewSmartHome :: SourceView -> IO ()
sourceViewSmartHome a = do
    textViewSmartHome $ sourceViewView a
    sourceViewApplySelectionMark a

-- | Smart end.
sourceViewSmartEnd :: SourceView -> IO ()
sourceViewSmartEnd a = do
    textViewSmartEnd $ sourceViewView a
    sourceViewApplySelectionMark a

-- | Delete forward char.
sourceViewDeleteForwardChar :: SourceView -> IO ()
sourceViewDeleteForwardChar view = 
  textViewDeleteForwardChar (sourceViewView view) False >> return ()

-- | Backward char.
sourceViewDeleteBackwardChar :: SourceView -> IO ()
sourceViewDeleteBackwardChar view = 
  textViewDeleteBackwardChar (sourceViewView view) False >> return ()

-- | Forward word.
sourceViewDeleteForwardWord :: SourceView -> IO ()
sourceViewDeleteForwardWord view = 
  textViewDeleteForwardWord (sourceViewView view) False >> return ()

-- | Backward word.
sourceViewDeleteBackwardWord :: SourceView -> IO ()
sourceViewDeleteBackwardWord view = 
  textViewDeleteBackwardWord (sourceViewView view) False >> return ()

-- | Delete to line end.
sourceViewDeleteToLineEnd :: SourceView -> IO ()
sourceViewDeleteToLineEnd view = 
  textViewDeleteToLineEnd (sourceViewView view) False >> return ()

-- | Delete to line start.
sourceViewDeleteToLineStart :: SourceView -> IO ()
sourceViewDeleteToLineStart view = 
  textViewDeleteToLineStart (sourceViewView view) False >> return ()

-- | Duplicate lines.
sourceViewDupLinesBelow, sourceViewDupLinesAbove :: SourceView -> IO ()
sourceViewDupLinesBelow = textViewDupLinesBelow . sourceViewView
sourceViewDupLinesAbove = textViewDupLinesAbove . sourceViewView

-- | Delete lines.
sourceViewDelLines :: SourceView -> IO ()
sourceViewDelLines view = 
  textViewDelLines (sourceViewView view) >> return ()

-- | Transposes lines.
sourceViewTraLinesBelow, sourceViewTraLinesAbove :: SourceView -> IO ()
sourceViewTraLinesBelow = textViewTraLinesBelow . sourceViewView
sourceViewTraLinesAbove = textViewTraLinesAbove . sourceViewView

-- | Reload file.
sourceViewReload :: SourceView -> IO ()
sourceViewReload sv = do
  -- Reload file.
  name <- sourceViewName sv
  textViewLoadFile (sourceViewView sv) name

  -- Move to view begin.
  sourceViewScrollToTop sv

-- | Set text.
sourceViewSetText :: SourceView -> String -> IO ()
sourceViewSetText = textViewSetText . sourceViewView

-- | String buffer keymap.
sourceViewKeymap :: Map Text (SourceView -> IO ())
sourceViewKeymap = 
    M.fromList 
         [("M-a",    sourceViewSelectAll)
         ,("M-s",    sourceViewSave)
         ,("M-d",    sourceViewDelLines)
         ,("M-D",    sourceViewDelete)
         ,("M-/",    sourceViewUndo)
         ,("M-?",    sourceViewRedo)
         ,("M-r",    sourceViewReload)
         ,("M-,",    sourceViewDeleteBackwardChar)
         ,("M-.",    sourceViewDeleteForwardChar)
         ,("M-<",    sourceViewDeleteBackwardWord)
         ,("M->",    sourceViewDeleteForwardWord)
         ,("M-C-,",  sourceViewDeleteToLineStart)
         ,("M-C-.",  sourceViewDeleteToLineEnd)
         ,("M-j",    sourceViewForwardLine)
         ,("M-k",    sourceViewBackwardLine)
         ,("M-l",    sourceViewForwardChar)
         ,("M-h",    sourceViewBackwardChar)
         ,("M-m",    sourceViewNewline)
         ,("Down",   sourceViewForwardLine)
         ,("Up",     sourceViewBackwardLine)
         ,("Left",   sourceViewForwardChar)
         ,("Right",  sourceViewBackwardChar)
         ,("Return", sourceViewNewline)
         ,("M-L",    sourceViewForwardWord)
         ,("M-H",    sourceViewBackwardWord)
         ,("M-P-h",  sourceViewSmartHome)
         ,("M-P-l",  sourceViewSmartEnd)
         ,("M-N",    sourceViewOpenNewlineBelow)
         ,("M-P",    sourceViewOpenNewlineAbove)
         ,("M-w",    sourceViewDupLinesBelow)
         ,("M-W",    sourceViewDupLinesAbove)
         ,("M-e",    sourceViewTraLinesBelow)
         ,("M-E",    sourceViewTraLinesAbove)
         ,("C-c",    sourceViewToggleSelectionMark)
         ,("C-C",    sourceViewExchangeSelectionMark)
         ,("C-o",    sourceViewOpenFile)
         ,("C-g",    sourceViewGotoLine)
         ,("C-G",    sourceViewGotoColumn)
         ]

-- | Open file.
sourceViewOpenFile :: SourceView -> IO ()
sourceViewOpenFile view = 
  localInteractive view "fOpen file : " $ \ [path] ->                       
      mkDaemonSignal (pageViewClient view) NewTab (NewTabArgs "PageEditor" path [])

-- | Goto column.
sourceViewGotoColumn :: SourceView -> IO ()          
sourceViewGotoColumn view@SourceView {sourceViewView = sourceView} = 
  localInteractive view "nColumn : " $ \ [column] -> do
      let number = read column :: Int
      textViewGotoColumn sourceView number
  
-- | Goto row.  
sourceViewGotoLine :: SourceView -> IO ()
sourceViewGotoLine view@SourceView {sourceViewView   = sourceView
                                   ,sourceViewBuffer = sourceBuffer} = do
  let buffer = sourceBufferBuffer sourceBuffer
  lines <- textBufferGetLineCount buffer
  localInteractive view ("nLine (1 - " ++ show lines ++ ") : ") $ \ [line] -> do
      let number = read line :: Int
      textViewGotoLine sourceView number

-- | Set selection mark.
sourceViewToggleSelectionMark :: SourceView -> IO ()
sourceViewToggleSelectionMark view = 
  ifM (textViewToggleSelectionMark $ sourceViewView view )
      (pageFrameUpdateStatusbar (sourceViewFrame view) "Selection" "Selection (Active)")
      (pageFrameUpdateStatusbar (sourceViewFrame view) "Selection" "Selection (Inactive)")

-- | Exchange selection mark.
sourceViewExchangeSelectionMark :: SourceView -> IO ()
sourceViewExchangeSelectionMark = textViewExchangeSelectionMark . sourceViewView 

-- | Show selection mark.
sourceViewApplySelectionMark :: SourceView -> IO ()
sourceViewApplySelectionMark = textViewApplySelectionMark . sourceViewView

-- | Scroll page vertically.
sourceViewScrollVerticalPage :: Bool -> SourceView -> IO ()
sourceViewScrollVerticalPage isDown a = do
  let sw = sourceViewScrolledWindow a
      tv = sourceViewView a
  pageInc <- (<=<) adjustmentGetPageIncrement scrolledWindowGetVAdjustment sw
  textViewScrollVertical tv sw (if isDown then pageInc else (- pageInc))
  sourceViewApplySelectionMark a

-- | Scroll step vertically.
sourceViewScrollVerticalStep :: Bool -> SourceView -> IO ()
sourceViewScrollVerticalStep isDown a = do
  let sw = sourceViewScrolledWindow a
      tv = sourceViewView a
  ti <- textViewGetTextIter tv
  (_, lineHeight) <- textViewGetLineYrange tv ti
  let stepInc = i2d lineHeight
  textViewScrollVertical tv sw (if isDown then stepInc else (- stepInc))
  sourceViewApplySelectionMark a

-- | Handle key action.
sourceViewHandleKeyAction :: SourceView -> Text -> SerializedEvent -> IO ()
sourceViewHandleKeyAction view keystoke sEvent = 
  case M.lookup keystoke sourceViewKeymap of
    -- Execute action when found in keymap.
    Just action -> action view
    -- Otherwise propagate event.
    Nothing -> widgetPropagateEvent (sourceViewView view) sEvent 

-- | Source view scrolled window.
sourceViewScrolledWindow :: SourceView -> ScrolledWindow    
sourceViewScrolledWindow =
  pageFrameScrolledWindow . sourceViewFrame