################################################################################
#
# windows.tcl -- create and handle toplevel windows for tgdb
#
# (c) 1994 HighTec EDV-Systeme GmbH
#          Neue Bahnhofstr. 71
#          66386 St.Ingbert, Germany
#          Email: tgdb@HighTec.saarlink.de
#
# *** ALL RIGHTS RESERVED ***
#
################################################################################

################################################################################
#
# create intro window (grabs all events 'till end of initialization)
#
################################################################################
proc intro {} {
  global tgdb_version bitmap_path

  focus none
  toplevel .welcome -cursor watch
  wm transient .welcome .
  wm overrideredirect .welcome 1
  frame .welcome.f0 -relief raised -border 4
  frame .welcome.f0.f1 -relief groove -border 4
  message .welcome.f0.f1.msg -justify center \
    -text "Welcome to tgdb!\nInitializing - please wait..."

  frame .welcome.f0.f2
  append mtxt "tgdb $tgdb_version, Copyright 1994\n"
  append mtxt "by\n"
  message .welcome.f0.f2.msg -justify center -aspect 1000 -text $mtxt
  frame .welcome.f0.f2.fh
  button .welcome.f0.f2.fh.hightec -bitmap @$bitmap_path/hightec.xbm \
    -state disabled -disabledforeground blue -bg white -relief raised -border 4
  frame .welcome.f0.f2.fh.f
  append address "\n"
  append address "HighTec EDV-Systeme GmbH\n"
  append address "Neue Bahnhofstr. 71\n"
  append address "66386 St. Ingbert, Germany\n"
  append address "Email: tgdb@HighTec.saarlink.de\n"
  message .welcome.f0.f2.fh.f.msg -justify left -aspect 10000 \
   -font -adobe-times-bold-r-*-*-*-140-* -text $address

  pack .welcome.f0.f1.msg -padx 10m -pady 10m
  pack .welcome.f0.f1 -padx 3m -pady 3m
  pack .welcome.f0.f2.msg
  pack .welcome.f0.f2.fh.hightec -side left -padx 10 -pady 10
  pack .welcome.f0.f2.fh.f.msg
  pack .welcome.f0.f2.fh.f
  pack .welcome.f0.f2.fh -side right
  pack .welcome.f0.f2 -in .welcome.f0.f1 -side bottom
  pack .welcome.f0
  wm withdraw .welcome
  update idletasks
  set tw [winfo screenwidth .]; set th [winfo screenheight .]
  set w [winfo reqwidth .welcome]; set h [winfo reqheight .welcome]
  wm geometry .welcome +[expr ($tw-$w)/2]+[expr ($th-$h)/2]
  wm deiconify .welcome
  tkwait visibility .welcome
  grab .welcome
  focus .welcome
  bind .welcome <Visibility> {raise .welcome}
  bind .welcome <Control-c> {destroy .}
  update
}
################################################################################
#
# show the license dialog box after tgdb's initialization
# Note: you are not allowed to change even a single byte of this procedure!!!
#
################################################################################
proc show_license_box {} {
  global tgdb_version bitmap_path

  focus none
  catch {destroy .license}
  toplevel .license -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .license

  message .license.msg -justify center -aspect 20000 -text \
    "\ntgdb $tgdb_version, Copyright 1994\nby\n" \
    -font -adobe-courier-bold-r-normal--18-180-*
  frame .license.fh
  button .license.fh.hightec -bitmap @$bitmap_path/hightec.xbm -state disabled \
    -disabledforeground blue -bg white -relief raised -border 4
  frame .license.fh.f
  append address "\n"
  append address "HighTec EDV-Systeme GmbH\n"
  append address "Neue Bahnhofstr. 71\n"
  append address "66386 St. Ingbert, Germany\n"
  append address "Email: tgdb@HighTec.saarlink.de\n"
  message .license.fh.f.msg -justify left -aspect 10000 \
   -font -adobe-times-bold-r-*-*-*-140-* -text $address

  frame .license.fl
  append license "\n"
  append license "tgdb is shareware. Please invoke the\nmenu entry "
  append license "File->Visit->LICENSE to see the conditions."
  message .license.fl.msg -justify center -aspect 200 -text $license \
    -font -adobe-courier-bold-r-normal--18-180-* -foreground red

  frame .license.fb
  frame .license.fb.f0 -relief sunken -border 1
  button .license.fb.f0.but -reli raised -border 2 -text " Dismiss " -command {
    catch {destroy .license}
  }

  pack .license.msg -side top -fill x -fill y -expand 1
  pack .license.fh.hightec -side left -padx 10 -pady 10
  pack .license.fh.f.msg -side top -fill x
  pack .license.fh.f -side right -fill x -expand 1
  pack .license.fh -side top -fill x -expand 1
  pack .license.fl.msg -side top -fill both
  pack .license.fl -side top -fill both -expand 1
  pack .license.fb.f0.but -fill x -expand 1 -padx 6 -pady 6
  pack .license.fb.f0 -side bottom -padx 10 -pady 10 -fill x -expand 1
  pack .license.fb -side bottom -fill x -expand 1

  bind .license.fb.f0.but <Return> {.license.fb.f0.but invoke}
  bind .license.fb.f0.but <KP_Enter> [bind .license.fb.f0.but <Return>]
  bind .license.fb.f0.but <Control-c> [bind .license.fb.f0.but <Return>]

  bind .license <Visibility> {raise .license; focus .license.fb.f0.but}
  bind .license <FocusOut> {focus .license.fb.f0.but}

  update
  set tw [winfo width .]; set th [winfo height .]
  set x0 [winfo rootx .]; set y0 [winfo rooty .]
  set w [winfo reqwidth .license]; set h [winfo reqheight .license]
  wm geometry .license +[expr ($tw-$w)/2 + $x0]+[expr ($th-$h)/2 + $y0]
  wm title .license "tgdb Copyright and License Policy"
  wm protocol .license WM_TAKE_FOCUS {focus .license.fb.f0.but}
  wm deiconify .license
  tkwait visibility .license
  focus .license.fb.f0.but
  grab .license
  tkwait window .license
  after 300000 show_license_box
  focus none
}
################################################################################
#
# perform a reverse index search
#
################################################################################
proc reverse_i_search {} {
  global gdb_history gdb_history_nr gdb_history_max rs_buffer rs_len rs_entry
  global WinSize WinPos RevReady

  if { [array names gdb_history] == "0" } { bell; focus .f5.text; return; }
  set RevReady 0
  focus none
  catch { destroy .rs }
  toplevel .rs
  wm transient .rs .
  frame .rs.f0
  frame .rs.f1 -relief raised -border 2
  listbox .rs.f0.lb -setgrid 1 \
    -yscrollcommand {.rs.f0.yscr set} -xscrollcommand {.rs.f1.xscr set}
  set i [expr ($gdb_history_nr - 1) % $gdb_history_max]
  catch {unset rs_len}
  catch {unset rs_entry}
  while { 1 } {
    if { [info exists gdb_history($i)] } {
      set rs_len([.rs.f0.lb size]) [clength $gdb_history($i)]
      set rs_entry([.rs.f0.lb size]) $gdb_history($i)
      .rs.f0.lb insert end $gdb_history($i)
    } else break
    set i [expr ($i - 1) % $gdb_history_max]
    if { $i == $gdb_history_nr } break
  }
  scrollbar .rs.f0.yscr -orient vertical -command {.rs.f0.lb yview}
  scrollbar .rs.f1.xscr -orient horizontal -command {.rs.f0.lb xview}
  entry .rs.f1.entry -exportselection 0
  frame .rs.f1.f0 -relief sunken -border 1
  button .rs.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {rs2gdb; set RevReady 1}
  frame .rs.f1.f1 -relief flat -border 1
  button .rs.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set RevReady 1}

  pack .rs.f0.lb -side left -fill both -expand 1
  pack .rs.f0.yscr -side right -fill y
  pack .rs.f1.xscr -side top -fill x
  pack .rs.f1.entry -side top -fill x -expand 1
  pack .rs.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .rs.f1.f0 -side right -padx 10 -pady 10
  pack .rs.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .rs.f1.f1 -side right -padx 10 -pady 10
  pack .rs.f0 -side top -fill both -expand 1
  pack .rs.f1 -side top -fill x

  proc rs2gdb {} {
    global prompt

    # append the selected item to gdb's window
    set w .f5.text
    set pos [string first $prompt [$w get "insert linestart" "insert lineend"]]
    if { $pos >= 0 } {
      incr pos [string length $prompt]
      $w mark set insert [$w index "insert linestart + $pos c"]
      $w delete insert "insert lineend"
      $w insert insert [.rs.f1.entry get]
      $w tag add gdb_in "insert linestart + $pos c" insert
    } else {
      $w delete "insert linestart" "insert lineend"
      $w insert insert [.rs.f1.entry get]
      $w tag add gdb_in "insert linestart" insert
    }
    $w yview -pickplace insert
  }

  bind .rs <Visibility> {raise .rs}

  bind .rs.f0.lb <1> {
    %W select from [%W nearest %y]
    .rs.f1.entry delete 0 end
    .rs.f1.entry insert 0 [%W get [%W nearest %y]]
    .rs.f1.entry select from 0
    .rs.f1.entry select to end
    set rs_buffer [.rs.f1.entry get]
  }
  bind .rs.f0.lb <Double-1> {.rs.f1.f0.ok invoke}
  bind .rs.f0.lb <B1-Motion> [bind .rs.f0.lb <1>]
  bind .rs.f0.lb <Shift-1> { }
  bind .rs.f0.lb <Shift-B1-Motion> { }

  bind .rs.f1.entry <1> { focus %W }
  bind .rs.f1.entry <B1-Motion> { }
  bind .rs.f1.entry <Shift-1> { }
  bind .rs.f1.entry <Shift-B1-Motion> { }
  bind .rs.f1.entry <Control-h> { bell }
  bind .rs.f1.entry <Control-d> { bell }
  bind .rs.f1.entry <Control-u> { bell }
  bind .rs.f1.entry <Control-v> { bell }
  bind .rs.f1.entry <Control-w> { bell }

  proc check_rs_char { char } {
    global rs_buffer rs_len rs_entry WinSize

    # see which entry fits (best) for a given char
    set best -1
    set bestpos 1000000
    set bestlen 1000000
    set tmp "$rs_buffer$char"
    loop i 0 [.rs.f0.lb size] {
      if { [set pos [string first $tmp $rs_entry($i)]] < $bestpos } {
        if { ($pos >= 0) && ($rs_len($i) < $bestlen) } {
          set best $i
          set bestpos $pos
	  set bestlen $rs_len($i)
        }
      }
    }
    if { $best == -1 } { bell; return }
    .rs.f0.lb select clear
    .rs.f0.lb select from $best
    # make the selected item visible within the listbox
    # (similar to "yview -pickplace pos" for text widgets)
    set h [expr [winfo height .rs.f0.lb] / $WinSize(.rs,y)]
    set i [.rs.f0.lb nearest 0]
    if { ($best < $i) || ($best >= [expr $i + $h - 1]) } {
      .rs.f0.lb yview [expr $best - 2]
    }
    .rs.f1.entry delete 0 end
    .rs.f1.entry insert 0 [.rs.f0.lb get $best]
    .rs.f1.entry icursor [expr $bestpos + [clength $tmp]]
    .rs.f1.entry select from $bestpos
    .rs.f1.entry select to [expr $bestpos + [clength $tmp] - 1]
    tk_entrySeeCaret .rs.f1.entry
    set rs_buffer $tmp
  }

  bind .rs.f1.entry <BackSpace> {
    if { $rs_buffer == "" } {
      bell
    } else {
      set rs_buffer \
        [string range $rs_buffer 0 [expr [string length $rs_buffer] - 2]]
      if { $rs_buffer == "" } {
        .rs.f0.lb select clear
        %W delete 0 end
      } else {
        check_rs_char ""
      }
    }
  }
  bind .rs.f1.entry <Delete> [bind .rs.f1.entry <BackSpace>]
  bind .rs.f1.entry <Escape> {
    %W delete 0 end
    %W icursor 0
    .rs.f0.lb select clear
    set rs_buffer ""
  }
  bind .rs.f1.entry <Any-KeyPress> {
    if {"%A" != ""} {
      check_rs_char "%A"
    }
  }
  bind .rs.f1.entry <Return> {
    if { [lindex [.rs.f1.f0 configure -relief] 4] == "sunken" } {
      .rs.f1.f0.ok invoke
    } else {
      .rs.f1.f1.cancel invoke
    }
  }
  bind .rs.f1.entry <KP_Enter> [bind .rs.f1.entry <Return>]
  bind .rs.f1.entry <Control-c> {.rs.f1.f1.cancel invoke}
  bind .rs.f1.entry <Tab> {
    if { [lindex [.rs.f1.f0 configure -relief] 4] == "sunken" } {
      .rs.f1.f0 configure -relief flat
      .rs.f1.f1 configure -relief sunken
    } else {
      .rs.f1.f0 configure -relief sunken
      .rs.f1.f1 configure -relief flat
    }
  }
  bind .rs.f1.entry <Up> {
    proc rslb_get_first {} {
      global rs_buffer WinSize

      if { [set sel [.rs.f0.lb curselection]] == "" } {
	set sel [.rs.f0.lb nearest 0]
      }
      if { [incr sel -1] < 0 } {
	set sel 0
      }
      .rs.f0.lb select clear
      .rs.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .rs.f0.lb] / $WinSize(.rs,y)]
      set i [.rs.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .rs.f0.lb yview [expr $sel - 2]
      }
      .rs.f1.entry delete 0 end
      .rs.f1.entry insert 0 [.rs.f0.lb get $sel]
      .rs.f1.entry select from 0
      .rs.f1.entry select to end
      set rs_buffer [.rs.f1.entry get]
    }
    rslb_get_first
  }
  bind .rs.f1.entry <Down> {
    proc rslb_get_last {} {
      global rs_buffer WinSize

      if { [set sel [.rs.f0.lb curselection]] == "" } {
	set sel [.rs.f0.lb nearest 0]
      }
      if { [incr sel 1] >= [.rs.f0.lb size] } {
	incr sel -1
      }
      .rs.f0.lb select clear
      .rs.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .rs.f0.lb] / $WinSize(.rs,y)]
      set i [.rs.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .rs.f0.lb yview [expr $sel - 2]
      }
      .rs.f1.entry delete 0 end
      .rs.f1.entry insert 0 [.rs.f0.lb get $sel]
      .rs.f1.entry select from 0
      .rs.f1.entry select to end
      set rs_buffer [.rs.f1.entry get]
    }
    rslb_get_last
  }
  bind .rs.f1.entry <Right> {
    proc rslb_get_next {} {
      global rs_buffer

      if { [set line [.rs.f1.entry get]] == "" } {
	bell; return
      }
      set idx [.rs.f1.entry index insert]
      if { [set char [string index $line $idx]] == "" } {
	bell; return
      }
      check_rs_char $char
    }
    rslb_get_next
  }
  bind .rs.f1.entry <Left> [bind .rs.f1.entry <BackSpace>] 
  bind .rs.f1.entry <FocusOut> {focus .rs.f1.entry}

  set rs_buffer ""
  if { [catch {wm geometry .rs $WinPos(.rs)}] } {
    wm geometry .rs +200+200
  }
  set WinPos(.rs) [wm geometry .rs]
  wm minsize .rs 20 5
  wm title .rs "Reverse index search"
  wm protocol .rs WM_DELETE_WINDOW {set RevReady 1}
  wm protocol .rs WM_TAKE_FOCUS {focus .rs.f1.entry}
  tkwait visibility .rs
  grab .rs
  update
  scan [lindex [.rs.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.rs,x) [expr [winfo width .rs.f0.lb] / $w]
  set WinSize(.rs,y) [expr [winfo height .rs.f0.lb] / $h]
  focus .rs.f1.entry
  tkwait variable RevReady
  set WinPos(.rs) [wm geometry .rs]
  catch { destroy .rs }
  focus .f5.text
  update idletasks
}
################################################################################
#
# show help_about window
#
################################################################################
proc help_about {} {
  global old_focus bitmap_path tgdb_version WinPos WinProc

  if { [winfo exists .about] } {
    set geo [wm geometry .about]
    wm withdraw .about
    wm geometry .about $geo
    wm deiconify .about
    tkwait visibility .about
    raise .about
    focus .about
    return
  }

  set WinProc(.about) help_about
  set old_focus(.about) [focus]
  catch {destroy .about}
  toplevel .about -border 4 -relief sunken
  label .about.title -padx 15 -pady 15 -text "tgdb" 
  append mtxt "A graphical frontend to gdb, the GNU debugger.\n"
  append mtxt "Based on Tcl, Tk, TclX, TkSteal, Expect and BLT.\n"
  append mtxt "\n"
  append mtxt "tgdb $tgdb_version, Copyright 1994\n"
  append mtxt "by\n"
  message .about.msg -justify center -text $mtxt
  frame .about.fh
  button .about.fh.hightec -bitmap @$bitmap_path/hightec.xbm -state disabled \
    -disabledforeground blue -bg white -relief raised -border 4
  frame .about.fh.f
  append address "\n"
  append address "HighTec EDV-Systeme GmbH\n"
  append address "Neue Bahnhofstr. 71\n"
  append address "66386 St. Ingbert, Germany\n"
  append address "Email: tgdb@HighTec.saarlink.de\n"
  message .about.fh.f.msg -justify left -aspect 10000 \
   -font -adobe-times-bold-r-*-*-*-140-* -text $address
  frame .about.fb
  frame .about.fb.f0 -relief sunken -border 1
  button .about.fb.f0.but -relief raised -border 2 -text " Dismiss " -command {
    catch {focus $old_focus(.about)}
    set WinPos(.about) [wm geometry .about]
    catch {destroy .about}
  }

  pack .about.title -side top -fill x
  pack .about.msg -side top -fill x -fill y -expand 1
  pack .about.fh.hightec -side left -padx 10 -pady 10
  pack .about.fh.f.msg -side top -fill x
  pack .about.fh.f -side right -fill x -expand 1
  pack .about.fh -side top -fill x -expand 1
  
  pack .about.fb.f0.but -fill x -expand 1 -padx 6 -pady 6
  pack .about.fb.f0 -side bottom -padx 10 -pady 10 -fill x -expand 1
  pack .about.fb -side bottom -fill x -expand 1

  bind .about.fb.f0.but <Return> {.about.fb.f0.but invoke}
  bind .about.fb.f0.but <KP_Enter> [bind .about.fb.f0.but <Return>]
  bind .about.fb.f0.but <Control-c> [bind .about.fb.f0.but <Return>]

  wm title .about "About tgdb"
  wm protocol .about WM_TAKE_FOCUS {focus .about.fb.f0.but}
  if { [catch {wm geometry .about $WinPos(.about)}] } {
    wm geometry .about +200+200
  }
  set WinPos(.about) [wm geometry .about]
  tkwait visibility .about
  focus .about.fb.f0.but
}
################################################################################
#
# let's tell you who we are...
#
################################################################################
proc help_about_hightec {} {
  global old_focus bitmap_path tgdb_path WinPos WinProc

  if { [winfo exists .hightec] } {
    set geo [wm geometry .hightec]
    wm withdraw .hightec
    wm geometry .hightec $geo
    wm deiconify .hightec
    tkwait visibility .hightec
    raise .hightec
    focus .hightec
    return
  }

  set desc [open $tgdb_path/hightec.txt r]
  set text [read $desc]
  close $desc
  set WinProc(.hightec) help_about_hightec
  set old_focus(.hightec) [focus]
  catch {destroy .hightec}
  toplevel .hightec -border 4 -relief sunken
  frame .hightec.fh
  button .hightec.fh.hightec -bitmap @$bitmap_path/hightec.xbm -state disabled \
    -disabledforeground blue -bg white -relief raised -border 4
  frame .hightec.fh.f
  append address "\n"
  append address "HighTec EDV-Systeme GmbH\n"
  append address "Neue Bahnhofstr. 71\n"
  append address "66386 St. Ingbert, Germany\n"
  append address "Email: tgdb@hightec.saarlink.de\n"
  message .hightec.fh.f.msg -justify left -aspect 10000 \
   -font -adobe-times-bold-r-*-*-*-140-* -text $address

  frame .hightec.fm
  text .hightec.fm.txt -width 40 -height 10 -setgrid 1 -exportselection 0 \
    -font -adobe-courier-medium-r-normal--14-140-* -border 4 -relief sunken \
    -yscrollcommand {.hightec.fm.scr set}
  .hightec.fm.txt insert 1.0 $text
  .hightec.fm.txt configure -state disabled
  scrollbar .hightec.fm.scr -relief sunken -width 13 -orient vertical \
    -command {.hightec.fm.txt yview}

  frame .hightec.fb
  frame .hightec.fb.f0 -relief sunken -border 1
  button .hightec.fb.f0.but -relie raised -border 2 -text " Dismiss " -command {
    catch {focus $old_focus(.hightec)}
    set WinPos(.hightec) [wm geometry .hightec]
    catch {destroy .hightec}
  }

  pack .hightec.fh.hightec -side left -padx 10 -pady 10
  pack .hightec.fh.f.msg -fill x
  pack .hightec.fh.f -side left -fill x
  pack .hightec.fh -side top -fill x
  pack .hightec.fm.txt -side left -expand 1 -fill both
  pack .hightec.fm.scr -side right -fill y
  pack .hightec.fm -side top -fill both -expand 1
  pack .hightec.fb.f0.but -fill x -expand 1 -padx 6 -pady 6
  pack .hightec.fb.f0 -side bottom -padx 10 -pady 10 -fill x -expand 1
  pack .hightec.fb -side bottom -fill x

  foreach bind [bind Text] {
    if { ($bind == "<B2>") || ($bind == "<B2-Motion>") } continue
    bind .hightec.fm.txt $bind { }
  }
  bind .hightec.fb.f0.but <Return> {.hightec.fb.f0.but invoke}
  bind .hightec.fb.f0.but <KP_Enter> [bind .hightec.fb.f0.but <Return>]
  bind .hightec.fb.f0.but <Control-c> [bind .hightec.fb.f0.but <Return>]

  wm title .hightec "About HighTec EDV-Systeme GmbH"
  wm protocol .hightec WM_TAKE_FOCUS {focus .hightec.fb.f0.but}
  wm minsize .hightec 50 10
  wm maxsize .hightec 50 100
  if { [catch {wm geometry .hightec $WinPos(.hightec)}] } {
    wm geometry .hightec 50x10+220+220
  }
  set WinPos(.hightec) [wm geometry .hightec]
  tkwait visibility .hightec
  focus .hightec.fb.f0.but
}
################################################################################
#
# create stack window
#
################################################################################
proc create_stack_window {} {
  global WinSize WinPos WinProc

  if { [winfo exists .stack] } {
    set geo [wm geometry .stack]
    wm withdraw .stack
    wm geometry .stack $geo
    wm deiconify .stack
    tkwait visibility .stack
    raise .stack
    focus .stack
    return
  }

  set WinProc(.stack) create_stack_window
  catch { destroy .stack }
  toplevel .stack -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .stack

  frame .stack.f0 -relief groove -borderwidth 4
  listbox .stack.f0.lb -setgrid 1 -exportselection 0 \
    -yscrollcommand {.stack.f0.scr set}
  scrollbar .stack.f0.scr -orient vertical -command {.stack.f0.lb yview}
  frame .stack.f1 -relief groove -borderwidth 4
  frame .stack.f1.f0 -relief sunken -border 1
  button .stack.f1.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {set WinPos(.stack) [wm geometry .stack]; destroy .stack}
  frame .stack.f1.f1 -relief flat -border 1
  button .stack.f1.f1.update -relief raised -border 2 -text "  Update  " \
    -command {update_stack_window}

  pack .stack.f0.lb -side left -fill both -expand 1
  pack .stack.f0.scr -side right -fill y
  pack .stack.f1.f0.dismiss -expand 1 -padx 6 -pady 6
  pack .stack.f1.f0 -side right -padx 10 -pady 10
  pack .stack.f1.f1.update -expand 1 -padx 6 -pady 6
  pack .stack.f1.f1 -side right -padx 10 -pady 10
  pack .stack.f0 -side top -fill both -expand 1
  pack .stack.f1 -side top -fill x

  bind .stack <Tab> {
    if { [lindex [.stack.f1.f0 configure -relief] 4] == "sunken" } {
      .stack.f1.f0 configure -relief flat
      .stack.f1.f1 configure -relief sunken
    } else {
      .stack.f1.f0 configure -relief sunken
      .stack.f1.f1 configure -relief flat
    }
  }
  bind .stack <Return> {
    if { [lindex [.stack.f1.f0 configure -relief] 4] == "sunken" } {
      .stack.f1.f0.dismiss invoke
    } else {
      .stack.f1.f1.update invoke
    }
  }
  bind .stack <KP_Enter> [bind .stack <Return>]
  bind .stack <Control-c> {.stack.f1.f0.dismiss invoke}
  bind .stack <Up> {sel_frame down}
  bind .stack <Down> {sel_frame up}
  bind .stack.f0.lb <Button-1> { }
  bind .stack.f0.lb <Shift-B1-Motion> { }
  bind .stack.f0.lb <Shift-Button-1> { }
  bind .stack.f0.lb <B1-Motion> { }
  bind .stack.f0.lb <Double-1> [bind Listbox <Button-1>]
  bind .stack.f0.lb <Double-1> {+ $Tgdb_cmd(frame) [%W curselection]}
  bind .stack <Visibility> {check_visibility %W}

  if { [catch {wm geometry .stack $WinPos(.stack)}] } {
    wm geometry .stack +500+30
  }
  set WinPos(.stack) [wm geometry .stack]
  wm deiconify .stack
  wm title .stack "Tgdb stack window"
  wm minsize .stack 10 3
  wm protocol .stack WM_TAKE_FOCUS {focus .stack}
  wm protocol .stack WM_DELETE_WINDOW {.stack.f1.f0.dismiss invoke}
  tkwait visibility .stack
  raise .stack
  update
  scan [lindex [.stack.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.stack,x) [expr [winfo width .stack.f0.lb] / $w]
  set WinSize(.stack,y) [expr [winfo height .stack.f0.lb] / $h]
  update_stack_window
  focus .stack
}
################################################################################
#
# create display (watch) window
#
################################################################################
proc create_disp_window {} {
  global WinSize WinPos WinProc

  proc display_choice { selnr xpos ypos } {
    global DispNum DispVar DispExpr DispReady old_focus Tgdb_cmd

    if { ($selnr == "") || ($DispVar($selnr) == "") } {
      catch {.disp.f0.lb select clear}
      return
    }

    set selvar $DispVar($selnr)
    if { $DispExpr($selnr) != "" } { set selval $DispExpr($selnr) }
    set old_focus(.dispchg) [focus]
    catch { destroy .dispchg }
    toplevel .dispchg -borderwidth 4 -relief sunken -cursor top_left_arrow
    wm withdraw .dispchg

    frame .dispchg.f0 -relief groove -borderwidth 4
    label .dispchg.f0.l0 -text "What to do with \"$selvar\"?"
    if { [info exists selval] } {
      frame .dispchg.f0.f5 -relief sunken -border 1
      entry .dispchg.f0.f5.val -width 11 -relief sunken -exportselection 0
      .dispchg.f0.f5.val insert 0 $selval
    }

    frame .dispchg.f1 -relief groove -borderwidth 4
    frame .dispchg.f1.f0 -relief flat -border 1
    button .dispchg.f1.f0.cancel -relief raised -border 2 -text "  Cancel  " \
      -command {set DispReady 0}
    if { $DispNum($selnr) != 0 } {
      frame .dispchg.f1.f1 -relief flat -border 1
      button .dispchg.f1.f1.delete -relief raised -border 2 -text "  Delete  " \
        -command {set DispReady 1}
      frame .dispchg.f1.f2 -relief flat -border 1
      button .dispchg.f1.f2.disable -reli raised -border 2 -text "  Disable  " \
        -command {set DispReady 2}
    } else {
      frame .dispchg.f1.f1 -relief flat -border 1
      button .dispchg.f1.f1.add -relief raised -border 2 -text "  Add watch  " \
        -command {set DispReady 5}
    }
    if { [info exists selval] } {
      frame .dispchg.f1.f3 -relief flat -border 1
      button .dispchg.f1.f3.print -relief raised -border 2 -text "  Print *  " \
        -command {set DispReady 3}
      frame .dispchg.f1.f4 -relief flat -border 1
      button .dispchg.f1.f4.change -relief raised -border 2 -text "  Change  " \
        -command {set DispReady 4}
    }

    pack .dispchg.f0.l0 -padx 6 -pady 6
    if { [info exists selval] } {
      pack .dispchg.f0.f5.val -fill x -padx 6 -pady 6
      pack .dispchg.f0.f5 -side top -expand 1 -fill x -padx 10 -pady 10
    }
    pack .dispchg.f1.f0.cancel -fill x -padx 6 -pady 6
    pack .dispchg.f1.f0 -side bottom -expand 1 -fill x -padx 10 -pady 10
    if { $DispNum($selnr) != 0 } {
      pack .dispchg.f1.f1.delete -expand 1 -padx 6 -pady 6
      pack .dispchg.f1.f1 -side right -padx 10 -pady 10
      pack .dispchg.f1.f2.disable -expand 1 -padx 6 -pady 6
      pack .dispchg.f1.f2 -side right -padx 10 -pady 10
    } else {
      pack .dispchg.f1.f1.add -expand 1 -padx 6 -pady 6
      pack .dispchg.f1.f1 -side right -padx 10 -pady 10
    }
    if { [info exists selval] } {
      pack .dispchg.f1.f3.print -expand 1 -padx 6 -pady 6
      pack .dispchg.f1.f3 -side right -padx 10 -pady 10
      pack .dispchg.f1.f4.change -expand 1 -padx 6 -pady 6
      pack .dispchg.f1.f4 -side right -padx 10 -pady 10
    }
    pack .dispchg.f0 -side top -fill both -expand 1
    pack .dispchg.f1 -side top -fill x

    if { [info exists selval] } {
      foreach defbind [bind Entry] {
        bind .dispchg.f0.f5.val $defbind "[bind Entry $defbind]"
      }
      bind .dispchg.f0.f5.val <B1-Motion> { }
      bind .dispchg.f0.f5.val <Shift-1> { }
      bind .dispchg.f0.f5.val <Shift-B1-Motion> { }
      bind .dispchg.f0.f5.val <Control-d> {%W delete insert}
      bind .dispchg.f0.f5.val <Control-k> {%W delete insert end}
      bind .dispchg.f0.f5.val <Control-v> { }
      bind .dispchg.f0.f5.val <Control-w> { }
      bind .dispchg.f0.f5.val <Escape> {%W delete 0 end}
      bind .dispchg.f0.f5.val <Any-KeyPress> {
        if { "%A" != "" } {
          %W insert insert %A
          tk_entrySeeCaret %W
        }
      }
      bind .dispchg.f0.f5.val <Alt-Any-KeyPress> \
        [bind .dispchg.f0.f5.val <Any-KeyPress>]
      bind .dispchg.f0.f5.val <Right> {
        %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
      }
      bind .dispchg.f0.f5.val <Left> {
        %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
      }
      bind .dispchg.f0.f5.val <Up> {%W icursor 0; %W view 0}
      bind .dispchg.f0.f5.val <Down> {%W icursor end; tk_entrySeeCaret %W}
      bind .dispchg.f0.f5.val <Tab> {focus .dispchg.f1.f4.change}
      bind .dispchg.f0.f5.val <Shift-Tab> {focus .dispchg.f1.f0.cancel}
      bind .dispchg.f0.f5.val <Return> [bind .dispchg.f0.f5.val <Tab>]
      bind .dispchg.f0.f5.val <KP_Enter> [bind .dispchg.f0.f5.val <Return>]
      bind .dispchg.f0.f5.val <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f0.f5.val <FocusIn> {.dispchg.f0.f5 configure -reli sunken}
      bind .dispchg.f0.f5.val <FocusOut> {.dispchg.f0.f5 configure -reli flat}
    }

    if { $DispNum($selnr) != 0 } {
      if { [info exists selval] } {
        bind .dispchg.f1.f0.cancel <Tab> {focus .dispchg.f0.f5.val}
      } else {
        bind .dispchg.f1.f0.cancel <Tab> {focus .dispchg.f1.f2.disable}
      }
      bind .dispchg.f1.f0.cancel <Shift-Tab> {focus .dispchg.f1.f1.delete}
    } else {
      bind .dispchg.f1.f0.cancel <Tab> {focus .dispchg.f0.f5.val}
      bind .dispchg.f1.f0.cancel <Shift-Tab> {focus .dispchg.f1.f1.add}
    }
    bind .dispchg.f1.f0.cancel <Return> {%W invoke}
    bind .dispchg.f1.f0.cancel <KP_Enter> {%W invoke}
    bind .dispchg.f1.f0.cancel <Control-c> {%W invoke}
    bind .dispchg.f1.f0.cancel <FocusIn> {.dispchg.f1.f0 configure -reli sunken}
    bind .dispchg.f1.f0.cancel <FocusOut> {.dispchg.f1.f0 configure -reli flat}

    if { $DispNum($selnr) != 0 } {
      bind .dispchg.f1.f1.delete <Tab> {focus .dispchg.f1.f0.cancel}
      bind .dispchg.f1.f1.delete <Shift-Tab> {focus .dispchg.f1.f2.disable}
      bind .dispchg.f1.f1.delete <Return> {%W invoke}
      bind .dispchg.f1.f1.delete <KP_Enter> {%W invoke}
      bind .dispchg.f1.f1.delete <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f1.f1.delete <FocusIn> {.dispchg.f1.f1 configure -reli sunk}
      bind .dispchg.f1.f1.delete <FocusOut> {.dispchg.f1.f1 configure -rel flat}

      bind .dispchg.f1.f2.disable <Tab> {focus .dispchg.f1.f1.delete}
      if { [info exists selval] } {
        bind .dispchg.f1.f2.disable <Shift-Tab> {focus .dispchg.f1.f3.print}
      } else {
        bind .dispchg.f1.f2.disable <Shift-Tab> {focus .dispchg.f1.f0.cancel}
      }
      bind .dispchg.f1.f2.disable <Return> {%W invoke}
      bind .dispchg.f1.f2.disable <KP_Enter> {%W invoke}
      bind .dispchg.f1.f2.disable <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f1.f2.disable <FocusIn> {.dispchg.f1.f2 configure -rel sunk}
      bind .dispchg.f1.f2.disable <FocusOut> {.dispchg.f1.f2 configure -rel fla}
    } else {
      bind .dispchg.f1.f1.add <Tab> {focus .dispchg.f1.f0.cancel}
      bind .dispchg.f1.f1.add <Shift-Tab> {focus .dispchg.f1.f3.print}
      bind .dispchg.f1.f1.add <Return> {%W invoke}
      bind .dispchg.f1.f1.add <KP_Enter> {%W invoke}
      bind .dispchg.f1.f1.add <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f1.f1.add <FocusIn> {.dispchg.f1.f1 configure -reli sunken}
      bind .dispchg.f1.f1.add <FocusOut> {.dispchg.f1.f1 configure -reli flat}
    }

    if { [info exists selval] } {
      if { $DispNum($selnr) != 0 } {
        bind .dispchg.f1.f3.print <Tab> {focus .dispchg.f1.f2.disable}
      } else {
        bind .dispchg.f1.f3.print <Tab> {focus .dispchg.f1.f1.add}
      }
      bind .dispchg.f1.f3.print <Shift-Tab> {focus .dispchg.f1.f4.change}
      bind .dispchg.f1.f3.print <Return> {%W invoke}
      bind .dispchg.f1.f3.print <KP_Enter> {%W invoke}
      bind .dispchg.f1.f3.print <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f1.f3.print <FocusIn> {.dispchg.f1.f3 configure -rel sunken}
      bind .dispchg.f1.f3.print <FocusOut> {.dispchg.f1.f3 configure -reli flat}

      bind .dispchg.f1.f4.change <Tab> {focus .dispchg.f1.f3.print}
      bind .dispchg.f1.f4.change <Shift-Tab> {focus .dispchg.f0.f5.val}
      bind .dispchg.f1.f4.change <Return> {%W invoke}
      bind .dispchg.f1.f4.change <KP_Enter> {%W invoke}
      bind .dispchg.f1.f4.change <Control-c> {.dispchg.f1.f0.cancel invoke}
      bind .dispchg.f1.f4.change <FocusIn> {.dispchg.f1.f4 configure -rel sunke}
      bind .dispchg.f1.f4.change <FocusOut> {.dispchg.f1.f4 configure -rel flat}
    }

    if { [info exists selval] } {
      bind .dispchg <Visibility> {raise .dispchg; focus .dispchg.f0.f5.val}
    } else {
      bind .dispchg <Visibility> {raise .dispchg; focus .dispchg.f1.f0.cancel}
    }
    bind .dispchg <FocusOut> {focus .dispchg.f1.f0.cancel}
  
    wm geometry .dispchg +$xpos+$ypos
    wm deiconify .dispchg
    wm title .dispchg "Tgdb select box"
    if { [info exists selval] } {
      wm protocol .dispchg WM_TAKE_FOCUS {focus .dispchg.f0.f5.val}
    } else {
      wm protocol .dispchg WM_TAKE_FOCUS {focus .dispchg.f1.f0.cancel}
    }
    tkwait visibility .dispchg
    raise .dispchg
    if { [info exists selval] } {
      focus .dispchg.f0.f5.val
    } else {
      focus .dispchg.f1.f0.cancel
    }
    grab .dispchg
    tkwait variable DispReady

    switch $DispReady {
      1 { $Tgdb_cmd([list delete display]) $DispNum($selnr) }
      2 { $Tgdb_cmd([list disable display]) $DispNum($selnr) }
      3 { $Tgdb_cmd(print) "*($selvar)" }
      4 { $Tgdb_cmd([list set variable]) "$selvar = [.dispchg.f0.f5.val get]" }
      5 { set result [string trim [do_dialog "whatis $selvar" silent]]
	  # dereference expression to be added to the display list if it is
	  # a pointer - but don't do that for strings ([unsigned] char *)!
	  if { [cequal [cindex $result end] "*"]
	      && ![regexp {char \*$} $result] } {
	    $Tgdb_cmd(display) "*($selvar)"
	  } else {
	    $Tgdb_cmd(display) $selvar
	  }
	  update_disp_window new
	}
    }
    destroy .dispchg
    catch {.disp.f0.lb select clear}
    catch {focus $old_focus(.dispchg)}
  }

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

  if { [winfo exists .disp] } {
    set geo [wm geometry .disp]
    wm withdraw .disp
    wm geometry .disp $geo
    wm deiconify .disp
    tkwait visibility .disp
    raise .disp
    focus .disp
    return
  }

  set WinProc(.disp) create_disp_window
  catch { destroy .disp }
  toplevel .disp -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .disp

  frame .disp.f0 -relief groove -borderwidth 4
  listbox .disp.f0.lb -setgrid 1 -exportselection 0 \
    -yscrollcommand {.disp.f0.scr set}
  scrollbar .disp.f0.scr -orient vertical -command {.disp.f0.lb yview}
  frame .disp.f1 -relief groove -borderwidth 4
  frame .disp.f1.f0 -relief sunken -border 1
  button .disp.f1.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {set WinPos(.disp) [wm geometry .disp]; destroy .disp}
  frame .disp.f1.f1 -relief flat -border 1
  button .disp.f1.f1.update -relief raised -border 2 -text "  Update  " \
    -command {update_disp_window new}

  pack .disp.f0.lb -side left -fill both -expand 1
  pack .disp.f0.scr -side right -fill y
  pack .disp.f1.f0.dismiss -expand 1 -padx 6 -pady 6
  pack .disp.f1.f0 -side right -padx 10 -pady 10
  pack .disp.f1.f1.update -expand 1 -padx 6 -pady 6
  pack .disp.f1.f1 -side right -padx 10 -pady 10
  pack .disp.f0 -side top -fill both -expand 1
  pack .disp.f1 -side top -fill x

  bind .disp <Tab> {
    if { [lindex [.disp.f1.f0 configure -relief] 4] == "sunken" } {
      .disp.f1.f0 configure -relief flat
      .disp.f1.f1 configure -relief sunken
    } else {
      .disp.f1.f0 configure -relief sunken
      .disp.f1.f1 configure -relief flat
    }
  }
  bind .disp <Return> {
    if { [lindex [.disp.f1.f0 configure -relief] 4] == "sunken" } {
      .disp.f1.f0.dismiss invoke
    } else {
      .disp.f1.f1.update invoke
    }
  }
  bind .disp <KP_Enter> [bind .disp <Return>]
  bind .disp <Control-c> {.disp.f1.f0.dismiss invoke}
  bind .disp <Visibility> {check_visibility %W}

  bind .disp.f0.lb <Button-1> { }
  bind .disp.f0.lb <Shift-B1-Motion> { }
  bind .disp.f0.lb <Shift-Button-1> { }
  bind .disp.f0.lb <B1-Motion> { }
  bind .disp.f0.lb <Double-1> [bind Listbox <Button-1>]
  bind .disp.f0.lb <Double-1> {+
    display_choice [%W curselection] \
	[winfo rootx %W] [expr %Y + $WinSize(.disp,y)]
  }

  if { [catch {wm geometry .disp $WinPos(.disp)}] } {
    wm geometry .disp +500+30
  }
  set WinPos(.disp) [wm geometry .disp]
  wm deiconify .disp
  wm title .disp "Tgdb watch window"
  wm minsize .disp 10 3
  wm protocol .disp WM_TAKE_FOCUS {focus .disp}
  wm protocol .disp WM_DELETE_WINDOW {.disp.f1.f0.dismiss invoke}
  tkwait visibility .disp
  raise .disp
  update
  scan [lindex [.disp.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.disp,x) [expr [winfo width .disp.f0.lb] / $w]
  set WinSize(.disp,y) [expr [winfo height .disp.f0.lb] / $h]
  update_disp_window new
  focus .disp
}
################################################################################
#
# create memory dump window
#
################################################################################
proc create_memory_window {} {
  global WinSize WinPos WinProc MemOpts

  proc scroll_memwin { direction amount } {
    global WinSize MemOpts

    set w .mem.f1.txt
    set line [$w get 1.0 "1.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+):} $line {} addr] } {
      bell
      return
    }
    switch $MemOpts(mode) {
      flt { set size 4 }
      dbl { set size 8 }
      default { set size $MemOpts(size) }
    }
    set diff [expr $size*$MemOpts(cols,$MemOpts(mode),$size)]
    if { $amount == "line" } {
      if { $direction == "up" } {
	incr addr -$diff
      } else {
	incr addr $diff
      }
    } else {
      scan [wm geometry .mem] "%dx%d" width h
      incr h -1
      if { $direction == "up" } {
	set addr [expr $addr - $diff * $h]
      } else {
	set addr [expr $addr + $diff * $h]
      }
    }
    update_mem_window $addr
  }

  proc mem_scroll { newpos } {

    # the scrollbar has spoken...
    if { [blt_busy hosts] != "" } {
      return
    }

    switch -- $newpos {
      2 { .mem.f1.scr set 9 3 2 4
	  update idletasks
	  scroll_memwin up line
	}
      1 { .mem.f1.scr set 9 3 0 2
	  update idletasks
	  scroll_memwin up page
	}
      5 { .mem.f1.scr set 9 3 6 8
	  update idletasks
	  scroll_memwin down page
	}
      4 { .mem.f1.scr set 9 3 4 6
	  update idletasks
 	  scroll_memwin down line
	}
      default { .mem.f1.scr set 9 3 3 5 }
    }
    .mem.f1.scr set 9 3 3 5
    update idletasks
  }

  proc mem_change_mode {} {
    set w .mem.f1.txt
    set line [$w get 1.0 "1.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+):} $line {} addr] } {
      bell
    } else {
      update_mem_window $addr
    }
  }

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

  if { [winfo exists .mem] } {
    set geo [wm geometry .mem]
    wm withdraw .mem
    wm geometry .mem $geo
    wm deiconify .mem
    tkwait visibility .mem
    raise .mem
    focus .mem
    return
  }

  set WinProc(.mem) create_memory_window
  catch {destroy .mem}
  toplevel .mem -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .mem

  if { ![info exists MemOpts(last)] } {
    set MemOpts(last) "\$sp"
    set MemOpts(lastexpr) "\$sp"
  }

  if { ![info exists MemOpts(width)] } {
    set MemOpts(width) 55
    set MemOpts(mode) "hex"
    set res [do_dialog {printf "%d %d", sizeof(long), sizeof(int)} silent]
    if { [lindex $res 0] == 8 } {
      set MemOpts(giant) 1
    } else {
      set MemOpts(giant) 0
    }
    switch -- [lindex $res 1] {
      1 { set MemOpts(size) 1 }
      2 { set MemOpts(size) 2 }
      4 { set MemOpts(size) 4 }
      8 { set MemOpts(size) [expr $MemOpts(giant) ? 8 : 4] }
      default { set MemOpts(size) 4 }
    }

    set MemOpts(cols,hex,1) 8
    set MemOpts(cols,hex,2) 8
    set MemOpts(cols,hex,4) 4
    set MemOpts(cols,hex,8) 2

    set MemOpts(cols,dec,1) 8
    set MemOpts(cols,dec,2) 5
    set MemOpts(cols,dec,4) 3
    set MemOpts(cols,dec,8) 2

    set MemOpts(cols,uns,1) 8
    set MemOpts(cols,uns,2) 5
    set MemOpts(cols,uns,4) 3
    set MemOpts(cols,uns,8) 2

    set MemOpts(cols,flt,4) 2
    set MemOpts(cols,dbl,8) 1
  }

  frame .mem.f1 -relief flat
  text .mem.f1.txt -setgrid 1 -state disabled -exportselection 0 \
    -cursor top_left_arrow -wrap none -width $MemOpts(width) \
    -height 5 -border 2 -relief sunken
  scrollbar .mem.f1.scr -orient vertical -command {mem_scroll}
  .mem.f1.scr set 9 3 3 5

  frame .mem.f2 -border 2 -relief raised
  frame .mem.f2.f0 -relief flat
  frame .mem.f2.f0.up -relief flat
  frame .mem.f2.f0.dn -relief flat
  frame .mem.f2.f1 -relief flat
  radiobutton .mem.f2.f0.up.hex -text "Hexadecimal" -variable MemOpts(mode) \
    -value hex -command mem_change_mode
  radiobutton .mem.f2.f0.up.dec -text "Decimal" -variable MemOpts(mode) \
    -value dec -command mem_change_mode
  radiobutton .mem.f2.f0.up.uns -text "Unsigned" -variable MemOpts(mode) \
    -value uns -command mem_change_mode
  radiobutton .mem.f2.f1.flt -text "Float" -variable MemOpts(mode) -value flt \
    -command mem_change_mode
  radiobutton .mem.f2.f1.dbl -text "Double" -variable MemOpts(mode) -value dbl \
    -command mem_change_mode
  radiobutton .mem.f2.f0.dn.b1 -text "1 byte" -variable MemOpts(size) -value 1 \
    -command mem_change_mode
  radiobutton .mem.f2.f0.dn.b2 -text "2 bytes" -variable MemOpts(size) -value 2\
    -command mem_change_mode
  radiobutton .mem.f2.f0.dn.b4 -text "4 bytes" -variable MemOpts(size) -value 4\
    -command mem_change_mode
  radiobutton .mem.f2.f0.dn.b8 -text "8 bytes" -variable MemOpts(size) -value 8\
    -command mem_change_mode
  if { !$MemOpts(giant) } {
    if { $MemOpts(size) == 8 } {
      set MemOpts(size) 4
    }
    .mem.f2.f0.dn.b8 configure -state disabled
  }

  frame .mem.f3 -relief raised -border 4
  frame .mem.f3.f0 -relief sunken -border 1
  button .mem.f3.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {
      set WinPos(.mem) [wm geometry .mem]
      set MemOpts(lastexpr) [.mem.f3.f2.val get]
      destroy .mem
    }
  frame .mem.f3.f1 -relief flat -border 1
  button .mem.f3.f1.update -reli raised -border 2 -text "  Update  " -command {
    if { [lindex [.mem.f3.f1 configure -relief] 4] != "sunken" } {
      focus .mem
      .mem.f3.f0 configure -relief flat
      .mem.f3.f1 configure -relief sunken
      .mem.f3.f2 configure -relief flat
    }
    update_mem_window ""
  }
  label .mem.f3.lbl -text "Dump memory from: "
  frame .mem.f3.f2 -relief flat -border 1
  entry .mem.f3.f2.val -relief sunken -exportselection 0

  pack .mem.f1.txt -side left -fill both -expand 1
  pack .mem.f1.scr -side right -fill y
  pack .mem.f1 -side top -fill both -expand 1

  pack .mem.f2.f0.up.hex -side left -fill x -expand 1
  pack .mem.f2.f0.up.dec -side left -fill x -expand 1
  pack .mem.f2.f0.up.uns -side left -fill x -expand 1
  pack .mem.f2.f0.up -side top -fill x -expand 1
  pack .mem.f2.f0.dn.b1 -side left -fill x -expand 1
  pack .mem.f2.f0.dn.b2 -side left -fill x -expand 1
  pack .mem.f2.f0.dn.b4 -side left -fill x -expand 1
  pack .mem.f2.f0.dn.b8 -side left -fill x -expand 1
  pack .mem.f2.f0.dn -side top -fill x -expand 1
  pack .mem.f2.f0 -side left -fill both -expand 1
  pack .mem.f2.f1.flt -side left -fill both -expand 1
  pack .mem.f2.f1.dbl -side left -fill both -expand 1
  pack .mem.f2.f1 -side left -fill both -expand 1
  pack .mem.f2 -side top -fill x

  pack .mem.f3.f0.dismiss -padx 6 -pady 6
  pack .mem.f3.f0 -side right -padx 10 -pady 4
  pack .mem.f3.f1.update -padx 6 -pady 6
  pack .mem.f3.f1 -side right -padx 10 -pady 4
  pack .mem.f3.lbl -side left -fill x
  pack .mem.f3.f2.val -side left -padx 6 -pady 6 -fill x -expand 1
  pack .mem.f3.f2 -side left -padx 2 -pady 2 -fill x -expand 1
  pack .mem.f3 -side top -fill x

  foreach defbind [bind Text] {
    bind .mem.f1.txt $defbind { }
  }
  bind .mem.f1.txt <1> {
    set tk_priv(selectMode) word
    %W mark set insert @%x,%y
    %W mark set anchor insert
    tk_textSelectTo %W "@%x,%y wordstart"
    set tk_priv(selectMode) char
  }
  bind .mem.f1.txt <B1-Motion> [bind Text <B1-Motion>]
  bind .mem.f1.txt <Shift-1> [bind Text <Shift-1>]
  bind .mem.f1.txt <Shift-B1-Motion> [bind Text <Shift-B1-Motion>]

  foreach defbind [bind Entry] {
    bind .mem.f3.f2.val $defbind "[bind Entry $defbind]"
  }
  bind .mem.f3.f2.val <Right> {
    %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
  }
  bind .mem.f3.f2.val <Left> {
    %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
  }
  bind .mem.f3.f2.val <Up> {%W icursor 0; %W view 0}
  bind .mem.f3.f2.val <Down> {%W icursor end; tk_entrySeeCaret %W}
  bind .mem.f3.f2.val <Return> {
    .mem.f3.f2 configure -relief flat
    .mem.f3.f0 configure -relief sunken
    focus .mem
    update_mem_window [%W get]
  }
  bind .mem.f3.f2.val <Double-1> [bind .mem.f3.f2.val <Return>]
  bind .mem.f3.f2.val <KP_Enter> [bind .mem.f3.f2.val <Return>]
  bind .mem.f3.f2.val <Tab> {
    .mem.f3.f1 configure -relief sunken
    focus .mem
  }
  bind .mem.f3.f2.val <Shift-Tab> {
    .mem.f3.f0 configure -relief sunken
    focus .mem
  }
  bind .mem.f3.f2.val <FocusOut> {
    .mem.f3.f2 configure -relief flat
    if { [lindex [.mem.f3.f1 configure -relief] 4] == "sunken" } {
      .mem.f3.f0 configure -relief flat
    } else {
      .mem.f3.f0 configure -relief sunken
    }
  }
  bind .mem.f3.f2.val <1> {
    .mem.f3.f0 configure -relief flat
    .mem.f3.f1 configure -relief flat
    .mem.f3.f2 configure -relief sunken
    focus .mem.f3.f2.val
    .mem.f3.f2.val icursor @%x
  }
  bind .mem.f3.f2.val <B1-Motion> { }
  bind .mem.f3.f2.val <Shift-1> { }
  bind .mem.f3.f2.val <Shift-B1-Motion> { }
  bind .mem.f3.f2.val <3> {
    if { [catch {set MemSel [.mem.f1.txt get "sel.first" "sel.last"]}] } {
      if { [cequal [set MemSel [get_selection]] ""] } {
	bell
	show_status "No selection."
      }
    } else {
      regsub -all "\[ \t\n\]" $MemSel "" MemSel
      if { ($MemOpts(mode) == "hex") && ([string first "0x" $MemSel] != 0) } {
	if { [ctype xdigit $MemSel] } {
	  set MemSel "0x$MemSel"
	}
      }
    }
    if { ![cequal $MemSel ""] } {
      %W delete 0 end
      %W insert 0 $MemSel
      %W icursor end
      tk_entrySeeCaret %W
    }
  }
  bind .mem.f3.f2.val <Control-a> [bind .mem.f3.f2.val <Up>]
  bind .mem.f3.f2.val <Control-b> [bind .mem.f3.f2.val <Left>]
  bind .mem.f3.f2.val <Control-d> { }
  bind .mem.f3.f2.val <Control-e> [bind .mem.f3.f2.val <Down>]
  bind .mem.f3.f2.val <Control-f> [bind .mem.f3.f2.val <Right>]
  bind .mem.f3.f2.val <Control-k> {%W delete insert end}
  bind .mem.f3.f2.val <Control-v> { }
  bind .mem.f3.f2.val <Control-w> [bind .mem.f3.f2.val <3>]
  bind .mem.f3.f2.val <Escape> {%W delete 0 end}
  bind .mem.f3.f2.val <Any-KeyPress> {
    if { "%A" != "" } {
      %W insert insert %A
      tk_entrySeeCaret %W
    }
  }
  bind .mem.f3.f2.val <Alt-Any-KeyPress> [bind .mem.f3.f2.val <Any-KeyPress>]

  bind .mem <Tab> {
    if { [lindex [.mem.f3.f0 configure -relief] 4] == "sunken" } {
      .mem.f3.f0 configure -relief flat
      .mem.f3.f2 configure -relief sunken
      focus .mem.f3.f2.val
    } else {
      .mem.f3.f0 configure -relief sunken
      .mem.f3.f1 configure -relief flat
    }
  }
  bind .mem <Shift-Tab> {
    if { [lindex [.mem.f3.f0 configure -relief] 4] == "sunken" } {
      .mem.f3.f0 configure -relief flat
      .mem.f3.f1 configure -relief sunken
    } else {
      .mem.f3.f1 configure -relief flat
      .mem.f3.f2 configure -relief sunken
      focus .mem.f3.f2.val
    }
  }
  bind .mem <Return> {
    if { [lindex [.mem.f3.f0 configure -relief] 4] == "sunken" } {
      .mem.f3.f0.dismiss invoke
    } else {
      .mem.f3.f1.update invoke
    }
  }
  bind .mem <KP_Enter> [bind .mem <Return>]
  bind .mem <Shift-Up> {mem_scroll 1}
  bind .mem <Shift-Left> [bind .mem <Shift-Up>]
  bind .mem <Prior> [bind .mem <Shift-Up>]
  bind .mem <Up> {mem_scroll 2}
  bind .mem <Left> [bind .mem <Up>]
  bind .mem <Down> {mem_scroll 4}
  bind .mem <Right> [bind .mem <Down>]
  bind .mem <Shift-Down> {mem_scroll 5}
  bind .mem <Shift-Right> [bind .mem <Shift-Down>]
  bind .mem <Next> [bind .mem <Shift-Down>]
  bind .mem <Visibility> {check_visibility %W}
  bind .mem <Control-c> {.mem.f3.f0.dismiss invoke}
  bind .mem <Configure> {
    if { [string first .mem [focus]] == 0 } {
      .mem.f3.f1.update invoke
    }
  }

  if { [catch {wm geometry .mem $WinPos(.mem)}] } {
    wm geometry .mem +20+250
  }
  set WinPos(.mem) [wm geometry .mem]
  wm deiconify .mem
  wm title .mem "Tgdb memory dump window"
  wm minsize .mem $MemOpts(width) 5
  wm maxsize .mem $MemOpts(width) 100
  wm protocol .mem WM_TAKE_FOCUS {focus .mem}
  wm protocol .mem WM_DELETE_WINDOW {.mem.f3.f0.dismiss invoke}
  tkwait visibility .mem
  raise .mem
  update
  set w [lindex [.mem.f1.txt configure -width] 4]
  set h [lindex [.mem.f1.txt configure -height] 4]
  set WinSize(.mem,x) [expr [winfo width .mem.f1.txt] / $w]
  set WinSize(.mem,y) [expr [winfo height .mem.f1.txt] / $h]
  .mem.f3.f2.val insert 0 $MemOpts(lastexpr)
  update_mem_window $MemOpts(last)
  focus .mem
}
################################################################################
#
# open a dialog box for changing memory contents
#
################################################################################
proc change_memory { addr contents xpos ypos {is_string no} } {
  global MemOpts Tgdb_cmd ChgmemReady old_focus AsmLines

  proc mem_change_char { char } {
    set w .chgmem.f0.val
    set pos [$w index insert]
    set byte [format "%02x" [ctype ord $char]]
    if { ![ctype print $char] } {
      set char "."
    }
    $w delete $pos
    $w insert $pos $char
    if { [expr $pos + 2] == [$w index end] } {
      $w icursor $pos
    } else {
      $w icursor [expr $pos + 2]
    }
    .chgmem.f0.val2 delete $pos [expr $pos + 1]
    .chgmem.f0.val2 insert $pos $byte
    .chgmem.f0.val2 icursor $pos
  }

  proc mem_change_byte { nibble } {
    set w .chgmem.f0.val2
    set pos [$w index insert]
    $w delete $pos
    $w insert $pos $nibble
    if { [expr $pos + 1] == [$w index end] } {
      $w icursor $pos
    } else {
      $w icursor [expr $pos + 1]
    }
    set bytline [$w get]
    if { ($pos % 2) == 1 } {
      incr pos -1
    }
    set byte 0x[crange $bytline $pos $pos+1]
    set char [ctype char $byte]
    if { ![ctype print $char] } {
      set char "."
    }
    .chgmem.f0.val delete $pos
    .chgmem.f0.val insert $pos $char
    .chgmem.f0.val icursor $pos
  }

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

  set old_focus(.chgmem) [focus]
  catch { destroy .chgmem }
  toplevel .chgmem -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .chgmem

  set addr [format "0x%08x" $addr]
  frame .chgmem.f0 -relief groove -borderwidth 4
  label .chgmem.f0.l0 -text "  Change memory contents at $addr:  "

  if { $is_string != "no" } {
    set nchars 0
    set bytline ""
    set ascline ""
    set strformat "\""
    foreach byte $contents {
      append bytline $byte
      set char [ctype char 0x$byte]
      if { [ctype print $char] } {
	append ascline "$char "
      } else {
	append ascline ". "
      }
      append strformat "%02x"
      incr nchars 2
    }
    append strformat "\""
    entry .chgmem.f0.val -width $nchars -relief sunken -exportselection 0
    .chgmem.f0.val insert 0 $ascline
    entry .chgmem.f0.val2 -width $nchars -relief sunken -exportselection 0
    .chgmem.f0.val2 insert 0 $bytline
  } else {
    switch $MemOpts(mode) {
      dbl { set cmd "*(double *)$addr" }
      flt { set cmd "*(float *)$addr" }
      hex -
      uns { switch $MemOpts(size) {
	      1 { set cmd "*(unsigned char *)$addr" }
	      2 { set cmd "*(unsigned short *)$addr" }
	      4 { if { $MemOpts(giant) } {
		    set cmd "*(unsigned int *)$addr"
		  } else {
		    set cmd "*(unsigned long *)$addr"
		  }
	        }
	      8 { set cmd "*(unsigned long *)$addr"
		  if { $MemOpts(mode) == "hex" } {
		    set contents 0x$contents
		  }
	        }
	    }
	  }
      dec { switch $MemOpts(size) {
	      1 { set cmd "*(char *)$addr" }
	      2 { set cmd "*(short *)$addr" }
	      4 { if { $MemOpts(giant) } {
		    set cmd "*(int *)$addr"
		  } else {
		    set cmd "*(long *)$addr"
		  }
	        }
	      8 { set cmd "*(long *)$addr" }
	    }
	  }
    }
    entry .chgmem.f0.val -width 25 -relief sunken -exportselection 0
    .chgmem.f0.val insert 0 $contents
  }

  frame .chgmem.f1 -relief groove -borderwidth 4
  frame .chgmem.f1.f0 -relief sunken -border 1
  button .chgmem.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {set ChgmemReady 1}
  frame .chgmem.f1.f1 -relief flat -border 1
  button .chgmem.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set ChgmemReady 0}

  pack .chgmem.f0.l0
  if { $is_string == "no" } {
    pack .chgmem.f0.val -pady 6
  } else {
    pack .chgmem.f0.val -pady 6 -side top
    pack .chgmem.f0.val2 -pady 6 -side bottom
  }
  pack .chgmem.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .chgmem.f1.f0 -side right -padx 10 -pady 10
  pack .chgmem.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .chgmem.f1.f1 -side right -padx 10 -pady 10
  pack .chgmem.f0 -side top -fill both -expand 1
  pack .chgmem.f1 -side top -fill x

  foreach defbind [bind Entry] {
    bind .chgmem.f0.val $defbind "[bind Entry $defbind]"
  }
  bind .chgmem.f0.val <B1-Motion> { }
  bind .chgmem.f0.val <Shift-1> { }
  bind .chgmem.f0.val <Shift-B1-Motion> { }
  bind .chgmem.f0.val <Control-w> { }
  bind .chgmem.f0.val <Tab> {
    if { [lindex [.chgmem.f1.f0 configure -relief] 4] == "sunken" } {
      .chgmem.f1.f0 configure -relief flat
      .chgmem.f1.f1 configure -relief sunken
    } else {
      .chgmem.f1.f0 configure -relief sunken
      .chgmem.f1.f1 configure -relief flat
    }
  }
  bind .chgmem.f0.val <Return> {
    if { [lindex [.chgmem.f1.f0 configure -relief] 4] == "sunken" } {
      .chgmem.f1.f0.ok invoke
    } else {
      .chgmem.f1.f1.cancel invoke
    }
  }
  bind .chgmem.f0.val <KP_Enter> [bind .chgmem.f0.val <Return>]
  bind .chgmem.f0.val <Control-c> {.chgmem.f1.f1.cancel invoke}
  if { $is_string == "no" } {
    bind .chgmem.f0.val <Control-d> {%W delete insert}
    bind .chgmem.f0.val <Control-v> {%W delete insert end}
    bind .chgmem.f0.val <Escape> {%W delete 0 end}
    bind .chgmem.f0.val <Any-KeyPress> {
      if { "%A" != "" } {
        %W insert insert %A
        tk_entrySeeCaret %W
      }
    }
    bind .chgmem.f0.val <Alt-Any-KeyPress> [bind .chgmem.f0.val <Any-KeyPress>]
    bind .chgmem.f0.val <Right> {
      %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
    }
    bind .chgmem.f0.val <Left> {
      %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
    }
    bind .chgmem.f0.val <Up> {%W icursor 0; %W view 0}
    bind .chgmem.f0.val <Down> {%W icursor end; tk_entrySeeCaret %W}
  } else {
    .chgmem.f0.val icursor 0
    bind .chgmem.f0.val <2> { }
    bind .chgmem.f0.val <B2-Motion> { }
    bind .chgmem.f0.val <B1-Motion> { }
    bind .chgmem.f0.val <Shift-1> { }
    bind .chgmem.f0.val <Shift-B1-Motion> { }
    bind .chgmem.f0.val <Control-d> { }
    bind .chgmem.f0.val <Control-u> { }
    bind .chgmem.f0.val <Control-v> { }
    bind .chgmem.f0.val <Delete> { }
    bind .chgmem.f0.val <1> {
      %W icursor [expr [%W index @%x] / 2 * 2]
      focus %W
    }
    bind .chgmem.f0.val <Down> {
      .chgmem.f0.val2 icursor [%W index insert]
      focus .chgmem.f0.val2
    }
    bind .chgmem.f0.val <Left> {
      if { [%W index insert] > 0 } {
	%W icursor [expr [%W index insert] - 2]
      }
    }
    bind .chgmem.f0.val <Right> {
      if { [%W index insert] < [expr [%W index end] - 2] } {
	%W icursor [expr [%W index insert] + 2]
      }
    }
    bind .chgmem.f0.val <BackSpace> [bind .chgmem.f0.val <Left>]
    bind .chgmem.f0.val <Control-a> {%W icursor 0}
    bind .chgmem.f0.val <Control-b> [bind .chgmem.f0.val <Left>]
    bind .chgmem.f0.val <Control-e> {%W icursor [expr [%W index end] - 2]}
    bind .chgmem.f0.val <Control-f> [bind .chgmem.f0.val <Right>]
    bind .chgmem.f0.val <Control-h> [bind .chgmem.f0.val <Left>]
    bind .chgmem.f0.val <Any-KeyPress> {
      if { "%A" != "" } {
        mem_change_char %A
      }
    }
    bind .chgmem.f0.val <Alt-Any-KeyPress> [bind .chgmem.f0.val <Any-KeyPress>]

    foreach defbind [bind Entry] {
      bind .chgmem.f0.val2 $defbind "[bind Entry $defbind]"
    }
    bind .chgmem.f0.val2 <2> { }
    bind .chgmem.f0.val2 <B2-Motion> { }
    bind .chgmem.f0.val2 <B1-Motion> { }
    bind .chgmem.f0.val2 <Shift-1> { }
    bind .chgmem.f0.val2 <Shift-B1-Motion> { }
    bind .chgmem.f0.val2 <Control-d> { }
    bind .chgmem.f0.val2 <Control-u> { }
    bind .chgmem.f0.val2 <Control-v> { }
    bind .chgmem.f0.val2 <Delete> { }
    bind .chgmem.f0.val2 <Tab> [bind .chgmem.f0.val <Tab>]
    bind .chgmem.f0.val2 <Return> [bind .chgmem.f0.val <Return>]
    bind .chgmem.f0.val2 <KP_Enter> [bind .chgmem.f0.val <KP_Enter>]
    bind .chgmem.f0.val2 <Control-c> [bind .chgmem.f0.val <Control-c>]
    bind .chgmem.f0.val2 <1> {
      %W icursor [%W index @%x]
      focus %W
    }
    bind .chgmem.f0.val2 <Up> {
      .chgmem.f0.val icursor \
	[expr [%W index insert]%%2==0 ? [%W index insert] : [%W index insert]-1]
      focus .chgmem.f0.val
    }
    bind .chgmem.f0.val2 <Left> {
      if { [%W index insert] > 0 } {
	%W icursor [expr [%W index insert] - 1]
      }
    }
    bind .chgmem.f0.val2 <Right> {
      if { [%W index insert] < [expr [%W index end] - 1] } {
	%W icursor [expr [%W index insert] + 1]
      }
    }
    bind .chgmem.f0.val2 <BackSpace> [bind .chgmem.f0.val2 <Left>]
    bind .chgmem.f0.val2 <Control-a> {%W icursor 0}
    bind .chgmem.f0.val2 <Control-b> [bind .chgmem.f0.val2 <Left>]
    bind .chgmem.f0.val2 <Control-e> {%W icursor [expr [%W index end] - 1]}
    bind .chgmem.f0.val2 <Control-f> [bind .chgmem.f0.val2 <Right>]
    bind .chgmem.f0.val2 <Control-h> [bind .chgmem.f0.val2 <Left>]
    bind .chgmem.f0.val2 <Any-KeyPress> {
      if { [string first "%A" "0123456789abcdefABCDEF"] != -1 } {
        mem_change_byte %A
      }
    }
    bind .chgmem.f0.val2 <Alt-Any-KeyPress> \
     [bind .chgmem.f0.val2 <Any-KeyPress>]
  }

  bind .chgmem <Visibility> {raise .chgmem; focus .chgmem.f0.val}
  bind .chgmem <FocusOut> {focus .chgmem.f0.val}

  wm geometry .chgmem +$xpos+$ypos
  wm deiconify .chgmem
  wm title .chgmem "Change memory contents"
  wm protocol .chgmem WM_TAKE_FOCUS {focus .chgmem.f0.val}
  tkwait visibility .chgmem
  raise .chgmem
  focus .chgmem.f0.val
  grab .chgmem
  while { 1 } {
    tkwait variable ChgmemReady
    if { $ChgmemReady == 0 } break
    if { [set val [.chgmem.f0.val get]] != "" } {
      if { $is_string == "no" } {
	$Tgdb_cmd(set) "$cmd = $val"
      } else {
	set bytes ""
	set values [.chgmem.f0.val2 get]
	set xaddr $addr
	set i 0
	while { 1 } {
	  if { [set byte [string range $values $i [expr $i + 1]]] == "" } break
	  append bytes ", *(unsigned char *)$addr = 0x$byte"
	  set addr [format "0x%08x" [expr $addr + 1]]
	  incr i 2
	}
	set result [do_dialog "printf $strformat$bytes" silent]
	if { ![cequal $result $values] && [string first $values $result] < 0} {
	  show_status $result steady
	} else {
	  catch {update_asm_window [lindex $AsmLines 0] new}
	  update_disp_window new
	  update_mem_window
	}
      }
      break
    } else bell
  }
  destroy .chgmem
  catch {.cpu.f0.lb select clear}
  catch {focus $old_focus(.chgmem)}
}
################################################################################
#
# create assembly dump window
#
################################################################################
proc create_assembly_window {} {
  global debugger WinSize WinPos WinProc AsmOpts bitmap_path colormodel

  proc toggle_asm_brk { w x y } {
    global Tgdb_cmd

    set lineno [int [$w index @$x,$y]]
    set line [$w get $lineno.0 "$lineno.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr] } {
      bell
      return
    }
    if { [lsearch -exact [$w tag names $lineno.0] brktag] != -1 } {
      $Tgdb_cmd(clear) "*$addr"
    } else {
      $Tgdb_cmd(break) "*$addr"
    }
  }

  proc set_asm_tbreak { w x y } {
    global Tgdb_cmd

    set lineno [int [$w index @$x,$y]]
    set line [$w get $lineno.0 "$lineno.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr] } {
      bell
      return
    }
    if { [expr2bpno "*$addr"] == "" } {
      if { [$Tgdb_cmd(tbreak) "*$addr"] } {
	$Tgdb_cmd(continue)
      }
    } else {
      $Tgdb_cmd(continue)
    }
  }

  proc fill_asm_cache { addr } {
    global AsmCache AsmCacheFirst AsmCacheLast

    set insns [split [do_dialog "disassemble $addr" silent] \n]
    lvarpop insns
    set len [expr [llength $insns] - 3]
    if { ![regexp {^(0x[0-9a-fA-F]+)} [lindex $insns 0] {} first] } {
      return 0
    }
    if { ![regexp {^(0x[0-9a-fA-F]+)} [lindex $insns $len] {} last]} {
      return 0
    }
    set insns [lrange $insns 0 $len]

    if { ![info exists AsmCache] } {
      set AsmCache $insns
      set AsmCacheFirst $first
      set AsmCacheLast $last
    } elseif { $last < $AsmCacheFirst } {
      set result [split [do_dialog "x/2i $last" silent] \n]
      if {   ![regexp {^(0x[0-9a-fA-F]+)} [lindex $result 1] {} edge]
	  || ($edge < $AsmCacheFirst) } {
        set AsmCache $insns
        set AsmCacheLast $last
      } else {
        append insns " $AsmCache"
        set AsmCache $insns
      }
      set AsmCacheFirst $first
    } elseif { $first > $AsmCacheLast } {
      set result [split [do_dialog "x/2i $AsmCacheLast" silent] \n]
      if {   ![regexp {^(0x[0-9a-fA-F]+)} [lindex $result 1] {} edge]
	  || ($edge <= $first) } {
        set AsmCache $insns
        set AsmCacheFirst $first
      } else {
        append AsmCache " $insns"
      }
      set AsmCacheLast $last
    }
    return 1
  }

  proc get_asm_cache { addr amount } {
    global AsmCache AsmCacheFirst AsmCacheLast

    if { ![info exists AsmCache] } {
      if { ![fill_asm_cache $addr] } {
	return ""
      }
    }
    if { ($addr < $AsmCacheFirst) || ($addr > $AsmCacheLast) } {
      if { ![fill_asm_cache $addr] } {
	return ""
      }
    }
    if { [set idx [lsearch -regexp $AsmCache "^$addr"]] == -1 } {
      return ""
    }
    loop i 0 $amount {
      if { [incr idx -1] < 0 } {
	set addr $AsmCacheFirst
	if { ![fill_asm_cache [expr $addr - 1]] } {
	  return ""
	}
	if { [set idx [lsearch -regexp $AsmCache "^$addr"]] == -1 } {
	  return ""
	}
	incr idx -1
      }
    }
    if { ![regexp {^(0x[0-9a-fA-F]+)} [lindex $AsmCache $idx] {} addr] } {
      return ""
    }
    return $addr
  }

  proc scroll_asmwin_up { amount } {
    global WinSize AsmOpts

    set w .asm.f1.txt
    set line [$w get 1.0 "1.0 lineend"]
    if { ![regexp {^(0x[0-9a-fA-F]+)} $line {} addr] } {
      bell
      return
    }
    if { $amount == "line" } {
      if { $AsmOpts(mode) == "fixed" } {
	set addr [expr $addr - $AsmOpts(size)]
	update_asm_window $addr new
	return
      }
      if { $AsmOpts(cache) } {
	if { [set start [get_asm_cache $addr 1]] != "" } {
	  update_asm_window $start new
	  return
	} else {
	  show_status "Instruction cache lookup failure."
	}
      }
      set start [expr $addr - $AsmOpts(size)]
      loop i 0 20 {
	set result [split [do_dialog "x/2i $start" silent] \n]
	if { [regexp {^(0x[0-9a-fA-F]+)} [lindex $result 0] {} a0] } {
	  if { [regexp {^(0x[0-9a-fA-F]+)} [lindex $result 1] {} a1] } {
	    if { $a1 <= $addr } {
	      update_asm_window $a0 new
	      break
	    }
	  }
	}
	incr start -$AsmOpts(size)
      }
    } else {
      set h [expr [winfo height $w] / $WinSize(.asm,y) - 1]
      if { ($AsmOpts(mode) == "variable") && $AsmOpts(cache) } {
	if { [set start [get_asm_cache $addr $h]] != "" } {
	  update_asm_window $start new
	  return
	} else {
	  show_status "Instruction cache lookup failure."
	}
      }
      set addr [expr $addr - $AsmOpts(size) * $h]
      update_asm_window $addr new
    }
  }

  proc asm_scroll { newpos } {
    global AsmLines

    # the scrollbar has spoken...
    if { [blt_busy hosts] != "" } {
      return
    }

    switch -- $newpos {
      2 { .asm.f1.scr set 9 3 2 4
	  update idletasks
	  scroll_asmwin_up line
	}
      1 { .asm.f1.scr set 9 3 0 2
	  update idletasks
	  scroll_asmwin_up page
	}
      5 { .asm.f1.scr set 9 3 6 8
	  update idletasks
          update_asm_window [lindex $AsmLines [expr [llength $AsmLines] -1]] new
	}
      4 { .asm.f1.scr set 9 3 4 6
	  update idletasks
          update_asm_window [lindex $AsmLines 1] new
	}
      default { .asm.f1.scr set 9 3 3 5 }
    }
    .asm.f1.scr set 9 3 3 5
    update idletasks
  }

  proc toggle_asm_status_line {} {
    global AsmOpts

    if { !$AsmOpts(status) } {
      catch {destroy .asm.f4}
    } else {
      frame .asm.f4 -relief raised -border 2
      entry .asm.f4.status
      foreach config [.f1.status configure] {
	set conf [lindex [.f1.status configure [lindex $config 0]] 4]
        if { $conf != "" } {
	  .asm.f4.status configure [lindex $config 0] $conf
	}
      }
      foreach bind .f1.status {
	bind .asm.f4.status <$bind> [bind .f1.status <$bind>]
      }
      pack .asm.f4.status -side left -fill x -expand 1 -anchor w
      pack after .asm.f1 .asm.f4 {top fillx}
    }
  }

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

  if { [winfo exists .asm] } {
    set geo [wm geometry .asm]
    wm withdraw .asm
    wm geometry .asm $geo
    wm deiconify .asm
    tkwait visibility .asm
    raise .asm
    focus .asm
    return
  }

  set WinProc(.asm) create_assembly_window
  catch {destroy .asm}
  toplevel .asm -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .asm
  if { ![info exists AsmOpts(size)] } {
    set AsmOpts(size) 1
    set AsmOpts(mode) variable
    set AsmOpts(cache) 1
    set AsmOpts(status) 0
  }
  frame .asm.f0 -relief raised -border 2
  frame .asm.f0.f -relief raised -border 2
  #-----------------------------------------------------------------------------
  menubutton .asm.f0.f.file -text {File } -relief flat -menu .asm.f0.f.file.m
  menu .asm.f0.f.file.m
  .asm.f0.f.file.m add command -label { Close window } \
    -command {.asm.f3.f0.dismiss invoke}
  .asm.f0.f.file.m add separator
  .asm.f0.f.file.m add command -label { Quit } -command {exit_tgdb}
  #-----------------------------------------------------------------------------
  menubutton .asm.f0.f.opt -text { Options } -relief flat -menu .asm.f0.f.opt.m
  menu .asm.f0.f.opt.m
  .asm.f0.f.opt.m add command -label { Minimal insn size is } -state disabled
  .asm.f0.f.opt.m add radiobutton -label { 1 byte } -variable AsmOpts(size) \
    -value 1
  .asm.f0.f.opt.m add radiobutton -label { 2 bytes } -variable AsmOpts(size) \
    -value 2
  .asm.f0.f.opt.m add radiobutton -label { 3 bytes } -variable AsmOpts(size) \
    -value 3
  .asm.f0.f.opt.m add radiobutton -label { 4 bytes } -variable AsmOpts(size) \
    -value 4
  .asm.f0.f.opt.m add radiobutton -label { 6 bytes } -variable AsmOpts(size) \
    -value 6
  .asm.f0.f.opt.m add radiobutton -label { 8 bytes } -variable AsmOpts(size) \
    -value 8
  .asm.f0.f.opt.m add command -label { Insn size is } -state disabled
  .asm.f0.f.opt.m add radiobutton -label { variable } -variable AsmOpts(mode) \
    -value variable
  .asm.f0.f.opt.m add radiobutton -label { fixed } -variable AsmOpts(mode) \
    -value fixed
  .asm.f0.f.opt.m add command -label { For scrolling upwards } -state disabled
  .asm.f0.f.opt.m add checkbutton -label { use insn cache } -onvalue 1 \
    -offvalue 0 -variable AsmOpts(cache)
  .asm.f0.f.opt.m add separator
  .asm.f0.f.opt.m add checkbutton -label { Show status line } -onvalue 1 \
    -offvalue 0 -variable AsmOpts(status) -command toggle_asm_status_line
  #-----------------------------------------------------------------------------
  menubutton .asm.f0.f.run -text { Running } -relief flat -menu .asm.f0.f.run.m
  menu .asm.f0.f.run.m
  .asm.f0.f.run.m add command -label { Run / restart program } \
    -accelerator {Alt-z} -command {$Tgdb_cmd(run)}
  .asm.f0.f.run.m add command -label { Continue } -command {$Tgdb_cmd(continue)}
  .asm.f0.f.run.m add command -label { Next instruction } \
    -command {$Tgdb_cmd(nexti)}
  .asm.f0.f.run.m add command -label { Step instruction } \
    -command {$Tgdb_cmd(stepi)}
  .asm.f0.f.run.m add command -label { Finish } \
    -command {$Tgdb_cmd(finish)}
  .asm.f0.f.run.m add command -label { Return } \
    -command {$Tgdb_cmd(return)}
  #-----------------------------------------------------------------------------
  menubutton .asm.f0.f.win -text { Windows } -relief flat -menu .asm.f0.f.win.m
  menu .asm.f0.f.win.m
  .asm.f0.f.win.m add command -label { Tgdb } -accelerator {Alt-t} \
    -command {raise_main_window}
  if { $debugger != "gdb166" } {
    .asm.f0.f.win.m add command -label { Program (debugee) } \
       -accelerator {Alt-p} -command {raise_debug_window}
  }
  .asm.f0.f.win.m add command -label { Stack } -accelerator {Alt-s} \
    -command {create_stack_window}
  .asm.f0.f.win.m add command -label { CPU registers } -accelerator {Alt-r} \
    -command {create_cpu_window}
  .asm.f0.f.win.m add command -label { Watches } -accelerator {Alt-w} \
    -command {create_disp_window}
  .asm.f0.f.win.m add command -label { Memory dump } -accelerator {Alt-d} \
    -command {create_memory_window}
  .asm.f0.f.win.m add command -label { Assembly dump } -accelerator {Alt-a} \
    -command {create_assembly_window}
  .asm.f0.f.win.m add command -label { Xterm (shell) } -accelerator {Alt-x} \
    -command {create_shell_window}
  .asm.f0.f.win.m add separator
  .asm.f0.f.win.m add command -label { Cycle windows } -accelerator {Alt-c} \
    -command {toggle_windows}
  #-----------------------------------------------------------------------------
  menubutton .asm.f0.f.help -text { Help} -relief flat -menu .asm.f0.f.help.m
  menu .asm.f0.f.help.m
  .asm.f0.f.help.m add command -label { About tgdb } -accelerator {Alt-i} \
    -command help_about
  .asm.f0.f.help.m add command -label { About HighTec } \
    -command help_about_hightec
  .asm.f0.f.help.m add command -label { tgdb } -accelerator {Alt-h} \
    -command create_tgdb_help_window
  .asm.f0.f.help.m add command -label { gdb commands } -command show_help
  #-----------------------------------------------------------------------------

  frame .asm.f1 -relief flat
  text .asm.f1.txt -setgrid 1 -state disabled -exportselection 1 \
    -cursor top_left_arrow -wrap none
  if { $colormodel == "color" } {
    .asm.f1.txt tag configure brktag -background red
  } else {
    .asm.f1.txt tag configure brktag -foreground white -background black
  }
  .asm.f1.txt tag lower brktag
  if { $colormodel == "color" } {
    .asm.f1.txt tag configure mytag -background green
  } else {
    .asm.f1.txt tag configure mytag -foreground white -background black
  }
  .asm.f1.txt tag lower mytag sel
  .asm.f1.txt tag raise mytag brktag
  scrollbar .asm.f1.scr -orient vertical -command {asm_scroll}
  .asm.f1.scr configure -relief [lindex [.f3.scroll configure -relief] 4]
  .asm.f1.scr configure -width [lindex [.f3.scroll configure -width] 4]
  .asm.f1.scr set 9 3 3 5

  frame .asm.f2 -relief raised -border 2
  button .asm.f2.list_d -bitmap @$bitmap_path/list_d.xbm -command {
    if { [get_selection] == "" } {
      bell
      show_status "No selection."
    } else {
      update_asm_window "[get_selection]" new
    }
  }
  button .asm.f2.list_l -bitmap @$bitmap_path/list_l.xbm -command {
    asm_scroll 1
  }
  button .asm.f2.list_lp -bitmap @$bitmap_path/list_lp.xbm -command {
    asm_scroll 2
  }
  .asm.f2.list_lp configure -foreground [lindex [.f4.list configure -fore] 4]
  .asm.f2.list_lp configure -background [lindex [.f4.list configure -back] 4]
  button .asm.f2.list_n -bitmap @$bitmap_path/list_n.xbm -command {
    if { ![info exists AsmLines] } {
      bell
    } else {
      asm_scroll 4
    }
  }
  .asm.f2.list_n configure -foreground [lindex [.f4.list configure -fore] 4]
  .asm.f2.list_n configure -background [lindex [.f4.list configure -back] 4]
  button .asm.f2.list_np -bitmap @$bitmap_path/list_np.xbm -command {
    if { ![info exists AsmLines] } {
      bell
    } else {
      asm_scroll 5
    }
  }
  .asm.f2.list_np configure -foreground [lindex [.f4.list configure -fore] 4]
  .asm.f2.list_np configure -background [lindex [.f4.list configure -back] 4]
  button .asm.f2.frame_dn -bitmap @$bitmap_path/frame_dn.xbm \
    -command {sel_frame down}
  button .asm.f2.frame_0 -bitmap @$bitmap_path/frame_0.xbm \
    -command {sel_frame frame 0}
  button .asm.f2.frame_up -bitmap @$bitmap_path/frame_up.xbm \
    -command {sel_frame up}
  button .asm.f2.cont -bitmap @$bitmap_path/cont.xbm \
    -command { $Tgdb_cmd(continue) }
  button .asm.f2.next -bitmap @$bitmap_path/next.xbm \
    -command { $Tgdb_cmd(nexti) }
  button .asm.f2.step -bitmap @$bitmap_path/step.xbm \
    -command { $Tgdb_cmd(stepi) }
  button .asm.f2.finish -bitmap @$bitmap_path/finish.xbm \
    -command { $Tgdb_cmd(finish) }
  button .asm.f2.break -bitmap @$bitmap_path/break.xbm -command {
    if { [get_selection] == "" } {
      show_status "No selection." steady
    } else {
      $Tgdb_cmd(break) [get_selection]
    }
  }
  foreach but [winfo children .asm.f2] {
    set base [file extension $but]
    if { [winfo exists .f4$base] } {
      $but configure -foreground [lindex [.f4$base configure -foreground] 4]
      $but configure -background [lindex [.f4$base configure -background] 4]
    }
    $but configure -activeforeground [lindex [$but configure -background] 4]
    $but configure -activebackground [lindex [$but configure -foreground] 4]
  }

  frame .asm.f3 -relief raised -border 4
  frame .asm.f3.f0 -relief sunken -border 1
  button .asm.f3.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {set WinPos(.asm) [wm geometry .asm]; destroy .asm}
  frame .asm.f3.f1 -relief flat -border 1
  button .asm.f3.f1.update -reli raised -border 2 -text "  Update  " -command {
    if { [lindex [.asm.f3.f1 configure -relief] 4] != "sunken" } {
      focus .asm
      .asm.f3.f0 configure -relief flat
      .asm.f3.f1 configure -relief sunken
      .asm.f3.f2 configure -relief flat
    }
    if { [info exists AsmLines] } {
      update_asm_window [lindex $AsmLines 0] new
    }
  }
  label .asm.f3.lbl -text "Disassemble from: "
  frame .asm.f3.f2 -relief flat -border 1
  entry .asm.f3.f2.val -relief sunken -exportselection 0

  pack append .asm .asm.f0 {top fillx}
  pack append .asm.f0.f \
    .asm.f0.f.file left \
    .asm.f0.f.opt left \
    .asm.f0.f.run left \
    .asm.f0.f.win left \
    .asm.f0.f.help right

  pack .asm.f0.f -side top -fill x
  pack .asm.f0 -side top -fill x
  pack .asm.f1.txt -side left -fill both -expand 1
  pack .asm.f1.scr -side right -fill y
  pack .asm.f1 -side top -fill both -expand 1
  toggle_asm_status_line

  pack .asm.f2.list_d -side left
  pack .asm.f2.list_l -side left
  pack .asm.f2.list_lp -side left
  pack .asm.f2.list_n -side left
  pack .asm.f2.list_np -side left
  pack .asm.f2.frame_dn -side left
  pack .asm.f2.frame_0 -side left
  pack .asm.f2.frame_up -side left
  pack .asm.f2.cont -side left
  pack .asm.f2.next -side left
  pack .asm.f2.step -side left
  pack .asm.f2.finish -side left
  pack .asm.f2.break -side left -expand 1 -fill x -anchor c
  pack .asm.f2 -side top -fill x

  pack .asm.f3.f0.dismiss -padx 6 -pady 6
  pack .asm.f3.f0 -side right -padx 10 -pady 4
  pack .asm.f3.f1.update -padx 6 -pady 6
  pack .asm.f3.f1 -side right -padx 10 -pady 4
  pack .asm.f3.lbl -side left -fill x
  pack .asm.f3.f2.val -side left -padx 6 -pady 6 -fill x -expand 1
  pack .asm.f3.f2 -side left -padx 2 -pady 2 -fill x -expand 1
  pack .asm.f3 -side top -fill x

  tk_menuBar .asm.f0.f \
    .asm.f0.f.file \
    .asm.f0.f.opt \
    .asm.f0.f.run \
    .asm.f0.f.win \
    .asm.f0.f.help

  bind .asm.f1.txt <2> { }
  bind .asm.f1.txt <B2-Motion> { }
  bind .asm.f1.txt <3> {toggle_asm_brk %W %x %y}
  bind .asm.f1.txt <Control-1> {set_asm_tbreak %W %x %y}

  foreach but [winfo children .asm.f2] {
    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 .asm.f2.list_d <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "List disassembly starting at selected expression."}}
  bind .asm.f2.list_l <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Scroll up one page of instructions."}}
  bind .asm.f2.list_lp <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Scroll up one instruction."}}
  bind .asm.f2.list_n <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Scroll down one instruction."}}
  bind .asm.f2.list_np <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Scroll down one page of instructions."}}
  bind .asm.f2.frame_dn <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Select frame called by this one (go down one frame)."}}
  bind .asm.f2.frame_0 <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Select innermost (bottom) frame."}}
  bind .asm.f2.frame_up <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Select frame that called this one (go up one frame)."}}
  bind .asm.f2.finish <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Continue until selected frame returns (finishes)."}}
  bind .asm.f2.cont <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Continue program execution."}}
  bind .asm.f2.next <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Execute one instruction, skip function calls."}}
  bind .asm.f2.step <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Execute one instruction, follow function calls."}}
  bind .asm.f2.break <Any-Enter> {+if { !$Tgdb_busy && !$FreezeStatus } {
    set TextStatus "Set breakpoint at selected expression."}}

  foreach defbind [bind Entry] {
    bind .asm.f3.f2.val $defbind "[bind Entry $defbind]"
  }
  bind .asm.f3.f2.val <Right> {
    %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
  }
  bind .asm.f3.f2.val <Left> {
    %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
  }
  bind .asm.f3.f2.val <Up> {%W icursor 0; %W view 0}
  bind .asm.f3.f2.val <Down> {%W icursor end; tk_entrySeeCaret %W}
  bind .asm.f3.f2.val <Return> {
    .asm.f3.f2 configure -relief flat
    .asm.f3.f0 configure -relief sunken
    focus .asm
    update_asm_window [%W get] new
  }
  bind .asm.f3.f2.val <Double-1> [bind .asm.f3.f2.val <Return>]
  bind .asm.f3.f2.val <KP_Enter> [bind .asm.f3.f2.val <Return>]
  bind .asm.f3.f2.val <Tab> {
    .asm.f3.f1 configure -relief sunken
    focus .asm
  }
  bind .asm.f3.f2.val <Shift-Tab> {
    .asm.f3.f0 configure -relief sunken
    focus .asm
  }
  bind .asm.f3.f2.val <FocusOut> {
    .asm.f3.f2 configure -relief flat
    if { [lindex [.asm.f3.f1 configure -relief] 4] == "sunken" } {
      .asm.f3.f0 configure -relief flat
    } else {
      .asm.f3.f0 configure -relief sunken
    }
  }
  bind .asm.f3.f2.val <1> {
    .asm.f3.f0 configure -relief flat
    .asm.f3.f1 configure -relief flat
    .asm.f3.f2 configure -relief sunken
    focus .asm.f3.f2.val
    .asm.f3.f2.val icursor @%x
  }
  bind .asm.f3.f2.val <B1-Motion> { }
  bind .asm.f3.f2.val <Shift-1> { }
  bind .asm.f3.f2.val <Shift-B1-Motion> { }
  bind .asm.f3.f2.val <3> {
    if { [get_selection] == "" } {
      bell
      show_status "No selection."
    } else {
      %W delete 0 end
      %W insert 0 [selection get]
      %W icursor end
      tk_entrySeeCaret %W
    }
  }
  bind .asm.f3.f2.val <Control-a> [bind .asm.f3.f2.val <Up>]
  bind .asm.f3.f2.val <Control-b> [bind .asm.f3.f2.val <Left>]
  bind .asm.f3.f2.val <Control-d> { }
  bind .asm.f3.f2.val <Control-e> [bind .asm.f3.f2.val <Down>]
  bind .asm.f3.f2.val <Control-f> [bind .asm.f3.f2.val <Right>]
  bind .asm.f3.f2.val <Control-k> {%W delete insert end}
  bind .asm.f3.f2.val <Control-v> { }
  bind .asm.f3.f2.val <Control-w> [bind .asm.f3.f2.val <3>]
  bind .asm.f3.f2.val <Escape> {%W delete 0 end}
  bind .asm.f3.f2.val <Any-KeyPress> {
    if { "%A" != "" } {
      %W insert insert %A
      tk_entrySeeCaret %W
    }
  }
  bind .asm.f3.f2.val <Alt-Any-KeyPress> [bind .asm.f3.f2.val <Any-KeyPress>]

  bind .asm <Key-F10> [bind Entry <Key-F10>]
  bind .asm <Tab> {
    if { [lindex [.asm.f3.f0 configure -relief] 4] == "sunken" } {
      .asm.f3.f0 configure -relief flat
      .asm.f3.f2 configure -relief sunken
      focus .asm.f3.f2.val
    } else {
      .asm.f3.f0 configure -relief sunken
      .asm.f3.f1 configure -relief flat
    }
  }
  bind .asm <Shift-Tab> {
    if { [lindex [.asm.f3.f0 configure -relief] 4] == "sunken" } {
      .asm.f3.f0 configure -relief flat
      .asm.f3.f1 configure -relief sunken
    } else {
      .asm.f3.f1 configure -relief flat
      .asm.f3.f2 configure -relief sunken
      focus .asm.f3.f2.val
    }
  }
  bind .asm <Return> {
    if { [lindex [.asm.f3.f0 configure -relief] 4] == "sunken" } {
      .asm.f3.f0.dismiss invoke
    } else {
      .asm.f3.f1.update invoke
    }
  }
  bind .asm <KP_Enter> [bind .asm <Return>]
  bind .asm <Shift-Up> {.asm.f2.list_l invoke}
  bind .asm <Shift-Left> [bind .asm <Shift-Up>]
  bind .asm <Up> {.asm.f2.list_lp invoke}
  bind .asm <Left> [bind .asm <Up>]
  bind .asm <Down> {.asm.f2.list_n invoke}
  bind .asm <Right> [bind .asm <Down>]
  bind .asm <Shift-Down> {.asm.f2.list_np invoke}
  bind .asm <Shift-Right> [bind .asm <Shift-Down>]
  bind .asm <Visibility> {check_visibility %W}
  bind .asm <Control-c> {bell}
  bind .asm <Configure> {
    if { [string first .asm [focus]] == 0 } {
      .asm.f3.f1.update invoke
    }
  }

  if { [catch {wm geometry .asm $WinPos(.asm)}] } {
    wm geometry .asm +10+300
  }
  set WinPos(.asm) [wm geometry .asm]
  wm deiconify .asm
  wm title .asm "Tgdb assembly dump window"
  wm minsize .asm 30 5
  wm protocol .asm WM_TAKE_FOCUS {focus .asm}
  wm protocol .asm WM_DELETE_WINDOW {.asm.f3.f0.dismiss invoke}
  tkwait visibility .asm
  raise .asm
  update
  set w [lindex [.asm.f1.txt configure -width] 4]
  set h [lindex [.asm.f1.txt configure -height] 4]
  set WinSize(.asm,x) [expr [winfo width .asm.f1.txt] / $w]
  set WinSize(.asm,y) [expr [winfo height .asm.f1.txt] / $h]
  update_asm_bpts
  .asm.f3.f2.val insert 0 "\$pc"
  update_asm_window "\$pc" new
  focus .asm
}
################################################################################
#
# create cpu window
#
################################################################################
proc create_cpu_window {} {
  global debugger WinSize WinPos WinProc

  if { [winfo exists .cpu] } {
    set geo [wm geometry .cpu]
    wm withdraw .cpu
    wm geometry .cpu $geo
    wm deiconify .cpu
    tkwait visibility .cpu
    raise .cpu
    focus .cpu
    return
  }

  set WinProc(.cpu) create_cpu_window
  catch { destroy .cpu }
  toplevel .cpu -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .cpu
  frame .cpu.f0 -relief groove -borderwidth 4
  listbox .cpu.f0.lb -setgrid 1 -exportselection 0 \
    -yscrollcommand {.cpu.f0.scr set}
  scrollbar .cpu.f0.scr -orient vertical -command {.cpu.f0.lb yview}
  frame .cpu.f1 -relief groove -borderwidth 4
  frame .cpu.f1.f0 -relief sunken -border 1
  button .cpu.f1.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {set WinPos(.cpu) [wm geometry .cpu]; destroy .cpu}
  frame .cpu.f1.f1 -relief flat -border 1
  button .cpu.f1.f1.update -relief raised -border 2 -text "  Update  " \
    -command {update_cpu_window}

  pack .cpu.f0.lb -side left -fill both -expand 1
  pack .cpu.f0.scr -side right -fill y
  pack .cpu.f1.f0.dismiss -expand 1 -padx 6 -pady 6
  pack .cpu.f1.f0 -side right -padx 10 -pady 10
  pack .cpu.f1.f1.update -expand 1 -padx 6 -pady 6
  pack .cpu.f1.f1 -side right -padx 10 -pady 10
  pack .cpu.f0 -side top -fill both -expand 1
  pack .cpu.f1 -side top -fill x

  bind .cpu <Tab> {
    if { [lindex [.cpu.f1.f0 configure -relief] 4] == "sunken" } {
      .cpu.f1.f0 configure -relief flat
      .cpu.f1.f1 configure -relief sunken
    } else {
      .cpu.f1.f0 configure -relief sunken
      .cpu.f1.f1 configure -relief flat
    }
  }
  bind .cpu <Return> {
    if { [lindex [.cpu.f1.f0 configure -relief] 4] == "sunken" } {
      .cpu.f1.f0.dismiss invoke
    } else {
      .cpu.f1.f1.update invoke
    }
  }
  bind .cpu <KP_Enter> [bind .cpu <Return>]
  bind .cpu <Control-c> {.cpu.f1.f0.dismiss invoke}
  bind .cpu.f0.lb <Button-1> { }
  bind .cpu.f0.lb <Shift-B1-Motion> { }
  bind .cpu.f0.lb <Shift-Button-1> { }
  bind .cpu.f0.lb <B1-Motion> { }
  bind .cpu.f0.lb <Double-1> [bind Listbox <Button-1>]
  bind .cpu.f0.lb <Double-1> {+
    if { [%W curselection] != "" } {
      change_register [%W get [%W curselection]] \
	[winfo rootx %W] [expr %Y + $WinSize(.cpu,y)]
    }
  }
  bind .cpu <Visibility> {check_visibility %W}

  if { [catch {wm geometry .cpu $WinPos(.cpu)}] } {
    wm geometry .cpu +460+85
  }
  set WinPos(.cpu) [wm geometry .cpu]
  wm minsize .cpu 12 10
  wm deiconify .cpu
  wm title .cpu "Tgdb cpu window"
  wm protocol .cpu WM_TAKE_FOCUS {focus .cpu}
  wm protocol .cpu WM_DELETE_WINDOW {.cpu.f1.f0.dismiss invoke}
  tkwait visibility .cpu
  raise .cpu
  update
  scan [lindex [.cpu.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.cpu,x) [expr [winfo width .cpu.f0.lb] / $w]
  set WinSize(.cpu,y) [expr [winfo height .cpu.f0.lb] / $h]
  update_cpu_window
  focus .cpu
}
################################################################################
#
# open a dialog box for changing a register's contents
#
################################################################################
proc change_register { old_contents xpos ypos } {
  global Tgdb_cmd ChgregReady old_focus

  set regnam [lindex $old_contents 0]
  set regval [lindex $old_contents 1]
  set old_focus(.chgreg) [focus]
  catch { destroy .chgreg }
  toplevel .chgreg -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .chgreg

  frame .chgreg.f0 -relief groove -borderwidth 4
  label .chgreg.f0.l0 -text "  Change contents of register \"$regnam\":  "
  entry .chgreg.f0.val -width 25 -relief sunken -exportselection 0
  .chgreg.f0.val insert 0 $regval

  frame .chgreg.f1 -relief groove -borderwidth 4
  frame .chgreg.f1.f0 -relief sunken -border 1
  button .chgreg.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {set ChgregReady 1}
  frame .chgreg.f1.f1 -relief flat -border 1
  button .chgreg.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set ChgregReady 0}

  pack .chgreg.f0.l0
  pack .chgreg.f0.val -pady 6
  pack .chgreg.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .chgreg.f1.f0 -side right -padx 10 -pady 10
  pack .chgreg.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .chgreg.f1.f1 -side right -padx 10 -pady 10
  pack .chgreg.f0 -side top -fill both -expand 1
  pack .chgreg.f1 -side top -fill x

  foreach defbind [bind Entry] {
    bind .chgreg.f0.val $defbind "[bind Entry $defbind]"
  }
  bind .chgreg.f0.val <B1-Motion> { }
  bind .chgreg.f0.val <Shift-1> { }
  bind .chgreg.f0.val <Shift-B1-Motion> { }
  bind .chgreg.f0.val <Control-d> {%W delete insert}
  bind .chgreg.f0.val <Control-v> {%W delete insert end}
  bind .chgreg.f0.val <Control-w> { }
  bind .chgreg.f0.val <Escape> {%W delete 0 end}
  bind .chgreg.f0.val <Tab> {
    if { [lindex [.chgreg.f1.f0 configure -relief] 4] == "sunken" } {
      .chgreg.f1.f0 configure -relief flat
      .chgreg.f1.f1 configure -relief sunken
    } else {
      .chgreg.f1.f0 configure -relief sunken
      .chgreg.f1.f1 configure -relief flat
    }
  }
  bind .chgreg.f0.val <Return> {
    if { [lindex [.chgreg.f1.f0 configure -relief] 4] == "sunken" } {
      .chgreg.f1.f0.ok invoke
    } else {
      .chgreg.f1.f1.cancel invoke
    }
  }
  bind .chgreg.f0.val <KP_Enter> [bind .chgreg.f0.val <Return>]
  bind .chgreg.f0.val <Control-c> {.chgreg.f1.f1.cancel invoke}
  bind .chgreg.f0.val <Any-KeyPress> {
    if { "%A" != "" } {
      %W insert insert %A
      tk_entrySeeCaret %W
    }
  }
  bind .chgreg.f0.val <Alt-Any-KeyPress> [bind .chgreg.f0.val <Any-KeyPress>]
  bind .chgreg.f0.val <Right> {
    %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
  }
  bind .chgreg.f0.val <Left> {
    %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
  }
  bind .chgreg.f0.val <Up> {%W icursor 0; %W view 0}
  bind .chgreg.f0.val <Down> {%W icursor end; tk_entrySeeCaret %W}

  bind .chgreg <Visibility> {raise .chgreg; focus .chgreg.f0.val}
  bind .chgreg <FocusOut> {focus .chgreg.f0.val}

  wm geometry .chgreg +$xpos+$ypos
  wm deiconify .chgreg
  wm title .chgreg "Change register contents"
  wm protocol .chgreg WM_TAKE_FOCUS {focus .chgreg.f0.val}
  tkwait visibility .chgreg
  raise .chgreg
  focus .chgreg.f0.val
  grab .chgreg
  while { 1 } {
    tkwait variable ChgregReady
    if { $ChgregReady == 0 } break
    if { [set val [.chgreg.f0.val get]] != "" } {
      $Tgdb_cmd(set) "\$$regnam=$val"
      break
    } else bell
  }
  destroy .chgreg
  catch {.cpu.f0.lb select clear}
  catch {focus $old_focus(.chgreg)}
}
################################################################################
#
# create a xterm/shell window
#
################################################################################
proc create_shell_window { {shell_cmd ""} } {
  global WinPos WinProc

  proc strconv { str } {
    if { ![regexp "<|>" $str] } {
      return "$str<Return>"
    }
    loop i 0 [clength $str] {
      set char [cindex $str $i]
      if { $char == "<" } {
	append nstr "<less>"
      } elseif { $char == ">" } {
	append nstr "<greater>"
      } else {
	append nstr $char
      }
    }
    return "$nstr<Return>"
  }

  if { [winfo exists .shell] } {
    set shell_xid [lindex [.shell.f0.xterm configure -windowid] 4]
    if { [catch {xaccess xwinchilds -windowid $shell_xid}] } {
      catch {set WinPos(.shell) [wm geometry .shell]}
      catch {destroy .shell}
      update
      create_shell_window $shell_cmd
      return
    }
    set geo [wm geometry .shell]
    wm withdraw .shell
    wm geometry .shell $geo
    wm deiconify .shell
    tkwait visibility .shell
    raise .shell
    focus .shell
    if { $shell_cmd != "" } {
      .shell.f0.xterm sendstring [strconv $shell_cmd]
    }
    return
  }

  show_status "Loading xterm..." steady
  update idletasks
  set WinProc(.shell) create_shell_window
  catch {destroy .shell}
  toplevel .shell -cursor top_left_arrow
  wm withdraw .shell
  frame .shell.f0 -relief sunken -border 4
  if { [catch {set shlfont [option get .shell.f0 font Font]}] } {
    set shlfont ""
  } elseif { $shlfont != "" } {
    set shlfont "-fn $shlfont"
  }
  if { [catch {set shlcolor [option get .shell.f0 foreground Foreground]}] } {
    set shlcolor ""
  } elseif { $shlcolor != "" } {
    set shlcolor "-xrm xterm*foreground:$shlcolor"
  }
  tksteal .shell.f0.xterm \
    -command "xterm -iconic #+10000+10000 -title Tgdbshell \
      -xrm xterm*allowSendEvents:true $shlcolor $shlfont \
      -j -ls +si -vb -sl 100 -sk \
      -xrm xterm*background:bisque1 -geometry 200x100+0+0" \
    -width 80 -height 25 -name Tgdbshell

  frame .shell.f1 -relief sunken -border 4
  frame .shell.f1.f0 -relief sunken -border 1
  button .shell.f1.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {set WinPos(.shell) [wm geometry .shell]; destroy .shell}

  pack .shell.f1.f0.dismiss -fill x -expand 1 -padx 6 -pady 6
  pack .shell.f1.f0 -side bottom -fill x -expand 1
  pack .shell.f0 -side top -fill both -expand 1
  pack .shell.f0.xterm -in .shell.f0 -expand 1 -fill both
  pack .shell.f1 -side bottom -fill x -expand 1

  if { [catch {wm geometry .shell $WinPos(.shell)}] } {
    wm geometry .shell +0+0
  }
  set WinPos(.shell) [wm geometry .shell]
  wm deiconify .shell
  wm title .shell "Tgdb shell window"
  wm minsize .shell 1 1
  wm protocol .shell WM_TAKE_FOCUS {focus .shell.f0.xterm}
  tkwait visibility .shell
  raise .shell
  focus .shell.f0.xterm
  if { $shell_cmd != "" } {
    after 2500 ".shell.f0.xterm sendstring [strconv $shell_cmd]"
  }
  show_status ""
}
################################################################################
#
# create a mini text editor for defining and documenting user commands, or
# attaching commands to a given breakpoint -- this sounds like fun, but
# indeed it is surprisingly hard to do...
#
################################################################################
proc do_edit { what {arg ""} } {
  global debugger old_focus gdb_class gdb_cmd EditCmd EditReady Tgdb_interactive

  proc edit_check { cmd arg {fill yes} } {
    global debugger gdb_class gdb_cmd Tgdb_interactive

    if { $cmd == "define" } {
      if { $arg == "" } {
	if { !$Tgdb_interactive && ![winfo exists .edit] } {
	  return 1
	}
	if { [winfo exists .edit] } {
	  show_status "No command name specified."
	} else {
	  append_to_gdbwin "Argument required (name of command to define).\n"
	}
	return 0
      }
      if { $debugger == "gdb166" } {
        set result [do_dialog "list %-$arg" silent]
	regsub -all {[ ]*[0-9]+: } $result "" result
      } else {
        set result [do_dialog "show user $arg" silent]
      }
      if { ![regexp "^Undefined command:" $result] } {
        if {   [regexp "^Not a user command." $result]
	    || [regexp "^That is not a user-defined command." $result] } {
	  if { [info exists gdb_cmd($arg)] } {
            show_status "Command \"$arg\" is built-in." 4000
	  }
        } elseif { $fill == "yes" } {
          if { $debugger != "gdb166" } {
	    set result [crange $result [string first "\n" $result]+1 end]
	    set result [crange $result 0 end-1]
	  }
	  .edit.f2.text delete 1.0 end
          .edit.f2.text insert 1.0 $result
          .edit.f2.text yview 0
	}
      }
      return 1
    } elseif { $cmd == "document" } {
      if { $arg == "" } {
	if { !$Tgdb_interactive && ![winfo exists .edit] } {
	  return 1
	}
	if { [winfo exists .edit] } {
	  show_status "No command name specified."
	} else {
	  append_to_gdbwin "Argument required (name of command to document).\n"
	}
	return 0
      }
      catch {foreach cmd $gdb_class(user) { catch {unset gdb_cmd($cmd)} }}
      catch {unset gdb_class(user)}
      find_gdb_cmds "user" "user"
      set dummy $arg
      expand_cmd dummy dummy2
      if {   ![info exists gdb_class(user)]
	  || ([lsearch -exact $gdb_class(user) $dummy] == -1) } {
        if { [info exists gdb_cmd($arg)] } {
	  set msg "Command \"$dummy\" is built-in."
        } else {
	  set msg "Undefined command: \"$arg\"."
        }
        if { [winfo exists .edit] } {
	  show_status $msg
        } else {
	  append_to_gdbwin "$msg\n"
        }
        return 0
      }
      if { $fill == "yes" } {
	.edit.f2.text delete 1.0 end
	.edit.f2.text insert 1.0 $gdb_cmd($dummy)
	.edit.f2.text yview 0
	.edit.f0.title.f.val delete 0 end
	.edit.f0.title.f.val insert 0 $dummy
      }
      return 1
    } elseif { $cmd == "commands" } {
      if { [set bpcmds [find_bpt_cmds arg]] == "false" } {
	if { !$Tgdb_interactive && ![winfo exists .edit] } {
	  return 1
	}
        if { $Tgdb_interactive && ![winfo exists .edit]} {
	  append_to_gdbwin "No breakpoint number \"$arg\".\n"
        } else {
	  show_status "No breakpoint number \"$arg\"."
        }
 	return 0
      }
      if { $fill == "yes" } {
	.edit.f2.text delete 1.0 end
	.edit.f2.text insert 1.0 $bpcmds
	.edit.f2.text yview 0
	.edit.f0.title.f.val delete 0 end
	.edit.f0.title.f.val insert 0 $arg
      }
      return 1
    } 
  }

  proc edit_dialog { cmd arg val } {
    global Tgdb_busy Tgdb_interactive prompt gdb_class gdb_cmd

    set Tgdb_busy 1
    busy_create
    set first 1
    set sent 0
    set say_what ""
    append say_what $cmd " " $arg
    regsub -all "\t" $say_what " " say_what
    if { [crange $val end end] == "\n" } {
      append val "end"
    } else {
      append val "\nend"
    }
    regsub -all "\t" $val " " val
    regsub -all "\n" $val "\r" val
    exp_send "$say_what\r"
    expect {
      -re "\[^\n\]*\n" {
        regsub -all "\r|" $expect_out(buffer) "" expect_out(buffer)
        if { $first } {
	  set first 0
	  set expect_out(buffer) [string range $expect_out(buffer) \
	    [expr [string first "\n" $expect_out(buffer)] + 1] end]
	} else {
	  if { ![string first "End with a line saying just \"end\"." \
	       $expect_out(buffer)] } {
	    if { !$sent } {
	      exp_send "$val\r"
	      set sent 1
	    }
          }
	}
	exp_continue
      }
      "? (y or n) " {
        if { [yes_no_box "$expect_out(buffer)"] } {
	  exp_send "y\r$val\r"
	  set sent 1
	  exp_continue
	} else {
	  exp_send "n\r"
	  expect $prompt
	}
      }
      "$prompt" {
      }
      eof {
	exit_tgdb
      }
    }

    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}
    if { $sent && ($cmd == "define") } {
      catch {foreach cmd $gdb_class(user) { catch {unset gdb_cmd($cmd)} }}
      catch {unset gdb_class(user)}
      find_gdb_cmds "user" "user"
    }
  }

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

  if { [edit_check $what $arg no] == 0 } {
    return
  }

  set old_focus(.edit) [focus]
  focus none
  set EditCmd $what
  catch { destroy .edit }
  toplevel .edit -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm transient .edit .
  wm withdraw .edit

  frame .edit.f0 -relief groove -borderwidth 4
  frame .edit.f0.title
  label .edit.f0.title.l0
  label .edit.f0.title.l1 -text ". Don't type the \"end\" line!"
  frame .edit.f0.title.f -relief flat -border 1
  entry .edit.f0.title.f.val -relief sunken -exportselection 0
  switch $what {
    commands { .edit.f0.title.l0 configure -text \
	         "Enter commands for breakpoint"
               .edit.f0.title.f.val configure -width 4
	     }
    define   { .edit.f0.title.l0 configure -text \
		 "Define user command"
               .edit.f0.title.f.val configure -width 15
	     }
    document { .edit.f0.title.l0 configure -text \
		 "Document user command"
               .edit.f0.title.f.val configure -width 15
	     }
  }
  .edit.f0.title.f.val insert 0 $arg

  frame .edit.f2
  text .edit.f2.text -exportselection 0 -setgrid 1 \
    -yscrollcommand {.edit.f2.scr set}
  scrollbar .edit.f2.scr -orient vertical -command {.edit.f2.text yview}

  frame .edit.f1 -relief groove -borderwidth 4
  frame .edit.f1.f0 -relief flat -border 1
  button .edit.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {set EditReady 1}
  frame .edit.f1.f1 -relief flat -border 1
  button .edit.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set EditReady 0}
  frame .edit.f1.f2 -relief flat -border 1
  button .edit.f1.f2.clear -relief raised -border 2 -text "  Clear  " -command {
    if { [.edit.f2.text index end] != "1.0" } {
      if { [yes_no_box "Clear text window?"] } {
        .edit.f2.text delete 1.0 end
        .edit.f2.text yview 0
      }
    }
  }

  pack .edit.f0.title.l0 -side left
  pack .edit.f0.title.f.val -side left -padx 6 -pady 6
  pack .edit.f0.title.f -side left -padx 2 -pady 2
  pack .edit.f0.title -fill x -expand 1
  pack .edit.f0.title.l1 -side left

  pack .edit.f2.text -side left -fill both -expand 1
  pack .edit.f2.scr -side right -fill y

  pack .edit.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .edit.f1.f0 -side right -padx 10 -pady 10
  pack .edit.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .edit.f1.f1 -side right -padx 10 -pady 10
  pack .edit.f1.f2.clear -expand 1 -padx 6 -pady 6
  pack .edit.f1.f2 -side right -padx 10 -pady 10

  pack .edit.f0 -side top -fill x
  pack .edit.f2 -side top -fill both -expand 1
  pack .edit.f1 -side top -fill x

  bind .edit.f2.text <Tab> {
    .edit.f1.f2 configure -relief sunken
    focus .edit.f1.f2.clear
  }
  bind .edit.f2.text <Shift-Tab> {
    .edit.f0.title.f configure -relief sunken
    focus .edit.f0.title.f.val
  }
  bind .edit.f2.text <3> {
    if { ![catch {%W insert insert [%W get sel.first sel.last]}] } {
      %W yview -pickplace insert
    }
  }
  bind .edit.f2.text <Control-a> {
    %W mark set insert "insert linestart"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-b> {
    %W mark set insert "insert -1c"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-c> {.edit.f1.f1.cancel invoke}
  bind .edit.f2.text <Control-d> {
    %W delete insert
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-e> {
    %W mark set insert "insert lineend"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-f> {
    %W mark set insert "insert +1c"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-k> {
    %W delete insert "insert lineend"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-v> [bind .edit.f2.text <3>]
  bind .edit.f2.text <Control-y> {
    if { [%W get "insert linestart" "insert lineend"] != "" } {
      %W delete "insert linestart" "insert lineend +1c"
      %W yview -pickplace insert
    } else bell
  }
  bind .edit.f2.text <KP_Enter> [bind Text <Return>]
  bind .edit.f2.text <Up> {
    %W mark set insert "[%W index insert]-1l"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-p> [bind .edit.f2.text <Up>]
  bind .edit.f2.text <Down> {
    %W mark set insert "[%W index insert]+1l"
    %W yview -pickplace insert
  }
  bind .edit.f2.text <Control-n> [bind .edit.f2.text <Down>]
  bind .edit.f2.text <Left> [bind .edit.f2.text <Control-b>]
  bind .edit.f2.text <Right> [bind .edit.f2.text <Control-f>]
  bind .edit.f2.text <Alt-Any-Key> [bind Text <Any-KeyPress>]

  bind .edit.f1.f2.clear <Tab> {
    .edit.f1.f2 configure -relief flat
    .edit.f1.f1 configure -relief sunken
    focus .edit.f1.f1.cancel
  }
  bind .edit.f1.f2.clear <Shift-Tab> {
    .edit.f1.f2 configure -relief flat
    focus .edit.f2.text
  }
  bind .edit.f1.f2.clear <FocusOut> {.edit.f1.f2 configure -relief flat}
  bind .edit.f1.f2.clear <Return> {%W invoke; focus .edit.f2.text}
  bind .edit.f1.f2.clear <KP_Enter> [bind .edit.f1.f2.clear <Return>]
  bind .edit.f1.f2.clear <Control-c> {.edit.f1.f1.cancel invoke}

  bind .edit.f1.f1.cancel <Tab> {
    .edit.f1.f1 configure -relief flat
    .edit.f1.f0 configure -relief sunken
    focus .edit.f1.f0.ok
  }
  bind .edit.f1.f1.cancel <Shift-Tab> {
    .edit.f1.f1 configure -relief flat
    .edit.f1.f2 configure -relief sunken
    focus .edit.f1.f2.clear
  }
  bind .edit.f1.f1.cancel <FocusOut> {.edit.f1.f1 configure -relief flat}
  bind .edit.f1.f1.cancel <Return> {%W invoke}
  bind .edit.f1.f1.cancel <KP_Enter> {%W invoke}
  bind .edit.f1.f1.cancel <Control-c> {%W invoke}

  bind .edit.f1.f0.ok <Tab> {
    .edit.f1.f0 configure -relief flat
    .edit.f0.title.f configure -relief sunken
    focus .edit.f0.title.f.val
  }
  bind .edit.f1.f0.ok <Shift-Tab> {
    .edit.f1.f0 configure -relief flat
    .edit.f1.f1 configure -relief sunken
    focus .edit.f1.f1.cancel
  }
  bind .edit.f1.f0.ok <FocusOut> {.edit.f1.f0 configure -relief flat}
  bind .edit.f1.f0.ok <Return> {%W invoke}
  bind .edit.f1.f0.ok <KP_Enter> {%W invoke}
  bind .edit.f1.f0.ok <Control-c> {.edit.f1.f1.cancel invoke}

  foreach defbind [bind Entry] {
    bind .edit.f0.title.f.val $defbind "[bind Entry $defbind]"
  }
  bind .edit.f0.title.f.val <Tab> {
    .edit.f0.title.f configure -relief flat
    focus .edit.f2.text
  }
  bind .edit.f0.title.f.val <Shift-Tab> {
    .edit.f0.title.f configure -relief flat
    .edit.f1.f0 configure -relief sunken
    focus .edit.f1.f0.ok
  }
  bind .edit.f0.title.f.val <Return> {
    edit_check $EditCmd [%W get]
    .edit.f0.title.f configure -relief flat
    focus .edit.f2.text
  }
  bind .edit.f0.title.f.val <KP_Enter> [bind .edit.f0.title.f.val <Return>]
  bind .edit.f0.title.f.val <1> {
    .edit.f1.f1 configure -relief flat
    .edit.f1.f0 configure -relief flat
    .edit.f0.title.f configure -relief sunken
    focus .edit.f0.title.f.val
    .edit.f0.title.f.val icursor @%x
  }
  bind .edit.f0.title.f.val <FocusOut> {.edit.f0.title.f configure -relief flat}
  bind .edit.f0.title.f.val <Control-c> {.edit.f1.f1.cancel invoke}
  bind .edit.f0.title.f.val <B1-Motion> { }
  bind .edit.f0.title.f.val <Shift-1> { }
  bind .edit.f0.title.f.val <Shift-B1-Motion> { }
  bind .edit.f0.title.f.val <Control-d> { }
  bind .edit.f0.title.f.val <Control-v> { }
  bind .edit.f0.title.f.val <Control-w> { }
  bind .edit.f0.title.f.val <Escape> {%W delete 0 end}
  bind .edit.f0.title.f.val <Any-KeyPress> {
    if { "%A" != "" } {
      %W insert insert %A
      tk_entrySeeCaret %W
    }
  }
  bind .edit.f0.title.f.val <Right> {
    %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
  }
  bind .edit.f0.title.f.val <Left> {
    %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
  }
  bind .edit.f0.title.f.val <Up> {%W icursor 0; %W view 0}
  bind .edit.f0.title.f.val <Down> {%W icursor end; tk_entrySeeCaret %W}

  bind .edit <Visibility> {raise .edit; focus .edit.f2.text}
  bind .edit <FocusOut> {focus .edit.f2.text}

  set xpos [winfo rootx .]; set ypos [winfo rooty .]
  wm geometry .edit +$xpos+$ypos
  wm minsize .edit "" ""
  wm maxsize .edit "" ""
  wm deiconify .edit
  wm title .edit "Tgdb mini editor"
  wm protocol .edit WM_TAKE_FOCUS {focus .edit.f2.text}
  tkwait visibility .edit
  raise .edit
  focus .edit.f2.text
  grab .edit

  edit_check $what $arg yes
  if { [.edit.f0.title.f.val get] == "" } {
    update
    .edit.f0.title.f configure -relief sunken
    focus .edit.f0.title.f.val
  }
 
  while { 1 } {
    tkwait variable EditReady
    if { $EditReady == 0 } {
      show_status "Editor cancelled." 4000
      break
    }
    if { [edit_check $EditCmd [.edit.f0.title.f.val get] no] } {
      show_status ""
      update idletasks
      edit_dialog $what [.edit.f0.title.f.val get] [.edit.f2.text get 1.0 end]
      break
    } else {
      bell
      .edit.f0.title.f configure -relief sunken
      focus .edit.f0.title.f.val
    }
  }
  destroy .edit
  catch {focus $old_focus(.edit)}
}
################################################################################
#
# realize tgdb's hypertext help window
#
################################################################################
proc create_tgdb_help_window {} {
  global WinSize WinPos WinProc tgdb_path bitmap_path ThelpContents
  global blt_htext ThelpLastLine ThelpOpt ThelpTitleMaxLvl

  proc thelp_resize {} {
    global WinSize ThelpLvl

    ############################################################################
    # the following lines are a hell of a kludge and took an amazingly amount
    # of time to be coded... it's all about the blt_htext widget: at least in
    # this version of BLT (1.3) it isn't "griddable" (i.e. it lacks the -grid
    # option :-(); furthermore, it can't be resized in the usual way (e.g. by
    # using the window manager's "size" menu entry), and finally it's not
    # willing to display enough text lines when resizing forces growing of the
    # widget. I'm not sure who is responsible for this mess, but these lines
    # will do their best to get around it - without blaming someone :-)...
    ############################################################################
    if { ![info exists ThelpLvl] } { set ThelpLvl 0 }
    if { [incr ThelpLvl] > 1 } { incr ThelpLvl -1; return }
    wm grid .thelp "" "" "" ""
    scan [winfo geometry .thelp] "%dx%d" w h
    set wy [winfo reqwidth .thelp.f3.yscr]
    set hf [winfo reqheight .thelp.f1]
    set hs [winfo reqheight .thelp.f2]
    set hx [winfo reqheight .thelp.f4]
    set hb [winfo reqheight .thelp.f5]
    set w [expr $w - $wy]
    set h [expr $h - $hs - $hx -$hf - $hb]
    if { ($w < 0) || ($h < 0) } { set ThelpLvl 0; return }
    set gw [expr ($w / $WinSize(.,x) - 1)]
    set gh [expr ($h / $WinSize(.,y) - 1)]
    set w [expr $gw * $WinSize(.,x)]
    set h [expr $gh * $WinSize(.,y)]
    .thelp.f3.f.txt configure -width $w
    .thelp.f3.f.txt configure -height $h
    update idletasks
    wm grid .thelp $gw $gh $WinSize(.,x) $WinSize(.,y)
    .thelp.f3.f.txt gotoline [.thelp.f3.f.txt gotoline] ;# 8-))
    set ThelpLvl 0
  }

  proc thelp_scroll { direction } {
    global blt_htext WinSize

    set curline [$blt_htext(widget) gotoline]
    set h [expr [lindex [$blt_htext(widget) configure -height] 4]/$WinSize(.,y)]
    if { $direction == "up" } {
      set newline [expr $curline - $h + 2]
      if { $newline < 1 } {
	set newline 1
      }
      $blt_htext(widget) gotoline $newline
    } else {
      $blt_htext(widget) gotoline [expr $curline + $h - 2]
    }
  }

  proc thelp_search { direction } {
    global ThelpSearchString blt_htext

    if { $ThelpSearchString == "" } {
      bell
      show_status "No string to search for."
      return
    }
    set pattern "*$ThelpSearchString*"
    set htext $blt_htext(widget)
    set curpos [$htext gotoline]
    if { $direction == "down" } {
      set last end; set first [expr $curpos+1]
    } else {
      set last 1; set first [expr $curpos-1]
    }
    set newpos [$htext search $pattern $first $last]
    if { $newpos == -1 } {
      bell
      show_status "String not found."
    } else {
      $htext gotoline $newpos
    }
  }

  proc thelp_reset_vars { {keep_index "dont"} } {
    global Thelp_TOC_index Thelp_TOC_line

    foreach var [info globals Hyper*] {
      if { ($keep_index == "dont") || ($var != "HyperIndex") } {
        uplevel #0 "unset $var"
      }
    }
    if { $keep_index == "dont" } {
      catch {unset Thelp_TOC_index}
      catch {unset Thelp_TOC_line}
    }
  }

  proc thelp_reload {} {
    global blt_htext tgdb_path ThelpPath
    global ThelpContents Thelp_index Thelp_TOC

    thelp_reset_vars
    catch {unset ThelpPath}
    catch {unset Thelp_index}
    catch {unset Thelp_TOC}
    set line [$blt_htext(widget) gotoline]
    set ThelpContents file
    $blt_htext(widget) configure -file $tgdb_path/tgdb.hlp
    $blt_htext(widget) gotoline $line
    thelp_create_index_table
    thelp_create_TOC
  }

  proc maketitle { title {makeidx no} } {
    thelp_add_title 0 $title $makeidx
  }

  proc makesubtitle { subtitle {makeidx no} } {
    thelp_add_title 1 $subtitle $makeidx
  }

  proc makesubsubtitle { subsubtitle {makeidx no} } {
    thelp_add_title 2 $subsubtitle $makeidx
  }

  proc makesubsubsubtitle { subsubsubtitle {makeidx no} } {
    thelp_add_title 3 $subsubsubtitle $makeidx
  }

  proc makesubsubsubsubtitle { subsubsubsubtitle {makeidx no} } {
    thelp_add_title 4 $subsubsubsubtitle $makeidx
  }

  proc thelp_add_title { lvl title {makeidx no} } {
    global blt_htext HyperIndex HyperButtonNr HyperTitleNr ThelpTitleMaxLvl
    global Thelp_TOC_index Thelp_TOC_line ThelpOpt

    if { $lvl >= $ThelpTitleMaxLvl } {
      tkerror "Title numbering exceeds max. level $ThelpTitleMaxLvl ($lvl)."
      return
    }
    if { $makeidx != "no" } {
      if { [info exists HyperIndex($title)] } {
        tkerror "Title \"$title\" (level $lvl) already exists!"
        return
      }
      set HyperIndex($title) $blt_htext(line)
    }
    if { [catch {incr HyperButtonNr}] } { set HyperButtonNr 0 }
    if { [catch {incr HyperTitleNr($lvl)}] } {
      if { $lvl == 0 } {
	set HyperTitleNr(0) 0
      } else {
	set HyperTitleNr($lvl) 1
      }
    }
    loop i $lvl+1 $ThelpTitleMaxLvl { set HyperTitleNr($i) 0 }
    set indexnr $HyperTitleNr(0)
    loop i 1 $lvl+1 { append indexnr ".$HyperTitleNr($i)" }
    set Thelp_TOC_index($indexnr) $title
    if { [info exists Thelp_TOC_line($title)] } {
      tkerror "TOC entry \"$title\" exists!"
      return
    }
    set Thelp_TOC_line($title) $blt_htext(line)
    button $blt_htext(widget).title$HyperButtonNr -state disabled \
      -relief flat -font $ThelpOpt(title$lvl,font) \
      -disabledforeground $ThelpOpt(title$lvl,fg) \
      -background $ThelpOpt(title$lvl,bg) -border 0
    if { $lvl == 0 } {
      $blt_htext(widget).title$HyperButtonNr configure -text "$indexnr.  $title"
    } else {
      $blt_htext(widget).title$HyperButtonNr configure -text "$indexnr  $title"
    }
    $blt_htext(widget) append $blt_htext(widget).title$HyperButtonNr
  }

  proc makeidx { index } {
    global blt_htext HyperIndex

    if { [info exists HyperIndex($index)] } {
      tkerror "Index \"$index\" exists!"
      return
    }
    set HyperIndex($index) $blt_htext(line)
  }

  proc thelp_showidx { index } {
    global blt_htext tgdb_path HyperIndex ThelpPath ThelpPathLine ThelpContents
    global ThelpLastLine Thelp_TOC_line

    if { [catch {set line $HyperIndex($index)}] } {
      set line $Thelp_TOC_line($index)
    }
    append ThelpPath "/$index"; tk_entrySeeCaret .thelp.f5.f.path
    if { $ThelpContents != "file" } {
      set ThelpLastLine($ThelpContents) [$blt_htext(widget) gotoline]
      lappend ThelpPathLine $ThelpLastLine(file)
      set ThelpContents file
      thelp_reset_vars
      $blt_htext(widget) configure -file $tgdb_path/tgdb.hlp
    } else {
      lappend ThelpPathLine [$blt_htext(widget) gotoline]
    }
    $blt_htext(widget) gotoline $line
  }

  proc gotoidx { index } {
    global blt_htext HyperIndex HyperButtonNr ThelpOpt

    if { [catch {incr HyperButtonNr}] } { set HyperButtonNr 0 }
    button $blt_htext(widget).idx$HyperButtonNr -text $index -relief flat \
      -command "thelp_showidx \"$index\"" -background $ThelpOpt(idx,bg) \
      -border 0 -font $ThelpOpt(idx,font) -foreground $ThelpOpt(idx,fg)
    $blt_htext(widget) append $blt_htext(widget).idx$HyperButtonNr
  }

  proc thelp_go_back {} {
    global blt_htext tgdb_path ThelpPath ThelpPathLine
    global ThelpContents ThelpLastLine

    if { ![info exists ThelpPath] || ($ThelpPath == "") } {
      if { $ThelpContents != "file" } {
        set ThelpLastLine($ThelpContents) [$blt_htext(widget) gotoline]
        set ThelpContents file
        thelp_reset_vars
        $blt_htext(widget) configure -file $tgdb_path/tgdb.hlp
        $blt_htext(widget) gotoline $ThelpLastLine(file)
      } else {
        bell
      }
      return
    }
    if { [set last [string last "/" $ThelpPath]] > 0 } {
      set ThelpPath [crange $ThelpPath 0 $last-1]
    } else {
      set ThelpPath ""
    }
    tk_entrySeeCaret .thelp.f5.f.path
    set last [expr [llength $ThelpPathLine] - 1]
    set line [lvarpop ThelpPathLine $last]
    if { $ThelpContents != "file" } {
      set ThelpContents file
      thelp_reset_vars
      $blt_htext(widget) configure -file $tgdb_path/tgdb.hlp
    }
    $blt_htext(widget) gotoline $line
  }

  proc thelp_create_index_table {} {
    global blt_htext HyperIndex Thelp_index

    proc thelp_cmp { str1 str2 } {
      return [string compare [translit a-z A-Z $str1] [translit a-z A-Z $str2]]
    }

    if { ![info exists HyperIndex] } return
    set Thelp_index "*** Alphabetical index: ***\n"
    set char ""
    foreach entry [lsort -command thelp_cmp [array names HyperIndex]] {
      if { [string toupper [cindex $entry 0]] != "$char" } {
        set char [string toupper [cindex $entry 0]]
        append Thelp_index "\n  $char\n\n"
      }
      append Thelp_index "%%gotoidx \"$entry\"%%\n"
    }
  }

  proc thelp_load_index_table {} {
    global blt_htext Thelp_index ThelpLastLine ThelpContents

    if { $ThelpContents == "index" } {
      return
    }
    if { ![info exists Thelp_index] } {
      bell
      show_status "No index available."
      return
    }
    thelp_reset_vars keep_index
    set ThelpLastLine($ThelpContents) [$blt_htext(widget) gotoline]
    set ThelpContents index
    $blt_htext(widget) configure -text "$Thelp_index"
    if { [info exists ThelpLastLine(index)] } {
      $blt_htext(widget) gotoline $ThelpLastLine(index)
    }
  }

  proc thelp_create_TOC {} {
    global Thelp_TOC Thelp_TOC_index

    proc thelp_create_sorted_TOC { lvl pfx idx_ptr } {
      global ThelpTitleMaxLvl Thelp_TOC Thelp_TOC_index
      upvar $idx_ptr indices

      if { $lvl >= $ThelpTitleMaxLvl } return
      if { [set subs [lmatch -regexp $indices "^$pfx.\[0-9\]+$"]] == "" } return
      set len [clength "$pfx."]
      foreach ssub $subs {
	lappend ssubs [crange $ssub $len end]
      }
      foreach sub [lsort -integer $ssubs] {
	set sub "$pfx.$sub"
        append Thelp_TOC "$sub  %%gotoidx \"$Thelp_TOC_index($sub)\"%%\n"
        thelp_create_sorted_TOC [expr $lvl + 1] $sub indices
      }
    }

    if { ![info exists Thelp_TOC_index] } return
    set Thelp_TOC "*** Table of contents: ***\n"
    set idxs [array names Thelp_TOC_index]
    foreach title [lsort -integer [lmatch -regexp $idxs {^[0-9]+$}]] {
      append Thelp_TOC "\n$title.  %%gotoidx \"$Thelp_TOC_index($title)\"%%\n"
      thelp_create_sorted_TOC 1 $title idxs
    }
  }

  proc thelp_load_TOC {} {
    global blt_htext Thelp_TOC ThelpLastLine ThelpContents

    if { $ThelpContents == "TOC" } {
      return
    }
    if { ![info exists Thelp_TOC] } {
      bell
      show_status "No TOC available."
      return
    }
    thelp_reset_vars keep_index
    set ThelpLastLine($ThelpContents) [$blt_htext(widget) gotoline]
    set ThelpContents TOC
    $blt_htext(widget) configure -text "$Thelp_TOC"
    if { [info exists ThelpLastLine(TOC)] } {
      $blt_htext(widget) gotoline $ThelpLastLine(TOC)
    }
  }

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

  if { [winfo exists .thelp] } {
    set geo [wm geometry .thelp]
    wm withdraw .thelp
    wm geometry .thelp $geo
    wm deiconify .thelp
    tkwait visibility .thelp
    raise .thelp
    focus .thelp
    return
  }

  set WinProc(.thelp) create_tgdb_help_window
  catch { destroy .thelp }
  toplevel .thelp -borderwidth 4 -relief sunken -cursor top_left_arrow
  wm withdraw .thelp

  frame .thelp.f2
  label .thelp.f2.lbl1
  label .thelp.f2.lbl2
  entry .thelp.f2.search
  frame .thelp.f2.f
  button .thelp.f2.f.up
  button .thelp.f2.f.dn
  foreach widget ".f2 .f2.lbl1 .f2.lbl2 .f2.search .f2.f .f2.f.up .f2.f.dn" {
    foreach config [$widget configure] {
      set conf [lindex [$widget configure [lindex $config 0]] 4]
      if { $conf != "" } {
	.thelp$widget configure [lindex $config 0] $conf
      }
    }
  }
  .thelp.f2.search configure -textvariable ThelpSearchString
  .thelp.f2.f.up configure -command {thelp_search up}
  .thelp.f2.f.dn configure -command {thelp_search down}

  frame .thelp.f5 -border 2 -relief raised
  button .thelp.f5.toc -text "  TOC  " -command thelp_load_TOC
  button .thelp.f5.index -text "  Index  " -command thelp_load_index_table
  button .thelp.f5.reset -text "  Reset path  " -command {
    set ThelpPath ""; tk_entrySeeCaret .thelp.f5.f.path
  }
  button .thelp.f5.back -text "  Go back  " -command thelp_go_back
  frame .thelp.f5.f -relief raised -border 2
  label .thelp.f5.f.lbl -text {Path: } -relief flat
  entry .thelp.f5.f.path -relief flat -state disabled -textvariable ThelpPath \
    -font [lindex [.f3.text configure -font] 4]

  frame .thelp.f3 -relief flat
  frame .thelp.f3.f -relief sunken -border 4
  blt_htext .thelp.f3.f.txt -cursor top_left_arrow -linespacing 0 \
    -xscrollcommand {.thelp.f4.xscr set} -yscrollcommand {.thelp.f3.yscr set} \
    -xscrollunits $WinSize(.,x) -yscrollunits $WinSize(.,y) \
    -font [lindex [.f3.text configure -font] 4]
  #
  # create dummy buttons to access the X database
  #
  set ThelpTitleMaxLvl 5
  loop i 0 $ThelpTitleMaxLvl {
    button .thelp.f3.f.txt.title$i
    set ThelpOpt(title$i,bg) \
      [option get .thelp.f3.f.txt.title$i background Background]
    set ThelpOpt(title$i,fg) \
      [option get .thelp.f3.f.txt.title$i disabledForeground DisabledForeground]
    set ThelpOpt(title$i,font) [option get .thelp.f3.f.txt.title$i font Font]
    destroy .thelp.f3.f.txt.title$i
  }
  button .thelp.f3.f.txt.idx
  set ThelpOpt(idx,bg) [option get .thelp.f3.f.txt.idx background Background]
  set ThelpOpt(idx,fg) [option get .thelp.f3.f.txt.idx foreground Foreground]
  set ThelpOpt(idx,font) [option get .thelp.f3.f.txt.idx font Font]
  destroy .thelp.f3.f.txt.idx
  #
  # now load the help file
  #
  thelp_reset_vars
  .thelp.f3.f.txt configure -file $tgdb_path/tgdb.hlp
  set ThelpContents file
  if { [info exists WinPos(.thelp)] } {
    scan $WinPos(.thelp) "%dx%d" txt_width txt_height
  } else {
    set txt_width 80; set txt_height 25
  }
  .thelp.f3.f.txt configure -width [expr $txt_width * $WinSize(.,x)] \
    -width [expr $txt_width * $WinSize(.,x)] \
    -height [expr $txt_height * $WinSize(.,y)]
  scrollbar .thelp.f3.yscr -orient vertical -command {.thelp.f3.f.txt yview} \
    -relief [lindex [.f3.scroll configure -relief] 4] \
    -width [lindex [.f3.scroll configure -width] 4]
  frame .thelp.f4 -relief flat
  scrollbar .thelp.f4.xscr -orient horizontal -command {.thelp.f3.f.txt xview} \
    -relief [lindex [.f3.scroll configure -relief] 4] \
    -width [lindex [.f3.scroll configure -width] 4]
  frame .thelp.f4.f -relief flat \
    -width [winfo reqwidth .thelp.f3.yscr] \
    -height [winfo reqwidth .thelp.f4.xscr]

  frame .thelp.f1 -relief groove -borderwidth 6
  frame .thelp.f1.f0 -relief sunken -border 1
  button .thelp.f1.f0.dismiss -relief raised -border 2 -text "  Dismiss  " \
    -command {
    set ThelpLastLine($ThelpContents) [$blt_htext(widget) gotoline];
    set WinPos(.thelp) [wm geometry .thelp]; destroy .thelp
  }

  pack .thelp.f2.lbl1 -side left
  pack .thelp.f2.f.up -side top
  pack .thelp.f2.f.dn -side bottom
  pack .thelp.f2.f -side left
  pack .thelp.f2.lbl2 -side left
  pack .thelp.f2.search -side left -fill x -expand 1 -anchor w
  pack .thelp.f2 -side top -fill x

  pack .thelp.f5.toc -side left -fill y
  pack .thelp.f5.index -side left -fill y
  pack .thelp.f5.reset -side left -fill y
  pack .thelp.f5.back -side left -fill y
  pack .thelp.f5.f.lbl -side left
  pack .thelp.f5.f.path -side left -fill x -expand 1
  pack .thelp.f5.f -side left -fill x -expand 1
  pack .thelp.f5 -side top -fill x -expand 1

  pack .thelp.f3.f.txt -fill both
  pack .thelp.f3.f -side left -fill both -expand 1
  pack .thelp.f3.yscr -side left -fill y
  pack .thelp.f3 -side top -fill both -expand 1
  pack .thelp.f4.xscr -side left -fill x -expand 1
  pack .thelp.f4.f -side right
  pack .thelp.f4 -side top -fill x -expand 1

  pack .thelp.f1.f0.dismiss -fill x -expand 1 -padx 6 -pady 6
  pack .thelp.f1.f0 -padx 4 -pady 4 -fill x -expand 1
  pack .thelp.f1 -side bottom -fill x -expand 1

  foreach defbind [bind Entry] {
    if { [lsearch -exact \
           "<Key-F10> <Key-BackSpace> <Key-Delete> <Any-Key> \
            <B2-Motion> <Button-2> <Button-1>" \
           $defbind] >= 0 } {
      bind .thelp.f2.search $defbind "[bind Entry $defbind]"
    } else {
      bind .thelp.f2.search $defbind { }
    }
  }
  bind .thelp.f2.search <Any-Mod2-Key> [bind .thelp.f2.search <Any-Key>]
  bind .thelp.f2.search <Escape> { set ThelpSearchString "" }
  bind .thelp.f2.search <Return> { thelp_search down }
  bind .thelp.f2.search <KP_Enter> [bind .thelp.f2.search <Return>]
  bind .thelp.f2.search <Any-Enter> {
    if { [focus] == "none" || ([winfo toplevel [focus]] == ".thelp") } {
      set old_focus(%W) [focus]
      focus %W
    }
  }
  bind .thelp.f2.search <Any-Leave> {
    if { [focus] == "none" || ([winfo toplevel [focus]] == ".thelp") } {
      catch {focus $old_focus(%W)}
    }
  }
  bind .thelp.f2.search <Right> {
    %W icursor [expr [%W index insert]+1]; tk_entrySeeCaret %W
  }
  bind .thelp.f2.search <Left> {
    %W icursor [expr [%W index insert]-1]; tk_entrySeeCaret %W
  }
  bind .thelp.f2.search <Up> {%W icursor 0; %W view 0}
  bind .thelp.f2.search <Down> {%W icursor end; tk_entrySeeCaret %W}
  bind .thelp.f2.search <3> {+
    if { [get_selection] == "" } {
      bell
      show_status "No selection."
    } else {
      set ThelpSearchString [get_selection]
    }
  }

  bind .thelp.f3.f.txt <2> {%W scan mark %x %y}
  bind .thelp.f3.f.txt <B2-Motion> {%W scan dragto %x %y}

  bind .thelp <Return> {.thelp.f1.f0.dismiss invoke}
  bind .thelp <KP_Enter> [bind .thelp <Return>]
  bind .thelp <Control-c> {.thelp.f1.f0.dismiss invoke}
  bind .thelp <Control-l> {thelp_reload}
  bind .thelp <Configure> {
    if { [string first .thelp [focus]] == 0 } {
      thelp_resize
    }
  }
  bind .thelp <Left> {
     $blt_htext(widget) xview [expr [$blt_htext(widget) xview] - 8]
  }
  bind .thelp <Right> {
     $blt_htext(widget) xview [expr [$blt_htext(widget) xview] + 8]
  }
  bind .thelp <Up> {
    if { [$blt_htext(widget) gotoline] > 1 } {
      $blt_htext(widget) gotoline [expr [$blt_htext(widget) gotoline] - 1]
    }
  }
  bind .thelp <Down> {
    $blt_htext(widget) gotoline [expr [$blt_htext(widget) gotoline] + 1]
  }
  bind .thelp <Prior> {thelp_scroll up}
  bind .thelp <Next> {thelp_scroll down}
  bind .thelp <Home> {$blt_htext(widget) gotoline 1}
  bind .thelp <End> {$blt_htext(widget) gotoline 100000}

  wm grid .thelp $txt_width $txt_height $WinSize(.,x) $WinSize(.,y)
  wm minsize .thelp 55 10
  if { [catch {wm geometry .thelp $WinPos(.thelp)}] } {
    wm geometry .thelp +100+30
  }
  set WinPos(.thelp) [wm geometry .thelp]
  wm deiconify .thelp
  wm title .thelp "Tgdb help window"
  wm protocol .thelp WM_TAKE_FOCUS {focus .thelp}
  wm protocol .thelp WM_DELETE_WINDOW {.thelp.f1.f0.dismiss invoke}
  tkwait visibility .thelp
  thelp_resize
  raise .thelp
  focus .thelp
  thelp_create_index_table
  thelp_create_TOC
  tk_entrySeeCaret .thelp.f5.f.path
  if { [info exists ThelpLastLine(file)] } {
    $blt_htext(widget) gotoline $ThelpLastLine(file)
  }
}
################################################################################
#
# display a yes/no box
#
################################################################################
proc yes_no_box { question } {
  global old_focus YesNo

  regsub { \(y or n\) } $question "" question
  set old_focus(.yesno) [focus]
  catch { destroy .yesno }
  toplevel .yesno -borderwidth 4 -relief raised -cursor top_left_arrow
  wm transient .yesno .
  wm overrideredirect .yesno 1
  frame .yesno.f0 -relief groove -borderwidth 4
  message .yesno.f0.msg -text "$question"
  frame .yesno.f1 -relief groove -borderwidth 4
  frame .yesno.f1.f0 -relief sunken -border 1
  button .yesno.f1.f0.yes -relief raised -border 2 -text "  Yes  " \
    -command {set YesNo 1}
  frame .yesno.f1.f1 -relief flat -border 1
  button .yesno.f1.f1.no -relief raised -border 2 -text "  No  " \
    -command {set YesNo 0}

  pack .yesno.f0.msg -side top -fill x
  pack .yesno.f1.f0.yes -expand 1 -padx 6 -pady 6
  pack .yesno.f1.f0 -side right -padx 10 -pady 10
  pack .yesno.f1.f1.no -expand 1 -padx 6 -pady 6
  pack .yesno.f1.f1 -side right -padx 10 -pady 10
  pack .yesno.f0 -side top -fill both
  pack .yesno.f1 -side top -fill x

  bind .yesno <Visibility> {raise .yesno}
  bind .yesno <Tab> {
    if { [lindex [.yesno.f1.f0 configure -relief] 4] == "sunken" } {
      .yesno.f1.f0 configure -relief flat
      .yesno.f1.f1 configure -relief sunken
    } else {
      .yesno.f1.f0 configure -relief sunken
      .yesno.f1.f1 configure -relief flat
    }
  }
  bind .yesno <Return> {
    if { [lindex [.yesno.f1.f0 configure -relief] 4] == "sunken" } {
      .yesno.f1.f0.yes invoke
    } else {
      .yesno.f1.f1.no invoke
    }
  }
  bind .yesno <KP_Enter> [bind .yesno <Return>]
  bind .yesno <Control-c> {.yesno.f1.f1.no invoke}
  bind .yesno <n> {.yesno.f1.f1.no invoke}
  bind .yesno <y> {.yesno.f1.f0.yes invoke}
  bind .yesno <FocusOut> {focus .yesno}
  wm withdraw .yesno
  update idletasks
  set tx [winfo rootx .f5.text]; set ty [winfo rooty .f5.text]
  set tw [winfo width .f5.text]; set th [winfo height .f5.text]
  set w [winfo reqwidth .yesno]; set h [winfo reqheight .yesno]
  wm geometry .yesno +[expr $tx + ($tw-$w)/2]+[expr $ty + ($th-$h)/2]
  wm deiconify .yesno
  wm protocol .yesno WM_TAKE_FOCUS {focus .yesno}
  tkwait visibility .yesno
  grab .yesno
  focus .yesno
  tkwait variable YesNo
  catch {destroy .yesno}
  catch {focus $old_focus(.yesno)}
  return $YesNo
}
################################################################################
#
# display a listbox containing items for the command line completion
#
################################################################################
proc command_line_completion {} {
  global prompt WinSize WinPos CompReady gdb_cmd

  if { ![info exists gdb_cmd(complete)] } {
    show_status "Command line completion requires gdb 4.13 or above."
    focus .f5.text
    bell
    return
  }
  set command [.f5.text get "insert linestart" "insert lineend"]
  if { [set pos [string first $prompt $command]] >= 0 } {
    incr pos [string length $prompt]
    set command [string range $command $pos end]
  }
  set cmdlist [split [string trim [do_dialog "complete $command" silent]] "\n"]
  set cmdlist [lrmdups $cmdlist]
  if {   [cequal $command $cmdlist]
      || [cequal $cmdlist ""]
      || [cequal $cmdlist "Quit"] } {
    if { [cequal $cmdlist "Quit"] } {
      show_status "Command line completion aborted."
    }
    focus .f5.text
    bell
    return
  }
  if {   ([llength $cmdlist] == 1)
      && ([string first $command [join $cmdlist]] == 0) } {
    # append the selected item to gdb's window
    set cmdlist [join $cmdlist]
    set w .f5.text
    set pos [string first $prompt [$w get "insert linestart" "insert lineend"]]
    if { $pos >= 0 } {
      incr pos [string length $prompt]
      $w mark set insert [$w index "insert linestart + $pos c"]
      $w delete insert "insert lineend"
      $w insert insert "$cmdlist "
      $w tag add gdb_in "insert linestart + $pos c" insert
    } else {
      $w delete "insert linestart" "insert lineend"
      $w insert insert "$cmdlist "
      $w tag add gdb_in "insert linestart" insert
    }
    $w yview -pickplace insert
    return
  }

  set CompReady 0
  focus none
  catch { destroy .clc }
  toplevel .clc
  wm transient .clc .
  frame .clc.f0
  frame .clc.f1 -relief raised -border 2
  listbox .clc.f0.lb -setgrid 1 \
    -yscrollcommand {.clc.f0.yscr set} -xscrollcommand {.clc.f1.xscr set}
  foreach cmd $cmdlist {
    if { [cequal $cmd ""] } continue
    .clc.f0.lb insert end $cmd
  }
  .clc.f0.lb select from 0
  scrollbar .clc.f0.yscr -orient vertical -command {.clc.f0.lb yview}
  scrollbar .clc.f1.xscr -orient horizontal -command {.clc.f0.lb xview}
  frame .clc.f1.f0 -relief sunken -border 1
  button .clc.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {clc2gdb; set CompReady 1}
  frame .clc.f1.f1 -relief flat -border 1
  button .clc.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set CompReady 1}

  pack .clc.f0.lb -side left -fill both -expand 1
  pack .clc.f0.yscr -side right -fill y
  pack .clc.f1.xscr -side top -fill x
  pack .clc.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .clc.f1.f0 -side right -padx 10 -pady 10
  pack .clc.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .clc.f1.f1 -side right -padx 10 -pady 10
  pack .clc.f0 -side top -fill both -expand 1
  pack .clc.f1 -side top -fill x

  proc clc2gdb {} {
    global prompt

    # append the selected item to gdb's window
    set w .f5.text
    set pos [string first $prompt [$w get "insert linestart" "insert lineend"]]
    if { $pos >= 0 } {
      incr pos [string length $prompt]
      $w mark set insert [$w index "insert linestart + $pos c"]
      $w delete insert "insert lineend"
      $w insert insert "[.clc.f0.lb get [.clc.f0.lb curselection]] "
      $w tag add gdb_in "insert linestart + $pos c" insert
    } else {
      $w delete "insert linestart" "insert lineend"
      $w insert insert "[.clc.f0.lb get [.clc.f0.lb curselection]] "
      $w tag add gdb_in "insert linestart" insert
    }
    $w yview -pickplace insert
  }

  bind .clc <Visibility> {check_visibility %W}

  bind .clc.f0.lb <1> {
    %W select from [%W nearest %y]
  }
  bind .clc.f0.lb <Double-1> {.clc.f1.f0.ok invoke}
  bind .clc.f0.lb <B1-Motion> [bind .clc.f0.lb <1>]
  bind .clc.f0.lb <Shift-1> { }
  bind .clc.f0.lb <Shift-B1-Motion> { }
  bind .clc.f0.lb <Return> {
    if { [lindex [.clc.f1.f0 configure -relief] 4] == "sunken" } {
      .clc.f1.f0.ok invoke
    } else {
      .clc.f1.f1.cancel invoke
    }
  }
  bind .clc.f0.lb <KP_Enter> [bind .clc.f0.lb <Return>]
  bind .clc.f0.lb <Control-c> {.clc.f1.f1.cancel invoke}
  bind .clc.f0.lb <Tab> {
    if { [lindex [.clc.f1.f0 configure -relief] 4] == "sunken" } {
      .clc.f1.f0 configure -relief flat
      .clc.f1.f1 configure -relief sunken
    } else {
      .clc.f1.f0 configure -relief sunken
      .clc.f1.f1 configure -relief flat
    }
  }
  bind .clc.f0.lb <Up> {
    proc clc_get_first {} {
      global WinSize

      if { [set sel [.clc.f0.lb curselection]] == "" } {
	set sel [.clc.f0.lb nearest 0]
      }
      if { [incr sel -1] < 0 } {
	set sel 0
      }
      .clc.f0.lb select clear
      .clc.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .clc.f0.lb] / $WinSize(.clc,y)]
      set i [.clc.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .clc.f0.lb yview [expr $sel - 2]
      }
    }

    clc_get_first
  }
  bind .clc.f0.lb <Down> {
    proc clc_get_last {} {
      global WinSize

      if { [set sel [.clc.f0.lb curselection]] == "" } {
	set sel [.clc.f0.lb nearest 0]
      }
      if { [incr sel 1] >= [.clc.f0.lb size] } {
	incr sel -1
      }
      .clc.f0.lb select clear
      .clc.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .clc.f0.lb] / $WinSize(.clc,y)]
      set i [.clc.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .clc.f0.lb yview [expr $sel - 2]
      }
    }

    clc_get_last
  }
  bind .clc.f0.lb <Right> [bind .clc.f0.lb <Down>]
  bind .clc.f0.lb <Left> [bind .clc.f0.lb <Up>]
  bind .clc.f0.lb <FocusOut> {focus .clc.f0.lb}

  if { [catch {wm geometry .clc $WinPos(.clc)}] } {
    wm geometry .clc +200+200
  }
  set WinPos(.clc) [wm geometry .clc]
  wm minsize .clc 20 5
  wm title .clc "Command line completion"
  wm protocol .clc WM_DELETE_WINDOW {set CompReady 1}
  wm protocol .clc WM_TAKE_FOCUS {focus .clc.f0.lb}
  tkwait visibility .clc
  grab .clc
  update
  scan [lindex [.clc.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.clc,x) [expr [winfo width .clc.f0.lb] / $w]
  set WinSize(.clc,y) [expr [winfo height .clc.f0.lb] / $h]
  focus .clc.f0.lb
  tkwait variable CompReady
  set WinPos(.clc) [wm geometry .clc]
  catch { destroy .clc }
  focus .f5.text
  update idletasks
}
################################################################################
#
# display a listbox containing overloaded c++ functions for setting a breakpoint
#
################################################################################
proc choose_bpt { bpt_list } {
  global WinSize WinPos ChooseBptReady

  set bptlist [split $bpt_list \n]
  set len [expr [llength $bptlist] - 2]
  set bptlist [lrange $bptlist 2 $len]
  set ChooseBptReady 0
  focus none
  catch { destroy .chbpt }
  toplevel .chbpt
  wm transient .chbpt .
  frame .chbpt.f0
  frame .chbpt.f1 -relief raised -border 2
  listbox .chbpt.f0.lb -setgrid 1 \
    -yscrollcommand {.chbpt.f0.yscr set} -xscrollcommand {.chbpt.f1.xscr set}
  foreach bpt $bptlist {
    if { [cequal $bpt ""] } continue
    regsub "^\\\[\[0-9\]+\\\] " $bpt "" bpt
    .chbpt.f0.lb insert end $bpt
  }
  .chbpt.f0.lb select from 0
  scrollbar .chbpt.f0.yscr -orient vertical -command {.chbpt.f0.lb yview}
  scrollbar .chbpt.f1.xscr -orient horizontal -command {.chbpt.f0.lb xview}
  frame .chbpt.f1.f0 -relief sunken -border 1
  button .chbpt.f1.f0.ok -relief raised -border 2 -text "  OK  " \
    -command {set ChooseBptReady 0}
  frame .chbpt.f1.f1 -relief flat -border 1
  button .chbpt.f1.f1.cancel -relief raised -border 2 -text "  Cancel  " \
    -command {set ChooseBptReady 1}
  frame .chbpt.f1.f2 -relief flat -border 1
  button .chbpt.f1.f2.all -relief raised -border 2 -text "  Select all  " \
    -command {set ChooseBptReady 2}

  pack .chbpt.f0.lb -side left -fill both -expand 1
  pack .chbpt.f0.yscr -side right -fill y
  pack .chbpt.f1.xscr -side top -fill x
  pack .chbpt.f1.f0.ok -expand 1 -padx 6 -pady 6
  pack .chbpt.f1.f0 -side right -padx 10 -pady 10
  pack .chbpt.f1.f1.cancel -expand 1 -padx 6 -pady 6
  pack .chbpt.f1.f1 -side right -padx 10 -pady 10
  pack .chbpt.f1.f2.all -expand 1 -padx 6 -pady 6
  pack .chbpt.f1.f2 -side right -padx 10 -pady 10
  pack .chbpt.f0 -side top -fill both -expand 1
  pack .chbpt.f1 -side top -fill x

  bind .chbpt <Visibility> {check_visibility %W}

  bind .chbpt.f0.lb <1> {
    %W select from [%W nearest %y]
  }
  bind .chbpt.f0.lb <Double-1> {.chbpt.f1.f0.ok invoke}
  bind .chbpt.f0.lb <B1-Motion> [bind .chbpt.f0.lb <1>]
  bind .chbpt.f0.lb <Shift-1> { }
  bind .chbpt.f0.lb <Shift-B1-Motion> { }
  bind .chbpt.f0.lb <Return> {
    if { [lindex [.chbpt.f1.f0 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f0.ok invoke
    } elseif { [lindex [.chbpt.f1.f1 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f1.cancel invoke
    } else {
      .chbpt.f1.f2.all invoke
    }
  }
  bind .chbpt.f0.lb <KP_Enter> [bind .chbpt.f0.lb <Return>]
  bind .chbpt.f0.lb <Control-c> {.chbpt.f1.f1.cancel invoke}
  bind .chbpt.f0.lb <Tab> {
    if { [lindex [.chbpt.f1.f0 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f0 configure -relief flat
      .chbpt.f1.f1 configure -relief flat
      .chbpt.f1.f2 configure -relief sunken
    } elseif { [lindex [.chbpt.f1.f1 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f0 configure -relief sunken
      .chbpt.f1.f1 configure -relief flat
      .chbpt.f1.f2 configure -relief flat
    } else {
      .chbpt.f1.f0 configure -relief flat
      .chbpt.f1.f1 configure -relief sunken
      .chbpt.f1.f2 configure -relief flat
    }
  }
  bind .chbpt.f0.lb <Shift-Tab> {
    if { [lindex [.chbpt.f1.f0 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f0 configure -relief flat
      .chbpt.f1.f1 configure -relief sunken
      .chbpt.f1.f2 configure -relief flat
    } elseif { [lindex [.chbpt.f1.f1 configure -relief] 4] == "sunken" } {
      .chbpt.f1.f0 configure -relief flat
      .chbpt.f1.f1 configure -relief flat
      .chbpt.f1.f2 configure -relief sunken
    } else {
      .chbpt.f1.f0 configure -relief sunken
      .chbpt.f1.f1 configure -relief flat
      .chbpt.f1.f2 configure -relief flat
    }
  }
  bind .chbpt.f0.lb <Up> {
    proc chbpt_get_first {} {
      global WinSize

      if { [set sel [.chbpt.f0.lb curselection]] == "" } {
	set sel [.chbpt.f0.lb nearest 0]
      }
      if { [incr sel -1] < 0 } {
	set sel 0
      }
      .chbpt.f0.lb select clear
      .chbpt.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .chbpt.f0.lb] / $WinSize(.chbpt,y)]
      set i [.chbpt.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .chbpt.f0.lb yview [expr $sel - 2]
      }
    }

    chbpt_get_first
  }
  bind .chbpt.f0.lb <Down> {
    proc chbpt_get_last {} {
      global WinSize

      if { [set sel [.chbpt.f0.lb curselection]] == "" } {
	set sel [.chbpt.f0.lb nearest 0]
      }
      if { [incr sel 1] >= [.chbpt.f0.lb size] } {
	incr sel -1
      }
      .chbpt.f0.lb select clear
      .chbpt.f0.lb select from $sel
      # make the selected item visible within the listbox
      # (similar to "yview -pickplace pos" for text widgets)
      set h [expr [winfo height .chbpt.f0.lb] / $WinSize(.chbpt,y)]
      set i [.chbpt.f0.lb nearest 0]
      if { ($sel < $i) || ($sel >= [expr $i + $h - 1]) } {
        .chbpt.f0.lb yview [expr $sel - 2]
      }
    }

    chbpt_get_last
  }
  bind .chbpt.f0.lb <Right> [bind .chbpt.f0.lb <Down>]
  bind .chbpt.f0.lb <Left> [bind .chbpt.f0.lb <Up>]
  bind .chbpt.f0.lb <FocusOut> {focus .chbpt.f0.lb}

  if { [catch {wm geometry .chbpt $WinPos(.chbpt)}] } {
    wm geometry .chbpt +200+200
  }
  set WinPos(.chbpt) [wm geometry .chbpt]
  wm minsize .chbpt 30 10
  wm title .chbpt "Select overloaded function"
  wm protocol .chbpt WM_DELETE_WINDOW {set ChooseBptReady 1}
  wm protocol .chbpt WM_TAKE_FOCUS {focus .chbpt.f0.lb}
  tkwait visibility .chbpt
  grab .chbpt
  update
  scan [lindex [.chbpt.f0.lb configure -geometry] 4] "%dx%d" w h
  set WinSize(.chbpt,x) [expr [winfo width .chbpt.f0.lb] / $w]
  set WinSize(.chbpt,y) [expr [winfo height .chbpt.f0.lb] / $h]
  focus .chbpt.f0.lb
  tkwait variable ChooseBptReady
  switch $ChooseBptReady {
    0 { set result [expr [.chbpt.f0.lb curselection] + 2] }
    1 { set result 0 }
    2 { set result 1 }
  }
  set WinPos(.chbpt) [wm geometry .chbpt]
  catch { destroy .chbpt }
  focus .f5.text
  update idletasks
  return $result
}
################################################################################
#
# raise tgdb's main window (so that it is on top of all other windows)
#
################################################################################
proc raise_main_window {} {
  set geo [wm geometry .]
  wm withdraw .
  wm geometry . $geo
  wm deiconify .
  tkwait visibility .
  raise .
  focus .f5.text
}
################################################################################
#
# raise tgdb's debug window (so that it is on top of all other windows)
#
################################################################################
proc raise_debug_window {} {
  if { [winfo exists .dbg] } {
    set geo [wm geometry .dbg]
    wm withdraw .dbg
    wm geometry .dbg $geo
    wm deiconify .dbg
    tkwait visibility .dbg
    raise .dbg
    focus .dbg
  }
}
################################################################################
#
# raise toplevel window if no modal dialog box is opened (and if this
# feature is enabled by the user)
#
################################################################################
proc check_visibility { w } {
  global Tgdb_option

  if { $Tgdb_option(RaiseWindows) } {
    if { [grab current] != "" } {
      return
    }
    foreach win [winfo children .] {
      if { [cequal [set top [winfo toplevel $win]] .] } continue
      if { [lsearch -exact ".about .help .shell .thelp" $top] != -1 } continue
      if { [string first raise [bind $top <Visibility>]] != -1 } {
        if { [info exists binding] } {
          foreach top [array names binding] {
            lower $top [winfo toplevel $win]
            update
            bind $top <Visibility> $binding($top)
          }
        }
        return
      }
      set binding($top) [bind $top <Visibility>]
      bind $top <Visibility> { }
      raise $top
    }
    update
    if { [info exists binding] } {
      foreach top [array names binding] {
        bind $top <Visibility> $binding($top)
      }
    }
  }
}
################################################################################
#
# raise toplevel windows or main window
#
################################################################################
proc raise_windows {} {
  global Tgdb_option

  if { $Tgdb_option(RaiseWindows) } {
    foreach win [winfo children .] {
      if { [cequal [set top [winfo toplevel $win]] .] } continue
      if { [lsearch -exact ".about .help .shell .thelp" $top] != -1 } continue
      if { [cequal $win $top] } {
        if { [string first raise [bind $top <Visibility>]] != -1 } continue
        set binding($top) [bind $top <Visibility>]
        bind $top <Visibility> { }
	raise $top
      }
    }
    update
    if { [info exists binding] } {
      foreach top [array names binding] {
	bind $top <Visibility> $binding($top)
      }
    }
  } else {
    raise_main_window
  }
}
################################################################################
#
# toggle (cycle) windows
#
################################################################################
proc toggle_windows {} {
  if { [set focus [focus]] == "none" } {
    set win "."
  } else {
    set windows ""
    foreach win ". [winfo children .]" {
      set top [winfo toplevel $win]
      if { [lsearch -exact $windows $top] == -1 } {
        lappend windows $top
      }
    }
    set top [winfo toplevel $focus]
    if { [set idx [lsearch -exact $windows $top]] == -1 } {
      set win "."
    } else {
      set idx [expr ($idx + 1) % [llength $windows]]
      set win [lindex $windows $idx]
    }
    if { "$win" == "$top" } {
      return
    }
  }
  set geo [wm geometry $win]
  wm withdraw $win
  wm geometry $win $geo
  wm deiconify $win
  tkwait visibility $win
  raise $win
  focus $win
}
### EOF ########################################################################
