################################################################################
#
# command.tcl -- make gdb commands happen under tgdb's control
#
# (c) 1994 HighTec EDV-Systeme GmbH
#          Neue Bahnhofstr. 71
#          66386 St.Ingbert, Germany
#          Email: tgdb@HighTec.saarlink.de
#
# *** ALL RIGHTS RESERVED ***
#
################################################################################

################################################################################
# realize gdb's file command (we split it into exec-file and symbol-file
# commands to be compatible with gdb 3.x); on the other hand, we now can
# use the file command for gdb 3.x, too :-)
################################################################################
proc t_file { {file ""} } {
  global Tgdb_interactive QueryResult debugger SourcePath

  t_exec_file $file
  if { $QueryResult != "n" } {
    t_symbol_file $file
  }
  if { ($file != "") && ($debugger == "gdb166") } {
    set path [file dirname $file]
    canonicalize path
    if {   ($path != "") && ($path != ".")
        && ([lmatch [split $SourcePath ":"] $path] == "")} {
      set tmp_interactive $Tgdb_interactive
      set Tgdb_interactive 0
      t_directory "$path"
      set Tgdb_interactive $tmp_interactive
    }
  }
  do_dialog "set \$pc=main" silent
  t_list "main,"
}
################################################################################
# disassemble a given expression
################################################################################
proc t_disassemble { {expr ""} } {
  global Tgdb_interactive prompt

  if { $Tgdb_interactive } {
    do_dialog "disassemble $expr" verbose
  } else {
    set result [do_dialog "disassemble $expr" silent]
    regsub "Dump of assembler code \[^:\]*:\n" $result "" result
    regsub "End of assembler dump\.\n" $result "" result
    append_to_gdbwin "disassemble $expr\n$result$prompt" insert
  }
}
################################################################################
# print definition of a given expression
################################################################################
proc t_whatis { {expr ""} } {
  global Tgdb_interactive

  if { $Tgdb_interactive } {
    do_dialog "whatis $expr" verbose
  } else {
    show_status [do_dialog "whatis $expr" silent] steady
  }
}
################################################################################
# realize gdb's print command
################################################################################
proc t_print { {expr ""} } {
  global Tgdb_interactive prompt AsmLines

  if { $Tgdb_interactive } {
    do_dialog "print $expr" verbose
  } else {
    set result [do_dialog "print $expr" silent]
    show_status $result steady
    if {   ![regexp "^The history is empty" $result]
	&& ![regexp "^History" $result]
	&& ![regexp "^syntax error" $result]
	&& ![regexp "^Can't get value" $result]
	&& ![regexp "^Cannot access memory" $result]
	&& ![regexp "^No symbol table" $result]
	&& ![regexp "^String constants" $result]
	&& ![regexp "^evaluation of this" $result] } {
      append_to_gdbwin "print $expr\n$result$prompt" insert
    }
  }
  if { [string first "=" $expr] != -1 } {
    catch {update_asm_window [lindex $AsmLines 0] new}
    update_cpu_window
    update_disp_window new
    update_mem_window
  }
}
################################################################################
# realize gdb's printf command
################################################################################
proc t_printf { {expr ""} } {
  global Tgdb_interactive prompt AsmLines

  if { $Tgdb_interactive } {
    do_dialog "printf $expr" verbose
  } else {
    set result [do_dialog "printf $expr" silent]
    show_status $result steady
    if {   [regexp "^The history is empty" $result]
	|| [regexp "^History " $result]
	|| [regexp "^syntax error" $result]
	|| [regexp "^Can't get value" $result]
	|| [regexp "^Cannot access memory" $result]
	|| [regexp "^Argument required" $result]
	|| [regexp "^Bad format string" $result]
	|| [regexp "^No symbol table" $result]
	|| [regexp "^String constants" $result]
	|| [regexp "^evaluation of this" $result] } {
      return
    } else {
      append_to_gdbwin "printf $expr\n$result$prompt"
    }
  }
  if { [string first "=" $expr] != -1 } {
    catch {update_asm_window [lindex $AsmLines 0] new}
    update_cpu_window
    update_disp_window new
    update_mem_window
  }
}
################################################################################
# realize gdb's output command
################################################################################
proc t_output { {expr ""} } {
  global Tgdb_interactive prompt AsmLines

  set result [do_dialog "output $expr" silent]
  # this is a work-around for a bug in gdb's output command (e.g. "o $pc")
  append result [do_dialog "echo" silent]
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  } else {
    show_status $result steady
    if {   ![regexp "^The history is empty" $result]
	&& ![regexp "^History" $result]
	&& ![regexp "^Argument required" $result]
	&& ![regexp "^syntax error" $result]
	&& ![regexp "^Can't get value" $result]
	&& ![regexp "^No symbol table" $result]
	&& ![regexp "^String constants" $result]
	&& ![regexp "^evaluation of this" $result] } {
      append_to_gdbwin "output $expr\n$result$prompt" insert
    }
  }
  if { [string first "=" $expr] != -1 } {
    catch {update_asm_window [lindex $AsmLines 0] new}
    update_cpu_window
    update_disp_window new
    update_mem_window
  }
}
################################################################################
# realize gdb's set command
################################################################################
proc t_set { {expr ""} } {
  global Tgdb_interactive AsmLines

  if { $Tgdb_interactive } {
    set result [do_dialog "set $expr" verbose]
  } else {
    set result [do_dialog "set $expr" silent]
    if { $result != "" } {
      show_status $result
    }
  }
  if { ($result == "") && ([string first "=" $expr] != -1) } {
    catch {update_asm_window [lindex $AsmLines 0] new}
    update_cpu_window
    update_disp_window new
    update_mem_window
  }
}
################################################################################
# realize gdb's "set variable" command
################################################################################
proc t_set_variable { {expr ""} } {
  global Tgdb_interactive AsmLines

  if { $Tgdb_interactive } {
    set result [do_dialog "set variable $expr" verbose]
  } else {
    set result [do_dialog "set variable $expr" silent]
    if { $result != "" } {
      show_status $result
    }
  }
  if { ($result == "") && ([string first "=" $expr] != -1) } {
    catch {update_asm_window [lindex $AsmLines 0] new}
    update_cpu_window
    update_disp_window new
    update_mem_window
  }
}
################################################################################
# realize gdb's text search
################################################################################
proc t_forward_search { {regexpr ""} } {
  global SearchString

  if { $regexpr != "" } {
    set SearchString $regexpr
  }
  .f2.f.dn invoke
}
################################################################################
proc t_reverse_search { {regexpr ""} } {
  global SearchString

  if { $regexpr != "" } {
    set SearchString $regexpr
  }
  .f2.f.up invoke
}
################################################################################
# realize gdb's exec-file command
################################################################################
proc t_exec_file { {file ""} } {
  global QueryResult Tgdb_interactive prompt colormodel

  set result [do_dialog "exec-file $file" silent]
  if { $QueryResult == "y" } {
    show_status "The inferior died." steady
    .f3.text tag delete mytag
    if { $colormodel == "color" } {
      .f3.text tag configure mytag -background green
    } else {
      .f3.text tag configure mytag -foreground white -background black
    }
  }
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  } else {
    append_to_gdbwin "exec-file $file\n$result$prompt"
  }
  update_windows new
}
################################################################################
# realize gdb's symbol-file command
################################################################################
proc t_symbol_file { {file ""} } {
  global Tgdb_interactive Tgdb_option prompt

  set result [do_dialog "symbol-file $file" silent]
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  } else {
    append_to_gdbwin "symbol-file $file\n$result$prompt"
  }
  if { !$Tgdb_option(UpdateBpts) } {
    get_all_disps
    update_bpts
  }
  update_windows new
}
################################################################################
# realize gdb's core-file command
################################################################################
proc t_core_file { {file ""} } {
  global QueryResult Tgdb_interactive prompt gdb_corefile colormodel

  set result [do_dialog "core-file $file" silent yes]
  if { $QueryResult == "y" } {
    show_status "The inferior died." steady
    .f3.text tag delete mytag
    if { $colormodel == "color" } {
      .f3.text tag configure mytag -background green
    } else {
      .f3.text tag configure mytag -foreground white -background black
    }
  }
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  } else {
    append_to_gdbwin "core-file $file\n$result$prompt"
  }
  if { $QueryResult != "n" } {
    set gdb_corefile $file
  }
  update_windows new
}
################################################################################
# realize gdb's attach command
################################################################################
proc t_attach { {target ""} } {
  set result [do_dialog "attach $target" verbose yes]
  if { [cequal $result ""] } {
    update_windows new
  } else {
    update_windows $result
  }
}
################################################################################
# kill the inferior
################################################################################
proc t_kill { {arg ""} } {
  global QueryResult gdb_corefile

  do_dialog "kill $arg" verbose
  if { $QueryResult != "y" } {
    return
  }
  .f3.text tag delete mytag
  if { [cequal $gdb_corefile ""] } {
    do_dialog "set \$pc=main" silent
    t_list "main,"
  } else {
    sel_frame frame 0
  }
}
################################################################################
# change gdb's prompt
################################################################################
proc t_set_prompt { {new_prompt ""} } {
  global Tgdb_interactive prompt debugger

  if { $new_prompt == "" } {
    if { $Tgdb_interactive } {
      show_status "Cannot redefine gdb's prompt to \"\"" 3000
    }
  } else {
    set prompt "$new_prompt "
    set result [do_dialog "set prompt $prompt" silent]
    if { $Tgdb_interactive } {
      append_to_gdbwin $result
    }
  }
}
################################################################################
# realize gdb's help facility (in a way it never even dreamed of... :-)
################################################################################
proc t_help { {about ""} } {
  if { $about != "" } {
    expand_cmd about dummy help
  }
  show_help $about
}
################################################################################
# realize gdb's shell command
################################################################################
proc t_shell { {cmd ""} } {
  create_shell_window $cmd
}
################################################################################
# let's "make" it...
################################################################################
proc t_make { {make_args ""} } {
  t_shell "make $make_args"
}
################################################################################
# perform a "source" command; someday we'll be able to read the script inside
# tgdb to have better control, but for now we just pass it to gdb and update
# breakpoint and command information and the like afterwards...
################################################################################
proc t_source { {script ""} } {
  global Tgdb_option Tgdb_interactive prompt gdb_cmd gdb_class ThisFile

  if { !$Tgdb_interactive } {
    append_to_gdbwin "source $script\n"
  }
  set result [do_dialog "source $script" verbose]
  if { $script != "" } {
    catch {foreach cmd $gdb_class(user) { catch {unset gdb_cmd($cmd)} }}
    catch {unset gdb_class(user)}
    find_gdb_cmds "user" "user"
    if { !$Tgdb_option(UpdateBpts) } {
      get_all_disps
      update_bpts
    }
    if { [cequal $result ""] } {
      update_windows new
    } else {
      update_windows $result
    }
    if { $ThisFile == "" } {
      t_list "main,"
    } else {
      sel_frame frame 0
    }
  }
  if { !$Tgdb_interactive } {
    append_to_gdbwin $prompt
  }
}
################################################################################
# "info line" command; nothing special except for gdb 3.x, where we have
# to simulate the -fullname effects of 4.x
################################################################################
proc t_info_line { {which ""} {how verbose} {showpc no} {loadfile yes} } {
  global debugger

  set result [do_dialog "info line $which" $how $showpc $loadfile]
  if { $debugger != "gdb166" } {return $result}
  # simulate gdb 4.x behaviour...
  if { ![regexp {^Line ([0-9]+) of "(.*)" .* at (pc|address) (0x[0-9a-f]+)} \
	  $result {} line file fill addr] } {
    return $result
  }
  if { [cequal [set file [file2path $file $line]] $file] } {
    return $result
  }
  if { $loadfile != "yes" } {
    return [append result "$file:$line:0:beg:$addr\n"]
  } else {
    load_file $file $line $showpc
  }
}
################################################################################
# looks like someone wants to know more about debugee's guts...
################################################################################
proc t_info_frame { {which ""} } {
  global Tgdb_interactive prompt

  if { $Tgdb_interactive } {
    do_dialog "info frame $which" verbose
  } else {
    set result [do_dialog "info frame $which" silent]
    if { [regexp "^Stack level" $result] } {
      append_to_gdbwin "info frame\n$result$prompt" insert
    } else {
      show_status $result steady
    }
  }
}
################################################################################
# this is the place where the sources are handled (via the "list" command);
# we do not want gdb to display the lines in its own window ... look & enjoy!
################################################################################
proc t_list { {what ""} } {
  global ThisFile Tgdb_interactive

  if { [string first "+" $what] == 0 } { set what "" }
  if { $what == "" } {
    if { $ThisFile == "" } {
      set result [t_info_line "main" silent]
      if { ![regexp "^Line .* starts at" $result] } {
	if { $Tgdb_interactive } {
	  append_to_gdbwin $result
	} else {
	  show_status $result steady
	}
      }
    } else {
      scan [.f3.text index @0,0] "%d" line
      text_scroll [expr $line + 9]
    }
  } elseif { [cequal $what "-"] } {
    if { $ThisFile != "" } {
      scan [.f3.text index @0,0] "%d" line
      text_scroll [expr $line - 11]
    } else {
      if { $Tgdb_interactive } {
        append_to_gdbwin "No current source file.\n"
      } else {
	show_status "No current source file." steady
      }
    }
  } elseif { [ctype digit $what] } {
    if { $ThisFile != "" } {
      text_scroll [expr $what - 1]
    } else {
      if { $Tgdb_interactive } {
        append_to_gdbwin "No current source file.\n"
      } else {
	show_status "No current source file." steady
      }
    }
  } else {
    set exact 0
    if { [string index $what 0] == "," } {
      set what [string range $what 1 end]
    }
    if { [set pos [string first "," $what]] != -1 } {
      set what [string range $what 0 [expr $pos - 1]]
      set exact 1
    }
    set result [t_info_line "$what" silent]
    if { ![regexp {^Line ([0-9]+) of "(.*)" .* at (pc|address) (0x[0-9a-f]+)} \
	    $result {} line file fill addr] } {
      if { $Tgdb_interactive } {
        append_to_gdbwin $result
      } else {
	show_status $result steady
      }
    } else {
      if { $exact} {
        .f3.text yview [incr line -3]
      }
      if { ![cequal $ThisFile [file2path $file $line]] } {
        if { $Tgdb_interactive } {
	  append_to_gdbwin "\"$file\": No such file.\n"
        } else {
	  show_status "\"$file\": No such file." 4000
        }
      }
    }
  }
}
################################################################################
# especially for gdb 3.x it's sometimes useful to add directories to the
# source path; we're really interested in what's goin' on there...
################################################################################
proc t_directory { {dir ""} } {
  global Tgdb_interactive SourcePath PathCache debugger

  canonicalize dir
  if { $dir == "" } {
    if { $debugger == "gdb166" } {
      set result [do_dialog "info directories" silent]
      regexp {Source directories searched: (.*)} $result {} old_path
    } else {
      set result [do_dialog "show directories" silent]
      regexp {Source directories searched: (.*)} $result {} old_path
    }
  }
  if { $Tgdb_interactive } {
    set result [do_dialog "directory $dir" verbose]
  } else {
    set result [do_dialog "directory $dir" silent]
  }
  regexp {Source directories searched: (.*)} $result {} SourcePath
  if { ($dir == "") && ([string compare $SourcePath $old_path] != 0) } {
    unset PathCache
  }
  set SourcePath [string trim $SourcePath]
}
################################################################################
# just a helper for t_directory: make dots and stuff disappear from the
# path name so that it finally becomes a proper one...
################################################################################
proc canonicalize { directory_ptr } {
  upvar $directory_ptr dir

  if { $dir == "" } return
  catch {set old_dir [pwd]}
  if { [catch {cd $dir}] } return
  catch {set dir [pwd]}
  catch {cd $old_dir}
}

################################################################################
# a few commands which take multi-line arguments...
################################################################################
proc t_commands { {bpno ""} } {
  do_edit commands $bpno
}
################################################################################
proc t_define { {usercmd ""} } {
  do_edit define $usercmd
}
################################################################################
proc t_document { {usercmd ""} } {
  do_edit document $usercmd
}

################################################################################
# realize gdb's display command
################################################################################
proc t_display { {expr ""} } {
  global Tgdb_interactive prompt FreezeStatus

  if { $Tgdb_interactive } {
    do_dialog "display $expr" verbose
    update_disp_window new
  } else {
    set result [do_dialog "display $expr" silent]
    if { [regexp "^No symbol" $result] } {
      show_status $result steady
    } else {
      regexp {[0-9]+: (.*)} $result {} result
      if { ![winfo exists .disp] } {
        show_status $result
	append_to_gdbwin "display $expr\n$result$prompt" insert
      } else {
        update_disp_window new
      }
    }
  }
  set FreezeStatus 1
  if { $expr != "" } {
    get_all_disps
  }
  after 150 {set FreezeStatus 0}
}
################################################################################
# enable a display expression
################################################################################
proc t_enable_display { {dispnr ""} } {
  global Tgdb_interactive

  if { $Tgdb_interactive } {
    do_dialog "enable display $dispnr" verbose
  } else {
    do_dialog "enable display $dispnr" silent
  }
  get_all_disps
  update_disp_window new
}
################################################################################
# disable a display expression
################################################################################
proc t_disable_display { {dispnr ""} } {
  global Tgdb_interactive

  if { $Tgdb_interactive } {
    do_dialog "disable display $dispnr" verbose
  } else {
    do_dialog "disable display $dispnr" silent
  }
  get_all_disps
  update_disp_window new
}
################################################################################
# delete a display expression
################################################################################
proc t_delete_display { {dispnr ""} } {
  global Tgdb_interactive

  if { $Tgdb_interactive } {
    do_dialog "delete display $dispnr" verbose
  } else {
    do_dialog "delete display $dispnr" silent
  }
  get_all_disps
  update_disp_window new
}

################################################################################
# commands to make the inferior running
# uuhuuuu! ugly magic 'round here... for reasons I don't want to discuss here,
# tgdb needs a special program to launch the debugee (not just a shell like
# /bin/sh) - so we have to simulate shell's parameter substitutions before
# starting our special "shell" program...
################################################################################
proc t_run { {pargs ""} } {
  global debugger last_run_args

  show_status "Starting application." steady
  set tmp_pargs $pargs
  if { $debugger != "gdb166" } {
    if { $pargs != "" } {
      regsub -all {\\} $pargs {\\\\\\\\} pargs
      regsub -all {\[} $pargs {\[} pargs
      regsub -all {\]} $pargs {\]} pargs
      regsub -all {"} $pargs {\\\\\\\\\"} pargs
      regsub -all {`} $pargs {\`} pargs
      set pargs [join [list echo `eval echo $pargs`]]
      catch {set pargs [exec /bin/sh -c $pargs]}
      set last_run_args $pargs
    } else {
      catch {set pargs "$pargs $last_run_args"}
    }
  }
  do_proceed run $pargs
}
################################################################################
proc t_continue { {arg ""} } {
  do_proceed cont $arg ;# we use cont, not continue (gdb 3.x only knows cont)
}
################################################################################
proc t_until { {arg ""} } {
  do_proceed until $arg
}
################################################################################
proc t_next { {arg ""} } {
  do_proceed next $arg
}
################################################################################
proc t_step { {arg ""} } {
  do_proceed step $arg
}
################################################################################
proc t_nexti { {arg ""} } {
  do_proceed nexti $arg
}
################################################################################
proc t_stepi { {arg ""} } {
  do_proceed stepi $arg
}
################################################################################
proc t_jump { {arg ""} } {
  do_proceed jump $arg
}
################################################################################
proc t_return { {arg ""} } {
  do_proceed return $arg ;# not really proceed, but we want our windows updated
}
################################################################################
proc t_finish { {arg ""} } {
  do_proceed finish $arg
}
################################################################################
#
# run the inferior and filter gdb's output on return
#
################################################################################
proc do_proceed { cmd {arg ""} } {
  global Tgdb_interactive prompt Proceeding

  if { $cmd != "run" && $cmd != "return" } {
    show_status "Continuing." steady
    update idletasks
  }

  set Proceeding 1
  set result [do_dialog "$cmd $arg" silent yes]
  set Proceeding 0

  if { [regexp -indices "(^\[0-9\]+: )|\n(\[0-9\]+: )" $result {} pos pos2] } {
    if { [lindex $pos 0] != -1 } {
      set pos [lindex $pos 0]
    } else {
      set pos [lindex $pos2 0]
    }
    set disp_out [string range $result $pos end]
    set result [string range $result 0 [expr $pos - 1]]
  } else {
    set disp_out ""
  }

  if { $Tgdb_interactive } {
    show_status ""
    if { $disp_out != "" } {
      if { [winfo exists .disp] } {
	append result $disp_out
      } else {
	append_to_gdbwin $disp_out
      }
    }
  } else {
    if { ($cmd == "run") || ([regexp "^Continuing." $result]) } {
      set result [crange $result [string first \n $result]+1 end]
    } elseif { ($cmd == "finish") && [regexp "^Run till exit from" $result] } {
      set result [crange $result [string first \n $result]+1 end]
    }
    set result [string trim $result]
    if {   [regexp "^The program is not" $result]
	|| [regexp "^No selected frame" $result]
	|| [regexp "^Program " $result]
	|| [regexp "^Not confirmed" $result] } {
      show_status $result steady
      if { ($cmd == "finish") && [regexp "Value returned .*" $result value] } {
	if { ($disp_out != "") && ![winfo exists .disp] } {
          append_to_gdbwin "$cmd $arg\n$disp_out$value\n$prompt" insert
	  set disp_out ""
	} else {
          append_to_gdbwin "$cmd $arg\n$value\n$prompt" insert
	}
      } elseif { [regexp "Program " $result] } {
	if { ($disp_out != "") && ![winfo exists .disp] } {
          append_to_gdbwin "$cmd $arg\n$disp_out$result\n$prompt" insert
	  set disp_out ""
	} else {
          append_to_gdbwin "$cmd $arg\n$result\n$prompt" insert
	}
      }
    } elseif { $result != "" } {
      show_status $result steady
      if { ($cmd != "finish") || ![regexp {^"finish" not meaningful} $result]} {
	if { ($disp_out != "") && ![winfo exists .disp] } {
	  append_to_gdbwin "$cmd $arg\n$disp_out$result\n$prompt"
	  set disp_out ""
	} else {
	  append_to_gdbwin "$cmd $arg\n$result\n$prompt"
	}
      }
    } else {
      show_status ""
    }
    set last_line [.f5.text get "end linestart" end]
    if { [string first $prompt $last_line] != 0 } {
      if { $last_line == "" } {
	append_to_gdbwin "$prompt"
      } else {
	append_to_gdbwin "\n$prompt"
      }
    }
    if { $disp_out != "" } {
      if { [winfo exists .disp] } {
        append result "\n$disp_out"
      } else {
	append_to_gdbwin "$cmd $arg\n$disp_out$prompt"
      }
    }
  }

  if { ![regexp "^The program is not" $result] } {
    update_windows $result
  }
}
################################################################################
#
# some functions (pardon: procedures) dealing with "frame climbing"...
#
################################################################################
proc t_up { {arg ""} } {
  sel_frame up $arg
}
################################################################################
proc t_down { {arg ""} } {
  sel_frame down $arg
}
################################################################################
proc t_frame { {arg ""} } {
  sel_frame frame $arg
}
################################################################################
#
# select a frame and update windows if required
#
################################################################################
proc sel_frame { cmd {pargs ""} } {
  global Tgdb_interactive prompt FreezeStatus

  if { $Tgdb_interactive } {
    set result [do_dialog "$cmd $pargs" verbose yes]
  } else {
    set result [do_dialog "$cmd $pargs" silent yes]
    show_status $result steady
  }
  if { [regexp {^#[0-9]} $result] } {
    set FreezeStatus 1
    update_stack_window select_only
    update_cpu_window
    update_disp_window new
    update_asm_window "\$pc"
    after 150 {set FreezeStatus 0}
  }
}
################################################################################
#
# emulate gdb commands dealing with gdb's command history
#
################################################################################
proc t_set_history_expansion { {arg ""} } {
  global Tgdb_interactive

  if { ($arg != "off") && ($arg != "0") } {
    if { $Tgdb_interactive } {
      append_to_gdbwin "tgdb doesn't support history expansion (cmd ignored).\n"
    } else {
      show_status "Warning: tgdb doesn't support history expansion."
    }
  }
}
################################################################################
proc t_set_history_filename { {arg ""} } {
  global Tgdb_interactive

  if { $Tgdb_interactive } {
    append_to_gdbwin "tgdb doesn't accept a history filename (cmd ignored).\n"
  } else {
    show_status "Warning: tgdb doesn't accept a history filename."
  }
}
################################################################################
proc t_set_history_save { {arg ""} } {
  global Tgdb_interactive Tgdb_option

  if { ($arg == "") || ($arg == "1") || ($arg == "on") } {
    set Tgdb_option(SaveHistory) 1
  } elseif { ($arg == "0") || ($arg == "off") } {
    set Tgdb_option(SaveHistory) 0
  } else {
    if { $Tgdb_interactive } {
      append_to_gdbwin "Boolean value expected (0, 1, on or off).\n"
    } else {
      show_status "Boolean value expected (0, 1, on or off)."
    }
  }
}
################################################################################
proc t_set_history_size { {arg ""} } {
  global Tgdb_interactive
  global gdb_history gdb_history_spot gdb_history_nr gdb_history_max

  if { $Tgdb_interactive } {
    set msgproc append_to_gdbwin
  } else {
    set msgproc show_status
  }
  if { $arg == "" } {
    $msgproc "Argument required (integer to set it to).\n"
    return
  }
  if { ![ctype digit $arg] || ($arg < 2) } {
    $msgproc "Argument must be an integer >= 2.\n"
    return
  }
  if { $arg == $gdb_history_max } {
    return
  }
  if { $arg > $gdb_history_max } {
    set nr [expr ($gdb_history_nr - 1) % $gdb_history_max]
    loop i $gdb_history_max-1 -1 -1 {
      if { [info exists gdb_history($nr)] && ($gdb_history($nr) != "") } {
        set hist($i) $gdb_history($nr)
      }
      set nr [expr ($nr - 1) % $gdb_history_max]
    }
  } else {
    set nr [expr ($gdb_history_nr - 1) % $gdb_history_max]
    loop i $arg-1 -1 -1 {
      if { [info exists gdb_history($nr)] && ($gdb_history($nr) != "") } {
        set hist($i) $gdb_history($nr)
      }
      set nr [expr ($nr - 1) % $gdb_history_max]
    }
  }
  unset gdb_history
  set nr 0
  loop i 0 $arg {
    if { [info exists hist($i)] } {
      set gdb_history($nr) $hist($i)
      incr nr
    }
  }
  set gdb_history_max $arg
  set nr [expr $nr % $gdb_history_max]
  set gdb_history($nr) ""
  set gdb_history_nr $nr
  set gdb_history_spot $nr
}
################################################################################
proc t_show_history { {arg ""} } {
  global Tgdb_startfile Tgdb_option gdb_history_max

  if { $arg != "" } {
    append_to_gdbwin "Undefined show history command: \"$arg\".  "
    append_to_gdbwin "Try \"help show history\".\n"
    return
  }
  append_to_gdbwin \
    "filename:  The filename in which to record the command history is \n"
  append_to_gdbwin "    \"$Tgdb_startfile\".\n"
  append_to_gdbwin \
    "size:  The size of the command history is $gdb_history_max.\n"
  if { $Tgdb_option(SaveHistory) } {
    append_to_gdbwin "save:  Saving of the history record on exit is on.\n"
  } else {
    append_to_gdbwin "save:  Saving of the history record on exit is off.\n"
  }
  append_to_gdbwin "expansion:  History expansion on command input is off.\n"
}
################################################################################
proc t_show_history_expansion { args } {
  append_to_gdbwin "History expansion on command input is off.\n"
}
################################################################################
proc t_show_history_size { args } {
  global gdb_history_max

  append_to_gdbwin "The size of the command history is $gdb_history_max.\n"
}
################################################################################
proc t_show_history_save { args } {
  global Tgdb_option

  if { $Tgdb_option(SaveHistory) } {
    append_to_gdbwin "save:  Saving of the history record on exit is on.\n"
  } else {
    append_to_gdbwin "save:  Saving of the history record on exit is off.\n"
  }
}
################################################################################
proc t_show_history_filename { args } {
  global Tgdb_startfile

  append_to_gdbwin "The filename in which to record the command history is \n"
  append_to_gdbwin "    \"$Tgdb_startfile\".\n"
}
################################################################################
proc t_show_commands { args } {
  global gdb_history gdb_history_nr gdb_history_max

  if { [ctype digit $args] && ($args <= $gdb_history_max) } {
    set start [expr ($args - 1) % $gdb_history_max]
  } else {
    set start [expr ($gdb_history_nr - 10) % $gdb_history_max]
  }
  loop i 0 10 {
    if { [info exists gdb_history($start)] && ($gdb_history($start) != "") } {
      append_to_gdbwin \
	"[format "%5d  %s" [expr $start + 1] $gdb_history($start)]\n"
    }
    set start [expr ($start + 1) % $gdb_history_max]
  }
}

################################################################################
#
# update all active windows (e.g. after returning from debugee)
#
################################################################################
proc update_windows { {retval ""} } {
  global FreezeStatus Tgdb_option

  set FreezeStatus 1
  if { $Tgdb_option(UpdateBpts) } {
    get_all_disps
    update_bpts
  }
  update_stack_window
  update_cpu_window
  update_disp_window $retval
  update_asm_window "\$pc"
  update_mem_window
  # avoid busy_win side effects...
  after 150 {set FreezeStatus 0}
}
################################################################################
# update stack (backtrace) window
################################################################################
proc update_stack_window { {how new} } {
  global WinSize

  if { ![winfo exists .stack] } {
    return
  }
  if { $how == "new" } {
    set result [do_dialog "bt 100" silent]
    .stack.f0.lb delete 0 end
    foreach line [split $result "\n"] {
      if { [regexp {^#[0-9]} $line] } {
        .stack.f0.lb insert end $line
      }
    }
  }
  # see which stack frame is selected now
  set result [do_dialog "frame" silent]
  if { [regexp {^#([0-9]+)} $result {} fno] } {
    .stack.f0.lb select from $fno
    # make the selected item visible within the listbox
    # (similar to "yview -pickplace pos" for text widgets)
    set h [expr [winfo height .stack.f0.lb] / $WinSize(.stack,y)]
    set i0 [.stack.f0.lb nearest 0]
    if { ($fno < $i0) || ($fno >= [expr $i0 + $h - 1]) } {
      .stack.f0.lb yview [expr $fno - 2]
    }
  }
}
################################################################################
# update cpu (register) window
################################################################################
proc update_cpu_window {} {
  global debugger FirstPos

  if { ![winfo exists .cpu] } {
    return
  }
  set FirstPos(.cpu) [.cpu.f0.lb nearest 0]
  if { $debugger == "gdb166" } {
    set result [do_dialog "info registers" silent]
    .cpu.f0.lb delete 0 end
    if { ![regexp {^\*\*\* register contents} $result] } {
      show_status $result
      update idletasks
      return
    }
    set lines [split $result "\n"]
    set line [lindex $lines 2]
    set regs [split $line]
    loop i 0 16 {
      set reg "0x[lindex $regs $i]"
      .cpu.f0.lb insert end [format "%-6s 0x%04x %d" "r$i" $reg $reg]
    }
    set line [lindex $lines 3]
    scan "0x[string range $line 51 55]" "%i" psw
    .cpu.f0.lb insert end [format "%-6s 0x%04x %d" "psw" $psw $psw]
    set line [lindex $lines 4]
    scan "0x[string range $line 51 55]" "%i" tfr
    .cpu.f0.lb insert end [format "%-6s 0x%04x %d" "tfr" $tfr $tfr]
    set regs [split [string range $line 0 43]]
    loop i 0 9 {
      set reg "0x[lindex $regs $i]"
      set nam [lindex "dpp0 dpp1 dpp2 dpp3 csp ip ssp cp syscon" $i]
      .cpu.f0.lb insert end "[format "%-6s 0x%04x %d" $nam $reg $reg]"
    }
  } else {
    set result [do_dialog "info registers" silent]
    .cpu.f0.lb delete 0 end
    if { [regexp {^The program has} $result] } {
      show_status $result
      update idletasks
      return
    }
    foreach line [split $result "\n"] {
      if { [scan $line "%s %x" reg val] != 2 } {
        .cpu.f0.lb yview $FirstPos(.cpu)
	return
      }
      .cpu.f0.lb insert end [format "%-6s 0x%08x %d" $reg $val $val]
    }
  }
  .cpu.f0.lb yview $FirstPos(.cpu)
}
################################################################################
# update memory dump window
################################################################################
proc update_mem_window { {expr ""} } {
  global MemOpts WinSize debugger

  if { ![winfo exists .mem] } {
    return
  }

  set w .mem.f1.txt
  if { [cequal $expr ""] } {
    set line [$w get 1.0 "1.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+):} $line {} expr] } {
      return
    }
  }
  if { [ctype digit $expr] } {
    set expr [format "0x%x" $expr]
  }
  if { [regexp {^0x[0-9a-fA-F]+$} $expr] } {
    set addr $expr
  } else {
    set aresult [do_dialog "x/1bx $expr" silent]
    if { ![regexp {^(0x[0-9a-fA-F]+)} $aresult {} addr] } {
      show_status $aresult steady
      return
    }
  }
  set MemOpts(last) $addr

  set size $MemOpts(size)
  set cut 0
  set asc 0
  switch $MemOpts(mode) {
    dbl { set size 8 }
    flt { set size 4
	  set fmt "f"
	  set format "%15s "
	}
    hex { set fmt "x"
	  switch $size {
	    1 { set format "%02x "; set asc 1 }
	    2 { set format "%04x " }
	    4 { set format "%08x " }
	    8 { set format "%16s "; set cut 1 }
	  }
	}
    dec { set fmt "d"
	  switch $size {
	    1 { set format "%4d " }
	    2 { set format "%6d " }
	    4 { set format "%11d " }
	    8 { set format "%20s " }
	  }
	}
    uns { set fmt "u"
	  switch $size {
	    1 { set format "%3u "; set mask 0xff }
	    2 { set format "%5u "; set mask 0xffff }
	    4 { set format "%10u " }
	    8 { set format "%19s " }
	  }
	}
  }
  switch $size {
    1 { set size_spec "b" }
    2 { set size_spec "h" }
    4 { set size_spec "w" }
    8 { set size_spec "g" }
  }
  scan [wm geometry .mem] "%dx%d" width height
  set nitems $MemOpts(cols,$MemOpts(mode),$size)
  set amount [expr $height*$nitems]

  if { $MemOpts(mode) == "dbl" } {
    set result [do_dialog "output *(double *)$addr@$amount" silent]
    # this line is a work-around for an error concerning gdb's "@" operator...
    append result " [do_dialog "echo" silent]"
    regsub -all {[\{\},]} $result "" result
    $w configure -state normal
    $w delete 1.0 end
    foreach tag [$w tag names] {
      catch { $w tag delete $tag }
    }
    set tagno 0
    set i 0
    foreach line [split $result] {
      if { [cequal $line ""] } continue
      if { 1 != [scan $line "%g" dummy] } {
	if { ![regexp "NaN" $line] } {
	  $w configure -state disabled
	  regsub -all {[\{\}]} [lrange [split $result] $i end] "" result
	  show_status $result steady
	  bell
	  return
	}
      }
      set index [$w index end]
      $w insert end [format "0x%08x:  %24s\n" $addr $line]
      $w tag add itag$tagno $index+13c end-1c
      $w tag bind itag$tagno <Double-1> \
	"change_memory $addr $line \
	\[winfo rootx %W\] \[expr %Y + $WinSize(.mem,y)\]"
      incr tagno
      incr addr $size
      incr i
    }
    $w configure -state disabled
  } else {
    set result [do_dialog "x/$amount$size_spec$fmt $expr" silent]
    regsub -all {[ 	]*<[^>]*>[^:]*:[ 	]*} $result ": " result
    $w configure -state normal
    $w delete 1.0 end
    foreach tag [$w tag names] {
      catch { $w tag delete $tag }
    }
    set tagno 0
    set i 0
    foreach line [split $result "\n"] {
      if { [cequal $line ""] } continue
      if { ![regexp {^(0x[0-9a-fA-F]+):} $line {} xaddr] } {
	$w configure -state disabled
	show_status $line steady
	bell
	return
      }
      if { $xaddr != $addr } {
	$w configure -state disabled
	show_status "Found wrong address \"$xaddr\", expected \"$addr\"." steady
	bell
	return
      }
      foreach item [lrange $line 1 end] {
	if { $i == 0 } {
	  $w insert end [format "0x%08x:  " $addr]
	}
	if { $cut } {
	  set item [string range 2 end]
	}
	if { ($debugger == "gdb166") && [info exists mask] } {
	  set item [expr $item & $mask]
	}
        set index [$w index end]
	if { [catch {$w insert end [format $format $item]}] } {
	  $w configure -state disabled
	  show_status [lrange $line 1 end] steady
	  bell
	  return
	}
	$w tag add itag$tagno $index end-1c
	$w tag bind itag$tagno <Double-1> \
	  "change_memory $addr $item \
	  \[winfo rootx %W\] \[expr %Y + $WinSize(.mem,y)\]"
	incr tagno
	if { $asc } {
	  if { [ctype print [ctype char $item]] } {
	    append ascline [ctype char $item]
	  } else {
	    append ascline "."
	  }
	}
	if { [incr i] == $nitems } {
	  if { $asc } {
	    set index [$w index end]
	    $w insert end " --  $ascline\n"
	    $w tag add itag$tagno $index+5c end-1c
	    regexp {^(0x[0-9a-fA-F]+):(.*)} [$w get [int $index].0 $index] {} \
	      xaddr xline
	    $w tag bind itag$tagno <Double-1> \
	      "change_memory $xaddr \"$xline\" \
	      \[winfo rootx %W\] \[expr %Y + $WinSize(.mem,y)\] yes"
	    incr tagno
	    set ascline ""
	  } else {
	    $w insert end "\n"
	  }
	  set i 0
	}
	incr addr $size
      }
    }
    $w configure -state disabled
  }
  show_status ""
}
################################################################################
# update assembly dump window
################################################################################
proc update_asm_window { expr {rebuild no} } {
  global AsmOpts AsmLines AsmBpts WinSize colormodel BlinkingAsmPC

  if { ![winfo exists .asm] } {
    return
  }

  set w .asm.f1.txt
  # convert expr to an address and get current pc
  set result [do_dialog "printf \"0x%x 0x%x\\n\", $expr, \$pc" silent]
  if { ![regexp {(0x[0-9a-fA-F]+) (0x[0-9a-fA-F]+)} $result {} start_pc pc] } {
    # convert expr to an address
    set result [do_dialog "x/i $expr" silent]
    if { ![regexp {^(0x[0-9a-fA-F]+)} $result {} start_pc] } {
      show_status $result 4000
      update idletasks
      return
    }
    # get current pc
    if { $expr == "\$pc" } {
      set pc $start_pc
    } else {
      set result [do_dialog "p/x \$pc" silent]
      if { ![regexp {^\$[0-9]+ = (0x[0-9a-fA-F]+)} $result {} pc] } {
        set pc ""
      }
    }
  }
  set h [expr [winfo height $w] / $WinSize(.asm,y)]

  if { $rebuild == "no" } {
    # check if $start_pc is visible within text widget...
    loop i 1 $h+1 {
      set line [$w get $i.0 "$i.0 lineend"]
      if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr($i)] } continue
      if { $addr($i) == $start_pc } {
        # scroll up if we're at the bottom line (starting at line 2)
        if { $i == $h } {
	  set start_pc $addr([incr i -2])
	  break
        }
        # see if pc is visible
        $w tag remove mytag 1.0 end
        if { $pc != "" } {
	  if { $start_pc != $pc } {
	    unset addr
	    loop i 1 $h+1 {
	      set line [$w get $i.0 "$i.0 lineend"]
	      if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr] } continue
	      if { $addr == $pc } break
	    }
	    if { $i == [expr $h + 1] } return
	  }
          $w tag add mytag "$i.0" "$i.0 + 1l"
	  if { $colormodel == "color" } {
            if { [lsearch -exact [$w tag names $i.0] brktag] == -1 } {
	      $w tag configure mytag -background green
            } else {
	      $w tag configure mytag -background cyan
            }
	  } else {
	    $w tag configure mytag -foreground white -background black
            if { [lsearch -exact [$w tag names $i.0] brktag] == -1 } {
	      set BlinkingAsmPC 0
	    } else {
	      set BlinkingAsmPC 1
	    }
	  }
        }
        return
      }
    }
  }

  # rebuild
  catch {unset addr}
  catch {unset AsmLines}
  set result [split [do_dialog "x/$h\i $start_pc" silent] "\n"]
  $w configure -state normal
  $w delete 1.0 end
  set i 0
  foreach line $result {
    if { $line == "" } break
    if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr] } {
      $w configure -state disabled
      show_status $line 4000
      return
    }
    incr i
    lappend AsmLines $addr
    $w insert end "$line\n"
  }
  $w configure -state disabled

  # update breakpoint tags
  if { [info exists AsmBpts] } {
    set i 1
    foreach line $AsmLines {
      if { [lsearch -exact $AsmBpts $line] != -1 } {
	$w tag add brktag $i.0 "$i.0 + 1l"
      }
      incr i
    }
  }

  # update pc
  if { [set lpos [lsearch -exact $AsmLines $pc]] != -1 } {
    incr lpos
    $w tag add mytag $lpos.0 "$lpos.0 + 1l"
    if { $colormodel == "color" } {
      if { [lsearch -exact [$w tag names $lpos.0] brktag] == -1 } {
        $w tag configure mytag -background green
      } else {
        $w tag configure mytag -background cyan
      }
    } else {
      $w tag configure mytag -foreground white -background black
      if { [lsearch -exact [$w tag names $lpos.0] brktag] == -1 } {
	set BlinkingAsmPC 0
      } else {
	set BlinkingAsmPC 1
      }
    }
  }
}
################################################################################
# update display (watch) window
################################################################################
proc update_disp_window { {result ""} } {
  global FirstPos FreezeStatus DispNum DispVar DispLine DispExpr

  proc filter_disps { strings maxlines index dispindex pfx } {
    upvar $strings lines $index idx $dispindex dispidx
    global DispNum DispVar DispLine DispExpr

    while { 1 } {
      if { ([set line [lindex $lines $idx]] == "") && ($idx >= $maxlines) } \
        break
      if { [regexp {^([0-9]+): (.*)} $line {} dnum dline] } {
	set DispNum($dispidx) $dnum
	set DispLine($dispidx) $dline
        if { [regexp {^([^/ ]*/[^ ]* )?([^=]*) = (.*)} $dline {} {} var val] } {
	  if { [cequal [cindex $var 0] "*"] } {
	    set xvar [crange $var 1 end]
	    set ptr 1
	  } else {
	    set xvar $var
	    set ptr 0
	  }
	  set DispVar($dispidx) $pfx$xvar
	  if { [cequal [cindex $val end] "\{"] } {
	    set DispExpr($dispidx) ""
	    incr idx
	    incr dispidx
	    if { $ptr } {
	      filter_disps lines $maxlines idx dispidx "$pfx$xvar->"
	    } else {
	      filter_disps lines $maxlines idx dispidx "$pfx$var."
	    }
	  } else {
	    set DispExpr($dispidx) [string trimright $val " \t,"]
	  }
	} elseif { [regexp {^([^/ ]*/[^ ]* )?([^ ]*)} $dline {} {} var] } {
          set DispVar($dispidx) $var
	  set DispExpr($dispidx) ""
	} else {
	  set DispVar($dispidx) ""
	  set DispExpr($dispidx) ""
	}
	incr dispidx
      } elseif { $pfx != "" } {
	set DispNum($dispidx) 0
	set DispLine($dispidx) $line
	if { [cequal [string trim $line] "\}"] } {
	  set DispExpr($dispidx) ""
	  set DispVar($dispidx) ""
	  return
	}
        if { [regexp {^([ 	]*)([^=]*) = (.*)} $line {} {} var val] } {
	  if { [cequal [cindex $var 0] "*"] } {
	    set xvar [crange $var 1 end]
	    set ptr 1
	  } else {
	    set xvar $var
	    set ptr 0
	  }
	  set DispVar($dispidx) $pfx$xvar
	  if { [cequal [cindex $val end] "\{"] } {
	    set DispExpr($dispidx) ""
	    incr idx
	    incr dispidx
	    if { $ptr } {
	      filter_disps lines $maxlines idx dispidx "$pfx$xvar->"
	    } else {
	      filter_disps lines $maxlines idx dispidx "$pfx$var."
	    }
	  } else {
	    set DispExpr($dispidx) [string trimright $val " \t,"]
	  }
	  incr dispidx
	}
      }
      incr idx
    }
  }

  if { ![winfo exists .disp] } {
    return
  }
  if { $result == "" } {
    .disp.f0.lb delete 0 end
    catch {unset DispNum}
    catch {unset DispVar}
    catch {unset DispLine}
    catch {unset DispExpr}
    return
  }
  if { $result == "new" } {
    set FreezeStatus 1
    set result [do_dialog "display" silent]
    after 100 {set FreezeStatus 0}
  }
  set FirstPos(.disp) [.disp.f0.lb nearest 0]
  .disp.f0.lb delete 0 end
  catch {unset DispNum}
  catch {unset DispVar}
  catch {unset DispLine}
  catch {unset DispExpr}
  set lines [split $result "\n"]
  set index 0
  set dispindex 0
  filter_disps lines [llength $lines] index dispindex ""
  loop i 0 $dispindex {
    .disp.f0.lb insert end $DispLine($i)
  }
  .disp.f0.lb yview $FirstPos(.disp)
}

################################################################################
#
# it's time for breakpoint management, isn't it?
#
################################################################################
proc t_enable { {bpnos ""} } {
  set bplist [get_disabled_bpts $bpnos]
  set len [llength $bplist]
  for { set idx 0 } { $idx < $len } { incr idx 3 } {
    add_brktag [lindex $bplist [expr $idx + 1]] [lindex $bplist [expr $idx + 2]]
  }
  do_dialog "enable $bpnos" verbose
  update_asm_bpts
}
################################################################################
proc t_delete { {bpnos ""} } {
  global QueryResult BptNos

  set bplist [get_enabled_bpts $bpnos]
  do_dialog "delete $bpnos" verbose
  if { $QueryResult == "n" } {
    return
  }
  set len [llength $bplist]
  for { set idx 0 } { $idx < $len } { incr idx 3 } {
    del_brktag [lindex $bplist [expr $idx + 1]] [lindex $bplist [expr $idx + 2]]
  }
  if { $bpnos == "" } {
    catch {unset BptNos}
  } else {
    foreach bpt $bpnos { catch {unset BptNos($bpt)} }
  }
  update_asm_bpts
}
################################################################################
proc t_disable { {bpnos ""} } {
  set bplist [get_enabled_bpts $bpnos]
  set len [llength $bplist]
  for { set idx 0 } { $idx < $len } { incr idx 3 } {
    del_brktag [lindex $bplist [expr $idx + 1]] [lindex $bplist [expr $idx + 2]]
  }
  do_dialog "disable $bpnos" verbose
  update_asm_bpts
}
################################################################################
proc t_break { {bpexpr ""} } {
  global Tgdb_interactive BptNos prompt FreezeStatus

  set class_kludge 0
  # you probably don't want to understand the RE below... :-)
  if { [regexp {([^(]*(\(.*\))?)\.([^(]*)(\(.*\))?} $bpexpr {} first {} last]} {
    set lang [do_dialog "show language" silent]
    if { [regexp "The current source language is \".*c\\+\\+\"\\." $lang] } {
      set type [do_dialog "whatis $first" silent]
      if { [regexp "type = (struct )?(.*)\n" $type {} {} class] } {
	set bpexpr "$class\::$last"
	set class_kludge 1
      }
    }
  }
  set result [do_dialog "break $bpexpr" silent]
  if { [regexp {point ([0-9]+) at (0x[0-9a-f]+)(.*)} $result {} no addr rest]} {
    if { [regexp {: file (.*), line ([0-9]*)} $rest {} file line] } {
      set file [file2path $file $line]
      set BptNos($no) "$file,$line"
      add_brktag $file $line
    }
  }
  if { $Tgdb_interactive } {
    if { $class_kludge } {
      append_to_gdbwin "break $bpexpr\n$result"
    } else {
      append_to_gdbwin $result
    }
  } else {
    set FreezeStatus 1
    show_status $result
    after 350 {set FreezeStatus 0}
    append_to_gdbwin "break $bpexpr\n$result$prompt"
  }
  update_asm_bpts
}
################################################################################
# set a temporary breakpoint; this procedure is special in that it returns
# "1" for success and "0" in case of failure (this is because it is called
# from inside tgdb when the user clicked on a source line with the Control
# button pressed). Oh - another important difference: gdb 3.x enables this
# breakpoint once, which is what gdb 4.x claims to do; but instead it enables
# it for deletion (which I emulate for gdb 3.x for now).
################################################################################
proc t_tbreak { {bpexpr ""} } {
  global debugger Tgdb_interactive prompt

  set retval 0
  if { $debugger == "gdb166" } {
    set result [do_dialog "break $bpexpr" silent]
    if { [regexp {Breakpoint [0-9]* at (0x[0-9a-f]*)} $result] } {
      set retval 1
      do_dialog "enable delete \$" silent
    }
  } else {
    set result [do_dialog "tbreak $bpexpr" silent]
    if { [regexp {Breakpoint [0-9]* at (0x[0-9a-f]*)} $result] } {
      set retval 1
    }
  }
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  }
  return $retval
}
################################################################################
proc t_clear { {bpexpr ""} } {
  global Tgdb_interactive prompt BptNos LineBpts

  set result [do_dialog "clear $bpexpr" silent]
  if { [regexp {Deleted breakpoint[s]? (.*)} $result {} bpnumbers] } {
    foreach bpt $bpnumbers {
      catch {incr LineBpts($BptNos($bpt)) -1}
    }
    if { [set bpaddr [expr2line $bpexpr]] != "" } {
      set file [lindex $bpaddr 0]; set line [lindex $bpaddr 1]
      if { $LineBpts($file,$line) == 0 } {
        del_brktag $file $line
	foreach bpt [array names BptNos] {
	  if { $BptNos($bpt) == "$file,$line" } {
	    unset BptNos($bpt)
	  }
	}
      }
    }
  }
  if { $Tgdb_interactive } {
    append_to_gdbwin $result
  } else {
    if { [regexp "^Deleted breakpoint" $result] } {
      show_status $result 4000
    }
    append_to_gdbwin "clear $bpexpr\n$result$prompt"
  }
  update_asm_bpts
}
################################################################################
# update breakpoint information (e.g. after a source command)
################################################################################
proc update_bpts {} {
  global LineBpts BptNos

  catch {unset LineBpts}
  catch {unset BptNos}
  del_all_brktags
  set bplist [get_enabled_bpts]
  if { [info exists BptNos] } {
    foreach bpt [array names BptNos] {
      if { [info exists LineBpts($BptNos($bpt))] } {
        incr LineBpts($BptNos($bpt))
      } else {
        set LineBpts($BptNos($bpt)) 1
      }
    }
  }
  set len [llength $bplist]
  for { set idx 0 } { $idx < $len } { incr idx 3 } {
    add_brktag [lindex $bplist [expr $idx + 1]] [lindex $bplist [expr $idx + 2]]
  }
  update_asm_bpts
}
################################################################################
# update breakpoint information for assembly dump window
################################################################################
proc update_asm_bpts {} {
  global AsmLines AsmBpts colormodel BlinkingAsmPC

  if { ![winfo exists .asm] } {
    return
  }

  catch {unset AsmBpts}
  set bpinfo [split [do_dialog "info breakpoints" silent] "\n"]
  if { [string match "*Type*" [lvarpop bpinfo 0]] } {
    # gdb 4.x
    foreach line $bpinfo {
      if {   ([lindex $line 1] == "breakpoint")
	  && ([lindex $line 2] == "keep")
	  && ([lindex $line 3] == "y") } {
	lappend AsmBpts [format "0x%x" [lindex $line 4]]
      }
    }
  } else {
    # gdb 3.x
    foreach line $bpinfo {
      if {   ([regexp {^#[0-9]+} [lindex $line 0]])
	  && ([lindex $line 1] == "y") } {
	lappend AsmBpts [format "0x%x" [lindex $line 2]]
      }
    }
  }

  # update brktags in asm window
  set w .asm.f1.txt
  $w tag remove brktag 1.0 end
  if { $colormodel == "color" } {
    $w tag configure mytag -background green
  } else {
    $w tag configure mytag -foreground white -background black
  }
  if { [info exists AsmBpts] && [info exists AsmLines] } {
    set i 1
    foreach line $AsmLines {
      if { [lsearch -exact $AsmBpts $line] != -1 } {
        $w tag add brktag $i.0 "$i.0 + 1l"
	if { $colormodel == "color" } {
	  if { [lsearch -exact [$w tag names $i.0] mytag] != -1 } {
	    $w tag configure mytag -background cyan
	  }
	} else {
	  if { [lsearch -exact [$w tag names $i.0] mytag] != -1 } {
	    set BlinkingAsmPC 1
	  } else {
	    set BlinkingAsmPC 0
	  }
	}
      }
      incr i
    }
  }
}
################################################################################
#
# load a gdb source file
#
################################################################################
proc read_source_file {} {
  global Tgdb_cmd prompt

  set file [FileSelectBox -title "Select gdb source file to read" -perm r]
  if { $file == "" } {
    show_status "Command cancelled."
    return
  }
  append_to_gdbwin "source $file\n$prompt" insert
  $Tgdb_cmd(source) $file
}
################################################################################
#
# write a file containing all relevant information about the current session
# which can be re-read using gdb's source command
#
################################################################################
proc write_init_file { file } {
  global debugger gdb_class gdb_cmd

  if { $file == "" } {
    show_status "Command cancelled."
    return
  }
  if { [file exists $file] && ![yes_no_box "Overwrite file \"$file\"?"] } {
    show_status "File not overwritten."
    return
  }
  if { [catch {set desc [open $file w]}] } {
    show_status "Can't open file \"$file\"." 3000
    return
  }

  show_status "Creating gdb init file \"$file\"..." steady
  update idletasks
  puts $desc "#\n# $debugger init file; created by tgdb on [exec date].\n#\n"
  set result [do_dialog "pwd" silent]
  if { [regexp {^Working directory (.*)\.} $result {} result] } {
    puts $desc "cd $result"
  }
  if { $debugger == "gdb166" } {
    set result [do_dialog "info directories" silent]
  } else {
    set result [do_dialog "show directories" silent]
  }
  if { [regexp {^Source directories searched: (.*)} $result {} result] } {
    puts $desc "dir $result"
  }

  set result [do_dialog "info files" silent]
  if { $debugger == "gdb166" } {
    if { [regexp {Executable file "([^"]*)"} $result {} exec] } {
      puts $desc "exec-file $exec"
    }
  } else {
    if { [regexp {Local exec file:[^`]*`([^']*)'} $result {} exec] } {
      puts $desc "exec-file $exec"
    }
    if { [regexp {Local core dump file:[^`]*`([^']*)'} $result {} core] } {
      puts $desc "core-file $core"
    }
  }
  if { [regexp {Symbols from "([^"]*)"} $result {} symbol] } {
    puts $desc "symbol-file $symbol"
  }
  puts $desc ""
  if { $debugger == "gdb166" } {
    set bpinfo [split [do_dialog "info breakpoints" silent] "\n"]
    if { [string match "Breakpoints:" [lvarpop bpinfo]] } {
      lvarpop bpinfo
      set i 0
      while { 1 } {
        if { [set line [lindex $bpinfo $i]] == "" } break
        if { [regexp {^#([0-9]+)} $line {} bpnum] } {
	  if {[regexp {in (.*) \((.*) line ([0-9]+)\)} $line {} func fil lno]} {
	    set addr [expr2addr $func]
	    if { $addr == [lindex $line 2] } {
	      puts $desc "break $fil:$func"
	    } else {
	      puts $desc "break $fil:$lno"
	    }
	  } else {
	    puts $desc "break *[lindex $line 2]"
	  }
	  if { [lindex $line 1] == "d" } {
	    puts $desc "enable delete \$"
	  } elseif { [lindex $line 1] == "o" } {
	    puts $desc "enable once \$"
	  } elseif { [lindex $line 1] == "n" } {
	    puts $desc "disable \$"
	  }
	  set comm 0
	  while { 1 } {
            incr i
            if { [set line [lindex $bpinfo $i]] == "" } break
            if { [regexp {^#([0-9]+)} $line {} bpnum] } break
	    if { [regexp {break only if (.*)} $line {} cond] } {
	      puts $desc "cond \$ $cond"
	    } elseif { [regexp {ignore next ([0-9]+) hits} $line {} ign] } {
	      puts $desc "ignore \$ $ign"
	    } else {
	      if { !$comm } {
	        set comm 1
	        puts $desc "comm \$"
	      }
	      puts $desc [string trim $line]
	    }
	  }
	  if { $comm } {
	    puts $desc "end"
	  }
	  puts $desc ""
	  if { $line == "" } break
	  incr i -1
        }
        incr i
      }
    }
  } else {
    set result [do_dialog "show args" silent]
    if { [regexp {^Arguments to give program[^"]*"(.*)"} $result {} arg] } {
      puts $desc "set args $arg\n"
    }
    set bpinfo [split [do_dialog "info breakpoints" silent] "\n"]
    if { [string match "*Type*" [lvarpop bpinfo]] } {
      set i 0
      while { 1 } {
        if { [set line [lindex $bpinfo $i]] == "" } break
        if { [regexp {^([0-9]+)} $line {} bpnum] } {
          if { [lindex $line 1] == "breakpoint" } {
	    if {[regexp {in (.*) at (.*):([0-9]+)} $line {} func fil lineno]} {
	      set addr [expr2addr $func]
	      if { $addr == [lindex $line 4] } {
		puts $desc "break $fil:$func"
	      } else {
		puts $desc "break $fil:$lineno"
	      }
	    } else {
	      puts $desc "break *[lindex $line 4]"
	    }
          }
	  if { [lindex $line 2] == "del" } {
	    puts $desc "enable delete \$bpnum"
	  } elseif { [lindex $line 2] == "dis" } {
	    puts $desc "enable once \$bpnum"
	  }
	  if { [lindex $line 3] == "n" } {
	    puts $desc "disable \$bpnum"
	  }
	  set comm 0
	  while { 1 } {
            incr i
            if { [set line [lindex $bpinfo $i]] == "" } break
            if { [regexp {^([0-9]+)} $line {} bpnum] } break
	    if { [regexp {stop only if (.*)} $line {} cond] } {
	      puts $desc "cond \$bpnum $cond"
	    } elseif { [regexp {ignore next ([0-9]+) hits} $line {} ign] } {
	      puts $desc "ignore \$bpnum $ign"
	    } elseif { ![regexp {breakpoint already hit [0-9]+ times} $line] } {
	      if { !$comm } {
	        set comm 1
	        puts $desc "comm \$bpnum"
	      }
	      puts $desc [string trim $line]
	    }
	  }
	  if { $comm } {
	    puts $desc "end"
	  }
	  puts $desc ""
	  if { $line == "" } break
	  incr i -1
        }
        incr i
      }
    }
  }

  catch {foreach cmd $gdb_class(user) { catch {unset gdb_cmd($cmd)} }}
  catch {unset gdb_class(user)}
  find_gdb_cmds "user" "user"
  if { [info exists gdb_class(user)] } {
    foreach ucmd $gdb_class(user) {
      if { $debugger == "gdb166" } {
	set result [do_dialog "list %-$ucmd" silent]
        regsub -all {[ ]*[0-9]+: } $result "" result
      } else {
	set result [do_dialog "show user $ucmd" silent]
	set result [crange $result [string first "\n" $result]+1 end]
      }
      puts $desc "define $ucmd"
      puts $desc [string trim $result]
      puts $desc "end"
      if { $gdb_cmd($ucmd) != "" } {
	puts $desc "document $ucmd"
	puts $desc [string trim $gdb_cmd($ucmd)]
	puts $desc "end"
      }
      puts $desc ""
    }
  }

  set result [split [do_dialog "info display" silent] "\n"]
  if { [regexp {^Auto-display expressions} [lvarpop result]] } {
    lvarpop result
    puts $desc "define autodisp"
    foreach line $result {
      if { [regexp {^[0-9]+:[	]*(.*)} $line {} expr] } {
	puts $desc "disp [string trim [lrange $expr 1 end]]"
      }
    }
    puts $desc "end"
    puts $desc "document autodisp"
    puts $desc "Enable auto-display expressions."
    puts $desc "These expressions were saved using tgdb's"
    puts $desc "\"Save gdb init file\" command in a previous (t)gdb session."
    puts $desc "end"
  }

  close $desc
  show_status "File \"$file\" created."
}
################################################################################
#
# some useful functions for getting information on breakpoints and lines
#
################################################################################

################################################################################
# Convert a line expression (i.e. file:lineno, lineno, *addr or function) into
# a "path/file lineno" list; return "" if that fails.
################################################################################
proc expr2line { expr } {
  # is it a function? if so, return lineno of first real insn...
  if { ($expr == "") || [regexp {(^\*)|(:[0-9]+)} $expr] } {
    set result [t_info_line "$expr" silent no no]
  } else {
    set result [do_dialog "info address $expr" silent]
    if { [regexp {^Symbol .* is a function at} $result] } {
      set result [t_info_line "$expr" silent no no]
      if { ![regexp {^Line .* and ends at (0x[0-9a-f]+)} $result {} addr] } {
        return ""
      }
      set result [t_info_line "*$addr" silent no no]
    } else {
      set result [t_info_line "$expr" silent no no]
    }
  }
  if { ![regexp {([^:]*):([0-9]+):([0-9]+):(beg|middle):(0x[0-9a-f]+)} \
          $result {} file line off pc] } {
    return ""
  }
  return "$file $line"
}
################################################################################
# Convert a line expression into a list "path line addr" (or "" if that fails)
################################################################################
proc expr2info { expr } {
  # is it a function? if so, return info on first real insn...
  if { ($expr == "") || [regexp {(^\*)|(:[0-9]+)} $expr] } {
    set result [t_info_line "$expr" silent no no]
  } else {
    set result [do_dialog "info address $expr" silent]
    if { [regexp {^Symbol .* is a function at} $result] } {
      set result [t_info_line "$expr" silent no no]
      if { ![regexp {^Line .* and ends at (0x[0-9a-f]+)} $result {} addr] } {
        return ""
      }
      set result [t_info_line "*$addr" silent no no]
    } else {
      set result [t_info_line "$expr" silent no no]
    }
  }
  if { ![regexp {([^:]*):([0-9]+):([0-9]+):(beg|middle):(0x[0-9a-f]+)} \
          $result {} file line off pc] } {
    return ""
  }
  return "$file $line $pc"
}
################################################################################
# Convert a line expression into a hex address; return "" if that fails
################################################################################
proc expr2addr { expr } {
  # is it a function? if so, return address of first real insn...
  if { ($expr == "") || [regexp {(^\*)|(:[0-9]+)} $expr] } {
    set result ""
  } else {
    set result [do_dialog "info address $expr" silent]
  }
  if { [regexp {^Symbol .* is a function at} $result] } {
    set result [t_info_line "$expr" silent no no]
    if { ![regexp {^Line .* and ends at (0x[0-9a-f]+)} $result {} addr] } {
      return ""
    }
  } else {
    set result [t_info_line "$expr" silent no no]
    if { ![regexp {^Line .* (starts|is) at (pc|address) (0x[0-9a-f]+)} \
            $result {} {} {} addr] } {
      return ""
    }
  }
  return $addr
}
################################################################################
# return a list of all enabled breakpoints for which debug info is available;
# if bpnos is not empty, consider only those breakpoints contained therein
################################################################################
proc get_enabled_bpts { {bpnos ""} } {
  return [get_all_bpts $bpnos "y"]
}
################################################################################
# return a list of all disabled breakpoints for which debug info is available;
# if bpnos is not empty, consider only those breakpoints contained therein
################################################################################
proc get_disabled_bpts { {bpnos ""} } {
  return [get_all_bpts $bpnos "n"]
}
################################################################################
proc get_all_bpts { bpnos yes_or_no } {
  global BptNos

  set bplist ""
  set bpinfo [split [do_dialog "info breakpoints" silent] "\n"]
  if { [string match "*Type*" [lvarpop bpinfo 0]] } {
    # gdb 4.x
    if { $bpnos == "" } {
      foreach line $bpinfo {
        if {   ([lindex $line 1] == "breakpoint")
	    && ([lindex $line 2] == "keep")
	    && ([lindex $line 3] == "$yes_or_no") } {
	  if { [regexp {in .* at (.*):([0-9]+)} $line {} file lineno] } {
	    set file [file2path $file $lineno]
	    append bplist " [lindex $line 0] $file $lineno"
	    if { $yes_or_no == "y" } {
	      set BptNos([string trim [lindex $line 0]]) "$file,$lineno"
	    }
	  }
        }
      }
    } else {
      foreach line $bpinfo {
        if {   ([lsearch -exact $bpnos [lindex $line 0]] != -1)
	    && ([lindex $line 1] == "breakpoint")
	    && ([lindex $line 2] == "keep")
	    && ([lindex $line 3] == "$yes_or_no") } {
	  if { [regexp {in .* at (.*):([0-9]+)} $line {} file lineno] } {
	    set file [file2path $file $lineno]
	    append bplist " [lindex $line 0] $file $lineno"
	    if { $yes_or_no == "y" } {
	      set BptNos([string trim [lindex $line 0]]) "$file,$lineno"
	    }
	  }
        }
      }
    }
  } else {
    # gdb 3.x
    if { $bpnos == "" } {
      foreach line $bpinfo {
        if { [lindex $line 1] == "$yes_or_no" } {
	  if { [regexp {\((.*) line ([0-9]+)\)} $line {} file lineno] } {
	    set file [file2path $file $lineno]
	    append bplist " [string range [lindex $line 0] 1 end] $file $lineno"
	    if { $yes_or_no == "y" } {
	      set bpno [string trim [string range [lindex $line 0] 1 end]]
	      set BptNos($bpno) "$file,$lineno"
	    }
	  }
        }
      }
    } else {
      foreach line $bpinfo {
        set bpno [string range [lindex $line 0] 1 end]
        if {   ([lsearch -exact $bpnos $bpno] != -1)
	    && ([lindex $line 1] == "$yes_or_no") } {
	  if { [regexp {\((.*) line ([0-9]+)\)} $line {} file lineno] } {
	    set file [file2path $file $lineno]
	    append bplist " $bpno $file $lineno"
	    if { $yes_or_no == "y" } {
	      set BptNos($bpno) "$file,$lineno"
	    }
	  }
        }
      }
    }
  }
  return $bplist
}
################################################################################
# create a list of all currently enabled auto-display expression
################################################################################
proc get_all_disps {} {
  global AutoDisps

  set AutoDisps ""
  foreach line [split [do_dialog "info disp" silent] "\n"] {
    if { [regexp {^([0-9]+):[ 	]+y} $line {} num] } {
      lappend AutoDisps $num
    }
  }
}
################################################################################
# Given a file and a line number, return file's full path; we use a cache to
# minimize accesses to gdb
################################################################################
proc file2path { file line } {
  global PathCache SourcePath debugger

  if { [info exists PathCache($file)] } {
    return $PathCache($file)
  }
  if { $debugger == "gdb166" } {
    foreach dir [split $SourcePath ":"] {
      if { [file exists "$dir/$file"] } {
	return [set PathCache($file) "$dir/$file"]
      }
    }
    return $file
  } else {
    if { [set result [expr2line "$file:$line"]] == "" } {
      return $file
    }
    return [set PathCache($file) [lindex $result 0]]
  }
}
################################################################################
# Given a breakpoint number, return corresponding address in the form
# "path lineno" (or "" if that fails).
################################################################################
proc bpno2line { bpno } {
  if { $bpno == "" } {
    return ""
  }
  set result [do_dialog "info breakpoints $bpno" silent]
  if { ![regexp {(0x[0-9a-f]*)} $result {} addr] } {
    return ""
  }
  return [expr2line "*$addr"]
}
################################################################################
# Given a line expression, return a list of all breakpoints enabled at that
# address; return "" if expression is wrong or no breakpoints are set.
# This proc is special in that it doesn't distinguish between breakpoints,
# watchpoints or memorypoints, nor if a {break,watch,memory}point is enabled
# only once, enabled for deletion or enabled for disabling.
################################################################################
proc expr2bpno { expr } {
  if { ![regexp {^\*0x[0-9a-f]*} $expr] } {
    if { [set expr [expr2addr $expr]] == "" } {
      return ""
    }
  } else {
    set expr [string range $expr 1 end]
  }
  set bplist ""
  set bpinfo [split [do_dialog "info breakpoints" silent] "\n"]
  if { [string match "*Type*" [lvarpop bpinfo 0]] } {
    # gdb 4.x
    foreach line $bpinfo {
      if {   ([lindex $line 4] == "$expr")
	  && ([lindex $line 3] == "y") } {
	append bplist " [lindex $line 0]"
      }
    }
  } else {
    # gdb 3.x
    foreach line $bpinfo {
      if {   ([lindex $line 2] == "$expr")
	  && ([lindex $line 1] != "n") } {
	append bplist " [lrange [lindex $line 0] 1 end]"
      }
    }
  }
  return $bplist
}
################################################################################
# return the commands attached to a given breakpoint number (this number may
# also be ommited, or specified as $ or $bpnum, in which case it refers to
# the last breakpoint set, and $num will be set to that number); return the
# string "false" if that fails (since the list is empty if there are no cmds)
################################################################################
proc find_bpt_cmds { num } {
  upvar $num bpnum
  global debugger

  if {   (($debugger == "gdb166") && ($bpnum == "\$"))
      || (($debugger != "gdb166") && ($bpnum == "\$bpnum")) } {
    set bpnum ""
  }
  set bpinfo [split [do_dialog "info breakpoints $bpnum" silent] "\n"]
  if { $debugger == "gdb166" } {
    set line [lindex $bpinfo 0]
    if { [string compare "Breakpoints:" $line] && ![regexp {^#[0-9]+} $line] } {
      return "false"
    }
    if { ![string compare "Breakpoints:" $line] } {
      lvarpop bpinfo
    }
    if { $bpnum == "" } {
      set i 0
      foreach line $bpinfo {
        if { [regexp {^#([0-9]+)} $line {} bpnum] } {
	  set j $i
        }
        incr i
      }
      if { $bpnum == "" } {
	return "false"
      }
      set bpinfo [lreplace $bpinfo 0 $j ""]
    }
    lvarpop bpinfo
    set bpcmds ""
    foreach line $bpinfo {
      if { [set line [string trim $line]] == "" } break
      if { [regexp {^((ignore next)|(break only if))} $line] } continue
      append bpcmds $line "\n"
    }
  } else {
    # gdb 4.x
    if { ![string match "*Type*" [lvarpop bpinfo]] } {
      return "false"
    }
    if { $bpnum == "" } {
      set i 0
      foreach line $bpinfo {
        if { [regexp {^([0-9]+)} $line {} bpnum] } {
	  set j $i
        }
        incr i
      }
      if { $bpnum == "" } {
	return "false"
      }
      set bpinfo [lreplace $bpinfo 0 $j ""]
    }
    lvarpop bpinfo
    set bpcmds ""
    foreach line $bpinfo {
      if { [set line [string trim $line]] == "" } break
      if { [regexp {^((ignore next)|(stop only if)|(breakpoint already hit))} \
	     $line] } continue
      append bpcmds $line "\n"
    }
  }
  return $bpcmds
}
################################################################################
# add a breakpoint tag at file:line (and update source window if req'd)
################################################################################
proc add_brktag { file line } {
  global Tags ThisFile LineBpts colormodel BlinkingPC

  set beg "$line.0"; set end "[expr $line + 1].0"
  if { ![info exists Tags($file,brktag)] } {
    set Tags($file,brktag) "$beg $end"
    set LineBpts($file,$line) 1
  } else {
    if { [lsearch -exact $Tags($file,brktag) "$beg"] != -1 } {
      for { set idx 0 } { $idx < [llength $Tags($file,brktag)] } {incr idx 2} {
        if { [lindex $Tags($file,brktag) $idx] == "$beg" } {
	  incr LineBpts($file,$line)
	  return
        }
      }
    }
    append Tags($file,brktag) " $beg $end"
    set LineBpts($file,$line) 1
  }
  if { $file == $ThisFile } {
    .f3.text tag add brktag $beg $end
    .f3.text tag lower brktag
    if { $colormodel == "color" } {
      .f3.text tag configure brktag -background red
      if { [lsearch -exact [.f3.text tag names $beg] mytag] != -1 } {
        .f3.text tag configure mytag -background cyan
      }
    } else {
      .f3.text tag configure brktag -foreground white -background black
      if { [lsearch -exact [.f3.text tag names $beg] mytag] != -1 } {
	set BlinkingPC 1
      } else {
	set BlinkingPC 0
      }
    }
  }
}
################################################################################
# delete a breakpoint tag from file:line (and update source window if req'd)
################################################################################
proc del_brktag { file line } {
  global Tags ThisFile LineBpts colormodel

  if { ![info exists Tags($file,brktag)] } {
    return ;# "shouldn't happen"
  }
  set beg "$line.0"; set end "[expr $line + 1].0"
  if { [lsearch -exact $Tags($file,brktag) "$beg"] == -1 } {
    return ;# "shouldn't happen"
  }
  for {set idx 0} { $idx < [llength $Tags($file,brktag)] } { incr idx 2 } {
    if { [lindex $Tags($file,brktag) $idx] == "$beg" } {
      if { [incr LineBpts($file,$line) -1] <= 0 } {
	unset LineBpts($file,$line)
        set x $Tags($file,brktag)
        set Tags($file,brktag) \
	  "[lrange $x 0 [expr $idx-1]] [lrange $x [expr $idx+2] end]"
        if { $file == $ThisFile } {
          .f3.text tag remove brktag $beg $end
	  if { $colormodel == "color" } {
            if { [lsearch -exact [.f3.text tag names $beg] mytag] != -1 } {
              .f3.text tag configure mytag -background green
            }
	  }
        }
      }
      return
    }
  }
}
################################################################################
# delete all breakpoint tags (and update source window if req'd); used after
# a source command to update breakpoint information
################################################################################
proc del_all_brktags {} {
  global Tags colormodel

  catch {.f3.text tag delete brktag}
  if { $colormodel == "color" } {
    .f3.text tag configure brktag -background red
  } else {
    .f3.text tag configure brktag -foreground white -background black
  }
  if { [info exists Tags] } {
    foreach brktag [lmatch [array names Tags] "*,brktag"] {
      unset Tags($brktag)
    }
  }
}
################################################################################
# append text to gdb's window; typically used to display the results of
# gdb commands which were generated by button clicks and stuff...
################################################################################
proc append_to_gdbwin { {what ""} {yview end} } {
  global prompt Tgdb_interactive

  if { $what == "" } {
    return
  }
  set w .f5.text
  if { !$Tgdb_interactive } {
    set cmd [string range $what 0 [string first "\n" $what]]
    set ans [string range $what [expr [string first "\n" $what]+1] end]
    set what "[string trim $cmd]\n$ans"
  }
  if { [set pos [string first $prompt [$w get "end linestart" end]]] != -1 } {
    incr pos [string length $prompt]
    $w mark set insert [$w index "end linestart + $pos c"]
  } else {
    $w mark set insert [$w index "end linestart"]
  }
  set insert [$w index insert]
  $w insert insert $what
  if { !$Tgdb_interactive } {
    $w tag add gdb_in $insert "$insert lineend"
  }
  $w mark set insert end
  if { $yview == "end" } {
    $w yview -pickplace insert
  } else {
    $w yview $insert
  }
}
################################################################################
#
# initialize tgdb commands (bind gdb commands to tgdb procedures (if necessary))
#
################################################################################
proc init_tgdb_cmds {} {
  global Tgdb_cmd gdb_cmd gdb_scmd

  set Tgdb_cmd(run) t_run
  set Tgdb_cmd(continue) t_continue
  set Tgdb_cmd(next) t_next
  set Tgdb_cmd(step) t_step
  set Tgdb_cmd(nexti) t_nexti
  set Tgdb_cmd(stepi) t_stepi
  set Tgdb_cmd(jump) t_jump
  set Tgdb_cmd(finish) t_finish
  set Tgdb_cmd(return) t_return
  set Tgdb_cmd(attach) t_attach
  set Tgdb_cmd(help) t_help
  set Tgdb_cmd(search) t_forward_search
  set Tgdb_cmd(forward-search) t_forward_search
  set Tgdb_cmd(reverse-search) t_reverse_search
  set Tgdb_cmd([list info frame]) t_info_frame
  set Tgdb_cmd([list info line]) t_info_line
  set Tgdb_cmd(list) t_list
  set Tgdb_cmd(up) t_up
  set Tgdb_cmd(down) t_down
  set Tgdb_cmd(frame) t_frame
  set Tgdb_cmd(enable) t_enable
  set Tgdb_cmd(delete) t_delete
  set Tgdb_cmd([list delete breakpoints]) t_delete
  set Tgdb_cmd(disable) t_disable
  set Tgdb_cmd([list disable breakpoints]) t_disable
  set Tgdb_cmd(break) t_break
  set Tgdb_cmd(tbreak) t_tbreak
  set Tgdb_cmd(clear) t_clear
  set Tgdb_cmd(directory) t_directory
  set Tgdb_cmd(shell) t_shell
  set Tgdb_cmd(make) t_make
  set Tgdb_cmd(source) t_source
  set Tgdb_cmd(file) t_file
  set Tgdb_cmd(exec-file) t_exec_file
  set Tgdb_cmd(symbol-file) t_symbol_file
  set Tgdb_cmd(core-file) t_core_file
  set Tgdb_cmd(kill) t_kill
  set Tgdb_cmd([list set prompt]) t_set_prompt
  set Tgdb_cmd(until) t_until
  set Tgdb_cmd(whatis) t_whatis
  set Tgdb_cmd(print) t_print
  set Tgdb_cmd(printf) t_printf
  set Tgdb_cmd(output) t_output
  set Tgdb_cmd(set) t_set
  set Tgdb_cmd([list set variable]) t_set_variable
  set Tgdb_cmd(disassemble) t_disassemble
  set Tgdb_cmd(commands) t_commands
  set Tgdb_cmd(define) t_define
  set Tgdb_cmd(document) t_document
  set Tgdb_cmd(display) t_display
  set Tgdb_cmd([list enable display]) t_enable_display
  set Tgdb_cmd([list disable display]) t_disable_display
  set Tgdb_cmd([list delete display]) t_delete_display
  set Tgdb_cmd([list set history size]) t_set_history_size
  set Tgdb_cmd([list set history save]) t_set_history_save
  set Tgdb_cmd([list set history write]) t_set_history_save
  set Tgdb_cmd([list set history filename]) t_set_history_filename
  set Tgdb_cmd([list set history expansion]) t_set_history_expansion
  set Tgdb_cmd([list info editing]) t_show_history
  set Tgdb_cmd([list show history]) t_show_history
  set Tgdb_cmd([list show history expansion]) t_show_history_expansion
  set Tgdb_cmd([list show history filename]) t_show_history_filename
  set Tgdb_cmd([list show history save]) t_show_history_save
  set Tgdb_cmd([list show history size]) t_show_history_size
  set Tgdb_cmd([list show commands]) t_show_commands
  set Tgdb_cmd([list info commands]) t_show_commands

  ##############################################################################
  # for debugging purposes only: delete a given procedure; it will be reloaded
  # automatically when it is called the next time
  ##############################################################################
  proc reload { {name ""} } {
    if { [set l [info procs "$name"]] == "" } {
      set l [info procs "$name*"]
    }
    if { [llength $l] == 1 } {
      rename $l {}
      append_to_gdbwin "<$l> reloaded.\n"
    } elseif { $l == "" } {
      append_to_gdbwin "No matches.\n"
    } else {
      append_to_gdbwin "Too many matches: <$l>\n"
    }
  }
  ##############################################################################
  # for debugging purposes only: execute a tcl command on global level
  ##############################################################################
  proc do_tcl { {cmd ""} } {
    if { $cmd != "" } {
      if { [catch {set result [eval uplevel #0 $cmd]} errmsg] } {
        append_to_gdbwin "$errmsg\n"
      } else {
	append_to_gdbwin "$result\n"
      }
    }
  }
  set gdb_cmd(tcl) "Pass given argument(s) to the Tcl interpreter."
  set Tgdb_cmd(tcl) do_tcl

  set gdb_scmd [lsort [array names gdb_cmd]]
}
### EOF ########################################################################
