-- 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 DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Manatee.Extension.IrcClient.IrcBuffer where

import Control.Concurrent.STM
import Control.Monad
import DBus.Client hiding (Signal)
import Data.Array
import Data.Map (Map)
import Data.Maybe
import Data.Set (Set)
import Data.Typeable
import Graphics.UI.Gtk hiding (Language, eventButton, eventClick)
import Graphics.UI.Gtk.Gdk.Events
import Graphics.UI.Gtk.SourceView.SourceBuffer
import Language.Translate.Google
import Manatee.Core.DBus
import Manatee.Core.Types
import Manatee.Extension.IrcClient.DBus
import Manatee.Extension.IrcClient.HighlightNick
import Manatee.Extension.IrcClient.PageMode
import Manatee.Extension.IrcClient.Smile
import Manatee.Extension.IrcClient.Types
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.ByteString
import Manatee.Toolkit.General.DBus
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Process
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.General.Set
import Manatee.Toolkit.General.Time
import Manatee.Toolkit.Gtk.Multiline
import Network.FastIRC.Types
import Network.URI
import System.Posix.Process
import Text.Regex.Posix hiding (after)

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map as M
import qualified Data.Set as S

data IrcBuffer = 
    IrcBuffer {ircBufferServer            :: Server
              ,ircBufferPort              :: Port
              ,ircBufferChannel           :: Channel
              ,ircBufferClient            :: Client
              ,ircBufferPageId            :: PageId
              ,ircBufferMode              :: PageMode
              ,ircBufferBuffer            :: SourceBuffer
              ,ircBufferInsertMark        :: TextMark
              ,ircBufferPromptMark        :: TextMark
              ,ircBufferScrollMark        :: TVar (Maybe TextMark)
              ,ircBufferEditableTag       :: TextTag
              ,ircBufferMessageTag        :: TextTag
              ,ircBufferServerColorTag    :: TextTag
              ,ircBufferSelfColorTag      :: TextTag
              ,ircBufferOtherColorTag     :: TextTag
              ,ircBufferJoinColorTag      :: TextTag
              ,ircBufferQuitColorTag      :: TextTag
              ,ircBufferPartColorTag      :: TextTag
              ,ircBufferActionColorTag    :: TextTag
              ,ircBufferUrlColorTag       :: TextTag
              ,ircBufferTimeStamp         :: TVar (Map Int (String, Color))
              ,ircBufferNick              :: TVar Nick
              ,ircBufferNickSet           :: TVar (Set NickName)
              ,ircBufferNickColorMap      :: TVar (Map NickName TextTag)
              ,ircBufferTranslateLanguage :: TVar Language
              ,ircBufferBroadcastChannel  :: TChan IrcBufferSignal
              ,ircBufferSmilePixbufs      :: Map String Pixbuf
              }
    deriving Typeable

data IrcBufferSignal = SwitchTranslateLanguage 
                     | BufferChanged
                       deriving (Show, Eq, Ord)

-- | Create buffer new.
ircBufferNew :: String -> Client -> PageId -> IO IrcBuffer
ircBufferNew info client pageId = do
  -- Get server port channel information.
  let (mynick, server, port, channel) = ircParseInfo info
  putStrLn ("Buffer create (server, port, channel) : " ++ show (server, port, channel))

  -- Create source buffer and text mark.
  sourceBuffer <- sourceBufferNew Nothing
  ircBufferInsertPromptStr sourceBuffer
  insertMark <- ircBufferCreateInsertMark sourceBuffer
  promptMark <- ircBufferCreatePromptMark sourceBuffer
  scrollMark <- newTVarIO Nothing

  -- Create editable tag.
  textTag <- textTagNew Nothing
  set textTag [textTagEditable := False]
  tagTable <- textBufferGetTagTable sourceBuffer
  textTagTableAdd tagTable textTag

  -- Create message tag.
  messageTag <- textTagNew Nothing
  set messageTag [textTagEditable := False]
  textTagTableAdd tagTable messageTag

  -- Create color tag.
  serverColorTag <- ircBufferCreateColorTag sourceBuffer serverMsgColor
  selfColorTag   <- ircBufferCreateColorTag sourceBuffer selfMsgColor
  otherColorTag  <- ircBufferCreateColorTag sourceBuffer otherMsgColor
  joinColorTag   <- ircBufferCreateColorTag sourceBuffer joinMsgColor
  quitColorTag   <- ircBufferCreateColorTag sourceBuffer quitMsgColor
  partColorTag   <- ircBufferCreateColorTag sourceBuffer partMsgColor
  actionColorTag <- ircBufferCreateColorTag sourceBuffer actionMsgColor
  urlColorTag    <- ircBufferCreateColorTag sourceBuffer urlColor
  set urlColorTag [textTagUnderline := UnderlineSingle]

  -- Open url when click.
  urlColorTag `onTextTagEvent` \ event iter -> 
      case event of
        Button {eventClick  = click
               ,eventButton = button} -> 
          when (button == LeftButton && click == SingleClick) $ 
            textBufferGetTagTextWithIter sourceBuffer iter urlColorTag 
              >?>= \ url ->
                mkDaemonSignal client NewTab (NewTabArgs "PageBrowser" url)
        _ -> return ()

  -- Apply text tag.
  startIter <- textBufferGetStartIter sourceBuffer
  endIter   <- textBufferGetIterAtMark sourceBuffer promptMark
  textBufferApplyTag sourceBuffer textTag startIter endIter

  -- Time stamp.
  timeStamp <- newTVarIO M.empty

  -- Nick set.
  nick <- newTVarIO mynick

  -- Nick set.
  nickSet <- newTVarIO S.empty

  -- Nick color map.
  nickColorMap <- newTVarIO M.empty

  -- Target language.
  lang <- newTVarIO targetLanguage

  -- Broadcast channel.
  broadcastChannel <- newTChanIO :: IO (TChan IrcBufferSignal)

  -- Get smile pixbufs.
  smilePixbufs <- createSmilePixbufs

  -- Create buffer.
  let buffer = IrcBuffer server port channel
                         client pageId ircMode
                         sourceBuffer insertMark promptMark scrollMark 
                         textTag messageTag serverColorTag selfColorTag otherColorTag 
                         joinColorTag quitColorTag partColorTag actionColorTag urlColorTag
                         timeStamp nick nickSet nickColorMap lang
                         broadcastChannel smilePixbufs

  -- Add self in nick map.
  ircBufferAddNick buffer (B.pack mynick)

  -- Build DBus match rule.
  processId <- getProcessID
  mkIrcClientMatchRules client
    [(ReceivePrivate,
      \ (ReceivePrivateArgs nick msg) -> 
          ircBufferReceivePrivate buffer nick msg)
    ,(ReceiveJoin,
     \ (ReceiveJoinArgs nick user host) ->
          ircBufferReceiveJoin buffer nick user host)
    ,(ReceiveTopicReply,
      \ (ReceiveTopicReplyArgs msg) ->
          ircBufferReceiveTopicReply buffer msg)
    ,(ReceiveTopicWhoTime,
      \ (ReceiveTopicWhoTimeArgs nick seconds) ->
          ircBufferReceiveTopicWhoTime buffer nick seconds)
    ,(ReceiveChannelUrl,
      \ (ReceiveChannelUrlArgs url) ->
          ircBufferReceiveChannelUrl buffer url)
    ,(ReceiveNames,
      \ (ReceiveNamesArgs nicks) -> 
          ircBufferReceiveNames buffer nicks)
    ,(ReceiveQuit,
      \ (ReceiveQuitArgs nick user host reason) ->
          ircBufferReceiveQuit buffer nick user host reason)
    ,(ReceivePart,
      \ (ReceivePartArgs nick user host reason) ->
          ircBufferReceivePart buffer nick user host reason)
    ,(DaemonProcessStartup,
     \_ -> mkIrcDaemonSignal client Join (JoinArgs server port channel mynick processId))]
    
  -- Check whether daemon process has startup.
  ifM (isBusNameExist ircDaemonBusName)
      -- Send join signal if daemon process has startup.
      (mkIrcDaemonSignal client Join (JoinArgs server port channel mynick processId))
      -- Otherwise startup daemon process, send join signal after daemon process startup complete.
      (do
         putStrLn "No irc daemon process, starting one."
         runProcess_ "manatee-irc-daemon" [show processId])

  -- Add function when main loop left.
  -- Send part signal to daemon process if tab closed.
  quitAdd 0 (do
              putStrLn $ "Irc process "  ++ show processId ++ " quit."
              mkIrcDaemonSignal client Part (PartArgs server channel processId)
              return False)

  -- Record scroll mark before change buffer.
  -- Then we can restore scroll mark position after buffer changed.
  sourceBuffer `on` bufferChanged $ do
    cursorMark <- textBufferGetInsert sourceBuffer
    promptIter <- textBufferGetIterAtMark sourceBuffer promptMark
    insertIter <- textBufferGetInsertIter sourceBuffer
    order <- textIterCompare insertIter promptIter
    case order of
      GT -> writeTVarIO scrollMark (Just cursorMark)
      EQ -> writeTVarIO scrollMark (Just cursorMark)
      _  -> writeTVarIO scrollMark Nothing

  -- Broadcast signal when buffer changed.
  sourceBuffer `after` bufferChanged $
     writeTChanIO broadcastChannel BufferChanged 

  return buffer

-- | Parse "irc:[//[user@][server[:port]][/]][#channel]".
ircParseInfo :: String -> (Nick, Server, Port, Channel)
ircParseInfo str = 
    if null matchTextList
       then (defaultNick, defaultServer, defaultPort, defaultChannel)
       else 
           let (_ : (nickStr, _) : (serverStr, _) : (portStr, _) : (channelStr, _) : _) = elems $ head matchTextList
               nick = if null nickStr then defaultNick else init nickStr
               server = if null serverStr then defaultServer else serverStr
               port = if null portStr then defaultPort else read $ tail portStr :: Int
               channel = (\x -> case x of
                                 ('/':c) -> c 
                                 _ -> x
                         ) $ if null channelStr then defaultChannel else channelStr
           in (nick, server, port, channel)
    where matchTextList =
              matchAllText 
                  (makeRegex ("irc://([^<> \t\n'@:]+@)*([a-zA-Z.]+)*(:[0-9]+)*(/*[$#+!].[^ \t\n,]+)*" :: String) :: Regex) 
                  str
          

-- | Receive private message.
ircBufferReceivePrivate :: IrcBuffer -> NickName -> CommandArg -> IO ()
ircBufferReceivePrivate buffer@(IrcBuffer {ircBufferClient           = client
                                          ,ircBufferPageId           = pageId
                                          ,ircBufferSelfColorTag     = selfColorTag
                                          ,ircBufferOtherColorTag    = otherColorTag
                                          ,ircBufferActionColorTag   = actionColorTag
                                          ,ircBufferNick = mynick}) 
                        nick content = do
  -- Format private message.
  let ((msg, msgHeadLen), isAction) = 
        if B.pack "\SOHACTION " `B.isPrefixOf` content 
               && B.pack "\SOH" `B.isSuffixOf` content
           then 
               let prefixLen  = B.length (B.pack "\SOHACTION ")
                   suffixLen  = B.length (B.pack "\SOH")
                   takeLen    = B.length content - prefixLen - suffixLen
                   newContent = B.take takeLen $ B.drop prefixLen content
               in (ircBufferIndentMessage newContent (B.concat ["* ", nick, " "]), True)
           else 
               (ircBufferIndentMessage content (B.concat ["<", nick, "> "]), False)

  -- Get color with the type of private message.
  mynickname <- readTVarIO mynick
  let messageColor 
          -- Use selfColorTag when it's self message.
          | B.unpack nick == mynickname
              = selfColorTag
          -- User actionColorTag when print action message.
          | isAction 
              = actionColorTag
          -- Otherwise use otherColorTag.
          | otherwise 
              = otherColorTag

  -- Insert private message.
  ircBufferReceiveMsg buffer msg msgHeadLen messageColor

  -- Notify user when some call. 
  let myNickName = B.pack mynickname
  unless (nick == myNickName) $ 
    when (B.isInfixOf myNickName msg) $
      mkDaemonSignal client 
                     ShowTooltip 
                     (ShowTooltipArgs (init_ (UTF8.toString msg)) Nothing 8000 Nothing Nothing False (Just pageId))

-- | Receive quit message.
ircBufferReceiveQuit :: IrcBuffer -> NickName -> UserName -> HostName -> B.ByteString -> IO ()
ircBufferReceiveQuit buffer@(IrcBuffer {ircBufferNickSet = nickSet
                                       ,ircBufferQuitColorTag = quitColorTag}) 
                     nick user host reason = do
  -- Quit nick map.
  set <- readTVarIO nickSet
  case maybeFindMin set (== nick) of
    Just _ -> do
      -- Remove from set.
      modifyTVarIO nickSet $ \ set ->
          S.delete nick set

      -- Format quit message.
      let adjustMsg = B.pack "*** "
          content   = B.concat [nick, " (", user, "@", host, ") has quit: ", reason]
          (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg
      
      -- Insert quit message.
      ircBufferReceiveMsg buffer msg msgHeadLen quitColorTag
    Nothing -> return ()

-- | Receive part message.
ircBufferReceivePart :: IrcBuffer -> NickName -> UserName -> HostName -> B.ByteString -> IO ()
ircBufferReceivePart buffer@(IrcBuffer {ircBufferNickSet        = nickSet
                                       ,ircBufferPartColorTag   = partColorTag}) 
                     nick user host reason = do
  -- Remove from set.
  modifyTVarIO nickSet $ \ set ->
      S.delete nick set

  -- Format part message.
  let adjustMsg = B.pack "*** "
      content   = B.concat [nick, " (", user, "@", host, ") has part: ", reason]
      (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg
  
  -- Insert part message.
  ircBufferReceiveMsg buffer msg msgHeadLen partColorTag

-- | Receive topic replay message.
ircBufferReceiveNames :: IrcBuffer -> B.ByteString -> IO ()
ircBufferReceiveNames buffer nicks = 
  -- Add nick to color map.
  forM_ (B.words nicks) $ \nick -> 
    ircBufferAddNick buffer nick

-- | Receive topic replay message.
ircBufferReceiveChannelUrl :: IrcBuffer -> B.ByteString -> IO ()
ircBufferReceiveChannelUrl buffer@(IrcBuffer {ircBufferChannel          = channel
                                             ,ircBufferServerColorTag   = serverColorTag})
                           url = do
  -- Format channel url message.
  let adjustMsg = B.pack "*** "
      content   = B.concat [B.pack channel, " URL: ", url]
      (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg
      
  -- Insert channel url message.
  ircBufferReceiveMsg buffer msg msgHeadLen serverColorTag

-- | Receive topic replay message.
ircBufferReceiveTopicReply :: IrcBuffer -> CommandArg -> IO ()
ircBufferReceiveTopicReply buffer@(IrcBuffer {ircBufferChannel          = channel
                                             ,ircBufferServerColorTag   = serverColorTag})
                           message = do
  -- Format topic replay message.
  let adjustMsg = B.pack "*** "
      content   = B.concat ["Topic for ", B.pack channel, ": ", message]
      (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg
      
  -- Insert topic replay message.
  ircBufferReceiveMsg buffer msg msgHeadLen serverColorTag

-- | Receive topic replay message.
ircBufferReceiveTopicWhoTime :: IrcBuffer -> NickName -> Integer -> IO ()
ircBufferReceiveTopicWhoTime buffer@(IrcBuffer {ircBufferChannel        = channel
                                               ,ircBufferServerColorTag = serverColorTag})
                                nick seconds = do
  -- Format topic who time message.
  time <- getSecondsTimeStamp seconds "%H:%M:%S %Y/%m/%d"
  let adjustMsg = B.pack "*** "
      content   = B.concat [B.pack channel, ": topic set by ", nick, ", ", B.pack time]
      (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg
      
  -- Insert topic who time message.
  ircBufferReceiveMsg buffer msg msgHeadLen serverColorTag

-- | Receive join message.
ircBufferReceiveJoin :: IrcBuffer -> NickName -> UserName -> HostName -> IO ()
ircBufferReceiveJoin buffer@(IrcBuffer {ircBufferChannel        = channel
                                       ,ircBufferJoinColorTag   = joinColorTag
                                       ,ircBufferNick           = mynick}) 
                        nick user host = do
  nickname <- readTVarIO mynick
  -- Don't print self join message.
  when (B.unpack nick /= nickname) $ do
    -- Add nick to set.
    ircBufferAddNick buffer nick

    -- Format join message.
    let adjustMsg = B.pack "*** " 
        content   = B.concat [nick, " (", user, "@", host, ") has joined channel ", B.pack channel]
        (msg, msgHeadLen) = ircBufferIndentMessage content adjustMsg 

    -- Insert join message.
    ircBufferReceiveMsg buffer msg msgHeadLen joinColorTag
  
-- | Receive irc message.
ircBufferReceiveMsg :: IrcBuffer -> B.ByteString -> Int -> TextTag -> IO ()
ircBufferReceiveMsg IrcBuffer {ircBufferBuffer       = buffer
                              ,ircBufferInsertMark   = insertMark
                              ,ircBufferPromptMark   = promptMark
                              ,ircBufferEditableTag  = tag
                              ,ircBufferMessageTag   = messageTag
                              ,ircBufferTimeStamp    = stamp
                              ,ircBufferNickColorMap = nickColorMap
                              ,ircBufferUrlColorTag  = urlColorTag
                              ,ircBufferSmilePixbufs = smilePixbufs
                              } 
                    message msgHeadLen colorTag = do
  -- Make editable tag can edit temporary for insert irc message.
  set tag [textTagEditable := True]

  -- Update time stamp before insert message.
  insertIter<- textBufferGetIterAtMark buffer insertMark
  line      <- textIterGetLine insertIter
  timeStamp <- getTimeStamp "[%H:%M:%S]"
  color <- get colorTag textTagForegroundGdk
  modifyTVarIO stamp $ \s -> 
      M.insert line (timeStamp, color) s

  -- Create new mark to save insert iter position.
  -- To apply color tag after insert message.
  saveMark <- textBufferCreateMark buffer Nothing insertIter True

  -- Filter smile string from message.
  (msg, smileIndex) <- smileMessage message smilePixbufs

  -- Insert irc message before insertMark.
  textBufferInsertByteString buffer insertIter msg

  -- Apply base color tag.
  saveIter   <- textBufferGetIterAtMark buffer saveMark
  insertIter <- textBufferGetIterAtMark buffer insertMark
  textBufferApplyTag buffer colorTag saveIter insertIter

  -- Apply nick color tag.
  colorMap <- readTVarIO nickColorMap
  unless (null $ map fst $ M.toList colorMap) $ 
    -- Regex "[^<> \t\n\'@,.:]+" works fine,
    -- don't build regex match all nickname, 
    -- too big regex will make matchAllText *failed*.
    forM_ (matchAllText (makeRegex (B.pack "[^<> \t\n\'@,.:]+") :: Regex) msg)
        $ \ x -> do
          let ((word, (matchOffset, matchLength)) : _) = elems x
          case findMinMatch colorMap (\ nickName _ -> nickName == word) of
            Just (_, colorTag) -> do
                  matchStartIter <- textIterCopy saveIter
                  matchEndIter   <- textIterCopy saveIter
                  textIterForwardChars matchStartIter matchOffset
                  textIterForwardChars matchEndIter (matchOffset + matchLength)
                  textBufferApplyTag buffer colorTag matchStartIter matchEndIter
            Nothing -> return ()

  -- Apply URL color tag.
  forM_ (matchAllText (makeRegex (B.pack "[^]\\ \t\n`\\[\"^]+") :: Regex) msg)
      $ \ x -> do
        let ((word, (matchOffset, matchLength)) : _) = elems x
        parseURI (UTF8.toString word) ?>= \ uri -> 
          when (isJust $ uriAuthority uri) $ do 
            matchStartIter <- textIterCopy saveIter
            matchEndIter   <- textIterCopy saveIter
            textIterForwardChars matchStartIter matchOffset
            textIterForwardChars matchEndIter (matchOffset + matchLength)
            textBufferApplyTag buffer urlColorTag matchStartIter matchEndIter

  -- Insert smile pixbuf.
  forM_ smileIndex $ \ (offset, pixbuf) -> do
    iter <- textBufferGetIterAtMark buffer saveMark
    textIterForwardChars iter offset
    textBufferInsertPixbuf buffer iter pixbuf

  -- We should apply message tag after all INSERT action.
  -- Otherwise will get rang bound.
  msgStartIter <- textBufferGetIterAtMark buffer saveMark
  msgEndIter   <- textBufferGetIterAtMark buffer insertMark
  textIterForwardChars msgStartIter msgHeadLen -- skip message head (e.g. nick name)
  textIterBackwardChar msgEndIter              -- skip '\n' at last
  textBufferApplyTag buffer messageTag msgStartIter msgEndIter

  -- Apply editable tag to new rang (from start to insertMark).
  startIter <- textBufferGetStartIter buffer
  endIter   <- textBufferGetIterAtMark buffer promptMark
  textBufferApplyTag buffer tag startIter endIter

  -- Make irc message read-only again.
  set tag [textTagEditable := False]

-- | Add nick to nick set.
ircBufferAddNick :: IrcBuffer -> NickName -> IO ()
ircBufferAddNick buffer@(IrcBuffer {ircBufferNickSet = nickSet})
                 nick = do
    -- Add nick to list.
    set <- readTVarIO nickSet
    case maybeFindMin set (== nick) of
      Just _  -> 
          -- Debug.
          -- putStrLn $ "Nick " ++ B.unpack nick ++ " already in nick set."
          return ()
      Nothing -> 
        -- Debug.
        -- putStrLn $ "Nick " ++ B.unpack nick ++ " added to nick set."
        modifyTVarIO nickSet $ \ set -> 
            S.insert nick set

    -- Update nick color.
    ircBufferUpdateNickColor buffer nick

-- | Update nick color to  map.
ircBufferUpdateNickColor :: IrcBuffer -> NickName -> IO ()
ircBufferUpdateNickColor (IrcBuffer {ircBufferBuffer       = buffer
                                    ,ircBufferNickColorMap = nickColorMap})
                         nick = do
  colorMap <- readTVarIO nickColorMap
  case findMinMatch colorMap (\ nickName _ -> nickName == nick) of
    Just _  -> 
      -- Debug
      -- putStrLn $ "Have build color for nick : " ++ B.unpack nick
      return ()
    Nothing -> do
      -- Get color nick.
      let color = nickColorToColor $ nickColor nick

      -- Create color tag.
      textTag <- textTagNew Nothing
      set textTag [textTagForegroundGdk := color
                  ,textTagWeight        := fromEnum WeightBold]

      -- Add color tag to table.
      tagTable <- textBufferGetTagTable buffer
      textTagTableAdd tagTable textTag

      -- Update color map.
      modifyTVarIO nickColorMap $ \map ->
          M.insert nick textTag map
      
-- | Create color tag.
ircBufferCreateColorTag :: TextBufferClass buffer => buffer -> Color -> IO TextTag
ircBufferCreateColorTag buffer color = do
  tagTable <- textBufferGetTagTable buffer
  colorTag <- textTagNew Nothing
  set colorTag [textTagForegroundGdk := color]
  textTagTableAdd tagTable colorTag
  return colorTag

-- | Insert prompt string.
ircBufferInsertPromptStr :: TextBufferClass buffer => buffer -> IO ()
ircBufferInsertPromptStr buffer = 
    textBufferSetText buffer promptStr

-- | Create insert mark.
ircBufferCreateInsertMark :: TextBufferClass buffer => buffer -> IO TextMark
ircBufferCreateInsertMark buffer = do
  textIter <- textBufferGetStartIter buffer
  textBufferCreateMark buffer Nothing textIter False

-- | Create prompt mark.
ircBufferCreatePromptMark :: TextBufferClass buffer => buffer -> IO TextMark
ircBufferCreatePromptMark buffer = do
  textIter <- textBufferGetIterAtOffset buffer (length promptStr)
  textBufferCreateMark buffer Nothing textIter True
          
-- | Indent message.
ircBufferIndentMessage :: B.ByteString -> B.ByteString -> (B.ByteString, Int)
ircBufferIndentMessage content adjustMsg = (concatMsg msgLines, B.length adjustMsg)
  where indentMsg = B.replicate (B.length adjustMsg) ' '
        msgLines  = map B.unwords $ wrapLine (wrapColumn - B.length adjustMsg) (splitWords content)
        concatMsg []     = B.concat [adjustMsg, "\n"]
        concatMsg [x]    = B.concat [adjustMsg, x, "\n"]
        concatMsg (x:xs) = B.concat [B.concat [adjustMsg, x, "\n"]
                                    ,B.concat $ map (\ xx -> B.concat [indentMsg, xx, "\n"]) xs]