You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
212 lines
5.9 KiB
Tcl
212 lines
5.9 KiB
Tcl
# GDBtk (Insight) entry point
|
|
# Copyright (C) 1997, 1998, 1999, 2002, 2003, 2004, 2008 Red Hat, Inc.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License (GPL) as published by
|
|
# the Free Software Foundation; either version 2 of the License, or (at
|
|
# your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
|
|
|
|
# State is controlled by 5 global boolean variables.
|
|
#
|
|
# gdb_target_changed
|
|
# gdb_exe_changed
|
|
# gdb_running
|
|
# gdb_downloading
|
|
# gdb_loaded
|
|
|
|
################### Initialization code #########################
|
|
|
|
# If GDBtk fails to start at all, you might want to uncomment one or
|
|
# both of these.
|
|
#set tcl_traceExec 2
|
|
#set tcl_traceCompile 1
|
|
|
|
# Add gdb's Tcl library directory to the end of the auto-load search path, if
|
|
# it isn't already on the path.
|
|
# Also, add the plugins directory if it exists.
|
|
# Note: GDBTK_LIBRARY will be set in tcl_findLibrary before main.tcl is called.
|
|
|
|
set gdb_plugins ""
|
|
if {[info exists auto_path]} {
|
|
if {[lsearch -exact $auto_path $GDBTK_LIBRARY] < 0} {
|
|
lappend auto_path $GDBTK_LIBRARY
|
|
}
|
|
|
|
# Add default plugins directory, which will be [name of exe]/../../lib/insight1.0
|
|
set exename [info nameofexecutable]
|
|
set dir [file join [file dirname [file dirname $exename]] lib insight1.0]
|
|
if {[file exists $dir]} {
|
|
lappend gdb_plugins $dir
|
|
lappend auto_path $dir
|
|
}
|
|
# Add any user-specified plugins directories
|
|
if {[info exists env(INSIGHT_PLUGINS)]} {
|
|
set dirs [split $env(INSIGHT_PLUGINS) :]
|
|
lappend gdb_plugins $dirs
|
|
lappend auto_path $dirs
|
|
}
|
|
}
|
|
|
|
|
|
# Require the packages we need. Most are loaded already, but this will catch
|
|
# any odd errors... :
|
|
|
|
foreach p {{Tcl 8.0} {Tk 8.0} {Itcl 3.0} {Itk 3.0} {Gdbtk 1.0} {combobox 2.2} {debug 1.0}} {
|
|
if {[catch {package require [lindex $p 0] [lindex $p 1]} msg]} {
|
|
if {![info exists ::env(GDBTK_TEST_RUNNING)] || $::env(GDBTK_TEST_RUNNING) == 0} {
|
|
if {$::tcl_platform(platform) != "windows"} {
|
|
puts stderr "Error: $msg"
|
|
}
|
|
catch {tk_messageBox -title Error -message $msg -icon error -type ok}
|
|
}
|
|
exit -1
|
|
} else {
|
|
#puts "Loaded [lindex $p 0] $msg"
|
|
}
|
|
}
|
|
|
|
namespace import itcl::*
|
|
namespace import debug::*
|
|
|
|
# Finally, load Iwidgets
|
|
if {[info exists IWIDGETS_LIBRARY]} {
|
|
lappend auto_path $IWIDGETS_LIBRARY
|
|
}
|
|
if {[catch {package require Iwidgets} msg]} {
|
|
if {![info exists ::env(GDBTK_TEST_RUNNING)] || $::env(GDBTK_TEST_RUNNING) == 0} {
|
|
if {$::tcl_platform(platform) != "windows"} {
|
|
puts stderr "Error: $msg"
|
|
}
|
|
catch {tk_messageBox -title Error -message $msg -icon error -type ok}
|
|
}
|
|
exit -1
|
|
}
|
|
|
|
|
|
# Environment variables controlling debugging:
|
|
# GDBTK_TRACE
|
|
# unset or 0 no tracing
|
|
# 1 tracing initialized but not started
|
|
# 2 tracing initialized and started
|
|
#
|
|
# GDBTK_DEBUGFILE - filename to write debugging messages and
|
|
# trace information (if tracing is enabled).
|
|
#
|
|
if {[info exists env(GDBTK_TRACE)] && $env(GDBTK_TRACE) != 0} {
|
|
# WARNING: the tracing code must not trace into itself or
|
|
# infinite recursion will result. As currently configured
|
|
# the tracing code will not trace basic tcl functions or anything defined
|
|
# before debug::init. For this reason we must source the DebugWin
|
|
# code before debug::init is called.
|
|
source [file join $GDBTK_LIBRARY debugwin.ith]
|
|
source [file join $GDBTK_LIBRARY debugwin.itb]
|
|
|
|
# Calling this installs our hooks for tracing and profiling.
|
|
# This WILL slow things down.
|
|
::debug::init
|
|
|
|
if {$env(GDBTK_TRACE) == 2} {
|
|
::debug::trace_start
|
|
}
|
|
}
|
|
|
|
if {[info exists env(GDBTK_DEBUG)] && $env(GDBTK_DEBUG) != 0} {
|
|
if {[info exists env(GDBTK_DEBUGFILE)]} {
|
|
::debug::logfile $env(GDBTK_DEBUGFILE)
|
|
} else {
|
|
::debug::logfile "insight.log"
|
|
}
|
|
}
|
|
|
|
# For testing
|
|
set _test(interactive) 0
|
|
|
|
# Set up platform globals. We replace Tcl's tcl_platform with
|
|
# our own version which knows the difference between cygwin and
|
|
# mingw.
|
|
global gdbtk_platform
|
|
set gdbtk_platform(platform) $tcl_platform(platform)
|
|
switch $tcl_platform(platform) {
|
|
windows {
|
|
if {[llength [info commands ide_cygwin_path]] == 0} {
|
|
set gdbtk_platform(os) "mingw"
|
|
} else {
|
|
set gdbtk_platform(os) "cygwin"
|
|
}
|
|
}
|
|
|
|
default {
|
|
set gdbtk_platform(os) $tcl_platform(os)
|
|
}
|
|
}
|
|
set gdbtk_platform(osVersion) $tcl_platform(osVersion)
|
|
|
|
# set traces on state variables
|
|
trace variable gdb_running w do_state_hook
|
|
trace variable gdb_downloading w do_state_hook
|
|
trace variable gdb_loaded w do_state_hook
|
|
define_hook state_hook
|
|
|
|
# set up preferences
|
|
pref init
|
|
|
|
# let libgui tell us how to feel
|
|
standard_look_and_feel
|
|
|
|
# now let GDB set its default preferences
|
|
pref_set_defaults
|
|
|
|
# read in preferences
|
|
pref_read
|
|
|
|
init_disassembly_flavor
|
|
|
|
# initialize state variables
|
|
initialize_gdbtk
|
|
|
|
# Arrange for session code to notice when file changes.
|
|
add_hook file_changed_hook Session::notice_file_change
|
|
|
|
ManagedWin::init
|
|
|
|
# This stuff will help us play nice with WindowMaker's AppIcons.
|
|
# Can't do the first bit yet, since we don't get this from gdb...
|
|
# wm command . [concat $argv0 $argv]
|
|
wm group . .
|
|
|
|
# some initial commands to get gdb in the right mode
|
|
gdb_cmd {set height 0}
|
|
gdb_cmd {set width 0}
|
|
|
|
if {[info exists env(GDBTK_TEST_RUNNING)] && $env(GDBTK_TEST_RUNNING)} {
|
|
set gdb_target_name "exec"
|
|
} else {
|
|
# gdb_target_name is the name of the GDB target; that is, the argument
|
|
# to the GDB target command.
|
|
set gdb_target_name ""
|
|
# By setting gdb_target_changed, we force a target dialog
|
|
# to be displayed on the first "run"
|
|
set gdb_target_changed 1
|
|
}
|
|
|
|
update
|
|
|
|
# Uncomment the next line if you want a splash screen at startup...
|
|
# ManagedWin::open About -transient -expire 5000
|
|
|
|
# initialize IPC to enable multiple Insight's to communicate
|
|
# with each other.
|
|
set iipc 0
|
|
if {[pref get gdb/ipc/enabled]} {
|
|
set ::insight_ipc [Iipc \#auto]
|
|
}
|
|
|
|
gdbtk_idle
|
|
|