manatee-0.0.6: Manatee/Daemon.hs

-- 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 OverloadedStrings, ScopedTypeVariables #-}
module Manatee.Daemon where

import Control.Applicative hiding (empty)
import Control.Arrow
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import DBus.Client hiding (Signal)
import DBus.Types
import Data.Map (Map)
import Data.Text.Lazy (Text)
import GHC.Conc
import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew, 
                               Signal, Variant, Action, 
                               plugNew, plugGetId, get, Keymap)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Manatee.Action.Basic
import Manatee.Action.BufferList
import Manatee.Action.Tab
import Manatee.Action.Tabbar
import Manatee.Action.Window
import Manatee.Core.DBus
import Manatee.Core.Debug
import Manatee.Core.PageMode
import Manatee.Core.Interactive
import Manatee.Core.Types
import Manatee.Environment
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.FilePath
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Process
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.General.Set hiding (mapM)
import Manatee.Toolkit.Gio.Gio
import Manatee.Toolkit.Gtk.Concurrent
import Manatee.Toolkit.Gtk.Editable
import Manatee.Toolkit.Gtk.Event
import Manatee.Toolkit.Gtk.Gtk
import Manatee.Toolkit.Gtk.Struct
import Manatee.Toolkit.Widget.Interactivebar
import Manatee.Toolkit.Widget.NotebookTab
import Manatee.Toolkit.Widget.PopupWindow
import Manatee.Toolkit.Widget.Tooltip
import Manatee.Types
import Manatee.UI.Frame
import Manatee.UI.UIFrame
import Manatee.UI.Window
import System.Directory

import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text.Lazy as T
import qualified Data.Foldable as F
import qualified Data.ByteString.UTF8 as UTF8

-- | Daemon process main entry.
daemonMain :: IO ()
daemonMain = do
  -- Init.
  unsafeInitGUIForThreadedRTS

  env <- mkEnvironment 
  let frame = envFrame env
      anythingBox = envInitBox env
      anythingInteractivebar = envInitInteractivebar env

  -- Build daemon client for listen dbus signal.
  mkDaemonClient env 

  -- Build local object.
  mkDaemonMethods [("GetBufferList",    callGetBufferList env)
                  ,("Interactive",      callGetInteractive env)
                  ,("GetBufferHistory", callGetBufferHistory env)] 

  -- Handle key event.
  frame `on` keyPressEvent $ tryEvent $ do
      -- Remove tooltip when press key.
      liftIO $ do
        tList <- readTVarIO $ envTooltipSet env
        forM_ (Set.toList tList) (\x -> tooltipExit x (envTooltipSet env))

      -- Focus tab when press key.
      liftIO $ focusTab env
      -- Get event status.
      focusStatus <- liftIO $ getFocusStatus env
      keystoke <- eventKeystoke
      sEvent <- serializedEvent

      -- liftIO $ do
      --          ((tabbar, bufferList) :: (Tabbar, BufferList)) <- envGet env
      --          putStrLn $ "-------------------------------"
      --          putStrLn $ "daemonMain bufferlist: " ++ groom bufferList
      --          putStrLn $ "daemonMain tabbar: " ++ groom tabbar

      -- liftIO $ do
      --   (windowList, tabbar) :: (WindowList, Tabbar) <- envGet env
      --   putStrLn $ "---------------------------"
      --   putStrLn $ "daemonMain WindowList : " ++ groom windowList
      --   putStrLn $ "daemonMain tabbar: " ++ groom tabbar

      -- liftIO $ putStrLn $ "Debug keystoke : " ++ show keystoke

      -- Handle key press event.
      liftIO $ do
        -- Handle global keymap first.
        case M.lookup keystoke globalKeymap of
          -- Execute global command.
          Just action -> runAction env action
          Nothing -> 
              case focusStatus of
                -- Ignore localKeymap when handle init interactivebar.
                FocusInitInteractivebar -> handleInteractivebarKeyPress env keystoke anythingInteractivebar
                _ -> 
                  case M.lookup keystoke localKeymap of
                    -- Execute local command.
                    Just action -> runAction env action
                    _ -> case focusStatus of
                          -- Handle PageView keymap.
                          FocusWindow -> envGet env >>= handlePageViewKeyPress keystoke sEvent
                          -- Handle local interactivebar.
                          FocusLocalInteractivebar -> 
                              getCurrentInteractivebar env >?>= 
                                  handleInteractivebarKeyPress env keystoke
        -- Focus tab after handle event.
        focusTab env

  -- Init commander.
  anythingInitStartup frame anythingBox anythingInteractivebar

  -- Show.
  widgetShowAll frame
  frame `onDestroy` do
    -- Send broadcast quit signal, other process can listen this signal when daemon process quit.
    client <- envGet env
    mkDaemonBroadcastSignal client ExitDaemonProcess ExitDaemonProcessArgs
    -- Need exit all render processes before exit daemon process.
    exitAllRenderProcess env
    -- Exit daemon process.
    mainQuit

  -- Loop.
  mainGUI

globalKeymap :: Keymap
globalKeymap =
  M.fromList
   ["F2"     ==> startProcessManager
   ,"F3"     ==> startFeedReader
   ,"F4"     ==> startFileManager
   ,"F5"     ==> startBrowser
   ,"F6"     ==> loginIrcDefaultChannel
   ,"F7"     ==> startIrc
   ,"F11"    ==> toggleFullscreen
   ,"F12"    ==> lockScreen
   ,"C-'"    ==> tabUndoCloseGlobal
   ,"C-\""   ==> tabUndoCloseLocal
   ]

interactiveKeymap :: EditableClass ed => Map Text (ed -> IO ())
interactiveKeymap =
  M.fromList
       [("Tab",          editableExpandCompletion)
       ,("BackSpace",    editableDeleteBackwardChar)
       ,("M-,",          editableDeleteBackwardChar)
       ,("M-<",          editableDeleteBackwardWord)
       ,("M-d",          editableDeleteAllText)
       ,("M-x",          editableCutClipboard)
       ,("M-c",          editableCopyClipboard)
       ,("M-v",          editablePasteClipboard)]

localKeymap :: Keymap
localKeymap = 
    M.fromList
         -- Window keymap.
         ["M-t"    ==> windowSplitVertically
         ,"M-T"    ==> windowSplitHortizontally
         ,"M-n"    ==> windowSelectNext
         ,"M-p"    ==> windowSelectPrev
         ,"M-;"    ==> windowCloseCurrent  
         ,"M-:"    ==> windowCloseOthers
         -- Window zoom keymap.
         ,"P-."    ==> windowEnlarge
         ,"P-,"    ==> windowShrink
         ,"P-j"    ==> windowEnlargeDown
         ,"P-k"    ==> windowEnlargeUp
         ,"P-h"    ==> windowEnlargeLeft
         ,"P-l"    ==> windowEnlargeRight
         ,"P-J"    ==> windowShrinkDown
         ,"P-K"    ==> windowShrinkUp
         ,"P-H"    ==> windowShrinkLeft
         ,"P-L"    ==> windowShrinkRight
         -- Tab keymap in current window.
         ,"M-9"    ==> tabForwardGroup
         ,"M-0"    ==> tabBackwardGroup
         ,"M-7"    ==> tabSelectPrev
         ,"M-8"    ==> tabSelectNext
         ,"M-&"    ==> tabSelectFirst
         ,"M-*"    ==> tabSelectLast
         ,"C-7"    ==> tabMoveToLeft
         ,"C-8"    ==> tabMoveToRight
         ,"C-&"    ==> tabMoveToBegin
         ,"C-*"    ==> tabMoveToEnd
         ,"M-'"    ==> tabCloseCurrent   
         ,"M-\""   ==> tabCloseOthers
         -- Tab keymap with next window.
         ,"P-7"    ==> tabSelectPrevWithNextWindow
         ,"P-8"    ==> tabSelectNextWithNextWindow
         ,"P-&"    ==> tabSelectFirstWithNextWindow
         ,"P-*"    ==> tabSelectLastWithNextWindow
         ,"P-9"    ==> tabForwardGroupWithNextWindow
         ,"P-0"    ==> tabBackwardGroupWithNextWindow
         ,"C-P-7"  ==> tabMoveToLeftWithNextWindow
         ,"C-P-8"  ==> tabMoveToRightWithNextWindow
         ,"C-P-&"  ==> tabMoveToBeginWithNextWindow
         ,"C-P-*"  ==> tabMoveToEndWithNextWindow
         -- Other keymap.
         ,"M-f"    ==> focusInteractivebar
         ,"M-F"    ==> focusCurrentTab
         ,"M-b"    ==> focusSwitch
         ,"M-g"    ==> exitInteractivebar
         ,"M-["    ==> viewBufferDirectory
         ]

-- | Build daemon client for listen dbus signal.
mkDaemonClient :: Environment -> IO ()
mkDaemonClient env = do
  let tabbar = envTabbar env
      client = envDaemonClient env

  mkDaemonMatchRules client 
    [(NewRenderPageConfirm,      daemonHandleNewPageConfirm env)
    ,(RenderProcessExit,         daemonHandleRenderProcessExit)
    ,(NewTab,                    daemonHandleNewTab env)
    ,(NewAnythingProcessConfirm, daemonHandleNewAnythingProcessConfirm env)
    ,(AnythingViewOutput,        daemonHandleAnythingViewOutput env)
    ,(LocalInteractivebarExit,   daemonHandleLocalInteractivebarExit env)
    ,(LocalOutputbarUpdate,      daemonHandleLocalOutputbarUpdate tabbar)
    ,(LocalStatusbarUpdate,      daemonHandleLocalStatusbarUpdate tabbar)
    ,(LocalProgressUpdate,       daemonHandleLocalProgressUpdate tabbar)
    ,(SynchronizationPathName,   daemonHandleSynchronizationPathName env)
    ,(ChangeTabName,             daemonHandleChangeTabName env)
    ,(SwitchBuffer,              daemonHandleSwitchBuffer env)
    ,(ShowTooltip,               daemonHandleShowTooltip env)
    ,(LocalInteractiveReturn,    daemonHandleLocalInteractiveReturn env)
    ,(GlobalInteractiveReturn,   daemonHandleGlobalInteractiveReturn env)
    ]

-- | Handle render process exit signal.
daemonHandleRenderProcessExit :: DaemonSignalArgs -> IO ()
daemonHandleRenderProcessExit (RenderProcessExitArgs pageId processId) = 
  debugDBusMessage $ "daemonHandleRenderProcessExit: child process " ++ show processId ++ " exit. With page id : " ++ show pageId

-- | Handle new tab signal.
daemonHandleNewTab :: Environment -> DaemonSignalArgs -> IO ()  
daemonHandleNewTab env (NewTabArgs pageType pagePath) = 
  runAction env (Action (newTab pageType pagePath))

-- | Handle new anything process confirm signal.
daemonHandleNewAnythingProcessConfirm :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleNewAnythingProcessConfirm env (NewAnythingProcessConfirmArgs (GWindowId plugId) processId) = do
  let popupWindow = envAnythingPopupWindow env
      anythingBox = envInitBox env
      anythingProcessId = envAnythingProcessId env

  socket <- socketNew_
  focusStatus <- getFocusStatus env
  case focusStatus of
    FocusInitInteractivebar -> anythingBox `containerAdd` socket
    _ -> popupWindowAdd popupWindow socket
  socketAddId socket plugId
  
  writeTVarIO anythingProcessId processId

-- | Handle interactivebar input.
daemonHandleAnythingViewOutput :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleAnythingViewOutput env (AnythingViewOutputArgs input completion outputHeight keyPressId) = do
  -- Just update anything input entry status when 
  -- return return keyPressId is same current one.
  -- Otherwise drop *old* calculation result.
  currentKeyPressId <- readTVarIO $ envAnythingKeyPressId env
  when (currentKeyPressId == keyPressId) $ do
    let interactivebar = envInitInteractivebar env
        popupWindow = envAnythingPopupWindow env
    focusStatus <- getFocusStatus env
    case focusStatus of
      FocusInitInteractivebar -> 
          editableSetCompletionText (interactivebarEntry interactivebar) input completion
      _ -> 
        getCurrentInteractivebar env >?>= \ bar -> do
          -- Set entry.
          editableSetCompletionText (interactivebarEntry bar) input completion
          case outputHeight of
            -- Adjust popup window with special size and position.
            Just height -> do
              let adjustHeight | height < popupWindowDefaultHeight 
                                   = height
                               | otherwise 
                                   = popupWindowDefaultHeight
              -- Get size of interactivebar.
              (Rectangle x y w h) <- widgetGetAllocation (interactivebarEntry bar)
              -- Get size of screen.
              (_, screenHeight) <- widgetGetScreenSize (interactivebarEntry bar)
              -- If interactivebar's position too low, display popup window at above of interactivebar.
              -- Otherwise, at below of interactivebar.
              let adjustY | y + h + popupWindowDefaultHeight > screenHeight
                              = y - adjustHeight
                          | otherwise
                              = y + h
              popupWindowSetAllocation popupWindow (Rectangle x adjustY w adjustHeight)
              popupWindowShow popupWindow
            -- Hide popup window when no output need to display.
            Nothing -> popupWindowHide popupWindow 

-- | Handle local interactivebar exit.
daemonHandleLocalInteractivebarExit :: Environment -> DaemonSignalArgs -> IO ()            
daemonHandleLocalInteractivebarExit env LocalInteractivebarExitArgs = do
  focusStatus <- getFocusStatus env
  unless (focusStatus == FocusInitInteractivebar) $
         exitInteractivebar env

-- | Handle local outputbar update.
daemonHandleLocalOutputbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalOutputbarUpdate tabbar (LocalOutputbarUpdateArgs plugId output) = 
  tabUpdateOutput tabbar plugId output

-- | Handle local statusbar update.
daemonHandleLocalStatusbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalStatusbarUpdate tabbar (LocalStatusbarUpdateArgs plugId item status) = 
  tabUpdateStatus tabbar plugId item status

-- | Handle local statusbar update.
daemonHandleLocalProgressUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO ()
daemonHandleLocalProgressUpdate tabbar (LocalProgressUpdateArgs plugId progress) = 
  tabUpdateProgress tabbar plugId progress

-- | Handle synchronization tab name.
daemonHandleSynchronizationPathName :: Environment -> DaemonSignalArgs -> IO ()  
daemonHandleSynchronizationPathName env (SynchronizationPathNameArgs modeName pageId path) = do
  debugDBusMessage $ "daemonHandleSynchronizationPathName: Catch SynchronizationPathName signal. Page id : " ++ show pageId

  (bufferListTVar, Tabbar tabbar) <- envGet env

  -- Replace path name.
  modifyTVarIO bufferListTVar (bufferListReplacePath modeName pageId path)

  -- Adjust tab name.
  pageModeDuplicateTabList <- getDuplicateTabList
  modifyTVarIO bufferListTVar
                   (if modeName `elem` pageModeDuplicateTabList
                    -- Just strip tab name when current page mode in 'pageModeDuplicateTabList'
                    then bufferListStripName modeName pageId path
                    -- Otherwise unique all tab names.
                    else bufferListUniqueName modeName)

  -- Update notebook name.
  forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) -> 
      when (pageModeName == modeName) $ syncTabName env windowId

-- | Handle synchronization tab name.
daemonHandleChangeTabName :: Environment -> DaemonSignalArgs -> IO ()  
daemonHandleChangeTabName env (ChangeTabNameArgs modeName pageId path) = do
  debugDBusMessage $ "daemonHandleChangeTabName: Catch SynchronizationPathName signal. Page id : " ++ show pageId

  (bufferListTVar, Tabbar tabbar) <- envGet env

  -- Replace tab name.
  modifyTVarIO bufferListTVar (bufferListReplaceName modeName pageId path)

  -- Update notebook name.
  forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) -> 
      when (pageModeName == modeName) $ syncTabName env windowId

-- | Handle switch buffer.
daemonHandleSwitchBuffer :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleSwitchBuffer env (SwitchBufferArgs modeName pageId) = do
  -- Switch to buffer if it has exist.
  bufferList <- envGet env
  bufferListGetBufferIndexWithId bufferList modeName pageId
    ?>= \ i -> do
      tabSwitchGroupCurrentWindow env modeName
      window <- envGet env
      notebookSetCurrentPage (windowNotebook window) i

-- | Handle InteractiveReturn return.
daemonHandleLocalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleLocalInteractiveReturn env (LocalInteractiveReturnArgs strList) = do
  popupWindow <- envGet env
  focusStatus <- getFocusStatus env
  unless (focusStatus == FocusInitInteractivebar) $ do
    -- Get track value.
    track <- readTVarIO (envLocalInteractiveTrack env)
    -- Update return value.
    modifyTVarIO (envLocalInteractiveReturn env) (++ strList)
    if length track <= 1 
       -- Exit interactivebar when user input complete.
       then do
         returnList <- readTVarIO (envLocalInteractiveReturn env)
         tryPutMVar (envLocalInteractiveLock env) (Right returnList)
         exitInteractivebar env
       -- Or update track value and input next.
       else do
         let restTrack = tail track
             (interactiveName, interactiveTitle) = head restTrack
         -- Update track value.
         writeTVarIO (envLocalInteractiveTrack env) restTrack

         -- Reset interactivebar and popup window.
         getCurrentUIFrame env >?>= \uiFrame -> do
              let interactivebar = uiFrameInteractivebar uiFrame
              interactivebarSetTitle interactivebar interactiveTitle
              interactivebarSetContent interactivebar ""
              -- Hide popup window.
              popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1)
         
         -- Change anything view candidate.
         processId <- readTVarIO $ envAnythingProcessId env 
         mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate
                        (AnythingViewChangeCandidateArgs [interactiveName])

-- | Handle InteractiveReturn return.
daemonHandleGlobalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleGlobalInteractiveReturn env (GlobalInteractiveReturnArgs strList) = do
  -- Get popup window and focus status.
  popupWindow <- envGet env
  focusStatus <- getFocusStatus env
  -- Get track value.
  track <- readTVarIO (envGlobalInteractiveTrack env)
  -- Update return value.
  modifyTVarIO (envGlobalInteractiveReturn env) (++ strList)
  if length track <= 1 
     -- Exit interactivebar when user input complete.
     then do
       returnList <- readTVarIO (envGlobalInteractiveReturn env)
       tryPutMVar (envGlobalInteractiveLock env) (Right returnList)
       unless (focusStatus == FocusInitInteractivebar) $ 
            exitInteractivebar env
     -- Or update track value and input next.
     else do
       -- Get interactive name and title.
       let restTrack = tail track
           (interactiveName, interactiveTitle) = head restTrack
       -- Update track value.
       writeTVarIO (envGlobalInteractiveTrack env) restTrack

       -- Reset interactivebar and popup window.
       case focusStatus of
          FocusInitInteractivebar -> do
              -- Show init interactivebar.
              let interactivebar = envInitInteractivebar env
              interactivebarSetTitle interactivebar interactiveTitle
              interactivebarSetContent interactivebar ""
          _ -> 
              getCurrentUIFrame env >?>= \uiFrame -> do
                -- Show local interactivebar.
                let interactivebar = uiFrameInteractivebar uiFrame
                interactivebarSetTitle interactivebar interactiveTitle
                interactivebarSetContent interactivebar ""
                -- Hide popup window.
                popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1)
       
       -- Change anything view candidate.
       processId <- readTVarIO $ envAnythingProcessId env 
       mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate
                      (AnythingViewChangeCandidateArgs [interactiveName])

-- | Handle switch buffer.
daemonHandleShowTooltip :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleShowTooltip env (ShowTooltipArgs text point int foreground background hideWhenPress pageId) = do
  -- Init.
  tooltipId <- tickTVarIO (envTooltipCounter env)
  let showTooltip p = 
        tooltipNew tooltipId (envFrame env) text p int foreground background hideWhenPress (envTooltipSet env)
               -- Just add in set when tooltip will hide after press key.
               >>= \tooltip -> when hideWhenPress $ modifyTVarIO (envTooltipSet env) (Set.insert tooltip)

  -- Get current tab.
  focusStatus <- liftIO $ getFocusStatus env
  currentTab <- 
      case focusStatus of
        FocusInitInteractivebar -> return Nothing
        _ -> getCurrentTab env

  -- Show tooltip.
  case currentTab of
    -- Show tooltip when current no window exist.
    Nothing -> showTooltip point
    Just (Tab {tabPageId = tpId
              ,tabUIFrame = UIFrame {uiFrameFrame = frame}}) -> do
      -- Translate UIFrame coordinate to top-level coordinate.
      (Rectangle fx fy _ _) <- widgetGetAllocation frame
      let tooltipPoint = fmap ((+) fx *** (+) fy) point
      case pageId of
        -- Show tooltip directly when no pageId information in DBus signal.
        Nothing -> showTooltip tooltipPoint
        -- Or just show tooltip when user not at same page as signal from.
        Just pId -> when (tpId /= pId) $ showTooltip tooltipPoint

-- | Handle new page confirm signal.
daemonHandleNewPageConfirm :: Environment -> DaemonSignalArgs -> IO ()
daemonHandleNewPageConfirm env 
                           args@(NewRenderPageConfirmArgs 
                                 pageId pType sId plugId processId modeName path isFirstPage) = do
  (tabbarTVar, (bufferListTVar, (signalBoxList, windowList))) <- envGet env

  -- Debug.
  -- putStrLn $ "Page id : " ++ show pageId ++
  --            "\nPage plug id : " ++ show plugId ++
  --            "\nProcess id : " ++ show processId ++
  --            "\nMode name : " ++ modeName ++ 
  --            "\nPath : " ++ path
  
  -- Get signal box.
  sbList <- readTVarIO signalBoxList
  case (maybeFindMin sbList (\x -> signalBoxId x == sId)) of
    Nothing -> putStrLn $ "### Impossible: daemonHandleNewPageConfirm - Can't find signal box Id " ++ show sId
    Just signalBox -> do
          -- Get window id that socket add.
          let windowId = signalBoxWindowId signalBox 
          
          -- Add page.
          debugDBusMessage $ "daemonHandleNewPageConfirm: Catch NewRenderPageConfirm signal. Box id : " ++ show sId
          debugDBusMessage "------------------------------"
          
          -- Add plug to socket.
          let uiFrame = signalBoxUIFrame signalBox
              notebookTab = uiFrameNotebookTab uiFrame
          socketId <- socketFrameAdd uiFrame plugId modeName

          -- Stop spinner animation.
          notebookTabStop notebookTab

          -- Close current page when click close button.
          ntCloseButton notebookTab `onToolButtonClicked` do 
            -- Focus window container close button first,                                                           
            -- otherwise `tabClose` can't work.
            modifyTVarIO windowList (`windowListFocusId` windowId)
            tabClose env pageId
          
          -- Update buffer list when first page create.
          when isFirstPage $ do
            -- Add new buffer.
            modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, processId, pageId, pType, path))

            -- Adjust tab name.
            pageModeDuplicateTabList <- getDuplicateTabList
            modifyTVarIO bufferListTVar 
                             (if modeName `elem` pageModeDuplicateTabList
                              -- Just strip tab name when current page mode in 'pageModeDuplicateTabList'
                              then bufferListStripName modeName pageId path
                              -- Otherwise unique all tab names.
                              else bufferListUniqueName modeName)

            -- Update buffer history.
            bufferList <- readTVarIO bufferListTVar
            bufferListGetBuffer bufferList modeName pageId 
                ?>= \ Buffer {bufferPageType = pageType
                             ,bufferPath     = path} -> 
                    modifyTVarIO (envBufferHistory env) (insertUnique (BufferHistory modeName pageType path))
          
          -- Update tabbar.
          modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab processId pageId socketId plugId uiFrame))
          
          -- Synchronization tab name.
          syncTabName env windowId
          
          -- Delete corresponding SignalBox from SignalBoxList.
          writeTVarIO signalBoxList (Set.delete signalBox sbList)
          
          -- Synchronization tab in all window when first page create.
          when isFirstPage $ tabbarSyncNewTab env windowId args

-- | Add socket to socket frame.
socketFrameAdd :: UIFrame -> PagePlugId -> PageModeName -> IO PageSocketId
socketFrameAdd uiFrame (GWindowId plugId) modeName = do
  -- Add plug in UIFrame.
  let socketFrame = uiFrameFrame uiFrame
  socket <- socketNew_
  socketFrame `containerAdd` socket
  socketAddId socket plugId
  -- Update page mode status in UIFrame.
  uiFrameUpdateStatusbar uiFrame "PageMode" ("Mode (" ++ modeName ++ ")")
  GWindowId <$> socketGetId socket

-- | Return buffer history.
callGetBufferHistory :: Environment -> Member
callGetBufferHistory env = 
  Method "" "s" $ \ call -> do
    history <- readTVarIO $ envBufferHistory env
    replyReturn call [toVariant history]
    
-- | Return buffer list.
callGetBufferList :: Environment -> Member
callGetBufferList env = 
  Method "" "s" $ \ call -> do
     (BufferList bufferList) <- readTVarIO $ envBufferList env
     let list = concatMap (\ (modeName, bufferSeq) -> 
                               map (\ Buffer {bufferPageId   = pageId
                                             ,bufferPath     = path
                                             ,bufferName     = name} -> 
                                    BufferInfo modeName path name pageId) $ F.toList bufferSeq) 
                $ M.toList bufferList
     -- Don't return current buffer.
     focusStatus <- liftIO $ getFocusStatus env
     currentPageId <- 
         case focusStatus of
           FocusInitInteractivebar -> return Nothing
           _ -> tabGetCurrentPageId env
     let bufferInfos = 
             case currentPageId of
               Just pId -> filter (\ x -> bufferInfoId x /= pId) list 
               Nothing  -> list
     replyReturn call [toVariant bufferInfos]

-- | Return interactive [String].
callGetInteractive :: Environment -> Member
callGetInteractive env = 
  Method "s" "s" $ \ call -> do
    -- Get input arguments.
    (tabbar, popupWindow) <- envGet env
    let Just input = fromVariant (head $ methodCallBody call)
        (plugId, inputStr) = read input :: (PagePlugId, String)

    case parseInteractiveString inputStr of
      -- Return error if parse interactive string failed. 
      Left err   -> replyLocalInteractiveError call err
      Right list -> do
        -- Init track and return value.
        writeTVarIO (envLocalInteractiveTrack env) list
        writeTVarIO (envLocalInteractiveReturn env) []

        -- Empty interactive lock first.
        tryTakeMVar (envLocalInteractiveLock env)
        
        postGUIAsync $
           tabbarGetTab plugId tabbar
            ?>= \ Tab {tabUIFrame = uiFrame} -> do         
                let interactivebar = uiFrameInteractivebar uiFrame
                    interactiveName = (fst . head) list
                    title = (snd . head) list
                -- Show interactivebar.
                uiFrameInit uiFrame title ""
                -- When PopupWindow is invisible startup anythingView process.
                whenM (not <$> popupWindowIsVisible popupWindow)
                          (do
                            -- Activate popup window.
                            popupWindowActivate popupWindow interactivebar
                            -- Start anything process.
                            startupAnything (SpawnAnythingProcessArgs 
                                               (InteractiveSearchArgs LocalInteractive [interactiveName])))
        
        -- Wait interactive result.
        result <- takeMVar (envLocalInteractiveLock env)

        -- Return.
        case result of
          Left err  -> replyLocalInteractiveError call err
          Right res -> replyReturn call [toVariant res]

-- | Global interactive.
globalInteractive :: Environment -> String -> ([String] -> IO ()) -> IO ()
globalInteractive env inputStr action = 
  case parseInteractiveString inputStr of
    -- Return error if parse interactive string failed. 
    Left err   -> putStrLn $ "globalInteractive : parse interactive string failed : " ++ show err
    Right strList -> do
        -- Get popup window and focus status.
        popupWindow <- envGet env
        focusStatus <- getFocusStatus env

        -- Init track and return value.
        writeTVarIO (envGlobalInteractiveTrack env) strList
        writeTVarIO (envGlobalInteractiveReturn env) []

        -- Empty interactive lock first.
        tryTakeMVar (envGlobalInteractiveLock env)
        
        -- Get interactive name and title.
        let (interactiveName, interactiveTitle) = head strList

        case focusStatus of
          FocusInitInteractivebar -> do
              -- Show interactivebar.
              let interactivebar = envInitInteractivebar env
              interactivebarSetTitle interactivebar interactiveTitle
              interactivebarSetContent interactivebar ""

              -- Change interactive type.
              let client = envDaemonClient env 
              processId <- readTVarIO $ envAnythingProcessId env 
              mkRenderSignal client processId AnythingViewChangeInteractiveType
                             (AnythingViewChangeInteractiveTypeArgs GlobalInteractive)
              -- Change candidate.
              mkRenderSignal client processId AnythingViewChangeCandidate
                             (AnythingViewChangeCandidateArgs [interactiveName])
          _ -> 
              getCurrentUIFrame env >?>= \uiFrame -> do
                  -- Show interactivebar.
                  let interactivebar = uiFrameInteractivebar uiFrame
                  uiFrameInit uiFrame interactiveTitle ""
                  -- When PopupWindow is invisible startup anythingView process.
                  whenM (not <$> popupWindowIsVisible popupWindow)
                            (do
                              -- Activate popup window.
                              popupWindowActivate popupWindow interactivebar
                              -- Start anything process.
                              startupAnything (SpawnAnythingProcessArgs 
                                                 (InteractiveSearchArgs GlobalInteractive [interactiveName])))

        -- Wait interactive result.
        forkGuiIO_ (takeMVar (envGlobalInteractiveLock env))
                   (\ result ->                   
                        case result of
                          Left err  -> putStrLn $ "globalInteractive : " ++ show err
                          Right list -> 
                              -- Just do action if return list match.
                              when (length strList == length list) $ 
                                   bracketOnError 
                                    (return list) 
                                    -- Print error message if exception rasied when do action.
                                    (\ _ -> putStrLn "globalInteractive: exception rasied.")
                                    action)

-- | Reply interactive error.
replyLocalInteractiveError :: MethodCall -> Text -> IO ()
replyLocalInteractiveError call err = 
    replyError call (mkErrorName_ daemonInteractiveErrorName) [toVariant err]

-- | Handle page view key press event.
handlePageViewKeyPress :: Text -> SerializedEvent -> (Environment, Client) -> IO ()
handlePageViewKeyPress keystoke sEvent (env, client) = 
  getCurrentTab env >?>= \ Tab {tabProcessId = processId
                               ,tabPlugId    = plugId} -> 
    mkRenderSignal client processId PageViewKeyPress (PageViewKeyPressArgs plugId keystoke sEvent)

-- | Handle interactivebar key press event.  
handleInteractivebarKeyPress :: Environment -> Text -> Interactivebar -> IO ()
handleInteractivebarKeyPress env keystoke bar = do
  let client = envDaemonClient env
      entry = interactivebarEntry bar
  -- Focus anything input entry.
  editableFocus entry
  -- Do action.
  isChanged <- 
      editableIsChanged entry $
          case M.lookup keystoke interactiveKeymap of
            Just action -> action entry
            _ -> 
                -- Insert character.
                when (T.length keystoke == 1) $ do
                     unselectText <- editableGetUnselectText entry
                     editableSetText entry (unselectText ++ T.unpack keystoke)
  -- Get input string.
  allText <- editableGetAllText entry
  unselectText <- editableGetUnselectText entry
  -- Get anything process.
  processId <- readTVarIO $ envAnythingProcessId env 
  -- Get keyPressId for identify anything process.
  keyPressId <- tickTVarIO $ envAnythingKeyPressId env
  -- Send signal to anything process.
  mkRenderSignal client processId AnythingViewKeyPress 
      (AnythingViewKeyPressArgs keystoke allText unselectText keyPressId isChanged)   

-- | View buffer directory.
-- If buffer path is not directory, view current directory.
viewBufferDirectory :: Environment -> IO ()
viewBufferDirectory env = do
  (bufferList, (tabbar, window)) <- envGet env
  getCurrentTab env 
    >?>= \ tab -> 
        tabbarGetPageModeName tabbar (windowGetId window) 
    ?>= \modeName ->
        bufferListGetBuffer bufferList modeName (tabPageId tab) 
    ?>= \buffer -> do
      let path = getUpperDirectory $ bufferPath buffer
      if not (null path) && directoryDoesExist (UTF8.fromString path)
          then newTab "PageFileManager" path env
          else do
            currentDir <- getCurrentDirectory
            newTab "PageFileManager" currentDir env

-- | Lock screen.
lockScreen :: Environment -> IO ()
lockScreen _ = do
  -- Don't burn LCD power.
  (runCommand_ "xset dpms force off && sleep 1")
  -- Lock screen.
  (runCommand_ "xtrlock")

-- | Startup process manager.
startProcessManager :: Environment -> IO ()
startProcessManager = 
  newTab "PageProcessManager" "ProcessManager"

-- | Startup rss/atom reader.
startFeedReader :: Environment -> IO ()
startFeedReader =
  newTab "PageReader" "Feed Reader"

-- | Startup file manager.
startFileManager :: Environment -> IO ()
startFileManager env = do
  dir <- getCurrentDirectory
  newTab "PageFileManager" dir env

-- | Startup browser.
startBrowser :: Environment -> IO ()
startBrowser = 
  newTab "PageBrowser" "http://www.google.com"

-- | Login default channel.
loginIrcDefaultChannel :: Environment -> IO ()
loginIrcDefaultChannel =
  newTab "PageIrc" "irc://"

-- | Start irc.
startIrc :: Environment -> IO ()
startIrc env = 
  globalInteractive 
      env 
      "sServer : \nnPort : \nsChannel : \nsUserName : \n"
      $ \ [server, port, channel, user] -> do
        let info = "irc://" ++ user ++ "@" ++ server ++ ":" ++ port ++ "/" ++ channel
        mkDaemonSignal (envDaemonClient env) NewTab (NewTabArgs "PageIrc" info)