Gtk2Hs テキストビュー

ホーム   目次

簡単なテキストビュー

simpletextview.hs

import Graphics.UI.Gtk

main :: IO ()
main = do

  initGUI
  
  window <- windowNew
  set window [windowWindowPosition := WinPosCenter,
              windowDefaultWidth := 300,
              windowDefaultHeight := 200,
              windowTitle := "TextView"]
  
  vbox <- vBoxNew False 0
  
  table <- textTagTableNew
  buffer <- textBufferNew (Just table)
  textview <- textViewNewWithBuffer buffer
  
  boxPackStart vbox textview PackGrow 0
  
  buffer <- textViewGetBuffer textview
  
  tag1 <- textTagNew Nothing
  set tag1 [textTagLeftMargin := 5,
            textTagForeground := "blue"]
  textTagTableAdd table tag1
  tag2 <- textTagNew Nothing
  set tag2 [textTagLeftMargin := 5,
            textTagBackground := "gray"]
  textTagTableAdd table tag2
  tag3 <- textTagNew Nothing
  set tag3 [textTagLeftMargin := 5,
            textTagStyle := StyleItalic]
  textTagTableAdd table tag3
  tag4 <- textTagNew Nothing
  set tag4 [textTagLeftMargin := 5,
            textTagWeight := 800]
  textTagTableAdd table tag4
  
  iter0 <- textBufferGetIterAtOffset buffer (-1)
  textBufferInsert buffer iter0 "Plan text\n"
  iter1 <- textBufferGetIterAtOffset buffer (-1)
  textBufferInsert buffer iter1 "Colored Text\n"
  iter2 <- textBufferGetIterAtOffset buffer (-1)
  textIterBackwardLines iter1 1
  textBufferApplyTag buffer tag1 iter1 iter2
  textBufferInsert buffer iter2 "Text with colored backgroujnd\n"
  iter3 <- textBufferGetIterAtOffset buffer (-1)
  textIterBackwardLines iter2 1
  textBufferApplyTag buffer tag2 iter2 iter3
  textBufferInsert buffer iter3 "Text in italics\n"
  iter4 <- textBufferGetIterAtOffset buffer (-1)
  textIterBackwardLines iter3 1
  textBufferApplyTag buffer tag3 iter3 iter4
  textBufferInsert buffer iter4 "Bold text\n"
  iter5 <- textBufferGetIterAtOffset buffer (-1)
  textIterBackwardLines iter4 1
  textBufferApplyTag buffer tag4 iter4 iter5
  
  containerAdd window vbox
  
  on window objectDestroy mainQuit
  
  widgetShowAll window
  
  mainGUI
    

行と列

現在のカーソル位置の行と列を、ステータスバーに表示するようにしました。

サンプルで使用する画像はここからダウンロードできます。解凍した img フォルダをコードファイルと同じディレクトリに置いてください。

linescols.hs

import Graphics.UI.Gtk

updateStatusbar :: TextBuffer -> Statusbar -> IO ()
updateStatusbar buffer statusbar = do
  mark <- textBufferGetInsert buffer
  iter <- textBufferGetIterAtMark buffer mark
  row <- textIterGetLine iter
  col <- textIterGetLineOffset iter
  let msg = "rows:" ++ show (row+1) ++ " cols:" ++ show (col+1) 
  statusbarPush statusbar 0 msg
  return ()

markSetCallback :: Statusbar -> TextIter -> TextMark -> IO ()
markSetCallback statusbar iter mark = do
  row <- textIterGetLine iter
  col <- textIterGetLineOffset iter
  let msg = "rows:" ++ show (row+1) ++ " cols:" ++ show (col+1) 
  statusbarPush statusbar 0 msg
  return ()

main :: IO ()
main = do

  initGUI
  
  window <- windowNew
  set window [windowWindowPosition := WinPosCenter,
              windowDefaultWidth := 350,
              windowDefaultHeight := 300,
              windowTitle := "Lines & Columns"]
              
  vbox <- vBoxNew False 0
  containerAdd window vbox
  
  toolbar <- toolbarNew
  exit <- toolButtonNewFromStock stockQuit
  toolbarInsert toolbar exit 0
  
  boxPackStart vbox toolbar PackNatural 5
  
  textview <- textViewNew
  set textview [textViewWrapMode := WrapWord]
  boxPackStart vbox textview PackGrow 0
  widgetGrabFocus textview
  
  buffer <- textViewGetBuffer textview
  
  statusbar <- statusbarNew
  boxPackStart vbox statusbar PackNatural 0
  
  onToolButtonClicked exit $ do
    widgetHide window
    mainQuit
  
  on buffer bufferChanged $ updateStatusbar buffer statusbar
  
  on buffer markSet $ markSetCallback statusbar
  
  on window objectDestroy mainQuit
  
  widgetShowAll window
  
  updateStatusbar buffer statusbar
  
  mainGUI
              

    

検索とハイライト

「Ctrl + M」で現在選択されている文字列と同じ文字列がすべて選択されます。「Ctrl + R」で、すべての選択が解除されます。

search3.hs

import Graphics.UI.Gtk
import Control.Monad.IO.Class
import Data.Text

while :: TextBuffer -> TextIter -> TextIter -> String -> TextTag -> IO ()
while buffer start end text tag = do
  remainingtext <- textBufferGetText buffer start end False
  case remainingtext of
    "" -> return ()
    otherwise -> do
      Just (match1,match2) <- textIterForwardSearch start text
        [TextSearchTextOnly,TextSearchVisibleOnly] (Just end)
      textBufferApplyTag buffer tag match1 match2
      
      while buffer match2 end text tag --recursive

keyPressed :: TextBuffer -> String -> TextTag -> IO ()
keyPressed buffer keyname tag = do
  case keyname of
    "m" -> do
      (first, second) <- textBufferGetSelectionBounds buffer
      text <- textBufferGetText buffer first second False
      case text of
        "" -> return ()
        otherwise -> do
          start <- textBufferGetStartIter buffer
          end <- textBufferGetEndIter buffer
          textBufferRemoveTag buffer tag start end
          textBufferApplyTag buffer tag first second
          textBufferSelectRange buffer end end
          
          while buffer start end text tag
          
    "r" -> do
      start <- textBufferGetStartIter buffer
      end <- textBufferGetEndIter buffer
      textBufferRemoveTag buffer tag start end

main :: IO ()
main = do

  initGUI
  
  window <- windowNew
  set window [windowWindowPosition := WinPosCenter,
              windowDefaultWidth := 350,
              windowDefaultHeight := 300,
              windowTitle := "Search & highlight"]
  
  vbox <- vBoxNew False 0
  table <- textTagTableNew
  buffer <- textBufferNew (Just table)
  textview <- textViewNewWithBuffer buffer
  widgetAddEvents textview [ButtonPressMask]
  boxPackStart vbox textview PackGrow 0
  
  tag <- textTagNew Nothing
  set tag [textTagBackground := "lightgray"]
  textTagTableAdd table tag
  
  containerAdd window vbox
  
  on window objectDestroy mainQuit
  
  on window keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    keyname <- eventKeyName
    liftIO $ do
      keyPressed buffer (unpack keyname) tag
  
  widgetShowAll window
  
  mainGUI
    

ホーム   目次   ページトップ