--  GUI.hs: gtk UI for hircules IRC client
--
--  Author : Jens-Ulrik Petersen
--  Created: May 2003
--
--  Version: $Revision: 1.9 $ from $Date: 2008/11/03 03:14:11 $
--
--  Copyright (c) 2003 Jens-Ulrik Holger Petersen
--
--  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 2 of the License, or (at your option) 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.

module Hircules.GUI (addIRCchannel,
            alertchannel,
            allchannel,
            chanI,
            displayChannelTab,
            hideIRCchannel,
            newIRCchannel,
            rawchannel,
            renameChannelTab,
            setupGUI,
            timeStamp,
            updateChannelTab,
            writeTextLn,
            writeTextRaw,
            Interactive)
where

import Control.Concurrent
-- import Control.Exception
import Control.Monad (when, unless)
import Data.Char (isSpace, toLower)
import Data.Map (empty)
-- import Data.Maybe (fromMaybe, fromJust, isJust)
-- import System.Exit
import System.IO.Unsafe (unsafePerformIO)
import Data.Time.LocalTime (getZonedTime)

import Hircules.Channel
import Debug.State
import Hircules.EntryArea (setEditable)
import Graphics.UI.Gtk hiding (afterPasteClipboard)
import Graphics.UI.Gtk.Multiline.TextView(afterPasteClipboard)
import Graphics.UI.Gtk.Gdk.Events
-- import Hierarchy (toContainer)
import Graphics.UI.Gtk.Keymap
import Control.Monad.MaybeDo
import Hircules.Threads
import Text.WordString

-- tabchannel :: MVar (FiniteMap Int Channel)
-- tabchannel = unsafePerformIO $ newMVar empty

book :: Notebook
book = unsafePerformIO notebookNew

allchannel :: IRCChannel
allchannel = unsafePerformIO $ addIRCchannel "%all" "/" False

rawchannel :: IRCChannel
rawchannel = unsafePerformIO $ newIRCchannel "%raw" "/" False

alertchannel :: IRCChannel
alertchannel = unsafePerformIO $ newIRCchannel "%alert" "/" False

type MainWidget = Container

toMainWidget :: ContainerClass a => a -> MainWidget
toMainWidget = castToContainer

mainwidget :: MVar MainWidget
mainwidget = unsafePerformIO $ newEmptyMVar

mainwindow :: Window
mainwindow = unsafePerformIO windowNew

setupGUI :: IO ()
setupGUI = do
  initGUI
  let window = mainwindow
  windowSetDefaultSize window 496 382
  windowSetTitle window "Hircules IRC client"
  onDelete window (const $ shutDown >> return True)
  notebookSetScrollable book True
  notebookSetPopup book True
  onSwitchPage book updateTabN
  let initwidget = book
  putMVar mainwidget $ toMainWidget initwidget
  containerAdd window initwidget
  widgetShowAll window
  keymap <- newKeymap
  mapM_ (keymapAdd keymap) globalKeyBindings
  onKeyPress window $ keyPressCB keymap
  timeoutAdd (yield >> return True) 10
  return ()

globalKeyBindings :: [Keybinding]
globalKeyBindings =
    [ KB [Alt] "1" (switchToTab 0)
    , KB [Alt] "2" (switchToTab 1)
    , KB [Alt] "3" (switchToTab 2)
    , KB [Alt] "4" (switchToTab 3)
    , KB [Alt] "5" (switchToTab 4)
    , KB [Alt] "6" (switchToTab 5)
    , KB [Alt] "7" (switchToTab 6)
    , KB [Alt] "8" (switchToTab 7)
    , KB [Alt] "9" (switchToTab 8)
    , KB [Alt] "0" (switchToTab 9)
    , KB [Control,Shift] "W" hideCurrentChannel
    , KB [Control] "q" shutDown
    ]
  where
  switchToTab :: Int -> IO ()
  switchToTab n = do
      bookon <- widgetIsAncestor mainwindow book 
      unless bookon (switchTo book)
      notebookSetCurrentPage book n
  switchTo :: ContainerClass a => a -> IO ()
  switchTo widget = do
      displaying <- widgetIsAncestor mainwindow widget
      unless displaying $ do
        current <- takeMVar mainwidget
        containerRemove mainwindow current
        containerAdd mainwindow widget
        putMVar mainwidget $ toMainWidget widget

bufferKeyBindings :: IRCChannel -> [Keybinding]
bufferKeyBindings chan =
  [ KB [] "Return" (sendInput chan)
  , KB [Control] "r" (searchChannel chan True)
  , KB [Control] "s" (searchChannel chan False)
  ]

addIRCchannel :: String -> String -> Bool -> IO IRCChannel
addIRCchannel title nick real = do
  chan <- newIRCchannel title nick real
  displayChannelTab True chan
  widgetGrabFocus $ chanview chan
  return chan

displayChannelTab :: Bool -> IRCChannel -> IO ()
displayChannelTab switch chan = do
  let mainbox = chanbox chan
  pageno <- notebookPageNum book mainbox
  page <- case pageno of
             (Just p) -> return p
             Nothing -> do
                  n <- notebookGetNPages book
                  let lbltxt = show (n + 1) ++ " " ++ (channame chan)
                  label <- labelNew $ Just lbltxt
                  menulabel <- labelNew $ Just lbltxt
                  notebookAppendPageMenu book mainbox label menulabel
                  return n
  when switch $
      notebookSetCurrentPage book page

newIRCchannel :: String -> String -> Bool -> IO IRCChannel
newIRCchannel title nick real = do
--   mainbox <- vBoxNew False 5
  scrollwin <- scrolledWindowNew Nothing Nothing
  scrolledWindowSetPolicy scrollwin PolicyAutomatic PolicyAlways
--   boxPackStart mainbox scrollwin PackGrow 0
  buffer <- textBufferNew Nothing
  tTable <- textBufferGetTagTable buffer
  e <- textTagNew $ Just "editable"
  set e [textTagEditable := True]
  ne <- textTagNew $ Just "not-editable"
  set ne [textTagEditable := False]
  textTagTableAdd tTable e
  textTagTableAdd tTable ne
  view <- textViewNewWithBuffer buffer
  textViewSetWrapMode view WrapWordChar
  textViewSetEditable view True
  containerAdd scrollwin view
  textBufferSetText buffer $ 
                    if real
                       then nick
                       else ""
--   nstart <- textBufferGetStartIter buffer
--   nickstart <- textBufferCreateMark buffer Nothing nstart True
  nend' <- textBufferGetEndIter buffer
  nickend' <- textBufferCreateMark buffer Nothing nend' True
--   textMarkSetVisible nickstart True
--   textMarkSetVisible nickend True
  textBufferInsert buffer nend' $
                    if real
                       then "@" ++ title ++ "> "
                       else title +-+ nick
  start' <- textBufferGetStartIter buffer
  textBufferInsert buffer start' "\n"
  start <- textBufferGetStartIter buffer
  end <- textBufferGetEndIter buffer
  textBufferApplyTagByName buffer "not-editable" start end
  endmark <- textBufferCreateMark buffer Nothing start False
  entry <- textBufferGetEndIter buffer
  entrymark <- textBufferCreateMark buffer Nothing entry True
  nend <- textBufferGetIterAtMark buffer nickend'
  nickend <- textBufferCreateMark buffer Nothing nend False
  let result = IRCChan {chanbuffer = buffer, channame = (map toLower title), chanreal = real, chanend = endmark, channick = nickend, chanbox = toMainWidget scrollwin, chanentry = entrymark, chanview = view, chanusers = empty, chantopic = "", chancoding = Nothing}
  keymap <- newKeymap
  mapM_ (keymapAdd keymap) $ bufferKeyBindings result
  onKeyPress view $ keyPressCB keymap
  afterPasteClipboard view (setEditable result)
  widgetShowAll scrollwin
  return result

hideCurrentChannel :: IO ()
hideCurrentChannel = do
  notebookGetCurrentPage book >>= doRemoveNthPage

hideIRCchannel :: IRCChannel -> IO ()
hideIRCchannel chan = do
  total <- notebookGetNPages book
  if total <= 1
     then return ()
     else do
          let mainbox = chanbox chan
          p <- notebookPageNum book mainbox
          maybeDo_ p doRemoveNthPage

doRemoveNthPage :: Int -> IO ()
doRemoveNthPage page = do
  total <- notebookGetNPages book
  if total <= 1
     then return ()
     else do
          notebookRemovePage book page
          updateTabLabels

updateTabLabels :: IO ()
updateTabLabels = return ()

writeTextLn :: IRCChannel -> Bool -> String -> IO ()
writeTextLn chan alert str = do
  let buffer = chanbuffer chan
      endmark = chanend chan
  end <- textBufferGetIterAtMark buffer endmark
  newmark <- textBufferCreateMark buffer Nothing end True
  time <- timeStamp
  no_text <- textIterIsStart end
  textBufferInsert buffer end $ (if no_text then "" else "\n") ++ time ++ " " ++ cleanup str
  start <- textBufferGetIterAtMark buffer newmark
  end' <- textBufferGetIterAtMark buffer endmark
  textBufferApplyTagByName buffer "not-editable" start end'
--   let view = chanview chan
--   viewfocus <- widgetIsFocus view
--   unless viewfocus $ do
--       textViewScrollMarkOnscreen view endmark
--       textBufferPlaceCursor buffer end
--       displayChannelTab False chan
  textBufferGetInsert buffer >>= textViewScrollMarkOnscreen (chanview chan)
--   when (cursorAtEnd && not autoscroll)
--       (textBufferGetIterAtMark buffer endmark >>= textBufferPlaceCursor buffer)
  when alert $ do
      displayChannelTab False chan
      updateChannelTab chan alert
  where
  cleanup :: String -> String
  -- remove trailing whitespace
  cleanup = reverse . dropWhile isSpace . reverse 

writeTextRaw :: String -> IO ()
writeTextRaw str = writeTextLn rawchannel True str

timeStamp :: IO String
timeStamp = do
  ct <- getZonedTime
  return $ show ct

type Interactive = ([String], Channel)

chanI :: Chan Interactive
chanI = unsafePerformIO newChan

sendInput :: IRCChannel -> IO ()
sendInput chan = do
  let entry = chanentry chan
      buffer = chanbuffer chan
  start <- textBufferGetIterAtMark buffer entry
  end <- textBufferGetEndIter buffer
  text <- textBufferGetText buffer start end False
  debug "sendInput" text
  textBufferDelete buffer start end
  writeChan chanI (lines text, channame chan)

updateChannelTab :: IRCChannel -> Bool -> IO ()
updateChannelTab chan alert = do
  page <- notebookPageNum book mainbox
  current <- notebookGetCurrentPage book
  case page of
      (Just p) -> do
          let text = show (p + 1) ++ " " ++ (channame chan)
              markup = if alert && current /= p
                          then highlightText text
                          else text
          label <- labelNew Nothing
          labelSetMarkup label markup
          notebookSetTabLabel book mainbox label
      Nothing -> return ()
  where
  mainbox = chanbox chan

highlightText :: String -> Markup
highlightText = markSpan [FontForeground "red"]

unhighlightText :: String -> String
unhighlightText str | whead str == open && wlast str == close =
                        take rawlength $ drop (length open) str
                    | otherwise = str
  where
  template = highlightText encl
  (open,close) = breakString encl template
  encl = "  "
  rawlength = length str - length open - length close

updateTabN :: Int -> IO ()
updateTabN n = do
     mw <- notebookGetNthPage book n
     case mw of
         Just w -> do
             mlbl <- notebookGetTabLabel book w
             case mlbl of
                   Just lbl -> do
                       let label = castToLabel lbl
                       txt <- labelGetText label
                       labelSetText label $ unhighlightText txt
                   Nothing -> return ()
         Nothing -> return ()

-- FIXME todo
renameChannelTab :: Channel -> Channel -> IO ()
renameChannelTab _old _new = do
    return ()    

lastSearchText :: MVar String
lastSearchText = unsafePerformIO $ newMVar ""

searchChannel :: IRCChannel -> Bool -> IO ()
searchChannel chan backwds = do
    let buffer = chanbuffer chan
    startIter <- textBufferGetInsert buffer >>= textBufferGetIterAtMark buffer
    slctn <- textBufferHasSelection buffer
    text <- if slctn
               then do
                    slctIter <- textBufferGetSelectionBound buffer >>= textBufferGetIterAtMark buffer
                    textBufferGetText buffer startIter slctIter False
               else readMVar lastSearchText
    if null text
       then return ()
       else do
            swapMVar lastSearchText text
            result <- (if backwds then textIterBackwardSearch else textIterForwardSearch) startIter text [] Nothing
            maybe (return ()) (\ (start, end) -> do
                               textBufferPlaceCursor buffer (if backwds then start else end)
                               textBufferMoveMarkByName buffer "selection_bound" (if backwds then end else start)
                               textBufferGetInsert buffer >>= textViewScrollMarkOnscreen (chanview chan))
                             result