# This Tcl/Tk script implements a simple "diff" display system.
#
# For the public domain.
# Originally generated by...
#
#         D. Richard Hipp
#         Hipp, Wyrick & Company, Inc.
#         6200 Maple Cove Lane
#         Charlotte, NC 28269
#         704.948.4565
#         drh@vnet.net
#
option add *highlightThickness 0

# The next pair of functions implement a dialog box that tells about
# this program.  The dialog box is the one that appears when the user
# selects Help/AboutThisProgram from the main menu.
#
proc HelpAboutThisProgram {} {
  catch {destroy .about}
  toplevel .about
  wm title .about "About TkDiff"
  wm iconname .about "AboutTkDiff"
  label .about.title -text {TkDiff}\
    -font -adobe-times-bold-i-normal--24-240-75-75-p-128-iso8859-1
  pack .about.title -side top -pady 15
  message .about.subtitle -width 10c -justify center \
    -font -adobe-times-bold-i-normal-*-14-140-75-75-p-77-iso8859-1 \
    -text "A shell for the UNIX ``diff'' command\nwritten using Embedded Tk"
  pack .about.subtitle -side top -pady 10 -padx 15
  message .about.msg -width 10c -text "
By D. Richard Hipp
Hipp, Wyrick & Company, Inc.
6200 Maple Cove Lane
Charlotte, NC 28269
704-948-4565
drh@vnet.net" \
    -font -adobe-times-medium-r-normal-*-12-120-75-75-p-64-iso8859-1
  pack .about.msg -padx 15 -anchor w
  button .about.dismiss -text {Dismiss} -command {destroy .about}
  pack .about.dismiss -pady 8
  wm withdraw .about
  update idletasks
  set x [expr [winfo rootx .] + ([winfo width .]-[winfo reqwidth .about])/2]
  set y [expr [winfo rooty .] + ([winfo height .]-[winfo reqheight .about])/2]
  wm geometry .about +$x+$y
  wm deiconify .about
}

wm title . TkDiff
wm iconname . TkDiff
wm minsize . 320 240
wm protocol . WM_DELETE_WINDOW FileQuit

# Construct the menu bar across the top of the application
#
frame .mbar -bd 2 -relief raised
pack .mbar -side top -fill x
foreach i {file edit view help} {
  set name [string toupper [string range $i 0 0]][string range $i 1 end]
  menubutton .mbar.$i -text $name -underline 0 -menu .mbar.$i.menu -pady 0
  pack .mbar.$i -side left -padx 8
}
pack .mbar -side top -fill x

menu .mbar.file.menu
.mbar.file.menu add command -label Shell -command ShellOut
.mbar.file.menu add separator
.mbar.file.menu add command -label Quit -command FileQuit

menu .mbar.edit.menu
.mbar.edit.menu add command -label Cut -state disabled
.mbar.edit.menu add command -label Copy -command EditCopy
.mbar.edit.menu add command -label Paste -state disabled
.mbar.edit.menu add command -label Delete -state disabled
.mbar.edit.menu add separator
.mbar.edit.menu add command -label Search... -state disabled

menu .mbar.view.menu
.mbar.view.menu add cascade -label {Font Size} -menu .mbar.view.menu.fontsize
.mbar.view.menu add cascade -label Height -menu .mbar.view.menu.height
.mbar.view.menu add cascade -label Width -menu .mbar.view.menu.width
.mbar.view.menu add cascade -label Wrap -menu .mbar.view.menu.wrap
menu .mbar.view.menu.fontsize
foreach i {
  {Tiny -schumacher-clean-medium-r-normal--6-60-75-75-c-40-iso8859-1}
  {Small -schumacher-clean-medium-r-normal--8-80-75-75-c-50-iso8859-1}
  {Short -schumacher-clean-medium-r-normal-*-10-100-75-75-c-60-iso8859-1}
  {Normal -misc-fixed-medium-r-semicondensed-*-13-120-75-75-c-60-iso8859-1}
  {Big -misc-fixed-medium-r-normal--14-130-75-75-c-70-iso8859-1}
  {Huge -misc-fixed-medium-r-normal--20-200-75-75-c-100-iso8859-1}
} {
  .mbar.view.menu.fontsize add radiobutton \
     -label [lindex $i 0] -variable Font -value [lindex $i 1] \
     -command "ChangeFont [lindex $i 1]"
}
set Font -schumacher-clean-medium-r-normal--8-80-75-75-c-50-iso8859-1
menu .mbar.view.menu.height
foreach i {16 20 24 30 36 40 48 60 72 88} {
  .mbar.view.menu.height add radiobutton -label "$i lines" \
    -variable Height -value $i -command "ChangeHeight $i"
}
set Height 64
menu .mbar.view.menu.width
foreach i {32 40 52 64 72 80 92 112} {
  .mbar.view.menu.width add radiobutton -label "$i chars" \
    -variable Width -value $i -command "ChangeWidth $i"
}
set Width 64
menu .mbar.view.menu.wrap
.mbar.view.menu.wrap add radiobutton -label Word\
  -variable Wrap -value word -command {ChangeWrap word}
.mbar.view.menu.wrap add radiobutton -label Character\
  -variable Wrap -value char -command {ChangeWrap char}
.mbar.view.menu.wrap add radiobutton -label None\
  -variable Wrap -value none -command {ChangeWrap none}
set Wrap none


menu .mbar.help.menu
.mbar.help.menu add command -label {About this program...} \
  -command HelpAboutThisProgram

# Put a speed bar directly below the menu bar
#
# To change the contents of the speedbar, just add (or remove) entrys
# to the list on the 2nd argument to the "foreach" statement below.  The
# first field of each entry is the text to go in the speed button, the
# second field is the procedure to call when the speed button is pressed.
#
frame .sbar -bd 1  -relief raised
pack .sbar -side top -expand 1 -fill x
set i 0
foreach btn {
  {Quit FileQuit}
  {Copy EditCopy}
  {Search EditSearch}
  {{24} {ChangeHeight 24}}
  {{36} {ChangeHeight 36}}
  {{48} {ChangeHeight 48}}
  {{60} {ChangeHeight 60}}
  {{72} {ChangeHeight 72}}
  {Small {ChangeFont -schumacher-clean-medium-r-normal--8-80-75-75-c-50-iso8859-1}}
  {Short {ChangeFont -schumacher-clean-medium-r-normal-*-10-100-75-75-c-60-iso8859-1}}
  {Normal {ChangeFont -misc-fixed-medium-r-semicondensed-*-13-120-75-75-c-60-iso8859-1}}
     
} {
  incr i
  button .sbar.b$i -text [lindex $btn 0] \
    -font -adobe-helvetica-medium-r-normal-*-8-80-75-75-p-46-iso8859-1 \
    -command [lindex $btn 1] \
    -padx 1 -pady 0
  pack .sbar.b$i -side left -padx 1 -pady 1
}

# The ".mesg" frame is used to display the names of the files that are
# being compared.
#
frame .mesg -bd 1 -relief raised
pack .mesg -side bottom -fill x -expand 1
label .mesg.l1 -font $Font -text $File1 -anchor e
label .mesg.l2 -font $Font -text "  versus  " 
label .mesg.l3 -font $Font -text $File2 -anchor w
pack .mesg.l1 -side left -fill x -expand 1
pack .mesg.l2 -side left
pack .mesg.l3 -side left -fill x -expand 1

# The main text widgets with their scroll bar.
#
text .left -font $Font -width $Width -height $Height \
   -yscrollcommand {.sb set} \
   -wrap $Wrap -bd 1 -relief raised -padx 3 -pady 2 \
   -exportselection 0 -highlightthickness 0 -bg gray72
pack .left -side left -fill both -expand 1
scrollbar .sb -orient vertical -command Scroll \
  -highlightthickness 0 -bd 1 -relief raised
pack .sb -side left -fill y
proc Scroll {args} {
  eval .left yview $args
  eval .right yview $args
}
text .right -font $Font -width $Width -height $Height \
   -wrap $Wrap -bd 1 -relief raised -padx 3 -pady 2 \
   -exportselection 0 -highlightthickness 0 -bg gray72
pack .right -side left -fill both -expand 1

# Set the colors
foreach i {.left .right} {
  $i tag config blnk -background gray63
  $i tag config del -background Pink2
  $i tag config ins -background PaleGreen
  $i tag config diff -background PaleGoldenrod
}

# Change the height of the text windows.  The argument is the number of rows
# of text to display at one time.
#
proc ChangeHeight newheight {
  global Width Height
  .left config -height $newheight -width $Width
  .right config -height $newheight -width $Width
  set Height $newheight
}

# Change the width of the editor.  The argument is the number of columns
# of text to display.
#
proc ChangeWidth newwidth {
  global Height Width
  .left config -height $Height -width $newwidth
  .right config -height $Height -width $newwidth
  set Width $newwidth
}

# Change the word-wrap mode for the editor.  The argument should be
# one of:   word   char   none
#
proc ChangeWrap newmode {
  .left config -wrap $newmode
  .right config -wrap $newmode
}

# Change the font used by the editor.  The argument is the name of the
# font to use.  For best results, use a constant-width font.
#
proc ChangeFont newfont {
  global Font
  .left config -font $newfont
  .right config -font $newfont
  .mesg.l1 config -font $newfont
  .mesg.l2 config -font $newfont
  .mesg.l3 config -font $newfont
  set Font $newfont
}

# Attempt to launch a shell in the same directory as the file currently
# being edited.  We try to launch tkterm first, but if that fails we
# try xterm as a backup.
#
proc ShellOut {} {
  if {[catch {exec tkterm &}]} {
    catch {exec xterm &}
  }
}

#
# This routine is called in response to the "File/Quit" menu action.
#
proc FileQuit {} {
  destroy .
}

# A routine for dispensing the selection.  The selection is always owned
# by the window ".".  Its value is stored in the variable "Selection"
#
set Selection {}
selection handle . RetrieveSelection
proc RetrieveSelection {offset max} {
  global Selection
  return [string range $Selection $offset [expr {$offset+$max}]]
}

# This routine is called whenever "." owns the selection but another
# window claims ownership.
#
proc LoseSelection {} {
  global Selection
  set Selection {}
}

# Copy the text selected in the text widget into the Selection variable,
# then claim ownership of the selection.
#
proc EditCopy {} {
  global Selection
  catch {
    set Selection [.t get sel.first sel.last]
    selection own . LoseSelection
  }
}