################################################################################
#
# tgdb - A graphical frontend to gdb, the GNU debugger.
#	 Based on Tcl/Tk, TclX, TkSteal, Expect and BLT.
#
# (c) 1994 HighTec EDV-Systeme GmbH
#          Neue Bahnhofstr. 71
#          66386 St.Ingbert, Germany
#          Email: tgdb@HighTec.saarlink.de
#
# *** ALL RIGHTS RESERVED ***
#
################################################################################

set tgdb_version 1.1
wm withdraw .
focus none
catch {
  # drop a note to the session manager
  set hostname [exec hostname]
  if { [set domain [exec domainname]] != "" } {
    append hostname "." $domain
  }
  wm client . $hostname
  wm application . $argv
  unset hostname domain
}
  
catch {selection clear .}
set appname [winfo name .]
set std_out [dup stdout]
close stdout
################################################################################
#
# set default values for debugger, prompt, etc.
#
################################################################################
if { [catch {set debugger $env(TGDB_DEBUGGER)}] } {
  set debugger gdb
}
if { [catch {set prompt $env(TGDB_PROMPT)}] } {
  set prompt "($debugger) "
}
if { [catch {set PS2 $env(PS2)}] } {
  set PS2 ">"
}
if { [catch {set tgdb_path $env(TGDB_PATH)}] } {
  set tgdb_path "."
}
lappend auto_path $tgdb_path
append env(PATH) ":$tgdb_path"
if { [info exists env(TGDB_SMALLICONS)] && ($env(TGDB_SMALLICONS) == "1") } {
  set bitmap_path "$tgdb_path/icon16"
} else {
  set bitmap_path "$tgdb_path/icon32"
}
if { [catch {set tgdb_appdef_path $env(TGDB_APPDEF_PATH)}] } {
  set tgdb_appdef_path "."
}
################################################################################
# examine the argument(s) which we should pass to gdb; do this now,
# so that we can quickly exit if things go wrong
################################################################################
process_gdb_args

################################################################################
#
# load X application default database
#
################################################################################
set colormodel [tk colormodel .]
proc read_option_file { filename {prio widgetDefault} } {
  global appname colormodel

  # read an option file (replace application name if necessary)
  if { $colormodel == "color" } {
    if { $appname == "tgdb" } {
      option readfile $filename $prio
    } else {
      for_file line $filename {
        if { [regsub {^[ 	]*tgdb} $line $appname line] } {
	  if { [set seppos [string first ":" $line]] == -1 } continue
	  set option [string trim [crange $line 0 $seppos-1]]
	  set value [string trim [crange $line $seppos+1 end]]
	  option add $option $value $prio
        }
      }
    }
  } else {
    for_file line $filename {
      if { [regsub {^[ 	]*tgdb} $line $appname line] } {
	if { [set seppos [string first ":" $line]] == -1 } continue
	set option [string trim [crange $line 0 $seppos-1]]
	set value [string trim [crange $line $seppos+1 end]]
	if { [string first foreground $option] != -1 } {
	  set value black
	} elseif { [string first background $option] != -1 } {
	  set value white
	}
	option add $option $value $prio
      }
    }
  }
}
if { [info exists env(TGDB_SMALLICONS)] && ($env(TGDB_SMALLICONS) == "1") } {
  if { [file readable "./.Xdefaults-small"] } {
    read_option_file "./.Xdefaults-small"
  } elseif { [file readable "$tgdb_appdef_path/Tgdb-small"] } {
    read_option_file "$tgdb_appdef_path/Tgdb-small"
  } elseif { [file readable "~/.Xdefaults"] } {
    read_option_file "~/.Xdefaults"
  }
} else {
  if { [file readable "./.Xdefaults-big"] } {
    read_option_file "./.Xdefaults-big"
  } elseif { [file readable "$tgdb_appdef_path/Tgdb"] } {
    read_option_file "$tgdb_appdef_path/Tgdb"
  } elseif { [file readable "~/.Xdefaults"] } {
    read_option_file "~/.Xdefaults"
  }
}
################################################################################
#
# say hello to the user
#
################################################################################

intro

################################################################################
#
# create main window's widgets
#
################################################################################
frame .f0 -relief raised -border 2
frame .f0.f0 -relief raised -border 2
#-------------------------------------------------------------------------------
menubutton .f0.f0.file -text {File } -relief flat -menu .f0.f0.file.m
menu .f0.f0.file.m
menu .f0.f0.file.m.visit
.f0.f0.file.m add command -label { Load program } -command {file_command}
.f0.f0.file.m add command -label { Load executable file } \
  -command {exec_command}
.f0.f0.file.m add command -label { Load symbol file } -command {symbol_command}
.f0.f0.file.m add command -label { Load core file } -command {core_command}
.f0.f0.file.m add command -label { Load gdb source file } \
  -command {read_source_file}
.f0.f0.file.m add command -label { Load text file } -command {load_text_command}
.f0.f0.file.m add cascade -label { Visit } -menu .f0.f0.file.m.visit \
  -state disabled
.f0.f0.file.m add command -label { Save gdb window } -command {save_gdb_window}
.f0.f0.file.m add command -label { Save gdb init file } \
  -command {write_init_file [FileSelectBox -title "Select init file" -perm w]}
.f0.f0.file.m add separator
.f0.f0.file.m add command -label { Quit } -command {exit_tgdb} \
  -accelerator {Ctrl-c}
#-------------------------------------------------------------------------------
menubutton .f0.f0.options -text { Options } -relief flat -menu .f0.f0.options.m
menu .f0.f0.options.m
.f0.f0.options.m add checkbutton -label { Visual bell } \
  -onvalue visual -offvalue audible -variable {Tgdb_option(bell)}
set RaiseLabel " Auto-raise covered windows "
.f0.f0.options.m add checkbutton -label $RaiseLabel \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(RaiseWindows)} \
  -command raise_windows -accelerator {Alt-Esc}
.f0.f0.options.m add checkbutton -label { Make gdb window read-only } \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(gdbRO)}
.f0.f0.options.m add checkbutton -label { Trace tgdb/gdb dialog } \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(TraceGDB)}
.f0.f0.options.m add checkbutton -label { Update breakpoints on each stop } \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(UpdateBpts)}
.f0.f0.options.m add checkbutton -label { Auto-save & load command history } \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(SaveHistory)}
.f0.f0.options.m add separator
.f0.f0.options.m add checkbutton -label { Save preferences on exit } \
  -onvalue 1 -offvalue 0 -variable {Tgdb_option(SaveOptions)}
#-------------------------------------------------------------------------------
menubutton .f0.f0.running -text { Running } -relief flat -menu .f0.f0.running.m
menu .f0.f0.running.m
.f0.f0.running.m add command -label { Run / restart program } \
  -accelerator {Alt-z} -command {$Tgdb_cmd(run)}
.f0.f0.running.m add command -label { Continue } -accelerator {c<Return>} \
  -command {$Tgdb_cmd(continue)}
.f0.f0.running.m add command -label { Next line } -accelerator {n<Return>} \
  -command {$Tgdb_cmd(next)}
.f0.f0.running.m add command -label { Step line } -accelerator {s<Return>} \
  -command {$Tgdb_cmd(step)}
.f0.f0.running.m add command -label { Next instruction } \
  -accelerator {ni<Return>} -command {$Tgdb_cmd(nexti)}
.f0.f0.running.m add command -label { Step instruction } \
  -accelerator {si<Return>} -command {$Tgdb_cmd(stepi)}
.f0.f0.running.m add command -label { Finish } -accelerator {fin<Return>} \
  -command {$Tgdb_cmd(finish)}
.f0.f0.running.m add command -label { Return } -accelerator {ret<Return>} \
  -command {$Tgdb_cmd(return)}
#-------------------------------------------------------------------------------
menubutton .f0.f0.windows -text { Windows } -relief flat -menu .f0.f0.windows.m
menu .f0.f0.windows.m
.f0.f0.windows.m add command -label { Tgdb } -accelerator {Alt-t} \
  -command {raise_main_window}
if { $debugger != "gdb166" } {
.f0.f0.windows.m add command -label { Program (debugee) } -accelerator {Alt-p} \
  -command {raise_debug_window}
}
.f0.f0.windows.m add command -label { Stack } -accelerator {Alt-s} \
  -command {create_stack_window}
.f0.f0.windows.m add command -label { CPU registers } -accelerator {Alt-r} \
  -command {create_cpu_window}
.f0.f0.windows.m add command -label { Watches } -accelerator {Alt-w} \
  -command {create_disp_window}
.f0.f0.windows.m add command -label { Memory dump } -accelerator {Alt-d} \
  -command {create_memory_window}
.f0.f0.windows.m add command -label { Assembly dump } -accelerator {Alt-a} \
  -command {create_assembly_window}
.f0.f0.windows.m add command -label { Xterm (shell) } -accelerator {Alt-x} \
  -command {create_shell_window}
.f0.f0.windows.m add separator
.f0.f0.windows.m add command -label { Cycle windows } -accelerator {Alt-c} \
  -command {toggle_windows}
#-------------------------------------------------------------------------------
menubutton .f0.f0.cmds -text { Commands } -relief flat -menu .f0.f0.cmds.m
menu .f0.f0.cmds.m
.f0.f0.cmds.m add command -label { Attach commands to a breakpoint } \
  -command {do_edit commands}
.f0.f0.cmds.m add command -label { Define a user command } \
  -command {do_edit define}
.f0.f0.cmds.m add command -label { Document a user command } \
  -command {do_edit document}
.f0.f0.cmds.m add separator
.f0.f0.cmds.m add command -label { Clear command history } \
  -command {clear_command_history}
#-------------------------------------------------------------------------------
menubutton .f0.f0.info -text { Info } -relief flat -menu .f0.f0.info.m
menu .f0.f0.info.m
.f0.f0.info.m add command -label { Variables } -state disabled
.f0.f0.info.m add command -label { Functions } -state disabled
.f0.f0.info.m add command -label { Types } -state disabled
.f0.f0.info.m add command -label { Program } -state disabled
.f0.f0.info.m add command -label { Sources } -state disabled
#-------------------------------------------------------------------------------
menubutton .f0.f0.help -text { Help} -relief flat -menu .f0.f0.help.m
menu .f0.f0.help.m
.f0.f0.help.m add command -label { About tgdb } -accelerator {Alt-i} \
  -command help_about
.f0.f0.help.m add command -label { About HighTec } \
  -command help_about_hightec
.f0.f0.help.m add command -label { tgdb } -accelerator {Alt-h} \
  -command create_tgdb_help_window
.f0.f0.help.m add command -label { gdb commands } -accelerator {h<Return>} \
  -command show_help

################################################################################
frame .f1 -relief raised -border 2
entry .f1.status -state disabled -exportselection 0 -textvariable TextStatus
################################################################################
frame .title -relief raised -border 2
label .title.title -textvariable ThisFile
frame .title.f1 -relief raised -border 2
label .title.f1.line -text {Line: } -relief flat
entry .title.f1.lentry -textvariable Line -width 5 -relief flat \
  -state disabled
################################################################################
frame .f2 -relief raised -border 4
label .f2.lbl1 -text {Search} -relief flat
label .f2.lbl2 -text {: } -relief flat
entry .f2.search -textvariable SearchString -relief flat
frame .f2.f
button .f2.f.up -height 4 -bitmap @$bitmap_path/arrow_up.xbm \
  -command {search_string up}
button .f2.f.dn -height 4 -bitmap @$bitmap_path/arrow_dn.xbm \
  -command {search_string down}
################################################################################
frame .f3 -relief flat
text .f3.text -exportselection 1 -setgrid 1 -yscrollcommand {.f3.scroll set} \
  -state disabled -cursor top_left_arrow
scrollbar .f3.scroll -orient vertical -command {text_scroll}
################################################################################
frame .f4 -relief raised -border 2
button .f4.list -bitmap @$bitmap_path/list.xbm -command { list_sel_file }
button .f4.list_l -bitmap @$bitmap_path/list_l.xbm -command { list_last_file }
button .f4.list_d -bitmap @$bitmap_path/list_d.xbm -command { list_disassembly }
button .f4.list_f -bitmap @$bitmap_path/list_f.xbm -command { sel_frame frame }
button .f4.frame_dn -bitmap @$bitmap_path/frame_dn.xbm -command {sel_frame down}
button .f4.frame_0 -bitmap @$bitmap_path/frame_0.xbm \
  -command { sel_frame frame 0 }
button .f4.frame_up -bitmap @$bitmap_path/frame_up.xbm -command { sel_frame up }
button .f4.frame_in -bitmap @$bitmap_path/frame_in.xbm \
  -command { $Tgdb_cmd([list info frame]) }
button .f4.whatis -bitmap @$bitmap_path/whatis.xbm -command {
  if { [cequal [get_selection] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(whatis) [get_selection]
  }
}
button .f4.print -bitmap @$bitmap_path/print.xbm -command {
  if { [cequal [get_selection] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(print) [get_selection]
  }
}
button .f4.printc -bitmap @$bitmap_path/printc.xbm -command {
  if { [cequal [get_selection] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(print) "*([get_selection])"
  }
}
button .f4.printx -bitmap @$bitmap_path/printx.xbm -command {
  $Tgdb_cmd(print) "/x"
}
button .f4.watch -bitmap @$bitmap_path/watch.xbm -command {
  if { [cequal [get_selection] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(display) "[get_selection]"
  }
}
button .f4.finish -bitmap @$bitmap_path/finish.xbm \
  -command { $Tgdb_cmd(finish) }
button .f4.cont -bitmap @$bitmap_path/cont.xbm \
  -command { $Tgdb_cmd(continue) }
button .f4.next -bitmap @$bitmap_path/next.xbm \
  -command { $Tgdb_cmd(next) }
button .f4.step -bitmap @$bitmap_path/step.xbm \
  -command { $Tgdb_cmd(step) }
button .f4.break -bitmap @$bitmap_path/break.xbm \
  -command {
  if { [cequal [get_selection] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(break) [get_selection]
  }
}
button .f4.stop -bitmap @$bitmap_path/stop.xbm -command {
  if { ([blt_busy hosts] != "") && ![winfo exists .yesno] } {
    exp_send ""
  } else {
    show_status "The application is currently not running." steady
  }
}
foreach but [winfo children .f4] {
  $but configure -activeforeground [lindex [$but configure -background] 4]
  $but configure -activebackground [lindex [$but configure -foreground] 4]
}
################################################################################
frame .f5 -relief flat
text .f5.text -exportselection 1 -yscrollcommand {.f5.scroll set} \
  -cursor top_left_arrow
scrollbar .f5.scroll -orient vertical -command {.f5.text yview}
if { $colormodel == "color" } {
  .f5.text tag configure gdb_in -foreground black -background cyan
} else {
  .f5.text tag configure gdb_in -foreground white -background black
}
.f5.text tag lower gdb_in sel
################################################################################
#
# display widgets
#
################################################################################
pack append . .f0 {top fillx}
pack append .f0.f0 \
  .f0.f0.file left \
  .f0.f0.options left \
  .f0.f0.running left \
  .f0.f0.windows left \
  .f0.f0.cmds left \
  .f0.f0.help right
# .f0.f0.info left
pack .f0.f0 -side top -fill x
pack .title.title -side left -fill x -expand 1 -anchor center
pack .title.f1 -side left
pack .title.f1.line -side left
pack .title.f1.lentry -side left
pack .title -side top -fill x
pack .f2.lbl1 -side left
pack .f2.f.up -side top
pack .f2.f.dn -side bottom
pack .f2.f -side left
pack .f2.lbl2 -side left
pack .f2.search -side left -fill x -expand 1 -anchor w
pack .f2 -side top -fill x
pack .f3.text -side left -fill both -expand 1
pack .f3.scroll -side left -fill y
pack .f3 -side top -fill both -expand 1
pack .f1.status -side left -fill x -expand 1 -anchor w
pack .f1 -side top -fill x
pack .f4.list -side left
pack .f4.list_l -side left
pack .f4.list_d -side left
pack .f4.list_f -side left
pack .f4.frame_dn -side left ;# -fill x -expand 1
pack .f4.frame_0 -side left ;# -fill x -expand 1
pack .f4.frame_up -side left ;# -fill x -expand 1
pack .f4.frame_in -side left
pack .f4.whatis -side left
pack .f4.print -side left
pack .f4.printc -side left
pack .f4.printx -side left
pack .f4.watch -side left
pack .f4.stop -side right -expand 1
pack .f4.break -side right
pack .f4.finish -side right
pack .f4.step -side right
pack .f4.next -side right
pack .f4.cont -side right
pack .f4 -side top -fill x
pack .f5.text -side left -fill both -expand 1
pack .f5.scroll -side left -fill y
pack .f5 -side top -fill both -expand 1
################################################################################
#
# enable menu traversal
#
################################################################################
tk_menuBar \
  .f0.f0 \
    .f0.f0.file \
    .f0.f0.options \
    .f0.f0.running \
    .f0.f0.windows \
    .f0.f0.cmds \
    .f0.f0.help
#   .f0.f0.info
################################################################################
#
# handle bindings
#
################################################################################
bind all <Control-c> {exit_tgdb}
bind all <Alt-Any-Key-Escape> {.f0.f0.options.m invoke $RaiseLabel}
bind all <Alt-Any-Key-a> {create_assembly_window}
bind all <Alt-Any-Key-c> {toggle_windows}
bind all <Alt-Any-Key-d> {create_memory_window}
bind all <Alt-Any-Key-h> {create_tgdb_help_window}
bind all <Alt-Any-Key-i> {help_about}
bind all <Alt-Any-Key-r> {create_cpu_window}
bind all <Alt-Any-Key-s> {create_stack_window}
bind all <Alt-Any-Key-t> {raise_main_window}
bind all <Alt-Any-Key-w> {create_disp_window}
bind all <Alt-Any-Key-x> {create_shell_window}
bind all <Alt-Any-Key-z> {$Tgdb_cmd(run)}
if { $debugger != "gdb166" } {
  bind all <Alt-Any-Key-p> {raise_debug_window}
}

bind .f3.text <Alt-Any-Key-Escape> {.f0.f0.options.m invoke $RaiseLabel}
bind .f3.text <Alt-Any-Key-a> {create_assembly_window}
bind .f3.text <Alt-Any-Key-c> {toggle_windows}
bind .f3.text <Alt-Any-Key-d> {create_memory_window}
bind .f3.text <Alt-Any-Key-h> {create_tgdb_help_window}
bind .f3.text <Alt-Any-Key-i> {help_about}
bind .f3.text <Alt-Any-Key-r> {create_cpu_window}
bind .f3.text <Alt-Any-Key-s> {create_stack_window}
bind .f3.text <Alt-Any-Key-t> {raise_main_window}
bind .f3.text <Alt-Any-Key-w> {create_disp_window}
bind .f3.text <Alt-Any-Key-x> {create_shell_window}
bind .f3.text <Alt-Any-Key-z> {$Tgdb_cmd(run)}
if { $debugger != "gdb166" } {
  bind .f3.text <Alt-Any-Key-p> {raise_debug_window}
}
bind .f3.text <Any-Key> { }
bind .f3.text <Any-Mod2-Key> { }
bind .f3.text <Control-Key-v> { }
bind .f3.text <Control-Key-d> { }
bind .f3.text <Control-Key-h> { }
bind .f3.text <BackSpace> { }
bind .f3.text <Control-c> {exit_tgdb}
bind .f3.text <Motion> { set Line [int [%W index @%x,%y]] }
bind .f3.text <B2-Motion> "[bind Text <B2-Motion>]"
bind .f3.text <B2-Motion> "+[bind .f3.text <Motion>]"
bind .f3.text <Double-2> {.f4.print invoke}
#bind .f3.text <Any-Enter> { set old_focus(%W) [focus]; focus %W }
#bind .f3.text <Any-Leave> { catch {focus $old_focus(%W)} }
bind .f3.text <Up> {text_review [expr $Line - 2]}
bind .f3.text <Down> {text_review $Line}
bind .f3.text <Left> {
  text_review \
    [expr $Line - [lindex [split [wm geometry [winfo toplevel %W]] "x+"] 1]]
}
bind .f3.text <Right> {
  text_review \
    [expr $Line -2 + [lindex [split [wm geometry [winfo toplevel %W]] "x+"] 1]]
}
bind .f3.text <Control-Up> [bind .f3.text <Left>]
bind .f3.text <Control-Down> [bind .f3.text <Right>]
bind .f3.text <Return> [bind .f3.text <Down>]
bind .f3.text <KP_Enter> [bind .f3.text <Return>]
bind .f3.text <Key-j> [bind .f3.text <Down>]
bind .f3.text <Key-k> [bind .f3.text <Up>]
bind .f3.text <Key-h> [bind .f3.text <Left>]
bind .f3.text <Key-l> [bind .f3.text <Right>]
bind .f3.text <Prior> [bind .f3.text <Left>]
bind .f3.text <Next> [bind .f3.text <Right>]
bind .f3.text <Insert> { }
bind .f3.text <Delete> { }
bind .f3.text <Home> {text_review 0}
bind .f3.text <End> {text_review 10000000} ;# ugly, but fast...
bind .f3.text <3> {toggle_brk %W %x %y}
bind .f3.text <Control-1> {
  if { [expr2bpno [file tail $ThisFile]:[int [%W index @%x,%y]]] == "" } {
    if { [$Tgdb_cmd(tbreak) [file tail $ThisFile]:[int [%W index @%x,%y]]] } {
      $Tgdb_cmd(continue)
    }
  } else {
    $Tgdb_cmd(continue)
  }
}
################################################################################
#
# this binding realizes a popup menu within the text widget to set/goto marks
#
################################################################################
bind .f3.text <Shift-2> { popup_mark %X %Y }

proc popup_mark { x y } {
  global Popup Mark Line old_focus

  set Popup 0
  set old_focus(popup0) [focus]
  focus none
  update
  toplevel .popup0 -cursor arrow
  bind .popup0 <Visibility> {focus .popup0; grab -global .popup0}
  wm geometry .popup0 "+$x+$y"
  wm transient .popup0 .
  wm focusmodel .popup0 active
  wm overrideredirect .popup0 1
  label .popup0.lbl -text {L: goto mark / R: set mark} -relief raised -border 2
  pack .popup0.lbl -side top -fill x
  foreach but "1 2 3 4 5" {
    if { ![info exists Mark($but)] } {
      set text "unset"
    } else {
      set text [string trim \
	[.f3.text get $Mark($but).0 "$Mark($but).0 lineend"]]
      if { [string length $text] > 30 } {
	set text "[string range $text 0 29]..."
      }
      set text "($Mark($but)) $text"
    }
    button .popup0.b$but -anchor w -text "#$but: $text"
    pack .popup0.b$but -side top -fill x
    bind .popup0.b$but <Shift-3> "set Mark($but) $Line; set Popup 1"
    if { $text != "unset" } {
      bind .popup0.b$but <Shift-1> "text_review [expr $Mark($but) - 1]; \
				   set Popup 1"
    }
  }
  tkwait visibility .popup0
  grab -global .popup0
  bind .popup0 <KeyRelease-Shift_L> {set Popup 1}
  bind .popup0 <KeyRelease-Shift_R> {set Popup 1}
  bind .popup0 <B2-KeyRelease-Shift_L> {set Popup 1}
  bind .popup0 <B2-KeyRelease-Shift_R> {set Popup 1}
  focus .popup0
  tkwait variable Popup
  destroy .popup0
  catch {focus $old_focus(popup0)}
}
################################################################################
# bind Ctrl-1..5 and Alt-1..5 as hotkeys for set/goto mark
################################################################################
set AltMark(1) 1
set AltMark(twosuperior) 2
set AltMark(threesuperior) 3
set AltMark(4) 4
set AltMark(5) 5
foreach mark "1 twosuperior threesuperior 4 5" {
  bind .f3.text <Control-Key-$AltMark($mark)> {
    show_status "Mark #%K set to line $Line."
    set Mark(%K) $Line
  }
  bind .f3.text <Alt-Any-Key-$mark> {
    if { [catch {text_review [expr $Mark($AltMark(%K)) - 1]}] } {
      show_status "Mark #$AltMark(%K) not set."
    } else {
      show_status "Goto mark #$AltMark(%K)."
    }
  }
}
################################################################################
#
# These bindings allow to select some consecutive characters to be used as
# a search string by using Shift-B3-Motion mouse movement
#
################################################################################
bind .f3.text <Shift-3> {
  if { [%W get @%x,%y] != "\n" } {
    %W tag add stag @%x,%y
    %W tag raise stag
    if { $colormodel == "color" } {
      %W tag configure stag -background green
    } else {
      %W tag configure stag -foreground white -background black
    }
    %W mark set smark @%x,%y
  }
}
bind .f3.text <Shift-B3-Motion> {
  tag_SearchString %W %x %y
}
bind .f3.text <Shift-ButtonRelease-3> {
  catch {set SearchString [%W get stag.first stag.last]}
  %W tag delete stag
  %W mark unset smark
}
bind .f3.text <Shift-B3-KeyRelease-Shift_L> \
  [bind .f3.text <Shift-ButtonRelease-3>]
bind .f3.text <Shift-B3-KeyRelease-Shift_R> \
  [bind .f3.text <Shift-ButtonRelease-3>]
bind .f3.text <Key-slash> { focus .f2.search }
bind .f3.text <Key-n> { search_string down }
bind .f3.text <Shift-N> { search_string up }
################################################################################
# these bindings handle text selection
################################################################################
bind .f3.text <1> {select_c_expr %W %x %y}
bind .f3.text <Double-1> {select_c_bracket_expr %W %x %y}
bind .f3.text <Triple-1> {
  select_c_bracket_expr %W %x %y
  select_c_bracket_expr %W %x %y
}
bind .f3.text <B1-Motion> {select_motion %W %x %y}
################################################################################
#
# Bind lentry to Entry class default bindings, then override Any-KeyPress;
# this is important, since Any-KeyPress is more specific for lentry than
# for Entry (i.e. Entry bindings won't work anymore...)
#
################################################################################
foreach defbind [bind Entry] {
  bind .title.f1.lentry $defbind "[bind Entry $defbind]"
}
bind .title.f1.lentry <Any-KeyPress> {
  if { [string match \[0-9\] "%A"] } {
    %W insert insert %A
    tk_entrySeeCaret %W
  }
}
bind .title.f1.lentry <Escape> { set Line "" }
bind .title.f1.lentry <Return> adjust_curline
bind .title.f1.lentry <KP_Enter> [bind .title.f1.lentry <Return>]
bind .title.f1.lentry <Any-Enter> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    set old_focus(%W) [focus]
    focus %W
  }
}
bind .title.f1.lentry <Any-Leave> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    adjust_curline
    catch {focus $old_focus(%W)}
  }
}
bind .title.f1.lentry <Right> {
  %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
}
bind .title.f1.lentry <Left> {
  %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
}
bind .title.f1.lentry <Up> {%W icursor 0; %W view 0}
bind .title.f1.lentry <Down> {%W icursor end; tk_entrySeeCaret %W}
################################################################################
#
# bind search entry
#
################################################################################
foreach defbind [bind Entry] {
  if { [lsearch -exact \
         "<Key-F10> <Key-BackSpace> <Key-Delete> <Any-Key> \
	  <B2-Motion> <Button-2> <Button-1>" \
	 $defbind] >= 0 } {
    bind .f2.search $defbind "[bind Entry $defbind]"
  } else {
    bind .f2.search $defbind { }
  }
}
bind .f2.search <Any-Mod2-Key> [bind .f2.search <Any-Key>]
bind .f2.search <Escape> { set SearchString "" }
bind .f2.search <Return> { search_string down }
bind .f2.search <KP_Enter> [bind .f2.search <Return>]
bind .f2.search <Any-Enter> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    set old_focus(%W) [focus]
    focus %W
  }
}
bind .f2.search <Any-Leave> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    catch {focus $old_focus(%W)}
  }
}
bind .f2.search <Right> {
  %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
}
bind .f2.search <Left> {
  %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
}
bind .f2.search <Up> {%W icursor 0; %W view 0}
bind .f2.search <Down> {%W icursor end; tk_entrySeeCaret %W}
bind .f2.search <3> {+
  if { [cequal [get_selection] ""] } {
    bell
    show_status "No selection."
  } else {
    set SearchString [get_selection]
  }
}
################################################################################
#
# bind status entry, i.e. delete all bindings except scanning and menu traversal
#
################################################################################
foreach bind [bind Entry] {
  if { [lsearch -exact "<Button-2> <B2-Motion> <Key-F10>" $bind] == -1 } {
    bind .f1.status $bind { }
  }
}
################################################################################
#
# bindings for help messages on buttons
#
################################################################################
foreach but [winfo children .f4] {
  bind $but <Any-Enter> [bind Button <Any-Enter>]
  bind $but <Any-Leave> [bind Button <Any-Leave>]
  bind $but <Any-Leave> {+
    if { !$Tgdb_busy && !$FreezeStatus} {
      set TextStatus ""
    }
  }
}
bind .f4.list <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "List selected function."}}
bind .f4.list_l <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "List file that was displayed before the current one."}}
bind .f4.list_d <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "List disassembly of the line containing the selection."}}
bind .f4.list_f <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "List selected frame."}}
bind .f4.frame_dn <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Select frame called by this one (go down one frame)."}}
bind .f4.frame_0 <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Select innermost (bottom) frame."}}
bind .f4.frame_up <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Select frame that called this one (go up one frame)."}}
bind .f4.frame_in <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Show info about the selected frame."}}
bind .f4.whatis <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Print data type of selected expression."}}
bind .f4.print <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Print selected expression."}}
bind .f4.printc <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Print selected pointer expression."}}
bind .f4.printx <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Print last printed expression in hexadecimal format."}}
bind .f4.watch <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Add selected expression to display list."}}
bind .f4.finish <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Continue until selected frame returns (finishes)."}}
bind .f4.cont <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Continue program execution."}}
bind .f4.next <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Continue until next source line, skipping function calls."}}
bind .f4.step <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Continue until next source line, stepping into functions."}}
bind .f4.break <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Set breakpoint at selected function."}}
bind .f4.stop <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
  set TextStatus "Stop program execution."}}
################################################################################
#
# bindings for .f5.text (gdb window)
#
################################################################################
# first, copy all class bindings
foreach bind [bind Text] {
  bind .f5.text $bind [bind Text $bind]
}
# then overload them as necessary
bind .f5.text <Any-Key> {
  if { "%A" != "" } {
    %W insert insert %A
    %W tag add gdb_in "insert -1c" insert
    %W yview -pickplace insert
  }
}
bind .f5.text <Alt-Any-Key-Escape> {.f0.f0.options.m invoke $RaiseLabel}
bind .f5.text <Alt-Any-Key> [bind .f5.text <Any-Key>]
bind .f5.text <Alt-Any-Key-a> {create_assembly_window}
bind .f5.text <Alt-Any-Key-c> {toggle_windows}
bind .f5.text <Alt-Any-Key-d> {create_memory_window}
bind .f5.text <Alt-Any-Key-h> {create_tgdb_help_window}
bind .f5.text <Alt-Any-Key-i> {help_about}
bind .f5.text <Alt-Any-Key-r> {create_cpu_window}
bind .f5.text <Alt-Any-Key-s> {create_stack_window}
bind .f5.text <Alt-Any-Key-t> {raise_main_window}
bind .f5.text <Alt-Any-Key-w> {create_disp_window}
bind .f5.text <Alt-Any-Key-x> {create_shell_window}
bind .f5.text <Alt-Any-Key-z> {$Tgdb_cmd(run)}
if { $debugger != "gdb166" } {
  bind .f5.text <Alt-Any-Key-p> {raise_debug_window}
}
bind .f5.text <BackSpace> {
  if { [lsearch -exact [%W tag names "insert -1c"] gdb_in] == -1 } {
    bell
  } else {
    tk_textBackspace %W
    %W yview -pickplace insert
  }
}
bind .f5.text <Delete> [bind .f5.text <BackSpace>]
bind .f5.text <Return> {
  set gdb_command [%W get "insert linestart" "insert lineend"]
  if { [set gdb_curpos [string first $prompt $gdb_command]] >= 0 } {
    incr gdb_curpos [string length $prompt]
    set gdb_command [string range $gdb_command $gdb_curpos end]
  }
  %W mark set insert "insert lineend"
  %W insert insert "\n"
  %W tag remove gdb_in insert-1c
  %W yview -pickplace insert
  if { [cequal $gdb_command ""] } {
    set gdb_history_last [expr ($gdb_history_nr - 1) %% $gdb_history_max]
    if { [info exists gdb_history($gdb_history_last)] } {
      set gdb_command $gdb_history($gdb_history_last)
      set xgdb_command $gdb_command
      expand_cmd xgdb_command xgdb_args
      if { [info exists gdb_dont_repeat($xgdb_command)] } {
	set gdb_command "echo"
      } elseif { [cequal $xgdb_command "x"] } {
	# don't repeat args for last x command...
	set gdb_command "x"
      }
    } else {
      set gdb_command "echo"
    }
  } else {
    set gdb_history_last [expr ($gdb_history_nr - 1) %% $gdb_history_max]
    if {   ![info exists gdb_history($gdb_history_last)]
	|| ($gdb_command != $gdb_history($gdb_history_last)) } {
      set gdb_history($gdb_history_nr) $gdb_command
      set gdb_history_nr [expr ($gdb_history_nr + 1) %% $gdb_history_max]
    }
  }
  set gdb_history_spot $gdb_history_nr
  set gdb_history($gdb_history_nr) ""
  expand_cmd gdb_command gdb_args
  filter_output $gdb_command $gdb_args
  if {   [info exists gdb_class(user)]
      && ([lmatch -exact $gdb_class(user) $gdb_command] != "") } {
    update_windows new
  }
}
bind .f5.text <KP_Enter> [bind .f5.text <Return>]
bind .f5.text <Up> {
  set gdb_history_last [expr ($gdb_history_spot - 1) %% $gdb_history_max]
  if { ![info exists gdb_history($gdb_history_last)] } {
    bell
  } else {
    if { $gdb_history_last == $gdb_history_nr } {
      bell
    } else {
      set gdb_history_spot $gdb_history_last
      set gdb_tmp [%W get "insert linestart" "insert lineend"]
      if { [set gdb_curpos [string first $prompt $gdb_tmp]] >= 0 } {
        incr gdb_curpos [string length $prompt]
        %W mark set insert [%W index "insert linestart + $gdb_curpos c"]
        %W delete insert "insert lineend"
        %W insert insert $gdb_history($gdb_history_spot)
        %W tag add gdb_in "insert linestart + $gdb_curpos c" insert
      } else {
        %W delete "insert linestart" "insert lineend"
        %W insert insert $gdb_history($gdb_history_spot)
        %W tag add gdb_in "insert linestart" insert
      }
      %W yview -pickplace insert
    }
  }
}
bind .f5.text <Down> {
  if { $gdb_history_spot == $gdb_history_nr } {
    bell
  } else {
    set gdb_history_last [expr ($gdb_history_spot + 1) %% $gdb_history_max]
    if { ![info exists gdb_history($gdb_history_last)] } {
      bell
    } else {
      set gdb_history_spot $gdb_history_last
      set gdb_tmp [%W get "insert linestart" "insert lineend"]
      if { [set gdb_curpos [string first $prompt $gdb_tmp]] >= 0 } {
        incr gdb_curpos [string length $prompt]
        %W mark set insert [%W index "insert linestart + $gdb_curpos c"]
        %W delete insert "insert lineend"
        %W insert insert $gdb_history($gdb_history_spot)
        %W tag add gdb_in "insert linestart + $gdb_curpos c" insert
      } else {
        %W delete "insert linestart" "insert lineend"
        %W insert insert $gdb_history($gdb_history_spot)
        %W tag add gdb_in "insert linestart" insert
      }
      %W yview -pickplace insert
    }
  }
}
bind .f5.text <Control-a> {
  set gdb_tmp [%W get "insert linestart" "insert lineend"]
  if { [set gdb_curpos [string first $prompt $gdb_tmp]] >= 0 } {
    incr gdb_curpos [string length $prompt]
    %W mark set insert [%W index "insert linestart + $gdb_curpos c"]
  } else {
    %W mark set insert [%W index "insert linestart"]
  }
  %W yview -pickplace insert
}
bind .f5.text <Control-b> {
  if { [lsearch -exact [%W tag names "insert -1c"] gdb_in] == -1 } {
    bell
  } else {
    %W mark set insert "insert-1c"
    %W yview -pickplace insert
  }
}
bind .f5.text <Control-c> {
  set gdb_tmp [%W get "insert linestart" "insert lineend"]
  if { [set gdb_curpos [string first $prompt $gdb_tmp]] >= 0 } {
    incr gdb_curpos [string length $prompt]
    set gdb_tmp [string range $gdb_tmp $gdb_curpos end]
  }
  if { [cequal $gdb_tmp ""] } {
    exit_tgdb
  } else {
    %W mark set insert "insert lineend"
    %W insert insert "\n"
    %W tag remove gdb_in "insert-1c"
    %W insert end $prompt
    %W yview -pickplace end
    set gdb_history_spot $gdb_history_nr
  }
}
bind .f5.text <Control-d> {
  if { [lsearch -exact [%W tag names insert] gdb_in] == -1 } {
    bell
  } else {
    %W delete insert
    %W yview -pickplace insert
  }
}
bind .f5.text <Control-e> {
  %W mark set insert "insert lineend"
}
bind .f5.text <Control-f> {
  if { [lsearch -exact [%W tag names insert] gdb_in] == -1 } {
    bell
  } else {
    %W mark set insert "insert+1c"
    %W yview -pickplace insert
  }
}
bind .f5.text <Control-g> {bell}
bind .f5.text <Control-j> [bind .f5.text <Return>]
bind .f5.text <Control-k> {
  %W delete insert "insert lineend"
  %W yview -pickplace insert
}
bind .f5.text <Control-l> {
  if { $Tgdb_option(gdbRO) } {
    %W yview [int [%W index "insert-1l"]]
  } else {
    %W delete 1.0 "insert linestart"
    %W yview 0
  }
}
bind .f5.text <Control-m> [bind .f5.text <Return>]
bind .f5.text <Control-n> [bind .f5.text <Down>]
bind .f5.text <Control-o> { }
bind .f5.text <Control-p> [bind .f5.text <Up>]
bind .f5.text <Control-q> { }
bind .f5.text <Control-r> {focus none; reverse_i_search}
bind .f5.text <Control-s> { }
bind .f5.text <Control-t> { }
bind .f5.text <Control-u> { }
bind .f5.text <Control-v> { }
bind .f5.text <Control-w> { }
bind .f5.text <Control-x> { }
bind .f5.text <Control-y> { }
bind .f5.text <Control-z> { }
bind .f5.text <Left> [bind .f5.text <Control-b>]
bind .f5.text <Right> [bind .f5.text <Control-f>]
bind .f5.text <Shift-Left> [bind .f5.text <Control-a>]
bind .f5.text <Shift-Right> [bind .f5.text <Control-e>]
bind .f5.text <1> {%W mark set anchor @%x,%y}
bind .f5.text <Any-Enter> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    set old_focus(f5.text) [focus]
    focus %W
  }
}
bind .f5.text <Any-Leave> {
  if { [focus] == "none" || [winfo toplevel [focus]] == [winfo toplevel %W] } {
    catch {focus $old_focus(f5.text)}
  }
}
bind .f5.text <Prior> {
  %W yview [expr [int [%W index @0,0]] - [winfo height %W] / $WinSize(.,y)]
}
bind .f5.text <Next> {
  %W yview [expr [int [%W index @0,0]] + [winfo height %W] / $WinSize(.,y) - 2]
}
bind .f5.text <Shift-Up> [bind .f5.text <Prior>]
bind .f5.text <Shift-Down> [bind .f5.text <Next>]
bind .f5.text <Tab> {command_line_completion}

################################################################################
# these bindings handle text selection...
################################################################################
bind .f5.text <1> {
  select_c_expr %W %x %y
}
bind .f5.text <Double-1> {
  select_c_bracket_expr %W %x %y
}
bind .f5.text <Triple-1> {
  select_c_bracket_expr %W %x %y
  select_c_bracket_expr %W %x %y
}
bind .f5.text <B1-Motion> {select_motion %W %x %y}
bind .f5.text <3> {insert_selection %W}
bind .f5.text <Double-2> {.f4.print invoke}

################################################################################
################################################################################
#
# PROCEDURES
#
################################################################################
################################################################################

################################################################################
#
# procedures for selecting c expressions in text widgets
#
################################################################################

################################################################################
# select a simple c expression (by pressing button 1)
################################################################################
proc select_c_expr { w x y } {
  global SelAnchor

  set idx [$w index @$x,$y]
  set SelAnchor($w) $idx
  catch {selection clear .}
  set str [$w get "$idx linestart" "$idx lineend"]
  set delims " !%^&*()\$\[\]+-=~|;:{}\\,./#<>@?\"\n\t"
  regexp {(.*)\.(.*)} $idx {} line pos
  set len [string length $str]
  # find first position of c expression under the cursor
  for { set i $pos } { $i >= 0 } { incr i -1 } {
    if { [string match "*\\[cindex $str $i]*" $delims] } {
      break
    }
  }
  incr i; set beg [expr ($i > $pos) ? $pos : $i]
  # find last position of c expression under the cursor
  for { set i $pos } { $i < $len } { incr i } {
    if { [string match "*\\[cindex $str $i]*" $delims] } {
      break
    }
  }
  set end $i
  $w tag add sel $line.$beg $line.$end
}
################################################################################
# select a c expression containing brackets, parenthesis, '.' or '->' (Double-1)
# if we come here, something should have been selected due to the first
# mouse click - if not, we'll just return, otherwise we try to see if the
# first non-whitespace character after the last selected one is a bracket
# ("(" or "["). If this is the case, we try to select all characters up to
# the matching bracket or parenthesis; we handle strings as well as nested
# brackets and escape sequences. In case of '.' or '->' we select the
# following simple c expression.
################################################################################
proc select_c_bracket_expr { w x y } {
  if { [cequal [get_selection] ""] } {
    return
  }
  #
  # find next non-whitespace character first
  #
  set beg [lindex [$w tag ranges sel] 0]
  set end [lindex [$w tag ranges sel] 1]
  set ready 0
  while { !$ready } {
    set str [$w get "$end linestart" "$end lineend"]
    if { [set len [clength $str]] == 0 } {
      return
    }
    for { regexp {.*\.(.*)} $end {} idx } { $idx < $len } { incr idx } {
      if { ![cequal [string trim [cindex $str $idx]] ""] } {
        set ready 1
        break
      }
    }
    if { $ready } {
      set char [cindex $str $idx]
      if { $char == "(" } {
	set match ")"
      } elseif { $char == "\[" } {
	set match "\]"
      } elseif {   [cequal $char .]
	    || ([cequal $char -] && [cequal [cindex $str [incr idx]] >]) } {
	set ready 0
	while { !$ready } {
	  for { incr idx } { $idx < $len } { incr idx } {
	    if { ![cequal [string trim [cindex $str $idx]] ""] } {
	      set ready 1
	      break
	    }
	  }
	  if { $idx == $len } {
	    set idx 0
	    set end [expr [int $end] + 1].0
	    set str [$w get "$end linestart" "$end lineend"]
	    if { [set len [clength $str]] == 0 } {
	      return
	    }
	  }
	}
	set delims " !%^&*()\$\[\]+-=~|;:{}\\,./#<>@?\"\n\t"
	for { } { $idx < $len } { incr idx } {
	  if { [string match "*\\[cindex $str $idx]*" $delims] } {
	    break
	  }
	}
	catch {selection clear .}
	$w tag add sel $beg "$end linestart +$idx c"
	return
      } else {
        return
      }
    } else {
      set end [expr [int $end] + 1].0
    }
  }
  #
  # now find the matching bracket
  #
  set end [int $end].[incr idx]
  set nestlvl 1
  set in_str 0
  set ready 0
  while { !$ready } {
    set str [$w get "$end linestart" "$end lineend+1c"]
    if { [set len [string length $str]] == 0 } {
      return
    }
    for { regexp {.*\.(.*)} $end {} idx } { $idx < $len } { incr idx } {
      if { [cindex $str $idx] == "\\" } {
	incr idx 1
      } elseif { $in_str } {
        if { [cindex $str $idx] == "\"" } {
	  set in_str 0
	}
      } elseif { [cindex $str $idx] == "\"" } {
	set in_str 1
      } elseif { [cindex $str $idx] == "$char" } {
	incr nestlvl
      } elseif { [cindex $str $idx] == "$match" } {
	if { [incr nestlvl -1] == 0 } {
          set ready 1
          break
	}
      }
    }
    if { $ready } {
      set end [int $end].$idx
    } else {
      set end [expr [int $end] + 1].0
    }
  }
  catch {selection clear .}
  $w tag add sel $beg $end+1c
}
################################################################################
# select characters in the usual way by dragging the mouse with button 1 pressed
################################################################################
proc select_motion { w x y } {
  global SelAnchor

  catch {selection clear .}
  set beg $SelAnchor($w)
  set end [$w index @$x,$y]
  if { [$w compare $beg <= $end] } {
    $w tag add sel $beg $end+1c
  } else {
    $w tag add sel $end $beg+1c
  }
}
################################################################################
# return selected characters (or "" if nothing is selected - instead of griping)
################################################################################
proc get_selection {} {
  if { [catch {set selection [selection get]}] } {
    return ""
  }
  regsub -all "(\n|\t| )+" $selection " " selection
  return "$selection"
}
################################################################################
# insert selection (if there is one) to the given text widget
################################################################################
proc insert_selection { w } {
  if { ![cequal [set selection [get_selection]] ""] } {
    set beg [$w index end]
    $w insert end $selection
    $w tag add gdb_in $beg end
    $w yview -pickplace end
  } else {
    bell
    show_status "No selection."
  }
}
################################################################################
# list selected file
################################################################################
proc list_sel_file {} {
  global Tgdb_cmd

  if { [cequal [set file [get_selection]] ""] } {
    show_status "No selection." steady
  } else {
    $Tgdb_cmd(list) $file
  }
}
################################################################################
# list last file (the one displayed before the current one)
################################################################################
proc list_last_file {} {
  global LastFile LastLine

  if { [cequal $LastFile ""] } {
    show_status "No previously visited file." steady
  } else {
    set lastline $LastLine
    load_file $LastFile $LastLine
    .f3.text yview $lastline
  }
}
################################################################################
#
# procedures to keep track of the current line
#
################################################################################
################################################################################
# adjust current line in text widget
################################################################################
proc adjust_curline {{how -pickplace}} {
  global Line

  if { [catch {expr $Line}] } {
    set Line 1
  }
  if { $Line <= 0} {
    set Line 1
  } else {
    set end [expr [int [.f3.text index end]] - 1]
    if { $Line > $end } {
      set Line $end
    }
  }
  if { $how == "-pickplace" } {
    .f3.text yview -pickplace [expr $Line - 1]
  } else {
    .f3.text yview [expr $Line - 1]
  }
}
################################################################################
proc text_review { ypos } {
  global Line

  set Line [expr $ypos + 1]
  adjust_curline
}
################################################################################
proc text_scroll { ypos } {
  global Line

  set Line [expr $ypos + 1]
  adjust_curline -nopickplace ;# don't use -pickplace for scrollbar commands!
}
################################################################################
#
# display a message in the status line (and delete it after a while, if req'd)
#
################################################################################
proc show_status { msg {how_long 2000}} {
  global TextStatus StatusID

  proc hide_status { id oldmsg } {
    global TextStatus StatusID

    if { ($StatusID == $id) && ($TextStatus == $oldmsg) } { set TextStatus "" }
  }

  regsub -all "\n" $msg " " msg
  incr StatusID
  set TextStatus $msg
  if { "$how_long" != "steady" } {
    after $how_long "hide_status $StatusID [list $msg]"
  }
}
################################################################################
#
# tag a selected range of characters for later use as a search string
#
################################################################################
proc tag_SearchString { window xpos ypos } {
  global colormodel

  if { [catch {set beg [$window index smark]}] } {
    set beg @$xpos,$ypos
    if { [$window get $beg] == "\n" } {
      return
    }
    $window tag add stag $beg
    $window tag raise stag
    if { $colormodel == "color" } {
      $window tag configure stag -background green
    } else {
      $window tag configure stag -foreground white -background black
    }
    $window mark set smark $beg
  }
  set end [lindex [$window tag ranges stag] 1]
  set cur "@$xpos,$ypos"
  if { [$window compare $cur < "$beg linestart"] } {
    set cur "$beg linestart"
  }
  if { [$window compare $cur >= "$beg lineend"] } {
    set cur "$beg lineend - 1 char"
  }
  if { [$window compare $cur < $beg] } {
    set end "$beg + 1 char"
    set beg "$cur"
  } else {
    set end "$cur + 1 char"
  }
  $window tag remove stag 1.0 $beg
  $window tag remove stag $end end
  $window tag add stag $beg $end
}
################################################################################
#
# reset (t)gdb's command history
#
################################################################################
proc clear_command_history {} {
  global gdb_history gdb_history_nr gdb_history_spot

  if { $gdb_history_nr == 0 } {
    show_status "The command line history is empty."
  } else {
    if { [yes_no_box "Clear command line history?"] } {
      unset gdb_history
      set gdb_history_nr 0
      set gdb_history_spot 0
      set gdb_history(0) ""
    }
  }
}
################################################################################
#
# if colormodel is mono, make the current line blink if it contains a
# breakpoint tag and the current PC
#
################################################################################
proc blink_line {} {
  global BlinkingPC BlinkingAsmPC

  if { $BlinkingPC } {
    set fg [lindex [.f3.text tag configure mytag -foreground] 4]
    set bg [lindex [.f3.text tag configure mytag -background] 4]
    .f3.text tag configure mytag -foreground $bg
    .f3.text tag configure mytag -background $fg
  }
  if { $BlinkingAsmPC } {
    if { ![winfo exists .asm] } {
      set BlinkingAsmPC 0
    } else {
      set fg [lindex [.asm.f1.txt tag configure mytag -foreground] 4]
      set bg [lindex [.asm.f1.txt tag configure mytag -background] 4]
      .asm.f1.txt tag configure mytag -foreground $bg
      .asm.f1.txt tag configure mytag -background $fg
    }
  }
  after 500 blink_line
}
################################################################################
#
# load a file and display it in the source text widget starting at line cur_line
# and mark is line if highlight isn't "no"
#
################################################################################
proc load_file { name cur_line {highlight no} } {
  global Contents Line ThisFile TextBindings LentryBindings SearchBindings
  global Mark Marks Tags SearchLastLine LastFile LastLine colormodel
  global BlinkingPC ModTime WinSize

  proc set_filemenu_state { state } {
    .f0.f0.file.m entryconfigure { Load program } -state $state
    .f0.f0.file.m entryconfigure { Load executable file } -state $state
    .f0.f0.file.m entryconfigure { Load symbol file } -state $state
    .f0.f0.file.m entryconfigure { Load core file } -state $state
    .f0.f0.file.m entryconfigure { Load gdb source file } -state $state
    .f0.f0.file.m entryconfigure { Load text file } -state $state
    .f0.f0.file.m entryconfigure { Visit } -state $state
    .f0.f0.file.m entryconfigure { Save gdb window } -state $state
    .f0.f0.file.m entryconfigure { Save gdb init file } -state $state
  }

  if { [cequal $name ""] } {
    if { ![cequal $ThisFile ""] } {
      show_status "File selection cancelled." 2000
    }
    return
  }
  if { [cequal $name $ThisFile] && ([file mtime $name] > $ModTime($name)) } {
    # reload current file
    show_status "Reloading file \"$name\"..." steady
    update idletasks
    set_filemenu_state disabled
    unset Contents($name)
    if { [catch {set desc [open $name r]}] } {
      show_status "No such file \"$name\"." 4000
      set_filemenu_state normal
      return
    }
    if { [catch {set Contents($name) [read $desc]}] } {
      show_status "Error reading file \"$name\"." 4000
      close $desc
      catch {unset Contents($name)}
      set_filemenu_state normal
      return
    }
    close $desc
    set ModTime($name) [file mtime $name]
    .f3.text configure -state normal
    .f3.text delete 1.0 end
    .f3.text insert 1.0 $Contents($name)
    .f3.text configure -state disabled
    if { $colormodel == "color" } {
      .f3.text tag configure brktag -background red
    } else {
      .f3.text tag configure brktag -foreground white -background black
    }
    .f3.text tag lower brktag
    set_filemenu_state normal
    update_bpts
    show_status ""
  }

  if { [cequal $name $ThisFile] } {
    # the following lines provide a better "pickplace" behaviour...
    set topline [int [.f3.text index @0,0]]
    set lstline [expr $topline + ([winfo height .f3.text] / $WinSize(.,y)) - 1]
    if { ($cur_line <= $topline) && ($cur_line >= [expr $topline - 5]) } {
      set Line [expr $topline -8]; adjust_curline exact
    } elseif { ($cur_line >= $lstline) && ($cur_line <= [expr $lstline + 5]) } {
      set Line [expr $topline -8]; adjust_curline exact
    }
    set Line $cur_line; adjust_curline
    if { ($highlight != "no") && ($cur_line != 0) } {
      .f3.text tag delete mytag
      .f3.text tag add mytag $Line.0 "$Line.0 +1 line"
      .f3.text tag lower mytag sel
      .f3.text tag raise mytag brktag
      if { $colormodel == "color" } {
	if { [lsearch -exact [.f3.text tag names $Line.0] brktag] == -1 } {
	  .f3.text tag configure mytag -background green
	} else {
	  .f3.text tag configure mytag -background cyan
	}
      } else {
	.f3.text tag configure mytag -foreground white -background black
	if { [lsearch -exact [.f3.text tag names $Line.0] brktag] == -1 } {
	  set BlinkingPC 0
	} else {
	  set BlinkingPC 1
	}
      }
    }
    return
  }

  # disable menu entries
  set_filemenu_state disabled

  # see if we should force reloading
  if {   [info exists Contents($name)]
      && ([file mtime $name] > $ModTime($name)) } {
    show_status "Reloading file \"$name\"..."
    update idletasks
    unset Contents($name)
    update_bpts
  }

  # only load the file if it isn't loaded yet
  if { ![info exists Contents($name)] } {
    if { [catch {set desc [open $name r]}] } {
      show_status "No such file \"$name\"." 4000
      set_filemenu_state normal
      return
    }
    if { [catch {set Contents($name) [read $desc]}] } {
      show_status "Error reading file \"$name\"." 4000
      close $desc
      catch {unset Contents($name)}
      set_filemenu_state normal
      return
    }
    close $desc
    set ModTime($name) [file mtime $name]
  }

  # remember current file and line number
  set LastFile $ThisFile
  set LastLine [expr [int [.f3.text index @0,0]] - 1]

  # forget last string search position (if any)
  catch {unset SearchLastLine}

  # save old marks and selection tags
  if { ![cequal $ThisFile ""] } {
    foreach i "1 2 3 4 5" {
      catch {set Marks($ThisFile,$i) $Mark($i)}
    }
    catch {set Tags($ThisFile,sel) [.f3.text tag ranges sel]}
  }
  # remove all current marks and tags
  foreach i "1 2 3 4 5" { catch {unset Mark($i)} }
  catch {.f3.text tag delete [.f3.text tag names]}

  .f3.text configure -state normal
  .f3.text delete 1.0 end
  .f3.text insert 1.0 $Contents($name)
  .f3.text configure -state disabled
  if { $colormodel == "color" } {
    .f3.text tag configure brktag -background red
  } else {
    .f3.text tag configure brktag -foreground white -background black
  }
  .f3.text tag lower brktag

  # restore old marks and tags if available
  foreach i "1 2 3 4 5" { catch {set Mark($i) $Marks($name,$i)} }
  foreach tag "sel brktag" {
    catch {
      set tags $Tags($name,$tag)
      for { set b 0; set e 1 } { $e < [llength $tags] } { incr b 2; incr e 2 } {
        .f3.text tag add $tag [lindex $tags $b] [lindex $tags $e]
      }
    }
  }
  if { ![info exists Tags($name,brktag)] } {
    set Tags($name,brktag) ""
  }

  set Line $cur_line; adjust_curline
  if { ($highlight != "no") && ($cur_line != 0) } {
    .f3.text tag delete mytag
    .f3.text tag add mytag $Line.0 "$Line.0 +1 line"
    .f3.text tag lower mytag sel
    .f3.text tag raise mytag brktag
    if { $colormodel == "color" } {
      if { [lsearch -exact [.f3.text tag names $Line.0] brktag] == -1 } {
        .f3.text tag configure mytag -background green
      } else {
        .f3.text tag configure mytag -background cyan
      }
    } else {
      .f3.text tag configure mytag -foreground white -background black
      if { [lsearch -exact [.f3.text tag names $Line.0] brktag] == -1 } {
	set BlinkingPC 0
      } else {
	set BlinkingPC 1
      }
    }
  }
  set ThisFile $name
  .title.f1.lentry configure -state normal

  # restore bindings for text/line/search entry widgets
  foreach bind [array names TextBindings] {
    bind .f3.text $bind $TextBindings($bind)
  }
  foreach bind [array names LentryBindings] {
    bind .title.f1.lentry $bind $LentryBindings($bind)
  }
  foreach bind [array names SearchBindings] {
    bind .f2.search $bind $SearchBindings($bind)
  }

  # generate new file list for Menu->Visit entry and re-enable entries
  catch {.f0.f0.file.m.visit delete 0 last}
  set pwd "[pwd]/"; set pwdlen [string length $pwd]
  foreach name [lsort [array names Contents]] {
    if { [string first $pwd $name] == 0 } {
      set fname [string range $name $pwdlen end]
    } else {
      set fname $name
    }
    if { [cequal [file tail $fname] LICENSE] } {
      set fname "LICENSE"
    }
    .f0.f0.file.m.visit add command -label "$fname" -command "load_file $name 0"
  }
  set_filemenu_state normal
}
################################################################################
#
# load file LICENSE and display a copyright/license dialog box
# Note: as the LICENSE file tells you, you are not allowed to change tgdb's
#       sources before you have paid the shareware fee!
#
################################################################################
proc show_copyright_and_license_policy {} {
  global tgdb_path std_out Contents Tags ModTime

  set name $tgdb_path/LICENSE
  if { ![file readable $name] } {
    puts $std_out "Cannot read tgdb's LICENSE file."
    exit 1
  }
  if { [catch {set desc [open $name r]}] } {
    puts $std_out "Cannot open tgdb's LICENSE file."
    exit 1
  }
  if { [catch {set Contents($name) [read $desc]}] } {
    puts $std_out "Cannot read tgdb's LICENSE file."
    exit 1
  }
  close $desc
  set Tags($name,brktag) ""
  set ModTime($name) [file mtime $name]

  catch {.f0.f0.file.m.visit delete 0 last}
  .f0.f0.file.m.visit add command -label LICENSE -command "load_file $name 0"
  .f0.f0.file.m entryconfigure { Visit } -state normal
  show_license_box
}
################################################################################
#
# search a string upwards/downwards from the current line
#
################################################################################
proc search_string { direction } {
  global Interrupt

  set Interrupt 0
  set cursor_before_search [lindex [.f3.text configure -cursor] 4]
  .f3.text configure -cursor watch
  set bind_before_search [bind .f3.text <Delete>]
  bind .f3.text <Delete> {set Interrupt 1}
  search_string2 $direction
  .f3.text configure -cursor $cursor_before_search
  bind .f3.text <Delete> $bind_before_search
  if { $Interrupt } {
    set Interrupt 0
    show_status "Interrupt."
  }
  unset bind_before_search cursor_before_search
}
################################################################################
proc search_string2 { direction } {
  global Line Contents ThisFile SearchString SearchLastLine SearchLastIdx
  global Interrupt colormodel


  if { [cequal $SearchString ""] } {
    show_status "No string to search for."
    return
  }
  if { [catch {regexp -indices -- $SearchString ""} status] } {
    show_status $status steady
    return
  } else {
    show_status "Searching..." steady
  }
  set bol_only [regexp {^\^} $SearchString]
  set pos [.f3.text index end]
  set end [expr [string range $pos 0 [expr [string first "." $pos] - 1]]]
  set wrapped 0
  set lno $Line

  if { $direction == "down" } {
    if { [info exists SearchLastLine] && ($lno == $SearchLastLine) } {
      if { $bol_only } {
	incr lno
	set beg 0
      } else {
        set beg [expr $SearchLastIdx + 1]
	if { $beg >= [string length [.f3.text get $lno.0 "$lno.0 lineend"]] } {
	  incr lno
	  set beg 0
	}
      }
    } else {
      set beg 0
    }
    while {1} {
      if { [expr $lno % 20] == 0 } {
        update
        if { $Interrupt } return
      }
      if { $lno > $Line && $wrapped } {
        show_status "Pattern not found."
        return
      }
      if { $lno == $end } {
        set lno 1
	set beg 0
        set wrapped 1
      }
      set str [.f3.text get $lno.$beg "$lno.0 lineend"]
      if { [regexp -indices -- $SearchString $str idx] } {
        text_review [expr $lno - 1]
	catch {.f3.text tag delete search$SearchLastLine$SearchLastIdx}
        set p0 [expr [lindex $idx 0] + $beg]
        set p1 [expr [lindex $idx 1] + $beg]
        set SearchLastLine $lno
        set SearchLastIdx $p0
        .f3.text tag add search$lno$p0 $lno.$p0 "$lno.$p1 + 1 char"
	if { $colormodel == "color" } {
          .f3.text tag configure search$lno$p0 -background yellow
	} else {
          .f3.text tag configure search$lno$p0 -foregroun white -backgroun black
	}
        .f3.text tag raise search$lno$p0
         after 4000 "catch \{.f3.text tag delete search$lno$p0\}"
	if { $wrapped } { show_status "Wrapped." 3000 } else { show_status "" }
        return
      }
      set beg 0
      incr lno
    }
  } elseif { $direction == "up" } {
    if { [info exists SearchLastLine] && ($lno == $SearchLastLine) } {
      if { $bol_only || ($SearchLastIdx == 0) } {
	incr lno -1
      }
    } 
    while {1} {
      if { [expr $lno % 20] == 0 } {
        update
        if { $Interrupt } return
      }
      if { ($lno < $Line) && $wrapped } {
        show_status "Pattern not found."
        return
      }
      if { $lno == 0 } {
        set lno $end 
        set wrapped 1
      }
      if { ($lno == $Line) && !$wrapped } {
        set str [.f3.text get $lno.0 "$lno.0 lineend"]
	if { [info exists SearchLastLine] && ($lno == $SearchLastLine) } {
	  set last $SearchLastIdx
        } else {
          set last [string length $str]
	  if { $last == 0 } { set last 1 } ;# so we can find ".*$" in ""
        }
      } else {
        set str [.f3.text get $lno.0 "$lno.0 lineend"]
        set last [string length $str]
	if { $last == 0 } { set last 1 } ;# so we can find ".*$" in ""
      }
      if { [regexp -indices -- $SearchString $str idx] } {
        set beg [lindex $idx 0]
	set old_idx $idx
	if { !$bol_only } {
	  incr last -1
          set str [string range $str [expr $beg + 1] end]
	  while {   ![cequal $str ""]
		 && [regexp -indices -- $SearchString $str idx] } {
	    if { [expr $beg + [lindex $idx 0]] >= $last } {
	      set idx $old_idx
	      break
	    }
	    set beg [expr $beg + [lindex $idx 0] + 1]
	    set str [string range $str [expr [lindex $idx 0] + 1] end]
	    set old_idx $idx
	  }
	  incr last
	  set idx $old_idx
	}
	if { $beg < $last } {
          text_review [expr $lno - 1]
	  catch {.f3.text tag delete search$SearchLastLine$SearchLastIdx}
          set p0 $beg
          set p1 [expr [lindex $idx 1] - [lindex $idx 0] + $beg]
          set SearchLastLine $lno
          set SearchLastIdx $p0
          .f3.text tag add search$lno$p0 $lno.$p0 "$lno.$p1 + 1 char"
	  if { $colormodel == "color" } {
            .f3.text tag configure search$lno$p0 -background yellow
	  } else {
            .f3.text tag configure search$lno$p0 -forgroun white -backgrou black
	  }
          .f3.text tag raise search$lno$p0
           after 4000 "catch \{.f3.text tag delete search$lno$p0\}"
	  if { $wrapped } { show_status "Wrapped." 3000} else { show_status "" }
          return
	}
      }
      incr lno -1
    }
  } else {
    show_status "Internal error: wrong search direction \"$direction\"." steady
  }
}
################################################################################
# display the file select box to get a file for use as exec/symbol file for gdb
################################################################################
proc file_command {} {
  global Tgdb_cmd

  set file [FileSelectBox -title "Select program to debug" -perm x -sort name]
  if { ![cequal $file ""] } {
    $Tgdb_cmd(file) $file
  }
}
################################################################################
# display the file select box to get a file for use as executable file for gdb
################################################################################
proc exec_command {} {
  global Tgdb_cmd

  set file [FileSelectBox -title "Select an executable file" -perm x -sort name]
  if { ![cequal $file ""] } {
    $Tgdb_cmd(exec-file) $file
  }
}
################################################################################
# display the file select box to get a file for use as symbol file for gdb
################################################################################
proc symbol_command {} {
  global Tgdb_cmd

  set file [FileSelectBox -title "Select a symbol file" -perm x -sort name]
  if { ![cequal $file ""] } {
    $Tgdb_cmd(symbol-file) $file
  }
}
################################################################################
# display the file select box to get a file for use as core file for gdb
################################################################################
proc core_command {} {
  global Tgdb_cmd

  set file [FileSelectBox -title "Select a core file" -perm r -sort name]
  if { ![cequal $file ""] } {
    $Tgdb_cmd(core-file) $file
  }
}
################################################################################
# display the file select box to get a text file to be displayed
################################################################################
proc load_text_command {} {
  global Contents ModTime

  set file [FileSelectBox -title "Select a text file" -perm r -sort name]
  if { ![cequal $file ""] } {
    if { [info exists Contents($file)] } {
      set ModTime($file) 0
    }
    load_file $file 0
  }
}
################################################################################
# save contents of gdb window to a file
################################################################################
proc save_gdb_window {} {
  set file [FileSelectBox -title "Select file for saving gdb window"]
  if { ![cequal $file ""] } {
    if { [catch { set desc [open $file "w"] }] } {
      show_status "Couldn't open file \"$file\"." steady
    } else {
      puts $desc [.f5.text get 1.0 end]
      close $desc
    }
  }
}
################################################################################
# see if there is a breakpoint at the line denoted by x,y in window w; if so,
# tell gdb to delete it, otherwise tell him to set one at the first line that
# is known to contain any code
################################################################################
proc toggle_brk { w x y } {
  global ThisFile Tgdb_cmd

  set line [int [$w index @$x,$y]]
  set file [file tail $ThisFile]
  if { [lsearch -exact [$w tag names $line.0] brktag] != -1 } {
    $Tgdb_cmd(clear) "$file:$line"
  } else {
    set result [do_dialog "info line $file:$line" silent no no]
    if { ![regexp {^Line .* (starts|is) at (pc|address) (0x[0-9a-f]+)} \
            $result {} {} {} addr] } {
      bell; return
    }
    if { [regexp "but contains no code" $result] } {
      set result [do_dialog "info line *$addr" silent no no]
      if { ![regexp {^Line ([0-9]*) of} $result {} line] } {
        bell; return
      }
    }
    if { [lsearch -exact [$w tag names [$w index $line.0]] brktag] == -1 } {
      $Tgdb_cmd(break) "$file:$line"
    } else {
      $Tgdb_cmd(clear) "$file:$line"
    }
  }
}
################################################################################
# disassemble the line containing the selection (if owned by the source window)
################################################################################
proc list_disassembly {} {
  global ThisFile Tgdb_cmd

  if {   ([set sel_owner [selection own]] != ".f3.text")
      || ([set sel_range [.f3.text tag ranges sel]] == "") } {
    show_status "No source line selected." steady
    return
  }
  set file [file tail $ThisFile]
  set line [int [lindex $sel_range 0]]
  set result [do_dialog "info line $file:$line" silent no no]
  if { ![regexp {^Line .* (starts|is) at (pc|address) (0x[0-9a-f]+)} \
          $result {} {} {} start_addr] } {
    bell
    return
  }
  if { [regexp "but contains no code" $result] } {
    show_status "Line $line of file \"$file\" contains no code." steady
    return
  }
  if { ![regexp {and ends at (0x[0-9a-f]+)} $result {} end_addr] } {
    bell
    return
  }
  $Tgdb_cmd(disassemble) "$start_addr $end_addr" 
}
################################################################################
#
# procs for gdb's command window
#
################################################################################
 
################################################################################
# Tell the user that something went wrong; depending on Tgdb_option(bell) we do
# either make the gdb window flash, or ring the audible bell
################################################################################
proc bell {} {
  global Tgdb_option

  if { $Tgdb_option(bell) == "visual" } {
    incr Tgdb_option(bell,active)
    if { $Tgdb_option(bell,active) > 1 } {
      incr Tgdb_option(bell,active) -1
      return
    }
    set txtcolor [lindex [.f5.text configure -background] 4]
    .f5.text configure -background red
    after 100 ".f5.text configure -background $txtcolor; \
      set Tgdb_option(bell,active) 0"
  } else {
#   set desc [open "/dev/console" "w"]
#   puts -nonewline $desc ""
#   close $desc
    blt_bell ;# seems to be sexier - now that we use BLT
  }
}
################################################################################
#
# create/delete busy windows while talking to gdb
#
################################################################################
proc busy_create {} {
  global old_focus

  set old_focus(busy) [focus]
  focus none
  foreach sibling [winfo children .] {
    if { $sibling == ".f4" } {
      foreach but [winfo children .f4] {
	blt_busy hold $but
      }
      blt_busy forget .f4.stop
    } else {
      blt_busy hold $sibling
    }
  }
  catch {blt_busy forget .dbg}
  update
  bind .f4.stop <Control-c> {.f4.stop invoke}
  focus .f4.stop
}
################################################################################
proc busy_delete {} {
  global old_focus

  focus none
  bind .f4.stop <Control-c> { }
  catch {
    foreach bwin [blt_busy hosts] {
      blt_busy forget $bwin
    }
  }
  catch { focus $old_focus(busy) }
}
################################################################################
#
# send a command to gdb and return its output; this also handles queries in
# case gdb wants the user to confirm something, and it automatically handles
# gdb's line information output ("-fullname"), as well as "exceptional output"
#
################################################################################
proc do_dialog {say_what how {showpc no} {loadfile yes} } {
  global Tgdb_busy prompt Tgdb_option std_out QueryResult Proceeding
  global AutoDisps PS2

  proc filter_buffer { buffer } {
    global Tgdb_interactive
    upvar answer result
    upvar in_disp disp
    upvar skip_line skip_empty_line

    # examine each line of gdb's output to see if it should be directly output
    # to the gdb window, or if it should be saved for later examinations
    set lines [split $buffer "\n"]
    set maxlines [expr [llength $lines] - 1]
    for { set lineno 0 } { 1 } { incr lineno } {
      if { [cequal [set line [lindex $lines $lineno]] ""] } {
	if { $lineno >= $maxlines } {
          return
	}
	if { $skip_empty_line } {
	  set skip_empty_line 0
	  append result "\n"
	}
	if { $Tgdb_interactive } {
	  .f5.text insert end "\n"
	  .f5.text yview -pickplace end
	}
	continue
      }

      # we disabled all auto-displays at the beginning of this dialog, but if
      # a "enable display" command which is attached to a breakpoint re-enabled
      # at least one of them, we shouldd output the lines to the gdb window...
      if { $disp } {
	.f5.text insert end "$line\n"
	.f5.text yview -pickplace end
	update idletasks
	if { [cequal $line "\}"] } {
	  set disp 0
	}
	continue
      }
      if { [regexp {^[0-9]+: } $line] } {
	.f5.text insert end "$line\n"
	.f5.text yview -pickplace end
	update idletasks
	if { [cequal [cindex $line end] "\{"] } {
	  set disp 1
	}
	continue
      }

      if { [regexp "^Reading in symbols for " $line] } {
	continue
      }
      if {   [regexp "^Starting program" $line]
	  || [regexp "^Continuing" $line] } {
	if { $Tgdb_interactive } {
	  .f5.text insert end "$line\n"
	  .f5.text yview -pickplace end
	}
	show_status $line steady
	update idletasks
	append result "$line\n"
	set skip_empty_line 1
	continue
      }
      if {   [regexp "^Program " $line]
	  || [regexp "^Not confirmed" $line] } {
	if { $Tgdb_interactive } {
	  .f5.text insert end "$line\n"
	  .f5.text yview -pickplace end
	} else {
	  append result "\n$line\n"
	}
	continue
      }
      if { $Tgdb_interactive } {
	if { ![regexp {[^:]*:[0-9]+:([0-9]+):} $line] } {
	  .f5.text insert end "$line\n"
	  .f5.text yview -pickplace end
	  update idletasks
	}
	append result "$line\n"
	continue
      }
      if {   [regexp "^The program is not" $line]
          || [regexp "^No selected frame" $line]
          || [regexp "^Value returned " $line]
	  || [regexp {[^:]*:[0-9]+:([0-9]+):} $line]
	  || [regexp {^"finish" not meaningful} $line] } {
        append result "$line\n"
	continue
      }
      if {   [regexp {^0x[0-9a-fA-F]+ in } $line]
          || [regexp {^[a-zA-Z0-9_]+[^)]*\) at .*:[0-9]*.$} $line]
	  || [regexp {^[a-zA-Z0-9_]+[^)]*\) \(.* line [0-9]+\)$} $line]
	  || [regexp {^Breakpoint [0-9]+} $line]
	  || [regexp {^Bpt [0-9]+} $line] } {
	if {   [regexp -indices {Breakpoint [0-9]+} $result {} pos]
	    || [regexp -indices {Bpt [0-9]+} $result {} pos] } {
	  set result [string range $result 0 [lindex $pos 0]]
	  .f5.text insert end "$line\n"
	  .f5.text yview -pickplace end
	}
        append result "$line\n"
	continue
      }

      # no pattern was matched, so just output the line
      .f5.text insert end "$line\n"
      .f5.text yview -pickplace end
      update idletasks
    }
  }

  proc temp_disable_disps {} {
    global prompt AutoDisps

    # temporarily disable auto-display expressions while proceeding, so that
    # a "continue" command which is attached to a breakpoint won't lead to
    # "endless" display expression output...
    if { $AutoDisps != "" } {
      exp_send "disable display\r"
      expect $prompt
    }
  }

  proc reenable_disps {} {
    global prompt AutoDisps
    upvar answer result

    # re-enable auto-display expressions and sample their output
    if { $AutoDisps != "" } {
      exp_send "enable display $AutoDisps\r"
      expect $prompt
      exp_send "display\r"
      set first 1
      expect {
	-re ".*\n" {
	  regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
	  if { $first } {
	    set first 0
	    set expect_out(buffer) [crange $expect_out(buffer) \
	      [string first "\n" $expect_out(buffer)]+1 end]
	  }
	  append result $expect_out(buffer)
	  exp_continue;
        }

	$prompt {
	  if { ![cequal $expect_out(buffer) $prompt] } {
	    append result [crange $expect_out(buffer) 0 end-[clength $prompt]]
	  }
	}

	eof {
	  exit_tgdb
	}
      }
    }
  }

  #################
  # here we go... #
  #################

  if { $Tgdb_option(TraceGDB) } { puts $std_out ">>> START OF DO_DIALOG" }
  set Tgdb_busy 1
  busy_create

  if { $Proceeding } {
    temp_disable_disps
  }

  set answer ""
  set first 1
  set QueryResult ""
  set filter_query 0
  set in_disp 0
  set skip_line 0
  if { ![cequal $say_what ""] } {
    regsub -all "\t" $say_what " " say_what
    if { $Tgdb_option(TraceGDB) } { puts $std_out "SEND <$say_what>" }
    exp_send "$say_what\r"
  }

  expect {
    -re {.*\?.*\(y or n\) } {
      regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)>"
      }
      if { $first } {
	set first 0
	set expect_out(buffer) [crange $expect_out(buffer) \
	  [string first "\n" $expect_out(buffer)]+1 end]
      }
      if { [yes_no_box "$expect_out(buffer)"] } {
	append QueryResult y
	exp_send "y\r"
      } else {
	append QueryResult n
	exp_send "n\r"
      }
      set filter_query 1
      set answer ""
      exp_continue
    }

    -re "(\\\[(\[0-9\])+\\\]\[^\n\]*\n)+$PS2 " {
      regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)>"
      }
      if { $first } {
	set first 0
	set expect_out(buffer) [crange $expect_out(buffer) \
	  [string first "\n" $expect_out(buffer)]+1 end]
      }
      exp_send [choose_bpt $expect_out(buffer)]\r
      set first 1
      exp_continue
    }

    -re ".*\r\n\r.*\n" {
      regsub -all "\r\n\r" $expect_out(buffer) "" expect_out(buffer)
      regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)>"
      }
      if { $first } {
	set first 0
	set expect_out(buffer) [crange $expect_out(buffer) \
	  [string first "\n" $expect_out(buffer)]+1 end]
      }
      if { $filter_query } {
	if { [regexp "^(y|n)\n" $expect_out(buffer)] } {
	  set filter_query 0
	  set expect_out(buffer) [crange $expect_out(buffer) 2 end]
	} elseif { [regexp "\n(y|n)\n" $expect_out(buffer)] } {
	  set filter_query 0
	  regsub "\n(y|n)\n" $expect_out(buffer) "\n" expect_out(buffer)
	}
      }
      if { !$Proceeding } {
	append answer $expect_out(buffer)
      } else {
	filter_buffer $expect_out(buffer)
      }
      exp_continue;
    }

    -re ".*\n" {
      regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)>"
      }
      if { $first } {
	set first 0
	set expect_out(buffer) [crange $expect_out(buffer) \
	  [string first "\n" $expect_out(buffer)]+1 end]
      }
      if { $filter_query } {
	if { [regexp "^(y|n)\n" $expect_out(buffer)] } {
	  set filter_query 0
	  set expect_out(buffer) [crange $expect_out(buffer) 2 end]
	} elseif { [regexp "\n(y|n)\n" $expect_out(buffer)] } {
	  set filter_query 0
	  regsub "\n(y|n)\n" $expect_out(buffer) "\n" expect_out(buffer)
	}
      }
      if { !$Proceeding } {
	append answer $expect_out(buffer)
      } else {
	filter_buffer $expect_out(buffer)
      }
      exp_continue;
    }

    $prompt {
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)>"
      }
      if { ![cequal $expect_out(buffer) $prompt] } {
        append answer [crange $expect_out(buffer) 0 end-[clength $prompt]]
      }
      if { $Proceeding } {
        reenable_disps
      }
    }

    eof {
      if { $Tgdb_option(TraceGDB) } {
	puts $std_out "RECV <$expect_out(buffer)><\[EOF\]>"
      }
      exit_tgdb
    }
  }

  if { $loadfile == "yes" } {
    # don't display any sources if we stopped at a
    # place where no debug info is available...
    if {   ($showpc != "no" )
	&& ![regexp {[^:]*:[0-9]+:[0-9]+:(beg|middle):0x[0-9a-f]+} $answer]
       } {
      exp_send "info line *\$pc\r"
      expect $prompt {
	if {   ![regexp {[^:]*:[0-9]+:[0-9]+:(beg|middle):0x[0-9a-f]+} \
	          $expect_out(buffer)]
	    && ![regexp {Line [0-9]+ of "(.*)" .* at (pc|address) 0x[0-9a-f]+} \
		  $expect_out(buffer)] } {
	  global Line ThisFile LastFile LastLine

	  if { $ThisFile != "" } {
	    set LastFile $ThisFile
	    set LastLine [expr [int [.f3.text index @0,0]] - 1]
	  }
	  .f3.text configure -state normal
	  .f3.text delete 1.0 end
	  .f3.text configure -state disabled
	  set Line ""
	  set ThisFile ""
        }
      }
    }
    while { [regexp {([^:]*):([0-9]+):([0-9]+):(beg|middle):(0x[0-9a-f]+)} \
	      $answer {} file line off pc] } {
      if { $showpc == "no" } {
        load_file $file $line no
      } else {
        load_file $file $line yes
      }
      regsub {[^:]*:[0-9]+:[0-9]+:(beg|middle):0x[0-9a-fA-F]*.} $answer \
        "" answer
    }
  }
  regsub -all "Reading in symbols for .*done.\n" $answer "" answer
  if { ($how == "verbose") && !$Proceeding && (![cequal $answer ""]) } {
    .f5.text insert end $answer
    .f5.text yview -pickplace end
  }
  if { $Tgdb_option(TraceGDB) } { puts $std_out "<<< END OF DO_DIALOG" }
  busy_delete
  # avoid Enter/Leave event side effects created by busy windows, i.e. give
  # buttons a chance to redraw themselves before new actions can take place
  after 150 {set Tgdb_busy 0}
  return $answer
}
################################################################################
#
# evaluate a gdb command and filter gdb's output; must only be called for
# commands typed on the command line (not for commands produced by buttons,
# unless they simulate user interaction visibly)
#
################################################################################
proc filter_output { cmd {arg ""} } {
  global Tgdb_cmd Tgdb_interactive prompt

  set Tgdb_interactive 1
  if { [info exists Tgdb_cmd($cmd)] } {
    $Tgdb_cmd($cmd) $arg
  } else {
    if { ![cequal $arg ""] } {
      append cmd " $arg"
    }
    do_dialog $cmd verbose yes
  }
  .f5.text insert end $prompt
  .f5.text yview -pickplace insert
  set Tgdb_interactive 0
  update
}
################################################################################
#
# exit from tgdb (and destroy all windows)
#
################################################################################
proc exit_tgdb {} {
  global xterm_pid QueryResult ExitTgdb
  global Tgdb_option WinPos Tgdb_startfile WinProc AsmOpts
  global gdb_history gdb_history_nr gdb_history_max gdb_history_spot

  # avoid nested calling (due to EOF condition when killing gdb in do_dialog)
  if { ![info exists ExitTgdb] } { set ExitTgdb 0 }
  if { [incr ExitTgdb] > 1 } { incr ExitTgdb -1; return }

  set QueryResult ""
  if { ![catch {do_dialog "quit" silent}] && ($QueryResult == "n") } {
    set ExitTgdb 0
    return
  }

  show_status "Thanks for using tgdb. Good Bye."
  update idletasks

  catch {close -slave}
  catch {kill $xterm_pid}
  catch {.shell.f0.xterm stoptksteal}

  if { $Tgdb_option(SaveOptions) } {
    catch {
      set desc [open $Tgdb_startfile "w"]
      puts $desc "#\n# tgdb startup file\n#\n"
      puts $desc "global WinPos Tgdb_option AsmOpts\n"
      puts $desc "# options"
      foreach opt [array names Tgdb_option] {
	puts $desc "set Tgdb_option($opt) $Tgdb_option($opt)"
      }
      if { [info exists AsmOpts(size)] } {
	puts $desc "set AsmOpts(size) $AsmOpts(size)"
	puts $desc "set AsmOpts(mode) $AsmOpts(mode)"
	puts $desc "set AsmOpts(cache) $AsmOpts(cache)"
	puts $desc "set AsmOpts(status) $AsmOpts(status)"
      }
      # remember geometry of previously/currently opened windows
      set windows ""
      foreach win [winfo children .] {
	set top [winfo toplevel $win]
	if { [lsearch -exact $windows $top] == -1 } {
	  lappend windows $top
	  set WinPos($top) [wm geometry $top]
	}
      }
      puts $desc "\n# window geometries"
      foreach win [array names WinPos] {
	puts $desc "set WinPos($win) \"$WinPos($win)\""
      }
      # remember which windows are currently opened
      if { $windows != "" } {
        puts $desc "\n# open windows"
	foreach win $windows {
	  if { [lsearch -exact ". .help .dbg .thelp" $win] != -1 } continue
	  puts $desc "catch \{$WinProc($win)\}"
	}
      }
      # should we save tgdb's command history?
      if { $Tgdb_option(SaveHistory) } {
	puts $desc "\n# command history"
	puts $desc "global gdb_history gdb_history_max"
	puts $desc "global gdb_history_nr gdb_history_spot\n"
	puts $desc "set gdb_history_max $gdb_history_max"
	puts $desc "set gdb_history_nr $gdb_history_nr"
	puts $desc "set gdb_history_spot $gdb_history_spot"
	loop i 0 $gdb_history_max {
	  if { ![info exists gdb_history($i)] } break
	  puts $desc "set gdb_history($i) \{$gdb_history($i)\}"
	}
      }
      close $desc
    }
  }
  catch {destroy .}
  exit 0
}
################################################################################
#
# initialize/reset source window
#
################################################################################
proc init_srcwin {} {
  global Mark Line ThisFile Contents TextBindings LentryBindings SearchBindings
  global LastFile LastFile colormodel

  .f3.text delete 1.0 end
  catch {unset Contents}
  set ThisFile ""
  set Line ""
  set LastFile ""
  set LastLine 0
  foreach bind [bind .f3.text] {
    set TextBindings($bind) [bind .f3.text $bind]
    bind .f3.text $bind { }
  }
  foreach bind [bind .title.f1.lentry] {
    set LentryBindings($bind) [bind .title.f1.lentry $bind]
    bind .title.f1.lentry $bind { }
  }
  foreach bind [bind .f2.search] {
    set SearchBindings($bind) [bind .f2.search $bind]
    bind .f2.search $bind { }
  }
  if { $colormodel == "color" } {
    .f3.text tag configure mytag -background green
  } else {
    .f3.text tag configure mytag -foreground white -background black
  }
  del_all_brktags
}

################################################################################
################################################################################
#
# "main()"
#
################################################################################
################################################################################

# initialize global variables
set StatusID 0
set FreezeStatus 0
set SourcePath [pwd]
set gdb_history_max 128
set gdb_history(0) ""
set gdb_history_nr 0
set gdb_history_spot 0
set Tgdb_option(SaveHistory) 1
set Tgdb_option(bell) visual
set Tgdb_option(bell,active) 0
set Tgdb_option(RaiseWindows) 0
set Tgdb_option(gdbRO) 0
set Tgdb_option(TraceGDB) 0
set Tgdb_option(UpdateBpts) 0
set Tgdb_option(SaveOptions) 1
set Tgdb_busy 0
set Tgdb_interactive 0
set BlinkingPC 0
set BlinkingAsmPC 0
set Proceeding 0
set AutoDisps ""
set timeout -1

################################################################################
#
# initialize tgdb/gdb interface
#
################################################################################
if { "$debugger" == "gdb166" } {
  set gdb_invocation "spawn -noecho $debugger -nx -fullname [split $gdb_argv]"
  eval $gdb_invocation
  do_dialog "" silent
  do_dialog "set screen 0" silent
  do_dialog "set array-max 0" silent
  do_dialog "set pretty" silent
} else {
  toplevel .dbg -cursor top_left_arrow
  wm withdraw .dbg
  frame .dbg.f0 -border 4 -relief sunken
  if { [catch {set debfont [option get .dbg.f0 font Font]}] } {
    set debfont ""
  } elseif { $debfont != "" } {
    set debfont "-fn $debfont"
  }
  if { [catch {set debcolor [option get .dbg.f0 foreground Foreground]}] } {
    set debcolor ""
  } elseif { $debcolor != "" } {
    set debcolor "-xrm \"xterm*foreground:$debcolor\""
  }
  set xterm_desc [open "|mkxtty -iconic #+10000+10000 -title \"Tgdb debugee\" \
    -xrm \"xterm*allowSendEvents:true\" $debcolor \
    -xrm \"xterm*background:bisque1\" $debfont -geometry 200x100+0+0"]
  set xterm_line [gets $xterm_desc]
  set xterm_xid [lindex $xterm_line 0]
  set xterm_tty [lindex $xterm_line 1]
  set xterm_pid [lindex $xterm_line 2]
  catch {close $xterm_desc}
  tksteal .dbg.f0.xterm -name "Tgdb debugee" -windowid $xterm_xid
  pack .dbg.f0 -expand 1 -fill both
  pack .dbg.f0.xterm -in .dbg.f0 -expand 1 -fill both
  wm title .dbg "Tgdb debugee window"
  #
  # now call gdb
  #
  catch {set orig_shell $env(SHELL)}
  set env(SHELL) callcld
  set env(TGDB_TTYDEV) $xterm_tty
  set gdb_invocation "spawn -noecho $debugger -nx -fullname [split $gdb_argv]"
  eval $gdb_invocation
  catch {set env(SHELL) $orig_shell}
  unset env(TGDB_TTYDEV)
  do_dialog "" silent
  do_dialog "set height 0" silent
  do_dialog "set print elements 0" silent
  do_dialog "set print pretty" silent
  unset xterm_desc xterm_line debcolor debfont orig_shell
}
unset gdb_invocation
destroy .welcome

################################################################################
#
# try to load tgdb's startup file "./.t"$debugger"init" or "~/.t"$debugger"init"
#
################################################################################
set startfile0 ""; append startfile0 "./.t" $debugger "init"
set startfile1 ""; append startfile1 "~/.t" $debugger "init"
if { [file readable $startfile0] } {
  set Tgdb_startfile $startfile0
} else {
  set Tgdb_startfile $startfile1
}
unset startfile0 startfile1
catch {source $Tgdb_startfile}

################################################################################
#
# show debugee's window
#
################################################################################
if { [winfo exists .dbg] } {
  foreach bind [bind all] {
    bind .dbg $bind [bind all $bind]
  }
  catch {unset bind}
  bind .dbg <Control-c> {
    .f4.stop invoke
    raise_main_window
  }
  if { [catch {wm geometry .dbg $WinPos(.dbg)}] } {
    wm geometry .dbg 570x335+0+0
  }
  wm minsize .dbg 10 10
  wm protocol .dbg WM_DELETE_WINDOW {bell}
  wm protocol .dbg WM_TAKE_FOCUS {focus .dbg}
  wm deiconify .dbg
}

################################################################################
#
# show main window
#
################################################################################
wm title . "tgdb"
wm protocol . WM_TAKE_FOCUS {focus .f5.text}
wm protocol . WM_DELETE_WINDOW {exit_tgdb}
bind . <Visibility> {check_visibility %W}
if { [catch {wm geometry . $WinPos(.)}] } {
  wm geometry . +100+100
}
wm minsize . 40 15
wm deiconify .
focus none
tkwait visibility .
update
set txtw [lindex [.f3.text configure -width] 4]
set txth [lindex [.f3.text configure -height] 4]
set WinSize(.,x) [expr [winfo width .f3.text] / $txtw]
set WinSize(.,y) [expr [winfo height .f3.text] / $txth]
unset txtw txth

################################################################################
#
# initialize windows, commands and help facility
#
################################################################################
show_status "Initializing tgdb..." steady
update idletasks
init_srcwin
init_gdb_help
init_tgdb_cmds
show_copyright_and_license_policy

if { "$debugger" == "gdb166" } {
  filter_output "info version"
} else {
  filter_output "show version"
}
################################################################################
#
# add path names for exec/symbol/core files; call FileSelectBox (if req'd),
# and list main() function if no core file was specified
#
################################################################################
foreach file "$gdb_execfile $gdb_symfile $gdb_corefile" {
  set path [file dirname $file]
  if { ![cequal $path ""] && ![cequal $path "."] } {
    $Tgdb_cmd(directory) "$path"
  }
}
catch {unset file}
catch {path}
if {   [cequal $gdb_execfile ""]
    && [cequal $gdb_corefile ""]
    && [cequal $gdb_attach_pid ""]
    && [cequal $gdb_symfile ""]
    && [cequal $gdb_cmdfile ""]
    && ($gdb_nx || ![file readable "./.gdbinit"]) } {
  file_command
}

show_status "Good luck!" 4000
update idletasks

if { [cequal $gdb_corefile ""] && [cequal $gdb_attach_pid ""] } {
  do_dialog "set \$pc=main" silent
  $Tgdb_cmd(list) "main,"
} else {
  if { ![cequal $gdb_corefile ""] } {
    $Tgdb_cmd(core-file) $gdb_corefile
  }
  if { ![cequal $gdb_attach_pid ""] } {
    $Tgdb_cmd(attach) $gdb_attach_pid
  }
}

################################################################################
#
# try to load gdb's startup file
#
################################################################################
if { !$gdb_nx && [file readable "./.gdbinit"] } {
  show_status "Loading .gdbinit..." steady
  update idletasks
  $Tgdb_cmd(source) ".gdbinit"
  show_status ""
}

################################################################################
#
# now let's bite the bullet...
#
################################################################################
if { $colormodel == "monochrome" } {
  blink_line
}
focus .f5.text

### EOF ########################################################################
