#!/usr/bin/wish

# this file is part of the tkBindExtended package to demonstrate
# how one can use it

############################################################
# ENHANCED BINDINGS

# if the enhanced text.tcl is not the default, source it
if {[info proc tkBindDefVar]==""} { 
  foreach key [bind Text] { bind Text $key {} }
  foreach key [bind Entry] { bind Entry $key {} }
  source bindxtnd.tcl
  source text.tcl 
  source entry.tcl
}

# require desired packages
tkBindRequire isearch
tkBindRequire prompt
tkBindRequire rectangle

############################################################
# APPLICATION PROCEDURES

proc AppFileSave {w {saveas 0} {dialog 0}} {
  global App tkPrompt_valid

  if {![info exists App($w,file)]} { set App($w,file) {} }
  if {$saveas || ![string length $App($w,file)]} {
    set file [tkBindPromptString $w -prompt "Save file as:" \
		  -fc 1 -dialog $dialog -default $App($w,file)]
    if {!$tkPrompt_valid || ![string length $file]} {
      tkBindSetMesg $w Canceled.
      return
    }
  } else {
    set file $App($w,file)
  }

  if [catch {open $file w} fid] {
    bell
    tkBindSetMesg $w "ERROR: $fid."
    return
  }
  
  puts -nonewline $fid [$w get 1.0 "end-1c"]
  close $fid

  # set modified flag for buffer to false
  tkTextModified $w 0

  set App($w,file) $file
  wm title . $App($w,file)
  tkBindSetMesg $w "Saved buffer to $file."
}

proc AppBufferCheck {w {dialog 0}} {
  global tkPrompt_valid

  if [tkTextModified $w] {
    set char [tkBindPromptChar $w -dialog $dialog \
		  -prompt "Buffer modified. Save now?"]
    if {$char == "y"} { AppFileSave $w 0 $dialog }
    return $tkPrompt_valid
  }
  return 1
}

proc AppQuit { w {dialog 0}} {
  if ![AppBufferCheck $w $dialog] {
    tkBindSetMesg $w Canceled.
    return
  }
  exit
}

proc AppFileFind {w {file {}} {dialog 0}} {
  global App tkPrompt_valid

  if ![AppBufferCheck $w $dialog] {
    tkBindSetMesg $w Canceled.
    return
  }

  if {![string length $file]} {
    set file [tkBindPromptString $w -prompt "Open file:" -fc 1 \
		  -dialog $dialog -default [pwd]/]
    if {!$tkPrompt_valid || ![string length $file]} {
      tkBindSetMesg $w Canceled.
      return
    }
  }

  if [catch {open $file r} fid] {
    bell
    tkBindSetMesg $w "ERROR: $fid."
    return
  }

  $w delete 1.0 end
  $w insert end [read $fid]
  $w mark set insert 1.0
  close $fid

  # clear undo since we just screwed it up by not using tkTextInsert
  tkTextUndoSetup $w
  # set modified flag for buffer to false
  tkTextModified $w 0

  set App($w,file) $file
  wm title . $App($w,file)
  tkBindSetMesg $w "Opened file $file."
}

############################################################
# SETUP

# create text widget with scrollbars
set txt [text .t -yscroll ".tvscr set" -xscroll ".hbar.thscr set" -wrap none]
scrollbar .tvscr -relief raised -command "$txt yview"
frame .hbar
scrollbar .hbar.thscr -relief raised -command "$txt xview" \
    -orient horizontal

# setup some demo text tags
$txt tag configure underline -underline 1
$txt tag configure italic \
    -font -adobe-courier-medium-o-normal--14-140-75-75-m-90-iso8859-1
$txt tag configure bold \
    -font -adobe-courier-bold-r-normal--14-140-75-75-m-90-iso8859-1
$txt tag configure bolditalic \
    -font -adobe-courier-bold-o-normal--14-140-75-75-m-90-iso8859-1

# create menu
frame .menu -relief raised -bd 2
menubutton .menu.file -text {File} -menu .menu.file.m -underline 0
menubutton .menu.edit -text {Edit} -menu .menu.edit.m -underline 0
menubutton .menu.tags -text {Tags} -menu .menu.tags.m -underline 0
pack .menu.file .menu.edit .menu.tags -side left

menu .menu.file.m
.menu.file.m add command -label {Open} -underline 0 \
    -command "AppFileFind $txt {} 1" -accelerator "\tC-x C-f"
.menu.file.m add command -label {Save} -underline 0 \
    -command "AppFileSave $txt 0 1" -accelerator "\tC-x C-s"
.menu.file.m add command -label {Save As} -underline 5 \
    -command "AppFileSave $txt 1 1" -accelerator "\tC-x C-w"
.menu.file.m add command -label {Quit} -underline 0 \
    -command "AppQuit $txt 1" -accelerator "\tC-x C-c"

menu .menu.edit.m
.menu.edit.m add command -label {Undo} -underline 0 \
    -command "tkTextUndo $txt" -accelerator "\tC-x u"
.menu.edit.m add command -label {Cut} -underline 2 \
    -command "tkTextCut  $txt" -accelerator "\tC-w"
.menu.edit.m add command -label {Copy} -underline 0 \
    -command "tkTextCopy $txt" -accelerator "\tM-w"
.menu.edit.m add command -label {Paste} -underline 0 \
    -command "tkTextYank $txt" -accelerator "\tC-y"

menu .menu.tags.m
.menu.tags.m add command -label {Bold} -underline 0 \
    -command "tkTextReTag $txt {} bold sel.first sel.last"
.menu.tags.m add command -label {BoldItalic} -underline 1 \
    -command "tkTextReTag $txt {} bolditalic sel.first sel.last"
.menu.tags.m add command -label {Italic} -underline 0 \
    -command "tkTextReTag $txt {} italic sel.first sel.last"
.menu.tags.m add command -label {Underline} -underline 0 \
    -command "tkTextReTag $txt {} underline sel.first sel.last"

# have a indicator of modified status using tkText($txt,modified)
image create bitmap modflag -data {
#define modflag_width 15
#define modflag_height 15
static char modflag_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}
checkbutton .hbar.modflag -state disabled -borderwidth 2 \
    -selectimage modflag -image modflag -indicatoron 0 \
    -width [.tvscr cget -width] -variable tkText($txt,modified)

# pack widgets and create an emacs-like minibuffer
pack .menu -side top -fill x
pack [tkBindCreateMesgBuffer .m] -side bottom -fill x 
# pack [label .stat -relief groove -anchor w] -side bottom -fill x
pack .hbar.thscr -side left -fill x -expand true
pack .hbar.modflag -side left
pack .hbar -side bottom -fill x
pack .tvscr -side right -fill y
pack $txt -side left -expand true -fill both

# tell text widget to use MesgBuffer
tkBindAttachMesgBuffer $txt .m

# initialize undo for the text widget
tkTextUndoSetup $txt

# make some application specific bindings
bind TextCX <Control-f> "AppFileFind $txt"
bind TextCX <Control-s> "AppFileSave $txt"
bind TextCX <Control-w> "AppFileSave $txt 1"
bind TextCX <Control-c> "AppQuit $txt"

tkBindSetMesg $txt {Use C-x C-c to quit.}

# read in a file if argument given
if [llength $argv] {
  AppFileFind $txt [lindex $argv 0]
}

# give text widget initial focus
$txt mark set insert 1.0
focus $txt

# set tkBind($txt,prebindtags) PreState
# set tkBind($txt,postbindtags) PostState
#  
# bind PreState <KeyPress> { %W mark set lastpos insert }
# bind PostState <KeyPress> { 
#   if [%W compare lastpos != insert] {
#     .stat configure -text "Position: [%W index insert]"
#   }
# }
# bindtags $txt [list PreState Text $txt PostState . all]

# bind $txt <Control-x> {
#   tkBindSetStateKey %W {MyCX TextCX} C-x
# }
# bind MyCX <KeyPress-f> { 
#   if {%s == 0} {
#     puts stderr "Fill column overridden for %W (%s)" ; break 
#   }
# }


bind TextCX <KeyPress-m> { 
     set $tkBind(%W,mesgvar) "TagRange: [tkTextGetTagRange %W bold insert]" 
}