From: Tom Tromey Date: Wed, 24 Jan 1996 06:27:59 +0000 (+0000) Subject: Updated for Tcl 7.5a2 and Tk 4.1a2 X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4e327047ce195fe703b5ee64badca4631883cbe0;p=binutils-gdb.git Updated for Tcl 7.5a2 and Tk 4.1a2 --- diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 1441d3ce33e..e8ccefe3f6f 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -87,14 +87,6 @@ Wed Jan 17 13:22:27 1996 Stan Shebs * remote-nindy.c (nindy_ops): Ditto. * remote-udi.c (udi_ops): Ditto. -Tue Jan 16 11:22:58 1996 Stu Grossman (grossman@cygnus.com) - - * Makefile.in (CLIBS): Add LIBS to allow libraries to be - specified on the make command line (via make LIBS=xxx). -start-sanitize-gm - * configure.in (enable-gm): magic.o -> gmagic.o. -end-sanitize-gm - Tue Jan 16 18:00:35 1996 James G. Smith * remote-mips.c (pmon_opn, pmon_wait, pmon_makeb64, pmon_zeroset, @@ -107,6 +99,26 @@ Tue Jan 16 18:00:35 1996 James G. Smith (mips_enter_debug, mips_exit_debug): New functions. (pmon_ops): New target definition structure. +Tue Jan 16 11:22:58 1996 Stu Grossman (grossman@cygnus.com) + + * Makefile.in (CLIBS): Add LIBS to allow libraries to be + specified on the make command line (via make LIBS=xxx). +start-sanitize-gm + * configure.in (enable-gm): magic.o -> gmagic.o. +end-sanitize-gm + +start-sanitize-gdbtk +Mon Jan 15 09:58:41 1996 Tom Tromey + + * gdbtk.tcl (create_expr_window): Many changes to update GUI. + (add_expr): Changes from create_expr_window. + (create_command_window): Set focus. + (delete_expr): Rewrote. + (expr_update_button): New proc. + (add_expr): Put bindings on FocusIn, FocusOut. + Don't allow .file_popup to be torn off. +end-sanitize-gdbtk + Fri Jan 12 21:41:58 1996 Jeffrey A Law (law@cygnus.com) * symtab.c (find_pc_symtab): Don't lose if OBJF_REORDERED @@ -132,6 +144,30 @@ Fri Jan 12 13:11:42 1996 Stan Shebs * remote.c (remotetimeout): New GDB variable, use to set the remote timeout for reading. +start-sanitize-gdbtk +Fri Jan 12 09:36:17 1996 Tom Tromey + + * gdbtk.tcl (gdbtk_tcl_query): Swap Yes and No buttons. + (update_listing): Use lassign. Use "see" to scroll. Don't need + screen_top, screen_bot, screen_height. + (update_assembly): Use "see" to scroll. + (textscrollproc): Removed. + (create_file_win): Don't use textscrollproc. + (asmscrollproc): Removed. + (create_asm_window): Don't use asmscrollproc. + (create_asm_win): Ditto. + (screen_height, screen_top, screen_bot): Removed. + (run_editor): New proc. + (build_framework): Use it. + (create_file_win, create_source_window): Don't use textscrollproc. + (create_breakpoints_window): Set -xscrollcommand on canvas. + (not_implemented_yet): Default button is 0. + (delete_char): Don't use tk_textBackspace. + (create_command_window): Allow Tk bindings to fire after deleting + character. + (create_command_window): Make Delete delete left, not right. +end-sanitize-gdbtk + Fri Jan 12 07:14:27 1996 Fred Fish * lynx-nat.c, irix4-nat.c, sparc-nat.c: Include gdbcore.h @@ -158,97 +194,21 @@ Thu Jan 11 17:21:25 1996 Per Bothner parameter type as the expected type when evaluating arg expressions. * ch-lang.c (evaluate_subexp_chill): Likewise (for MULTI_SUBSCRIPT). -Wed Jan 10 11:25:37 1996 Fred Fish +start-sanitize-gdbtk +Thu Jan 11 10:08:14 1996 Tom Tromey + + * main.c (main): Disable window interface if --help or --version + specified. + + * gdbtk.tcl (FSBox): Don't use tk_listboxSingleSelect. + + Changes in sync with expect: + * configure.in (ENABLE_GDBTK): Use CY_AC_PATH_TCL and + CY_AC_PATH_TK. + * aclocal.m4: Replaced with version from expect. + * configure: Regenerated. +end-sanitize-gdbtk - * coredep.c: Renamed to core-aout.c - * core-svr4.c: Renamed to core-regset.c - * Makefile.in (ALLDEPFILES): Account for renamings. - * corelow.c (core_file_fns): Add, points to chain of structs. - (add_core_fns): New function to build chain of structs. - (get_core_registers): Modify to search core functions chain and call - appropriate fetch_core_registers function based on core file flavour. - * gdbcore.h (fetch_core_registers): Remove declaration. - (struct core_fns): Define struct for core function info. - * i386m3-nat.c: Update comment for filename change (coredep->core-aout) - * a68v-nat.c (fetch_core_registers): Remove stub, not needed now. - * alpha-nat.c (fetch_core_registers): Make static. - (alpha_core_fns, _initialize_core_alpha): New struct and func. - * core-aout.c (fetch_core_registers): Make static - (aout_core_fns, _initialize_core_aout): New struct and func. - * core-regset.c (fetch_core_registers): Make static. - (regset_core_fns, _initialize_core_regset): New struct and func. - * core-sol2.c (fetch_core_registers): Make static. - (solaris_core_fns, _initialize_core_solaris): New struct and func. - * hp300ux-nat.c (fetch_core_registers): Make static. - (hp300ux_core_fns, _initialize_core_hp300ux): New struct and func. - * i386aix-nat.c (fetch_core_registers): Make static. - (i386aix_core_fns, _initialize_core_i386aix): New struct and func. - * i386mach-nat.c (fetch_core_registers: Make static. - (i386mach_core_fns, _initialize_core_i386mach): New struct and func. - * irix4-nat.c (fetch_core_registers): Make static. - (irix4_core_fns, _initialize_core_irix4): New struct and func. - * irix5-nat.c (fetch_core_registers): - (irix5_core_fns, _initialize_core_irix5): New struct and func. - * lynx-nat.c (fetch_core_registers): Make static. - (lynx_core_fns, _initialize_core_lynx): New struct and func. - * mips-nat.c (fetch_core_registers): Make static. - (mips_core_fns, _initialize_core_mips): New struct and func. - * ns32km3-nat.c (fetch_core_registers): Remove stub. - * rs6000-nat.c (fetch_core_registers): Make static. - (rs6000_core_fns, _initialize_core_rs6000): New struct and func. - * sparc-nat.c (fetch_core_registers): Make static. - (sparc_core_fns, _initialize_core_sparc): New struct and func. - * sun3-nat.c (fetch_core_registers): - (sun3_core_fns, _initialize_core_sun3): New struct and func. - * sun386-nat.c (fetch_core_registers): Remove stub. - * ultra3-nat.c (fetch_core_registers): Make static. - (ultra3_core_fns, _initialize_core_ultra3): New struct and func. - * config/gould/pn.mh (XDEPFILES), - config/i386/fbsd.mh (NATDEPFILES), - config/i386/i386bsd.mh (NATDEPFILES), - config/i386/i386m3.mh (XDEPFILES), - config/i386/i386sco.mh (NATDEPFILES), - config/i386/i386sco4.mh (NATDEPFILES), - config/i386/i386v.mh (NATDEPFILES), - config/i386/i386v32.mh (NATDEPFILES), - config/i386/nbsd.mh (NATDEPFILES), - config/i386/ptx.mh (XDEPFILES), - config/i386/ptx4.mh (XDEPFILES), - config/i386/symmetry.mh (NATDEPFILES), - config/m68k/3b1.mh (XDEPFILES), - config/m68k/cisco.mt (TDEPFILES), - config/m68k/delta68.mh (NATDEPFILES), - config/m68k/dpx2.mh (NATDEPFILES), - config/m68k/hp300bsd.mh (NATDEPFILES), - config/m68k/hp300hpux.mh (NATDEPFILES), - config/m68k/isi.mh (XDEPFILES), - config/m68k/news.mh (NATDEPFILES), - config/m68k/news1000.mh (XDEPFILES), - config/m88k/cxux.mh (NATDEPFILES), - config/m88k/delta88.mh (NATDEPFILES), - config/mips/littlemips.mh (XDEPFILES), - config/mips/mipsm3.mh (XDEPFILES), - config/ns32k/merlin.mh (XDEPFILES), - config/ns32k/nbsd.mh (NATDEPFILES), - config/ns32k/ns32km3.mh (NATDEPFILES), - config/pa/hppabsd.mh (NATDEPFILES), - config/pa/hppahpux.mh (NATDEPFILES), - config/romp/rtbsd.mh (XDEPFILES), - config/tahoe/tahoe.mh (XDEPFILES), - config/vax/vaxbsd.mh (XDEPFILES), - config/vax/vaxult.mh (NATDEPFILES), - config/vax/vaxult2.mh (NATDEPFILES), - Account for coredep.o to core-aout.o name change. - * config/i386/i386dgux (NATDEPFILES), - config/i386/i386sol2.mh (NATDEPFILES), - config/i386/i386v4.mh (NATDEPFILES), - config/i386/linux.mh (NATDEPFILES), - config/i386/ncr3000.mh (NATDEPFILES), - config/m68k/m68kv4.mh (NATDEPFILES), - config/m88k/delta88v4.mh (NATDEPFILES), - config/mips/mipsv4.mh (NATDEPFILES), - Account for core-svr4.o to core-regset.o name change. - Wed Jan 10 16:08:49 1996 Brendan Kehoe * configure.in, configure: Recognize rs6000-*-aix4*. @@ -268,6 +228,47 @@ Wed Jan 10 11:25:37 1996 Fred Fish * stabsread.c (define_symbol): If register value is too large, tell what it is and what max is. +start-sanitize-gdbtk +Wed Jan 10 09:07:22 1996 Tom Tromey + + * gdbtk.tcl (gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, + gdbtk_tcl_flush): Use "see", not "yview". + (gdbtk_tcl_query): Use questhead bitmap. + various: Always wrap condition of 'if' in {...}. + (add_breakpoint_frame): Set -value on radiobuttons. + (lassign): New proc. + (add_breakpoint_frame): Use lassign, not series of assignments. + (decr): Made faster. + (interactive_cmd): Use "see", not "yview". + (not_implemented_yet): Use warning bitmap. + (update_expr): Don't allow $expr to be evalled by Tcl. + (create_expr_window): Don't use "focus". + (delete_char, delete_line): Define globally. + (delete_line, delete_char, create_command_window, update_autocmd, + build_framework, create_asm_win, create_file_win): Use "see", not + "yview". + (create_copyright_window, center_window, bind_widget_after_class): + New procs. + (FSBox,create_command_window, create_autocmd_window): Binding + changes for Tk4. + (textscrollproc): Define globally. + (build_framework): tk_menuBar no longer needed. Keys Prior, Next, + Home, End, Up, and Down are all defined by Tk. + (apply_filespec): Use error bitmap in dialog. + (files_command): Don't use tk_listboxSingleSelect. + (files_command): Don't use "uniq" to remove duplicates from a + list. + (update_assembly): Use lassign. + (create_asm_win): Removed redundant bindings. + (listing_window_button_1, file_popup_menu): Use tk_popup. + (ButtonRelease-1 binding): Just remove tag from window; rest + handled by Tk. + + * gdbtk.c (gdbtk_query): Use Tcl_Merge to provide quoting. + (call_wrapper): Use Tcl_Eval, not Tcl_VarEval. + (gdbtk_call_command): Ditto. +end-sanitize-gdbtk + Tue Jan 9 09:33:53 1996 Jeffrey A Law (law@cygnus.com) * hpread.c (hpread_build_psymtabs): Finish Jan 4th diff --git a/gdb/Makefile.in b/gdb/Makefile.in index 34fada98c2a..975eeda2d9b 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -146,7 +146,6 @@ ENABLE_CLIBS= @ENABLE_CLIBS@ ENABLE_OBS= @ENABLE_OBS@ -# All the includes used for CFLAGS and for lint. # -I. for config files. # -I$(srcdir) for gdb internal headers and possibly for gnu-regex.h also. # -I$(srcdir)/config for more generic config files. @@ -361,7 +360,6 @@ SFILES = blockframe.c breakpoint.c buildsym.c callback.c c-exp.y c-lang.c \ typeprint.c utils.c valarith.c valops.c \ valprint.c values.c serial.c ser-unix.c mdebugread.c os9kread.c -# All source files that lint should look at LINTFILES = $(SFILES) $(YYFILES) init.c # "system" headers. Using these in dependencies is a rather personal diff --git a/gdb/README.GDBTK b/gdb/README.GDBTK index 4756b0ecde8..d2aecdd1d0f 100644 --- a/gdb/README.GDBTK +++ b/gdb/README.GDBTK @@ -23,8 +23,7 @@ Building and installing Building GDBtk is very straightforward. The main difference is that you will need to use the `--enable-gdbtk' option when you run configure in the top level -directory. You will also need to install Tcl version 7.3 (or 7.4), and Tk 3.6. -[We haven't ported to Tk 4.0 yet.] +directory. You will also need to install Tcl version 7.5a2, and Tk 4.1a2. You will also need to have X11 (R4/R5/R6) installed (this is a prerequisite to installing Tk). @@ -307,6 +306,7 @@ generic problems window. I.E. "argc" works, as does "*(argv+argc)" but not "argv[argc]". Solution: None + [ I believe this problem is fixed, but I have not tested it ] o The Breakpoint window does not get automatically updated and changes made in the window are not reflected back in the results from "info br". diff --git a/gdb/aclocal.m4 b/gdb/aclocal.m4 index 19ba7edec84..d23d084cecd 100644 --- a/gdb/aclocal.m4 +++ b/gdb/aclocal.m4 @@ -1,147 +1,605 @@ -AC_DEFUN(CYGNUS_PATH_TK, [ +dnl This file is duplicated in four places: +dnl * gdb/aclocal.m4 +dnl * gdb/testsuite/aclocal.m4 +dnl * expect/aclocal.m4 +dnl * dejagnu/aclocal.m4 +dnl Consider modifying all copies in parallel. +dnl written by Rob Savoye for Cygnus Support +dnl CYGNUS LOCAL: This gets the right posix flag for gcc +AC_DEFUN(CY_AC_TCL_LYNX_POSIX, +[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP]) +AC_MSG_CHECKING([to see if this is LynxOS]) +AC_CACHE_VAL(ac_cv_os_lynx, +[AC_EGREP_CPP(yes, +[/* + * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__" + */ +#if defined(__Lynx__) || defined(Lynx) +yes +#endif +], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)]) # -# Ok, lets find the tk source trees so we can use the headers -# If the directory (presumably symlink) named "tk" exists, use that one -# in preference to any others. Same logic is used when choosing library -# and again with Tcl. +if test "$ac_cv_os_lynx" = "yes" ; then + AC_MSG_RESULT(yes) + AC_DEFINE(LYNX) + AC_MSG_CHECKING([whether -mposix or -X is available]) + AC_CACHE_VAL(ac_cv_c_posix_flag, + [AC_TRY_COMPILE(,[ + /* + * This flag varies depending on how old the compiler is. + * -X is for the old "cc" and "gcc" (based on 1.42). + * -mposix is for the new gcc (at least 2.5.8). + */ + #if defined(__GNUC__) && __GNUC__ >= 2 + choke me + #endif + ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")]) + CC="$CC $ac_cv_c_posix_flag" + AC_MSG_RESULT($ac_cv_c_posix_flag) + else + AC_MSG_RESULT(no) +fi +]) # -AC_CHECKING(for Tk source directory) -TKHDIR="" -for i in `ls -d ${srcdir}/../tk* 2>/dev/null` ${srcdir}/../tk ; do - if test -f $i/tk.h ; then - TKHDIR="-I$i" - fi -done -# if we can't find it, see if one is installed -if test x"$TKHDIR" = x ; then - installed=0 - if test -f $prefix/include/tk.h; then - installed=1 TKHDIR="-I$prefix/include" +# Sometimes the native compiler is a bogus stub for gcc or /usr/ucb/cc. This +# makes configure think it's cross compiling. If --target wasn't used, then +# we can't configure, so something is wrong. +AC_DEFUN(CY_AC_C_CROSS, +[# If we cannot run a trivial program, we must be cross compiling. +AC_MSG_CHECKING(whether cross-compiling) +AC_CACHE_VAL(ac_cv_c_cross,[ +AC_TRY_RUN([ + main(){return(0);}], + ac_cv_c_cross=no, ac_cv_c_cross=yes, ac_cv_c_cross=yes) +]) +if test x"${target}" = x"${host}" -a x"${ac_cv_c_cross}" = x"yes"; then + dnl this hack is cause the message is so long we don't call AC_MSG_ERROR + echo "configure: error: You need to specify --target to cross compile," 1>&2; + echo " or the native compiler is broken" 1>&2; + exit 1; +else + cross_compiling=$ac_cv_c_cross + AC_MSG_RESULT($ac_cv_c_cross) +fi +]) +AC_DEFUN(CY_AC_PATH_TCLH, [ +# +# Ok, lets find the tcl source trees so we can use the headers +# Warning: transition of version 9 to 10 will break this algorithm +# because 10 sorts before 9. We also look for just tcl. We have to +# be careful that we don't match stuff like tclX by accident. +# the alternative search directory is involked by --with-tclinclude +# +no_tcl=true +AC_MSG_CHECKING(for Tcl private headers) +AC_ARG_WITH(tclinclude, [ --with-tclinclude directory where tcl private headers are], with_tclinclude=${withval}) +AC_CACHE_VAL(ac_cv_c_tclh,[ +# first check to see if --with-tclinclude was specified +if test x"${with_tclinclude}" != x ; then + if test -f ${with_tclinclude}/tclInt.h ; then + ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)` else - AC_HEADER_CHECK(tk.h, installed=1) + AC_MSG_ERROR([${with_tclinclude} directory doesn't contain private headers]) fi - if test $installed -eq 0 ; then - TKHDIR="# no Tk directory found" - AC_MSG_WARN(Can't find Tk directory) +fi +# next check in private source directory +# +# since ls returns lowest version numbers first, reverse its output +if test x"${ac_cv_c_tclh}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` \ + ${srcdir}/../../tcl \ + `ls -dr ${srcdir}/../../tcl[[0-9]]* 2>/dev/null` \ + ${srcdir}/../../../tcl \ + `ls -dr ${srcdir}/../../../tcl[[0-9]]* 2>/dev/null ` ; do + if test -f $i/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)` + break + fi + # Tcl 7.5 and greater puts headers in subdirectory. + if test -f $i/generic/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)`/generic + fi + done +fi +# finally check in a few common install locations +# +# since ls returns lowest version numbers first, reverse its output +if test x"${ac_cv_c_tclh}" = x ; then + for i in \ + `ls -dr /usr/local/src/tcl[[0-9]]* 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[[0-9]]* 2>/dev/null` \ + /usr/local/src/tcl \ + /usr/local/lib/tcl \ + ${prefix}/include ; do + if test -f $i/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)` + break + fi + done +fi +# see if one is installed +if test x"${ac_cv_c_tclh}" = x ; then + AC_HEADER_CHECK(tclInt.h, ac_cv_c_tclh=installed, ac_cv_c_tclh="") +fi +]) +if test x"${ac_cv_c_tclh}" = x ; then + TCLHDIR="# no Tcl private headers found" + AC_MSG_ERROR([Can't find Tcl private headers]) +fi +if test x"${ac_cv_c_tclh}" != x ; then + no_tcl="" + if test x"${ac_cv_c_tkh}" = x"installed" ; then + AC_MSG_RESULT([is installed]) + TCLHDIR="" + else + AC_MSG_RESULT([found in ${ac_cv_c_tclh}]) + # this hack is cause the TCLHDIR won't print if there is a "-I" in it. + TCLHDIR="-I${ac_cv_c_tclh}" fi fi -if test x"$TKHDIR" != x ; then - AC_MSG_RESULT(Setting TKHDIR to be $i) + +AC_MSG_CHECKING([Tcl version]) +rm -rf tclmajor tclminor +orig_includes="$CPPFLAGS" + +if test x"${TCLHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TCLHDIR" fi +AC_TRY_RUN([ +#include +#include "tcl.h" +main() { + FILE *maj = fopen("tclmajor","w"); + FILE *min = fopen("tclminor","w"); + fprintf(maj,"%d",TCL_MAJOR_VERSION); + fprintf(min,"%d",TCL_MINOR_VERSION); + fclose(maj); + fclose(min); + return 0; +}], + tclmajor=`cat tclmajor` + tclminor=`cat tclminor` + tclversion=$tclmajor.$tclminor + AC_MSG_RESULT($tclversion) + rm -f tclmajor tclminor +, + AC_MSG_RESULT([can't happen]) +, + AC_MSG_ERROR([can't be cross compiled]) +) +CPPFLAGS="${orig_includes}" + +AC_PROVIDE([$0]) +AC_SUBST(TCLHDIR) +]) +AC_DEFUN(CY_AC_PATH_TCLLIB, [ # -# Ok, lets find the tk library +# Ok, lets find the tcl library # First, look for one uninstalled. +# the alternative search directory is invoked by --with-tcllib # -TKLIB="" -AC_CHECKING(for Tk library) -for i in `ls -d ../tk* 2>/dev/null` ../tk ; do - if test -f "$i/Makefile" ; then - TKLIB=$i/libtk.a + +if test $tclmajor -ge 7 -a $tclminor -ge 4 ; then + installedtcllibroot=tcl$tclversion +else + installedtcllibroot=tcl +fi + +if test x"${no_tcl}" = x ; then + # we reset no_tcl incase something fails here + no_tcl=true + AC_ARG_WITH(tcllib, [ --with-tcllib directory where the tcl library is], + with_tcllib=${withval}) + AC_MSG_CHECKING([for Tcl library]) + AC_CACHE_VAL(ac_cv_c_tcllib,[ + # First check to see if --with-tcllib was specified. + # This requires checking for both the installed and uninstalled name-styles + # since we have no idea if it's installed or not. + if test x"${with_tcllib}" != x ; then + if test -f "${with_tcllib}/lib$installedtcllibroot.so" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.so + elif test -f "${with_tcllib}/libtcl.so" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.so + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be built first. + elif test -f "${with_tcllib}/lib$installedtcllibroot.a" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.a + elif test -f "${with_tcllib}/libtcl.a" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.a + else + AC_MSG_ERROR([${with_tcllib} directory doesn't contain libraries]) + fi fi -done -# If not found, look for installed version -if test x"$TKLIB" = x ; then -dnl This doesn't work because of unresolved symbols. -dnl AC_HAVE_LIBRARY(libtk.a, installed=1, installed=0) - if test -f $prefix/lib/libtk.a; then - installed=1 - else - installed=0 + # then check for a private Tcl library + # Since these are uninstalled, use the simple lib name root. + if test x"${ac_cv_c_tcllib}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[0-9]]* 2>/dev/null` ; do + # Tcl 7.5 and greater puts library in subdir. Look there first. + if test -f "$i/unix/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.so + break + elif test -f "$i/unix/libtcl.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.a + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so + break + + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be + # built first. + elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a + break + fi + done fi - if test $installed -eq 1 ; then - TKLIB="-ltk" + # check in a few common install locations + if test x"${ac_cv_c_tcllib}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + # first look for a freshly built dynamically linked library + if test -f "$i/lib$installedtcllibroot.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.so + break + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be built first. + elif test -f "$i/lib$installedtcllibroot.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.a + break + fi + done fi -fi + # check in a few other private locations + if test x"${ac_cv_c_tcllib}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` ; do + # Tcl 7.5 and greater puts library in subdir. Look there first. + if test -f "$i/unix/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.so + break + elif test -f "$i/unix/libtcl.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.a + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so + break -# If still not found, assume Tk simply hasn't been built yet -if test x"$TKLIB" = x ; then - for i in `ls -d ../tk* 2>/dev/null` ../tk ; do - if test -f "$i/tk.h" ; then - TKLIB=$i/libtk.a + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be + # built first. + elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a + break + fi + done fi - done -fi -if test x"$TKLIB" = x ; then - TKLIB="# no Tk library found" - AC_MSG_WARN(Can't find Tk library) -else - AC_MSG_RESULT(setting TKLIB to be $TKLIB) - no_tk= + # see if one is conveniently installed with the compiler + if test x"${ac_cv_c_tcllib}" = x ; then + orig_libs="$LIBS" + LIBS="$LIBS -l$installedtcllibroot -lm" + AC_TRY_RUN([ + Tcl_AppInit() + { exit(0); }], ac_cv_c_tcllib="-l$installedtcllibroot", ac_cv_c_tcllib="" + , ac_cv_c_tclib="-l$installedtcllibroot") + LIBS="${orig_libs}" + fi + ]) + if test x"${ac_cv_c_tcllib}" = x ; then + TCLLIB="# no Tcl library found" + AC_MSG_WARN(Can't find Tcl library) + else + TCLLIB=${ac_cv_c_tcllib} + AC_MSG_RESULT(found $TCLLIB) + no_tcl= + fi fi -AC_SUBST(TKHDIR) -AC_SUBST(TKLIB) +AC_PROVIDE([$0]) +AC_SUBST(TCLLIB) ]) - - -AC_DEFUN(CYGNUS_PATH_TCL, [ -# -# Ok, lets find the tcl source trees so we can use the headers +AC_DEFUN(CY_AC_PATH_TKH, [ # -# Warning: transition of version 9 to 10 will break this algorithm -# because 10 sorts before 9. +# Ok, lets find the tk source trees so we can use the headers +# If the directory (presumably symlink) named "tk" exists, use that one +# in preference to any others. Same logic is used when choosing library +# and again with Tcl. The search order is the best place to look first, then in +# decreasing significance. The loop breaks if the trigger file is found. +# Note the gross little conversion here of srcdir by cd'ing to the found +# directory. This converts the path from a relative to an absolute, so +# recursive cache variables for the path will work right. We check all +# the possible paths in one loop rather than many seperate loops to speed +# things up. +# the alternative search directory is invoked by --with-tkinclude # -AC_CHECKING(for Tcl source directory) -TCLHDIR="" -for i in `ls -d ${srcdir}/../tcl* 2>/dev/null` ${srcdir}/../tcl ; do - if test -f $i/tclInt.h ; then - TCLHDIR="-I$i" - fi -done -# if we can't find it, see if one is installed -if test x"$TCLHDIR" = x ; then - installed=0 - if test -f $prefix/include/tclInt.h; then - installed=1 TCLHDIR="-I$prefix/include" +AC_MSG_CHECKING(for Tk private headers) +AC_ARG_WITH(tkinclude, [ --with-tkinclude directory where the tk private headers are], + with_tkinclude=${withval}) +no_tk=true +AC_CACHE_VAL(ac_cv_c_tkh,[ +# first check to see if --with-tkinclude was specified +if test x"${with_tkinclude}" != x ; then + if test -f ${with_tkinclude}/tk.h ; then + ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)` else - AC_HEADER_CHECK(tclInt.h, installed=1) + AC_MSG_ERROR([${with_tkinclude} directory doesn't contain private headers]) fi - if test $installed -eq 0 ; then - TCLHDIR="# no Tcl directory found" - AC_MSG_WARN(Can't find Tcl directory) +fi +# next check in private source directory +# +# since ls returns lowest version numbers first, reverse the entire list +# and search for the worst fit, overwriting it with better fits as we find them +if test x"${ac_cv_c_tkh}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` \ + ${srcdir}/../../tk \ + `ls -dr ${srcdir}/../../tk[[0-9]]* 2>/dev/null` \ + ${srcdir}/../../../tk \ + `ls -dr ${srcdir}/../../../tk[[0-9]]* 2>/dev/null ` ; do + if test -f $i/tk.h ; then + ac_cv_c_tkh=`(cd $i; pwd)` + break + fi + # Tk 4.1 and greater puts this in a subdir. + if test -f $i/generic/tk.h; then + ac_cv_c_tkh=`(cd $i; pwd)`/generic + fi + done +fi +# finally check in a few common install locations +# +# since ls returns lowest version numbers first, reverse the entire list +# and search for the worst fit, overwriting it with better fits as we find them +if test x"${ac_cv_c_tkh}" = x ; then + for i in \ + `ls -dr /usr/local/src/tk[[0-9]]* 2>/dev/null` \ + `ls -dr /usr/local/lib/tk[[0-9]]* 2>/dev/null` \ + /usr/local/src/tk \ + /usr/local/lib/tk \ + ${prefix}/include ; do + if test -f $i/tk.h ; then + ac_cv_c_tkh=`(cd $i; pwd)` + break + fi + done +fi +# see if one is installed +if test x"${ac_cv_c_tkh}" = x ; then + AC_HEADER_CHECK(tk.h, ac_cv_c_tkh=installed) +fi +]) +if test x"${ac_cv_c_tkh}" != x ; then + no_tk="" + if test x"${ac_cv_c_tkh}" = x"installed" ; then + AC_MSG_RESULT([is installed]) + TKHDIR="" + else + AC_MSG_RESULT([found in $ac_cv_c_tkh]) + # this hack is cause the TKHDIR won't print if there is a "-I" in it. + TKHDIR="-I${ac_cv_c_tkh}" fi else - AC_MSG_RESULT(setting TCLHDIR to be $i) + TKHDIR="# no Tk directory found" + AC_MSG_WARN([Can't find Tk private headers]) + no_tk=true fi +# if Tk is installed, extract the major/minor version +if test x"${no_tk}" = x ; then +AC_MSG_CHECKING([Tk version]) +rm -rf tkmajor tkminor +orig_includes="$CPPFLAGS" + +if test x"${TCLHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TCLHDIR" +fi +if test x"${TKHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TKHDIR" +fi +if test x"${x_includes}" != x -a x"${x_includes}" != xNONE ; then + CPPFLAGS="$CPPFLAGS -I$x_includes" +fi + +AC_TRY_RUN([ +#include +#include "tk.h" + main() { + FILE *maj = fopen("tkmajor","w"); + FILE *min = fopen("tkminor","w"); + fprintf(maj,"%d",TK_MAJOR_VERSION); + fprintf(min,"%d",TK_MINOR_VERSION); + fclose(maj); + fclose(min); + return 0; +}], + tkmajor=`cat tkmajor` + tkminor=`cat tkminor` + tkversion=$tkmajor.$tkminor + AC_MSG_RESULT($tkversion) + rm -f tkmajor tkminor +, + AC_MSG_ERROR([ +cannot compile a simple X program - suspect your xmkmf is +misconfigured and is incorrectly reporting the location of your X +include or libraries - report this to your system admin]) , + AC_MSG_ERROR([can't be cross compiled]) +) +CPPFLAGS="${orig_includes}" +fi + +AC_PROVIDE([$0]) +AC_SUBST(TKHDIR) +]) +AC_DEFUN(CY_AC_PATH_TKLIB, [ +AC_REQUIRE([CY_AC_PATH_TCL]) # -# Ok, lets find the tcl library -# First, look for the latest uninstalled +# Ok, lets find the tk library +# First, look for the latest private (uninstalled) copy +# Notice that the destinations in backwards priority since the tests have +# no break. +# Then we look for either .a, .so, or Makefile. A Makefile is acceptable +# is it indicates the target has been configured and will (probably) +# soon be built. This allows an entire tree of Tcl software to be +# configured at once and then built. +# the alternative search directory is invoked by --with-tklib # -TCLLIB="" -AC_CHECKING(for Tcl library) -for i in `ls -d ../tcl* 2>/dev/null` ../tcl ; do - if test -f "$i/Makefile" ; then - TCLLIB=$i/libtcl.a + +if test x"${no_tk}" = x ; then + # reset no_tk incase something fails here + no_tk="true" + + if test $tkmajor -ge 4 ; then + installedtklibroot=tk$tkversion + else + installedtkllibroot=tk fi -done -# If not found, look for installed version -if test x"$TCLLIB" = x ; then -dnl Don't use this, since we can't use it for libtk.a. -dnl AC_HAVE_LIBRARY(libtcl.a, installed=1, installed=0) - if test -f $prefix/lib/libtcl.a; then installed=1; else installed=0; fi - if test $installed -eq 1 ; then - TCLLIB="-ltcl" + + AC_ARG_WITH(tklib, [ --with-tklib directory where the tk library is], + with_tklib=${withval}) + AC_MSG_CHECKING([for Tk library]) + AC_CACHE_VAL(ac_cv_c_tklib,[ + # first check to see if --with-tklib was specified + # This requires checking for both the installed and uninstalled name-styles + # since we have no idea if it's installed or not. + if test x"${with_tklib}" != x ; then + if test -f "${with_tklib}/lib$installedtklibroot.so" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.so + no_tk="" + elif test -f "${with_tklib}/libtk.so" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.so + no_tk="" + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtk will be built + elif test -f "${with_tklib}/lib$installedtklibroot.a" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.a + no_tk="" + elif test -f "${with_tklib}/libtk.a" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.a + no_tk="" + else + AC_MSG_ERROR([${with_tklib} directory doesn't contain libraries]) + fi fi -fi -# If still not found, assume Tcl simply hasn't been built yet -if test x"$TCLLIB" = x ; then - for i in `ls -d ../tcl* 2>/dev/null` ../tcl ; do - if test -f "$i/tcl.h" ; then - TCLLIB=$i/libtcl.a + # then check for a private Tk library + # Since these are uninstalled, use the simple lib name root. + if test x"${ac_cv_c_tklib}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[0-9]]* 2>/dev/null` ; do + # Tk 4.1 and greater puts things in subdirs. Check these first. + if test -f "$i/unix/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.so + no_tk= + break + elif test -f "$i/unix/libtk.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.a + no_tk= + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so + no_tk= + break + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtk will be built + elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a + no_tk="" + break + fi + done + fi + # finally check in a few common install locations + if test x"${ac_cv_c_tklib}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + # first look for a freshly built dynamically linked library + if test -f "$i/lib$installedtklibroot.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.so + no_tk="" + break + # then look for a freshly built statically linked library + # if Makefile exists, we assume it's configured and libtcl will be built + elif test -f "$i/lib$installedtklibroot.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.a + no_tk="" + break + fi + done + fi + # check in a few other private locations + if test x"${ac_cv_c_tklib}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` ; do + # Tk 4.1 and greater puts things in subdirs. Check these first. + if test -f "$i/unix/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.so + no_tk= + break + elif test -f "$i/unix/libtk.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtk.a + no_tk= + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so + no_tk="" + break + # then look for a freshly built statically linked library + # if Makefile exists, we assume it's configured and libtcl will be built + elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a + no_tk="" + break + fi + done + fi + # see if one is conveniently installed with the compiler + if test x"${ac_cv_c_tklib}" = x ; then + AC_REQUIRE([AC_PATH_X]) + orig_libs="$LIBS" + LIBS="$LIBS -l$installedtklibroot $x_libraries $ac_cv_c_tcllib -lm" + AC_TRY_RUN([ + Tcl_AppInit() + { exit(0); }], ac_cv_c_tklib="-l$installedtklibroot", ac_cv_c_tklib="" + , ac_cv_c_tklib="-l$installedtklibroot") + LIBS="${orig_libs}" + fi + ]) + if test x"${ac_cv_c_tklib}" = x ; then + TKLIB="# no Tk library found" + AC_MSG_WARN(Can't find Tk library) + else + TKLIB=$ac_cv_c_tklib + AC_MSG_RESULT(found $TKLIB) + no_tk= fi - done -fi - -if test x"$TCLLIB" = x ; then - TCLLIB="# no Tcl library found" - AC_MSG_WARN(Can't find Tcl library) -else - AC_MSG_RESULT(setting TCLLIB to be $TCLLIB) fi - -AC_SUBST(TCLHDIR) -AC_SUBST(TCLLIB) -]) \ No newline at end of file +AC_PROVIDE([$0]) +AC_SUBST(TKLIB) +]) +AC_DEFUN(CY_AC_PATH_TK, [ + CY_AC_PATH_TKH + CY_AC_PATH_TKLIB +]) +AC_DEFUN(CY_AC_PATH_TCL, [ + CY_AC_PATH_TCLH + CY_AC_PATH_TCLLIB +]) diff --git a/gdb/configure b/gdb/configure index c3d8d8b3ad9..46d25f3abca 100755 --- a/gdb/configure +++ b/gdb/configure @@ -21,6 +21,14 @@ ac_help="$ac_help --enable-gdbtk " ac_help="$ac_help --with-x use the X Window System" +ac_help="$ac_help + --with-tclinclude directory where tcl private headers are" +ac_help="$ac_help + --with-tcllib directory where the tcl library is" +ac_help="$ac_help + --with-tkinclude directory where the tk private headers are" +ac_help="$ac_help + --with-tklib directory where the tk library is" # Initialize some variables set by options. # The variables have the same names as the options, with @@ -616,7 +624,7 @@ else # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error @@ -630,7 +638,7 @@ else rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error @@ -657,7 +665,7 @@ echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking for AIX""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 else cat > conftest.$ac_ext < EOF @@ -1018,7 +1026,7 @@ else ac_cv_c_cross=yes else cat > conftest.$ac_ext <&6 else cat > conftest.$ac_ext < #include @@ -1062,7 +1070,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -1080,7 +1088,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -1101,7 +1109,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -1139,7 +1147,7 @@ if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF @@ -1172,7 +1180,7 @@ if eval "test \"`echo '$''{'ac_cv_header_stat_broken'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include @@ -1230,7 +1238,7 @@ if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext < EOF @@ -1579,7 +1587,7 @@ rm -f conftest* ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext <&6 -TKHDIR="" -for i in `ls -d ${srcdir}/../tk* 2>/dev/null` ${srcdir}/../tk ; do - if test -f $i/tk.h ; then - TKHDIR="-I$i" - fi -done -# if we can't find it, see if one is installed -if test x"$TKHDIR" = x ; then - installed=0 - if test -f $prefix/include/tk.h; then - installed=1 TKHDIR="-I$prefix/include" +no_tcl=true +echo $ac_n "checking for Tcl private headers""... $ac_c" 1>&6 +# Check whether --with-tclinclude or --without-tclinclude was given. +if test "${with_tclinclude+set}" = set; then + withval="$with_tclinclude" + with_tclinclude=${withval} +fi + +if eval "test \"`echo '$''{'ac_cv_c_tclh'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + +# first check to see if --with-tclinclude was specified +if test x"${with_tclinclude}" != x ; then + if test -f ${with_tclinclude}/tclInt.h ; then + ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)` else - ac_safe=`echo "tk.h" | tr './\055' '___'` -echo $ac_n "checking for tk.h""... $ac_c" 1>&6 + { echo "configure: error: ${with_tclinclude} directory doesn't contain private headers" 1>&2; exit 1; } + fi +fi +# next check in private source directory +# +# since ls returns lowest version numbers first, reverse its output +if test x"${ac_cv_c_tclh}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[0-9]* 2>/dev/null` \ + ${srcdir}/../../tcl \ + `ls -dr ${srcdir}/../../tcl[0-9]* 2>/dev/null` \ + ${srcdir}/../../../tcl \ + `ls -dr ${srcdir}/../../../tcl[0-9]* 2>/dev/null ` ; do + if test -f $i/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)` + break + fi + # Tcl 7.5 and greater puts headers in subdirectory. + if test -f $i/generic/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)`/generic + fi + done +fi +# finally check in a few common install locations +# +# since ls returns lowest version numbers first, reverse its output +if test x"${ac_cv_c_tclh}" = x ; then + for i in \ + `ls -dr /usr/local/src/tcl[0-9]* 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[0-9]* 2>/dev/null` \ + /usr/local/src/tcl \ + /usr/local/lib/tcl \ + ${prefix}/include ; do + if test -f $i/tclInt.h ; then + ac_cv_c_tclh=`(cd $i; pwd)` + break + fi + done +fi +# see if one is installed +if test x"${ac_cv_c_tclh}" = x ; then + ac_safe=`echo "tclInt.h" | tr './\055' '___'` +echo $ac_n "checking for tclInt.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < +#include EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` @@ -1931,93 +1987,324 @@ rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 - installed=1 + ac_cv_c_tclh=installed else echo "$ac_t""no" 1>&6 +ac_cv_c_tclh="" fi +fi + +fi + +if test x"${ac_cv_c_tclh}" = x ; then + TCLHDIR="# no Tcl private headers found" + { echo "configure: error: Can't find Tcl private headers" 1>&2; exit 1; } +fi +if test x"${ac_cv_c_tclh}" != x ; then + no_tcl="" + if test x"${ac_cv_c_tkh}" = x"installed" ; then + echo "$ac_t""is installed" 1>&6 + TCLHDIR="" + else + echo "$ac_t""found in ${ac_cv_c_tclh}" 1>&6 + # this hack is cause the TCLHDIR won't print if there is a "-I" in it. + TCLHDIR="-I${ac_cv_c_tclh}" fi - if test $installed -eq 0 ; then - TKHDIR="# no Tk directory found" - echo "configure: warning: Can't find Tk directory" 1>&2 - fi fi -if test x"$TKHDIR" != x ; then - echo "$ac_t""Setting TKHDIR to be $i" 1>&6 + +echo $ac_n "checking Tcl version""... $ac_c" 1>&6 +rm -rf tclmajor tclminor +orig_includes="$CPPFLAGS" + +if test x"${TCLHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TCLHDIR" +fi + +if test "$cross_compiling" = yes; then + { echo "configure: error: can't be cross compiled" 1>&2; exit 1; } + +else +cat > conftest.$ac_ext < +#include "tcl.h" +main() { + FILE *maj = fopen("tclmajor","w"); + FILE *min = fopen("tclminor","w"); + fprintf(maj,"%d",TCL_MAJOR_VERSION); + fprintf(min,"%d",TCL_MINOR_VERSION); + fclose(maj); + fclose(min); + return 0; +} +EOF +eval $ac_link +if test -s conftest && (./conftest; exit) 2>/dev/null; then + tclmajor=`cat tclmajor` + tclminor=`cat tclminor` + tclversion=$tclmajor.$tclminor + echo "$ac_t""$tclversion" 1>&6 + rm -f tclmajor tclminor + +else + echo "$ac_t""can't happen" 1>&6 + +fi fi +rm -fr conftest* +CPPFLAGS="${orig_includes}" + + + + # -# Ok, lets find the tk library +# Ok, lets find the tcl library # First, look for one uninstalled. +# the alternative search directory is invoked by --with-tcllib # -TKLIB="" -echo "checking for Tk library" 1>&6 -for i in `ls -d ../tk* 2>/dev/null` ../tk ; do - if test -f "$i/Makefile" ; then - TKLIB=$i/libtk.a + +if test $tclmajor -ge 7 -a $tclminor -ge 4 ; then + installedtcllibroot=tcl$tclversion +else + installedtcllibroot=tcl +fi + +if test x"${no_tcl}" = x ; then + # we reset no_tcl incase something fails here + no_tcl=true + # Check whether --with-tcllib or --without-tcllib was given. +if test "${with_tcllib+set}" = set; then + withval="$with_tcllib" + with_tcllib=${withval} +fi + + echo $ac_n "checking for Tcl library""... $ac_c" 1>&6 + if eval "test \"`echo '$''{'ac_cv_c_tcllib'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + # First check to see if --with-tcllib was specified. + # This requires checking for both the installed and uninstalled name-styles + # since we have no idea if it's installed or not. + if test x"${with_tcllib}" != x ; then + if test -f "${with_tcllib}/lib$installedtcllibroot.so" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.so + elif test -f "${with_tcllib}/libtcl.so" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.so + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be built first. + elif test -f "${with_tcllib}/lib$installedtcllibroot.a" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.a + elif test -f "${with_tcllib}/libtcl.a" ; then + ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.a + else + { echo "configure: error: ${with_tcllib} directory doesn't contain libraries" 1>&2; exit 1; } + fi fi -done -# If not found, look for installed version -if test x"$TKLIB" = x ; then - if test -f $prefix/lib/libtk.a; then - installed=1 - else - installed=0 + # then check for a private Tcl library + # Since these are uninstalled, use the simple lib name root. + if test x"${ac_cv_c_tcllib}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[0-9]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[0-9]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[0-9]* 2>/dev/null` ; do + # Tcl 7.5 and greater puts library in subdir. Look there first. + if test -f "$i/unix/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.so + break + elif test -f "$i/unix/libtcl.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.a + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so + break + + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be + # built first. + elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a + break + fi + done fi - if test $installed -eq 1 ; then - TKLIB="-ltk" + # check in a few common install locations + if test x"${ac_cv_c_tcllib}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + # first look for a freshly built dynamically linked library + if test -f "$i/lib$installedtcllibroot.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.so + break + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be built first. + elif test -f "$i/lib$installedtcllibroot.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.a + break + fi + done fi + # check in a few other private locations + if test x"${ac_cv_c_tcllib}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[0-9]* 2>/dev/null` ; do + # Tcl 7.5 and greater puts library in subdir. Look there first. + if test -f "$i/unix/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.so + break + elif test -f "$i/unix/libtcl.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtcl.a + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtcl.so" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so + break + + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtcl will be + # built first. + elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then + ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a + break + fi + done + fi + + # see if one is conveniently installed with the compiler + if test x"${ac_cv_c_tcllib}" = x ; then + orig_libs="$LIBS" + LIBS="$LIBS -l$installedtcllibroot -lm" + if test "$cross_compiling" = yes; then + ac_cv_c_tclib="-l$installedtcllibroot" +else +cat > conftest.$ac_ext </dev/null; then + ac_cv_c_tcllib="-l$installedtcllibroot" +else + ac_cv_c_tcllib="" + +fi +fi +rm -fr conftest* + LIBS="${orig_libs}" + fi + fi -# If still not found, assume Tk simply hasn't been built yet -if test x"$TKLIB" = x ; then - for i in `ls -d ../tk* 2>/dev/null` ../tk ; do - if test -f "$i/tk.h" ; then - TKLIB=$i/libtk.a + if test x"${ac_cv_c_tcllib}" = x ; then + TCLLIB="# no Tcl library found" + echo "configure: warning: Can't find Tcl library" 1>&2 + else + TCLLIB=${ac_cv_c_tcllib} + echo "$ac_t""found $TCLLIB" 1>&6 + no_tcl= fi - done fi -if test x"$TKLIB" = x ; then - TKLIB="# no Tk library found" - echo "configure: warning: Can't find Tk library" 1>&2 -else - echo "$ac_t""setting TKLIB to be $TKLIB" 1>&6 - no_tk= -fi + # -# Ok, lets find the tcl source trees so we can use the headers -# -# Warning: transition of version 9 to 10 will break this algorithm -# because 10 sorts before 9. +# Ok, lets find the tk source trees so we can use the headers +# If the directory (presumably symlink) named "tk" exists, use that one +# in preference to any others. Same logic is used when choosing library +# and again with Tcl. The search order is the best place to look first, then in +# decreasing significance. The loop breaks if the trigger file is found. +# Note the gross little conversion here of srcdir by cd'ing to the found +# directory. This converts the path from a relative to an absolute, so +# recursive cache variables for the path will work right. We check all +# the possible paths in one loop rather than many seperate loops to speed +# things up. +# the alternative search directory is invoked by --with-tkinclude # -echo "checking for Tcl source directory" 1>&6 -TCLHDIR="" -for i in `ls -d ${srcdir}/../tcl* 2>/dev/null` ${srcdir}/../tcl ; do - if test -f $i/tclInt.h ; then - TCLHDIR="-I$i" - fi -done -# if we can't find it, see if one is installed -if test x"$TCLHDIR" = x ; then - installed=0 - if test -f $prefix/include/tclInt.h; then - installed=1 TCLHDIR="-I$prefix/include" +echo $ac_n "checking for Tk private headers""... $ac_c" 1>&6 +# Check whether --with-tkinclude or --without-tkinclude was given. +if test "${with_tkinclude+set}" = set; then + withval="$with_tkinclude" + with_tkinclude=${withval} +fi + +no_tk=true +if eval "test \"`echo '$''{'ac_cv_c_tkh'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + +# first check to see if --with-tkinclude was specified +if test x"${with_tkinclude}" != x ; then + if test -f ${with_tkinclude}/tk.h ; then + ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)` else - ac_safe=`echo "tclInt.h" | tr './\055' '___'` -echo $ac_n "checking for tclInt.h""... $ac_c" 1>&6 + { echo "configure: error: ${with_tkinclude} directory doesn't contain private headers" 1>&2; exit 1; } + fi +fi +# next check in private source directory +# +# since ls returns lowest version numbers first, reverse the entire list +# and search for the worst fit, overwriting it with better fits as we find them +if test x"${ac_cv_c_tkh}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[0-9]* 2>/dev/null` \ + ${srcdir}/../../tk \ + `ls -dr ${srcdir}/../../tk[0-9]* 2>/dev/null` \ + ${srcdir}/../../../tk \ + `ls -dr ${srcdir}/../../../tk[0-9]* 2>/dev/null ` ; do + if test -f $i/tk.h ; then + ac_cv_c_tkh=`(cd $i; pwd)` + break + fi + # Tk 4.1 and greater puts this in a subdir. + if test -f $i/generic/tk.h; then + ac_cv_c_tkh=`(cd $i; pwd)`/generic + fi + done +fi +# finally check in a few common install locations +# +# since ls returns lowest version numbers first, reverse the entire list +# and search for the worst fit, overwriting it with better fits as we find them +if test x"${ac_cv_c_tkh}" = x ; then + for i in \ + `ls -dr /usr/local/src/tk[0-9]* 2>/dev/null` \ + `ls -dr /usr/local/lib/tk[0-9]* 2>/dev/null` \ + /usr/local/src/tk \ + /usr/local/lib/tk \ + ${prefix}/include ; do + if test -f $i/tk.h ; then + ac_cv_c_tkh=`(cd $i; pwd)` + break + fi + done +fi +# see if one is installed +if test x"${ac_cv_c_tkh}" = x ; then + ac_safe=`echo "tk.h" | tr './\055' '___'` +echo $ac_n "checking for tk.h""... $ac_c" 1>&6 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < +#include EOF eval "$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ac_err=`grep -v '^ *+' conftest.out` @@ -2033,52 +2320,261 @@ rm -f conftest* fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 - installed=1 + ac_cv_c_tkh=installed else echo "$ac_t""no" 1>&6 fi - fi - if test $installed -eq 0 ; then - TCLHDIR="# no Tcl directory found" - echo "configure: warning: Can't find Tcl directory" 1>&2 +fi + +fi + +if test x"${ac_cv_c_tkh}" != x ; then + no_tk="" + if test x"${ac_cv_c_tkh}" = x"installed" ; then + echo "$ac_t""is installed" 1>&6 + TKHDIR="" + else + echo "$ac_t""found in $ac_cv_c_tkh" 1>&6 + # this hack is cause the TKHDIR won't print if there is a "-I" in it. + TKHDIR="-I${ac_cv_c_tkh}" fi else - echo "$ac_t""setting TCLHDIR to be $i" 1>&6 + TKHDIR="# no Tk directory found" + echo "configure: warning: Can't find Tk private headers" 1>&2 + no_tk=true fi +# if Tk is installed, extract the major/minor version +if test x"${no_tk}" = x ; then +echo $ac_n "checking Tk version""... $ac_c" 1>&6 +rm -rf tkmajor tkminor +orig_includes="$CPPFLAGS" + +if test x"${TCLHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TCLHDIR" +fi +if test x"${TKHDIR}" != x ; then + CPPFLAGS="$CPPFLAGS $TKHDIR" +fi +if test x"${x_includes}" != x -a x"${x_includes}" != xNONE ; then + CPPFLAGS="$CPPFLAGS -I$x_includes" +fi + +if test "$cross_compiling" = yes; then + { echo "configure: error: can't be cross compiled" 1>&2; exit 1; } + +else +cat > conftest.$ac_ext < +#include "tk.h" + main() { + FILE *maj = fopen("tkmajor","w"); + FILE *min = fopen("tkminor","w"); + fprintf(maj,"%d",TK_MAJOR_VERSION); + fprintf(min,"%d",TK_MINOR_VERSION); + fclose(maj); + fclose(min); + return 0; +} +EOF +eval $ac_link +if test -s conftest && (./conftest; exit) 2>/dev/null; then + tkmajor=`cat tkmajor` + tkminor=`cat tkminor` + tkversion=$tkmajor.$tkminor + echo "$ac_t""$tkversion" 1>&6 + rm -f tkmajor tkminor + +else + { echo "configure: error: +cannot compile a simple X program - suspect your xmkmf is +misconfigured and is incorrectly reporting the location of your X +include or libraries - report this to your system admin" 1>&2; exit 1; } +fi +fi +rm -fr conftest* +CPPFLAGS="${orig_includes}" +fi + + + + + + # -# Ok, lets find the tcl library -# First, look for the latest uninstalled +# Ok, lets find the tk library +# First, look for the latest private (uninstalled) copy +# Notice that the destinations in backwards priority since the tests have +# no break. +# Then we look for either .a, .so, or Makefile. A Makefile is acceptable +# is it indicates the target has been configured and will (probably) +# soon be built. This allows an entire tree of Tcl software to be +# configured at once and then built. +# the alternative search directory is invoked by --with-tklib # -TCLLIB="" -echo "checking for Tcl library" 1>&6 -for i in `ls -d ../tcl* 2>/dev/null` ../tcl ; do - if test -f "$i/Makefile" ; then - TCLLIB=$i/libtcl.a - fi -done -# If not found, look for installed version -if test x"$TCLLIB" = x ; then - if test -f $prefix/lib/libtcl.a; then installed=1; else installed=0; fi - if test $installed -eq 1 ; then - TCLLIB="-ltcl" + +if test x"${no_tk}" = x ; then + # reset no_tk incase something fails here + no_tk="true" + + if test $tkmajor -ge 4 ; then + installedtklibroot=tk$tkversion + else + installedtkllibroot=tk fi + + # Check whether --with-tklib or --without-tklib was given. +if test "${with_tklib+set}" = set; then + withval="$with_tklib" + with_tklib=${withval} fi -# If still not found, assume Tcl simply hasn't been built yet -if test x"$TCLLIB" = x ; then - for i in `ls -d ../tcl* 2>/dev/null` ../tcl ; do - if test -f "$i/tcl.h" ; then - TCLLIB=$i/libtcl.a + + echo $ac_n "checking for Tk library""... $ac_c" 1>&6 + if eval "test \"`echo '$''{'ac_cv_c_tklib'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + # first check to see if --with-tklib was specified + # This requires checking for both the installed and uninstalled name-styles + # since we have no idea if it's installed or not. + if test x"${with_tklib}" != x ; then + if test -f "${with_tklib}/lib$installedtklibroot.so" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.so + no_tk="" + elif test -f "${with_tklib}/libtk.so" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.so + no_tk="" + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtk will be built + elif test -f "${with_tklib}/lib$installedtklibroot.a" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.a + no_tk="" + elif test -f "${with_tklib}/libtk.a" ; then + ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.a + no_tk="" + else + { echo "configure: error: ${with_tklib} directory doesn't contain libraries" 1>&2; exit 1; } + fi fi - done -fi + # then check for a private Tk library + # Since these are uninstalled, use the simple lib name root. + if test x"${ac_cv_c_tklib}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[0-9]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[0-9]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[0-9]* 2>/dev/null` ; do + # Tk 4.1 and greater puts things in subdirs. Check these first. + if test -f "$i/unix/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.so + no_tk= + break + elif test -f "$i/unix/libtk.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.a + no_tk= + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so + no_tk= + break + # then look for a freshly built statically linked library + # if Makefile exists we assume its configured and libtk will be built + elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a + no_tk="" + break + fi + done + fi + # finally check in a few common install locations + if test x"${ac_cv_c_tklib}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + # first look for a freshly built dynamically linked library + if test -f "$i/lib$installedtklibroot.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.so + no_tk="" + break + # then look for a freshly built statically linked library + # if Makefile exists, we assume it's configured and libtcl will be built + elif test -f "$i/lib$installedtklibroot.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.a + no_tk="" + break + fi + done + fi + # check in a few other private locations + if test x"${ac_cv_c_tklib}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[0-9]* 2>/dev/null` ; do + # Tk 4.1 and greater puts things in subdirs. Check these first. + if test -f "$i/unix/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/unix/libtk.so + no_tk= + break + elif test -f "$i/unix/libtk.a" -o -f "$i/unix/Makefile"; then + ac_cv_c_tcllib=`(cd $i; pwd)`/unix/libtk.a + no_tk= + break + # look for a freshly built dynamically linked library + elif test -f "$i/libtk.so" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so + no_tk="" + break + # then look for a freshly built statically linked library + # if Makefile exists, we assume it's configured and libtcl will be built + elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then + ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a + no_tk="" + break + fi + done + fi + # see if one is conveniently installed with the compiler + if test x"${ac_cv_c_tklib}" = x ; then + + orig_libs="$LIBS" + LIBS="$LIBS -l$installedtklibroot $x_libraries $ac_cv_c_tcllib -lm" + if test "$cross_compiling" = yes; then + ac_cv_c_tklib="-l$installedtklibroot" +else +cat > conftest.$ac_ext <&2 + Tcl_AppInit() + { exit(0); } +EOF +eval $ac_link +if test -s conftest && (./conftest; exit) 2>/dev/null; then + ac_cv_c_tklib="-l$installedtklibroot" else - echo "$ac_t""setting TCLLIB to be $TCLLIB" 1>&6 + ac_cv_c_tklib="" + +fi +fi +rm -fr conftest* + LIBS="${orig_libs}" + fi + +fi + + if test x"${ac_cv_c_tklib}" = x ; then + TKLIB="# no Tk library found" + echo "configure: warning: Can't find Tk library" 1>&2 + else + TKLIB=$ac_cv_c_tklib + echo "$ac_t""found $TKLIB" 1>&6 + no_tk= + fi fi @@ -2755,10 +3251,10 @@ s%@X_CFLAGS@%$X_CFLAGS%g s%@X_PRE_LIBS@%$X_PRE_LIBS%g s%@X_LIBS@%$X_LIBS%g s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g -s%@TKHDIR@%$TKHDIR%g -s%@TKLIB@%$TKLIB%g s%@TCLHDIR@%$TCLHDIR%g s%@TCLLIB@%$TCLLIB%g +s%@TKHDIR@%$TKHDIR%g +s%@TKLIB@%$TKLIB%g s%@ENABLE_GDBTK@%$ENABLE_GDBTK%g s%@X_LDFLAGS@%$X_LDFLAGS%g s%@ENABLE_CFLAGS@%$ENABLE_CFLAGS%g diff --git a/gdb/configure.in b/gdb/configure.in index 959e7b4bb10..b21544599f0 100644 --- a/gdb/configure.in +++ b/gdb/configure.in @@ -115,8 +115,8 @@ if test "${enable_gdbtk}" = "yes"; then AC_PATH_X AC_PATH_XTRA - CYGNUS_PATH_TK - CYGNUS_PATH_TCL + CY_AC_PATH_TCL + CY_AC_PATH_TK ENABLE_GDBTK=1 diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index dd99f694427..aaf919344bf 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -153,11 +153,16 @@ gdbtk_query (query, args) char *query; va_list args; { - char buf[200]; + char buf[200], *merge[2]; + char *command; long val; vsprintf (buf, query, args); - Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL); + merge[0] = "gdbtk_tcl_query"; + merge[1] = buf; + command = Tcl_Merge (2, merge); + Tcl_Eval (interp, command); + free (command); val = atol (interp->result); return val; @@ -277,6 +282,8 @@ breakpoint_notify(b, action) if (b->type != bp_breakpoint) return; + /* We ensure that ACTION contains no special Tcl characters, so we + can do this. */ sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number); v = Tcl_Eval (interp, buf); @@ -680,7 +687,7 @@ call_wrapper (clientData, interp, argc, argv) /* In case of an error, we may need to force the GUI into idle mode because gdbtk_call_command may have bombed out while in the command routine. */ - Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); + Tcl_Eval (interp, "gdbtk_tcl_idle"); } do_cleanups (ALL_CLEANUPS); @@ -1069,9 +1076,9 @@ gdbtk_call_command (cmdblk, arg, from_tty) { if (cmdblk->class == class_run) { - Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL); + Tcl_Eval (interp, "gdbtk_tcl_busy"); (*cmdblk->function.cfunc)(arg, from_tty); - Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); + Tcl_Eval (interp, "gdbtk_tcl_idle"); } else (*cmdblk->function.cfunc)(arg, from_tty); diff --git a/gdb/gdbtk.tcl b/gdb/gdbtk.tcl index f35dbf54c49..c7b4ec12511 100644 --- a/gdb/gdbtk.tcl +++ b/gdb/gdbtk.tcl @@ -18,14 +18,11 @@ # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. set cfile Blank set wins($cfile) .src.text set current_label {} -set screen_height 0 -set screen_top 0 -set screen_bot 0 set cfunc NIL set line_numbers 1 set breakpoint_file(-1) {[garbage]} @@ -35,14 +32,76 @@ set expr_update_list(0) 0 #option add *Foreground Black #option add *Background White #option add *Font -*-*-medium-r-normal--18-*-*-*-m-*-*-1 -tk colormodel . monochrome proc echo string {puts stdout $string} -if [info exists env(EDITOR)] then { - set editor $env(EDITOR) - } else { - set editor emacs +# Assign elements from LIST to variables named in ARGS. FIXME replace +# with TclX version someday. +proc lassign {list args} { + set len [expr {[llength $args] - 1}] + while {$len >= 0} { + upvar [lindex $args $len] local + set local [lindex $list $len] + decr len + } +} + +# +# Local procedure: +# +# decr (var val) - compliment to incr +# +# Description: +# +# +proc decr {var {val 1}} { + upvar $var num + set num [expr {$num - $val}] + return $num +} + +# +# Center a window on the screen. +# +proc center_window toplevel { + # Withdraw and update, to ensure geometry computations are finished. + wm withdraw $toplevel + update idletasks + + set x [expr {[winfo screenwidth $toplevel] / 2 + - [winfo reqwidth $toplevel] / 2 + - [winfo vrootx $toplevel]}] + set y [expr {[winfo screenheight $toplevel] / 2 + - [winfo reqheight $toplevel] / 2 + - [winfo vrooty $toplevel]}] + wm geometry $toplevel +${x}+${y} + wm deiconify $toplevel +} + +# +# Rearrange the bindtags so the widget comes after the class. I was +# always for Ousterhout putting the class bindings first, but no... +# +proc bind_widget_after_class {widget} { + set class [winfo class $widget] + set newList {} + foreach tag [bindtags $widget] { + if {$tag == $widget} { + # Nothing. + } { + lappend newList $tag + if {$tag == $class} { + lappend newList $widget + } + } + } + bindtags $widget $newList +} + +if {[info exists env(EDITOR)]} then { + set editor $env(EDITOR) +} else { + set editor emacs } # GDB callbacks @@ -64,13 +123,13 @@ if [info exists env(EDITOR)] then { # proc gdbtk_tcl_fputs {arg} { - .cmd.text insert end "$arg" - .cmd.text yview -pickplace end + .cmd.text insert end "$arg" + .cmd.text see end } proc gdbtk_tcl_fputs_error {arg} { - .cmd.text insert end "$arg" - .cmd.text yview -pickplace end + .cmd.text insert end "$arg" + .cmd.text see end } # @@ -84,8 +143,8 @@ proc gdbtk_tcl_fputs_error {arg} { # proc gdbtk_tcl_flush {} { - .cmd.text yview -pickplace end - update idletasks + .cmd.text see end + update idletasks } # @@ -101,8 +160,12 @@ proc gdbtk_tcl_flush {} { # proc gdbtk_tcl_query {message} { - tk_dialog .query "gdb : query" "$message" {} 1 "No" "Yes" - } + # FIXME We really want a Help button here. But Tk's brain-damaged + # modal dialogs won't really allow it. Should have async dialog + # here. + set result [tk_dialog .query "gdb : query" "$message" questhead 0 Yes No] + return [expr {!$result}] +} # # GDB Callback: @@ -114,8 +177,9 @@ proc gdbtk_tcl_query {message} { # Not yet implemented. # -proc gdbtk_tcl_start_variable_annotation {valaddr ref_type stor_cl cum_expr field type_cast} { - echo "gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast" +proc gdbtk_tcl_start_variable_annotation {valaddr ref_type stor_cl + cum_expr field type_cast} { + echo "gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast" } # @@ -170,7 +234,7 @@ proc gdbtk_tcl_breakpoint {action bpnum} { proc create_breakpoints_window {} { global bpframe_lasty - if [winfo exists .breakpoints] {raise .breakpoints ; return} + if {[winfo exists .breakpoints]} {raise .breakpoints ; return} build_framework .breakpoints "Breakpoints" "" @@ -185,11 +249,13 @@ proc create_breakpoints_window {} { # Replace text with a canvas and fix the scrollbars destroy .breakpoints.text - canvas .breakpoints.c -relief sunken -bd 2 \ - -cursor hand2 -yscrollcommand {.breakpoints.scroll set} - .breakpoints.scroll configure -command {.breakpoints.c yview} scrollbar .breakpoints.scrollx -orient horizontal \ -command {.breakpoints.c xview} -relief sunken + canvas .breakpoints.c -relief sunken -bd 2 \ + -cursor hand2 \ + -yscrollcommand {.breakpoints.scroll set} \ + -xscrollcommand {.breakpoints.scrollx set} + .breakpoints.scroll configure -command {.breakpoints.c yview} pack .breakpoints.scrollx -side bottom -fill x -in .breakpoints.info pack .breakpoints.c -side left -expand yes -fill both \ @@ -207,107 +273,100 @@ proc create_breakpoints_window {} { # Create a frame for bpnum in the .breakpoints canvas proc add_breakpoint_frame bpnum { - global bpframe_lasty - global enabled - global disposition - - if ![winfo exists .breakpoints] return - - set bpinfo [gdb_get_breakpoint_info $bpnum] - - set file [lindex $bpinfo 0] - set line [lindex $bpinfo 1] - set pc [lindex $bpinfo 2] - set type [lindex $bpinfo 3] - set enabled($bpnum) [lindex $bpinfo 4] - set disposition($bpnum) [lindex $bpinfo 5] - set silent [lindex $bpinfo 6] - set ignore_count [lindex $bpinfo 7] - set commands [lindex $bpinfo 8] - set cond [lindex $bpinfo 9] - set thread [lindex $bpinfo 10] - set hit_count [lindex $bpinfo 11] - - set f .breakpoints.c.$bpnum - - if ![winfo exists $f] { - frame $f -relief sunken -bd 2 - - label $f.id -text "#$bpnum $file:$line ($pc)" \ - -relief flat -bd 2 -anchor w - frame $f.hit_count - label $f.hit_count.label -text "Hit count:" -relief flat \ - -bd 2 -anchor w -width 11 - label $f.hit_count.val -text $hit_count -relief flat \ - -bd 2 -anchor w - checkbutton $f.hit_count.enabled -text Enabled \ - -variable enabled($bpnum) -anchor w -relief flat - - pack $f.hit_count.label $f.hit_count.val -side left - pack $f.hit_count.enabled -side right - - frame $f.thread - label $f.thread.label -text "Thread: " -relief flat -bd 2 \ - -width 11 -anchor w - entry $f.thread.entry -bd 2 -relief sunken -width 10 - $f.thread.entry insert end $thread - pack $f.thread.label -side left - pack $f.thread.entry -side left -fill x - - frame $f.cond - label $f.cond.label -text "Condition: " -relief flat -bd 2 \ - -width 11 -anchor w - entry $f.cond.entry -bd 2 -relief sunken - $f.cond.entry insert end $cond - pack $f.cond.label -side left - pack $f.cond.entry -side left -fill x -expand yes - - frame $f.ignore_count - label $f.ignore_count.label -text "Ignore count: " \ - -relief flat -bd 2 -width 11 -anchor w - entry $f.ignore_count.entry -bd 2 -relief sunken -width 10 - $f.ignore_count.entry insert end $ignore_count - pack $f.ignore_count.label -side left - pack $f.ignore_count.entry -side left -fill x - - frame $f.disps - - label $f.disps.label -text "Disposition: " -relief flat -bd 2 \ - -anchor w -width 11 - - radiobutton $f.disps.delete -text Delete \ - -variable disposition($bpnum) -anchor w -relief flat \ - -command "gdb_cmd \"delete break $bpnum\"" - - radiobutton $f.disps.disable -text Disable \ - -variable disposition($bpnum) -anchor w -relief flat \ - -command "gdb_cmd \"disable break $bpnum\"" - - radiobutton $f.disps.donttouch -text "Leave alone" \ - -variable disposition($bpnum) -anchor w -relief flat \ - -command "gdb_cmd \"enable break $bpnum\"" - - pack $f.disps.label $f.disps.delete $f.disps.disable \ - $f.disps.donttouch -side left -anchor w - text $f.commands -relief sunken -bd 2 -setgrid true \ - -cursor hand2 -height 3 -width 30 - - foreach line $commands { - $f.commands insert end "${line}\n" - } + global bpframe_lasty + global enabled + global disposition + + if {![winfo exists .breakpoints]} return + + set bpinfo [gdb_get_breakpoint_info $bpnum] + + lassign $bpinfo file line pc type enabled($bpnum) disposition($bpnum) \ + silent ignore_count commands cond thread hit_count + + set f .breakpoints.c.$bpnum + + if {![winfo exists $f]} { + frame $f -relief sunken -bd 2 + + label $f.id -text "#$bpnum $file:$line ($pc)" \ + -relief flat -bd 2 -anchor w + frame $f.hit_count + label $f.hit_count.label -text "Hit count:" -relief flat \ + -bd 2 -anchor w -width 11 + label $f.hit_count.val -text $hit_count -relief flat \ + -bd 2 -anchor w + checkbutton $f.hit_count.enabled -text Enabled \ + -variable enabled($bpnum) -anchor w -relief flat + + pack $f.hit_count.label $f.hit_count.val -side left + pack $f.hit_count.enabled -side right + + frame $f.thread + label $f.thread.label -text "Thread: " -relief flat -bd 2 \ + -width 11 -anchor w + entry $f.thread.entry -bd 2 -relief sunken -width 10 + $f.thread.entry insert end $thread + pack $f.thread.label -side left + pack $f.thread.entry -side left -fill x + + frame $f.cond + label $f.cond.label -text "Condition: " -relief flat -bd 2 \ + -width 11 -anchor w + entry $f.cond.entry -bd 2 -relief sunken + $f.cond.entry insert end $cond + pack $f.cond.label -side left + pack $f.cond.entry -side left -fill x -expand yes + + frame $f.ignore_count + label $f.ignore_count.label -text "Ignore count: " \ + -relief flat -bd 2 -width 11 -anchor w + entry $f.ignore_count.entry -bd 2 -relief sunken -width 10 + $f.ignore_count.entry insert end $ignore_count + pack $f.ignore_count.label -side left + pack $f.ignore_count.entry -side left -fill x + + frame $f.disps + + label $f.disps.label -text "Disposition: " -relief flat -bd 2 \ + -anchor w -width 11 + + radiobutton $f.disps.delete -text Delete \ + -variable disposition($bpnum) -anchor w -relief flat \ + -command "gdb_cmd \"delete break $bpnum\"" \ + -value delete + + radiobutton $f.disps.disable -text Disable \ + -variable disposition($bpnum) -anchor w -relief flat \ + -command "gdb_cmd \"disable break $bpnum\"" \ + -value disable + + radiobutton $f.disps.donttouch -text "Leave alone" \ + -variable disposition($bpnum) -anchor w -relief flat \ + -command "gdb_cmd \"enable break $bpnum\"" \ + -value donttouch + + pack $f.disps.label $f.disps.delete $f.disps.disable \ + $f.disps.donttouch -side left -anchor w + text $f.commands -relief sunken -bd 2 -setgrid true \ + -cursor hand2 -height 3 -width 30 + + foreach line $commands { + $f.commands insert end "${line}\n" + } - pack $f.id -side top -anchor nw -fill x - pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \ - $f.commands -side top -fill x -anchor nw - } + pack $f.id -side top -anchor nw -fill x + pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \ + $f.commands -side top -fill x -anchor nw + } - set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw] - update - set bbox [.breakpoints.c bbox $tag] + set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw] + update + set bbox [.breakpoints.c bbox $tag] - set bpframe_lasty [lindex $bbox 3] + set bpframe_lasty [lindex $bbox 3] - .breakpoints.c configure -width [lindex $bbox 2] + .breakpoints.c configure -width [lindex $bbox 2] } # Delete a breakpoint frame @@ -315,7 +374,7 @@ proc add_breakpoint_frame bpnum { proc delete_breakpoint_frame bpnum { global bpframe_lasty - if ![winfo exists .breakpoints] return + if {![winfo exists .breakpoints]} return # First, clear the canvas @@ -367,26 +426,26 @@ proc create_breakpoint {bpnum file line pc} { set breakpoint_file($bpnum) $file set breakpoint_line($bpnum) $line set pos_to_breakpoint($file:$line) $bpnum - if ![info exists pos_to_bpcount($file:$line)] { + if {![info exists pos_to_bpcount($file:$line)]} { set pos_to_bpcount($file:$line) 0 } incr pos_to_bpcount($file:$line) set pos_to_breakpoint($pc) $bpnum - if ![info exists pos_to_bpcount($pc)] { + if {![info exists pos_to_bpcount($pc)]} { set pos_to_bpcount($pc) 0 } incr pos_to_bpcount($pc) # If there's a window for this file, update it - if [info exists wins($file)] { + if {[info exists wins($file)]} { insert_breakpoint_tag $wins($file) $line } # If there's an assembly window, update that too set win [asm_win_name $cfunc] - if [winfo exists $win] { + if {[winfo exists $win]} { insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc] } @@ -436,7 +495,7 @@ proc delete_breakpoint {bpnum file line pc} { # If there's a window for this file, update it - if [info exists wins($file)] { + if {[info exists wins($file)]} { delete_breakpoint_tag $wins($file) $line } } @@ -451,7 +510,7 @@ proc delete_breakpoint {bpnum file line pc} { catch "unset pos_to_breakpoint($pc)" set win [asm_win_name $cfunc] - if [winfo exists $win] { + if {[winfo exists $win]} { delete_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc] } } @@ -477,20 +536,20 @@ proc enable_breakpoint {bpnum file line pc} { global cfunc pclist global enabled - if [info exists wins($file)] { + if {[info exists wins($file)]} { $wins($file) tag configure $line -fgstipple {} } # If there's an assembly window, update that too set win [asm_win_name $cfunc] - if [winfo exists $win] { + if {[winfo exists $win]} { $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple {} } # If there's a breakpoint window, update that too - if [winfo exists .breakpoints] { + if {[winfo exists .breakpoints]} { set enabled($bpnum) 1 } } @@ -512,20 +571,20 @@ proc disable_breakpoint {bpnum file line pc} { global cfunc pclist global enabled - if [info exists wins($file)] { + if {[info exists wins($file)]} { $wins($file) tag configure $line -fgstipple gray50 } # If there's an assembly window, update that too set win [asm_win_name $cfunc] - if [winfo exists $win] { + if {[winfo exists $win]} { $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple gray50 } # If there's a breakpoint window, update that too - if [winfo exists .breakpoints] { + if {[winfo exists .breakpoints]} { set enabled($bpnum) 0 } } @@ -578,7 +637,7 @@ proc delete_breakpoint_tag {win line} { } proc gdbtk_tcl_busy {} { - if [winfo exists .src] { + if {[winfo exists .src]} { .src.start configure -state disabled .src.stop configure -state normal .src.step configure -state disabled @@ -589,7 +648,7 @@ proc gdbtk_tcl_busy {} { .src.down configure -state disabled .src.bottom configure -state disabled } - if [winfo exists .asm] { + if {[winfo exists .asm]} { .asm.stepi configure -state disabled .asm.nexti configure -state disabled .asm.continue configure -state disabled @@ -602,7 +661,7 @@ proc gdbtk_tcl_busy {} { } proc gdbtk_tcl_idle {} { - if [winfo exists .src] { + if {[winfo exists .src]} { .src.start configure -state normal .src.stop configure -state disabled .src.step configure -state normal @@ -614,7 +673,7 @@ proc gdbtk_tcl_idle {} { .src.bottom configure -state normal } - if [winfo exists .asm] { + if {[winfo exists .asm]} { .asm.stepi configure -state normal .asm.nexti configure -state normal .asm.continue configure -state normal @@ -626,20 +685,6 @@ proc gdbtk_tcl_idle {} { return } -# -# Local procedure: -# -# decr (var val) - compliment to incr -# -# Description: -# -# -proc decr {var {val 1}} { - upvar $var num - set num [expr $num - $val] - return $num -} - # # Local procedure: # @@ -660,7 +705,7 @@ proc pc_to_line {pclist pc} { if {$pc < $linepc} { decr line ; return $line } incr line } - return [expr $line - 1] + return [expr {$line - 1}] } # @@ -683,11 +728,13 @@ proc pc_to_line {pclist pc} { # to notify us of where the breakpoint needs to show up. # -menu .file_popup -cursor hand2 +menu .file_popup -cursor hand2 -tearoff 0 .file_popup add command -label "Not yet set" -state disabled .file_popup add separator -.file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &} -.file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"} +.file_popup add command -label "Edit" \ + -command {exec $editor +$selected_line $selected_file &} +.file_popup add command -label "Set breakpoint" \ + -command {gdb_cmd "break $selected_file:$selected_line"} # Use this procedure to get the GDB core to execute the string `cmd'. This is # a wrapper around gdb_cmd, which will catch errors, and send output to the @@ -696,7 +743,7 @@ menu .file_popup -cursor hand2 proc interactive_cmd {cmd} { catch {gdb_cmd "$cmd"} result .cmd.text insert end $result - .cmd.text yview -pickplace end + .cmd.text see end update_ptr } @@ -707,28 +754,14 @@ proc interactive_cmd {cmd} { # # Description: # -# This defines the binding for the file popup menu. Currently, there is -# only one, which is activated when Button-1 is released. This causes -# the menu to be unposted, releases the grab for the menu, and then -# unhighlights the line under the cursor. After that, the selected menu -# item is invoked. +# This defines the binding for the file popup menu. It simply +# unhighlights the line under the cursor. # bind .file_popup { - global selected_win - -# First, remove the menu, and release the pointer - - .file_popup unpost - grab release .file_popup - -# Unhighlight the selected line - - $selected_win tag delete breaktag - -# Actually invoke the menubutton here! - - tk_invokeMenu %W + global selected_win + # Unhighlight the selected line + $selected_win tag delete breaktag } # @@ -777,8 +810,7 @@ proc file_popup_menu {win x y xrel yrel} { # Post the menu near the pointer, (and grab it) .file_popup entryconfigure 0 -label "$selected_file:$selected_line" - .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10] - grab .file_popup + tk_popup .file_popup $x $y } # @@ -824,7 +856,7 @@ proc listing_window_button_1 {win x y xrel yrel} { set pos_break $selected_file:$selected_line set pos $file:$selected_line set tmp pos_to_breakpoint($pos) - if [info exists $tmp] { + if {[info exists $tmp]} { set bpnum [set $tmp] gdb_cmd "delete $bpnum" } else { @@ -836,8 +868,8 @@ proc listing_window_button_1 {win x y xrel yrel} { # Post the menu near the pointer, (and grab it) .file_popup entryconfigure 0 -label "$selected_file:$selected_line" - .file_popup post [expr $x-[winfo width .file_popup]/2] [expr $y-10] - grab .file_popup + + tk_popup .file_popup $x $y } # @@ -882,7 +914,7 @@ proc asm_window_button_1 {win x y xrel yrel} { if {$selected_col < 11} { set tmp pos_to_breakpoint($pc) - if [info exists $tmp] { + if {[info exists $tmp]} { set bpnum [set $tmp] gdb_cmd "delete $bpnum" } else { @@ -925,7 +957,7 @@ proc do_nothing {} {} proc not_implemented_yet {message} { tk_dialog .unimpl "gdb : unimpl" \ "$message: not implemented in the interface yet" \ - {} 1 "OK" + warning 0 "OK" } ## @@ -939,81 +971,81 @@ proc not_implemented_yet {message} { # set expr_num 0 +set delete_expr_num 0 -proc add_expr {expr} { - global expr_update_list - global expr_num +# Set delete_expr_num, and set -state of Delete button. +proc expr_update_button {num} { + global delete_expr_num + set delete_expr_num $num + if {$num > 0} then { + set state normal + } else { + set state disabled + } + .expr.buts.delete configure -state $state +} - incr expr_num +proc add_expr {expr} { + global expr_update_list + global expr_num - set e .expr.e${expr_num} + incr expr_num - frame $e + set e .expr.exprs + set f e$expr_num - checkbutton $e.update -text " " -relief flat \ - -variable expr_update_list($expr_num) - text $e.expr -width 20 -height 1 - $e.expr insert 0.0 $expr - bind $e.expr <1> "update_expr $expr_num" - text $e.val -width 20 -height 1 + checkbutton $e.updates.$f -text "" -relief flat \ + -variable expr_update_list($expr_num) + text $e.expressions.$f -width 20 -height 1 + $e.expressions.$f insert 0.0 $expr + bind $e.expressions.$f <1> "update_expr $expr_num" + text $e.values.$f -width 20 -height 1 - update_expr $expr_num + # Set up some bindings. + foreach frame {updates expressions values} { + bind $e.$frame.$f "expr_update_button $expr_num" + bind $e.$frame.$f "expr_update_button 0" + } - pack $e.update -side left -anchor nw - pack $e.expr $e.val -side left -expand yes -fill x + update_expr $expr_num - pack $e -side top -fill x -anchor w + pack $e.updates.$f -side top + pack $e.expressions.$f -side top -expand yes -fill x + pack $e.values.$f -side top -expand yes -fill x } -set delete_expr_flag 0 - -# This is a krock!!! - proc delete_expr {} { - global delete_expr_flag + global delete_expr_num + if {$delete_expr_num > 0} then { + set e .expr.exprs + set f e${delete_expr_num} - if {$delete_expr_flag == 1} { - set delete_expr_flag 0 - tk_butUp .expr.delete - bind .expr.delete {} - } else { - set delete_expr_flag 1 - bind .expr.delete do_nothing - tk_butDown .expr.delete - } + destroy $e.updates.$f $e.expressions.$f $e.values.$f + + # FIXME should we unset an element of expr_update_list here? + } } proc update_expr {expr_num} { - global delete_expr_flag - global expr_update_list + global expr_update_list - set e .expr.e${expr_num} + set e .expr.exprs + set f e${expr_num} - if {$delete_expr_flag == 1} { - set delete_expr_flag 0 - destroy $e - tk_butUp .expr.delete - tk_butLeave .expr.delete - bind .expr.delete {} - unset expr_update_list($expr_num) - return - } - - set expr [$e.expr get 0.0 end] - - $e.val delete 0.0 end - if [catch "gdb_eval $expr" val] { - - } else { - $e.val insert 0.0 $val - } + set expr [$e.expressions.$f get 0.0 end] + $e.values.$f delete 0.0 end + if {! [catch {gdb_eval $expr} val]} { + $e.values.$f insert 0.0 $val + } { + # FIXME consider flashing widget here. + } } proc update_exprs {} { global expr_update_list foreach expr_num [array names expr_update_list] { - if $expr_update_list($expr_num) { + if {$expr_update_list($expr_num)} { update_expr $expr_num } } @@ -1021,48 +1053,59 @@ proc update_exprs {} { proc create_expr_window {} { - if [winfo exists .expr] {raise .expr ; return} + if {[winfo exists .expr]} {raise .expr ; return} toplevel .expr - wm minsize .expr 1 1 - wm title .expr Expression - wm iconname .expr "Reg config" - - frame .expr.entryframe - - entry .expr.entry -borderwidth 2 -relief sunken - bind .expr {focus .expr.entry} - bind .expr.entry {add_expr [.expr.entry get] - .expr.entry delete 0 end } + wm title .expr "GDB Expressions" + wm iconname .expr "Expressions" - label .expr.entrylab -text "Expression: " + frame .expr.entryframe -borderwidth 2 -relief raised + label .expr.entryframe.entrylab -text "Expression: " + entry .expr.entryframe.entry -borderwidth 2 -relief sunken + bind .expr.entryframe.entry { + add_expr [.expr.entryframe.entry get] + .expr.entryframe.entry delete 0 end + } - pack .expr.entrylab -in .expr.entryframe -side left - pack .expr.entry -in .expr.entryframe -side left -fill x -expand yes + pack .expr.entryframe.entrylab -side left + pack .expr.entryframe.entry -side left -fill x -expand yes - frame .expr.buts + frame .expr.buts -borderwidth 2 -relief raised - button .expr.delete -text Delete - bind .expr.delete <1> delete_expr + button .expr.buts.delete -text Delete -command delete_expr \ + -state disabled - button .expr.close -text Close -command {destroy .expr} + button .expr.buts.close -text Close -command {destroy .expr} + button .expr.buts.help -text Help -state disabled - pack .expr.delete -side left -fill x -expand yes -in .expr.buts - pack .expr.close -side right -fill x -expand yes -in .expr.buts + pack .expr.buts.delete -side left + pack .expr.buts.help .expr.buts.close -side right pack .expr.buts -side bottom -fill x pack .expr.entryframe -side bottom -fill x - frame .expr.labels + frame .expr.exprs -borderwidth 2 -relief raised + + # Use three subframes so columns will line up. Easier than + # dealing with BLT for a table geometry manager. Someday Tk + # will have one, use it then. FIXME this messes up keyboard + # traversal. + frame .expr.exprs.updates -borderwidth 0 -relief flat + frame .expr.exprs.expressions -borderwidth 0 -relief flat + frame .expr.exprs.values -borderwidth 0 -relief flat - label .expr.updlab -text Update - label .expr.exprlab -text Expression - label .expr.vallab -text Value + label .expr.exprs.updates.label -text Update + pack .expr.exprs.updates.label -side top -anchor w + label .expr.exprs.expressions.label -text Expression + pack .expr.exprs.expressions.label -side top -anchor w + label .expr.exprs.values.label -text Value + pack .expr.exprs.values.label -side top -anchor w - pack .expr.updlab -side left -in .expr.labels - pack .expr.exprlab .expr.vallab -side left -in .expr.labels -expand yes -anchor w + pack .expr.exprs.updates -side left + pack .expr.exprs.values .expr.exprs.expressions \ + -side right -expand 1 -fill x - pack .expr.labels -side top -fill x -anchor w + pack .expr.exprs -side top -fill both -expand 1 -anchor w } # @@ -1112,12 +1155,12 @@ proc create_file_win {filename debug_file} { # Open the file, and read it into the text widget - if [catch "open $filename" fh] { + if {[catch "open $filename" fh]} { # File can't be read. Put error message into .src.nofile window and return. catch {destroy .src.nofile} text .src.nofile -height 25 -width 88 -relief sunken \ - -borderwidth 2 -yscrollcommand textscrollproc \ + -borderwidth 2 -yscrollcommand ".src.scroll set" \ -setgrid true -cursor hand2 .src.nofile insert 0.0 $fh .src.nofile configure -state disabled @@ -1129,7 +1172,7 @@ proc create_file_win {filename debug_file} { # Actually create and do basic configuration on the text widget. text $win -height 25 -width 88 -relief sunken -borderwidth 2 \ - -yscrollcommand textscrollproc -setgrid true -cursor hand2 + -yscrollcommand ".src.scroll set" -setgrid true -cursor hand2 # Setup all the bindings @@ -1144,7 +1187,7 @@ proc create_file_win {filename debug_file} { bind $win "$win yview {@0,0 - 1 lines}" bind $win "$win yview {@0,0 + 1 lines}" bind $win {update_listing [gdb_loc]} - bind $win "$win yview -pickplace end" + bind $win "$win see end" bind $win n {interactive_cmd next} bind $win s {interactive_cmd step} @@ -1161,7 +1204,7 @@ proc create_file_win {filename debug_file} { set numlines [$win index end] set numlines [lindex [split $numlines .] 0] - if $line_numbers { + if {$line_numbers} { for {set i 1} {$i <= $numlines} {incr i} { $win insert $i.0 [format " %4d " $i] $win tag add source $i.8 "$i.0 lineend" @@ -1252,7 +1295,7 @@ proc create_asm_win {funcname pc} { # Actually create and do basic configuration on the text widget. text $win -height 25 -width 80 -relief sunken -borderwidth 2 \ - -setgrid true -cursor hand2 -yscrollcommand asmscrollproc + -setgrid true -cursor hand2 -yscrollcommand ".asm.scroll set" # Setup all the bindings @@ -1262,12 +1305,6 @@ proc create_asm_win {funcname pc} { bind $win do_nothing bind $win do_nothing - bind $win "$win yview {@0,0 - 10 lines}" - bind $win "$win yview {@0,0 + 10 lines}" - bind $win "$win yview {@0,0 - 1 lines}" - bind $win "$win yview {@0,0 + 1 lines}" - bind $win {update_assembly [gdb_loc]} - bind $win "$win yview -pickplace end" bind $win n {interactive_cmd nexti} bind $win s {interactive_cmd stepi} @@ -1314,26 +1351,6 @@ proc create_asm_win {funcname pc} { return $win } -# -# Local procedure: -# -# asmscrollproc (WINHEIGHT SCREENHEIGHT SCREENTOP SCREENBOT) - Update the -# asm window scrollbar. -# -# Description: -# -# This procedure is called to update the assembler window's scrollbar. -# - -proc asmscrollproc {args} { - global asm_screen_height asm_screen_top asm_screen_bot - - eval ".asm.scroll set $args" - set asm_screen_height [lindex $args 1] - set asm_screen_top [lindex $args 2] - set asm_screen_bot [lindex $args 3] -} - # # Local procedure: # @@ -1373,9 +1390,6 @@ proc asmscrollproc {args} { proc update_listing {linespec} { global pointers - global screen_height - global screen_top - global screen_bot global wins cfile global current_label global win_to_file @@ -1384,10 +1398,7 @@ proc update_listing {linespec} { # Rip the linespec apart - set line [lindex $linespec 3] - set filename [lindex $linespec 2] - set funcname [lindex $linespec 1] - set debug_file [lindex $linespec 0] + lassign $linespec debug_file funcname filename line # Sometimes there's no source file for this location @@ -1402,7 +1413,7 @@ proc update_listing {linespec} { # Create a text widget for this file if necessary - if ![info exists wins($cfile)] then { + if {![info exists wins($cfile)]} then { set wins($cfile) [create_file_win $cfile $debug_file] if {$wins($cfile) != ".src.nofile"} { set win_to_file($wins($cfile)) $cfile @@ -1420,7 +1431,7 @@ proc update_listing {linespec} { .src.scroll configure -command "$wins($cfile) yview" - $wins($cfile) yview [expr $line - $screen_height / 2] + $wins($cfile) see "${line}.0 linestart" } # Update the label widget in case the filename or function name has changed @@ -1435,7 +1446,7 @@ proc update_listing {linespec} { # Update the pointer, scrolling the text widget if necessary to keep the # pointer in an acceptable part of the screen. - if [info exists pointers($cfile)] then { + if {[info exists pointers($cfile)]} then { $wins($cfile) configure -state normal set pointer_pos $pointers($cfile) $wins($cfile) configure -state normal @@ -1447,12 +1458,7 @@ proc update_listing {linespec} { $wins($cfile) delete $pointer_pos "$pointer_pos + 2 char" $wins($cfile) insert $pointer_pos "->" - - if {$line < $screen_top + 1 - || $line > $screen_bot} then { - $wins($cfile) yview [expr $line - $screen_height / 2] - } - + $wins($cfile) see "${line}.0 linestart" $wins($cfile) configure -state disabled } } @@ -1470,7 +1476,7 @@ proc update_listing {linespec} { proc create_asm_window {} { global cfunc - if [winfo exists .asm] {raise .asm ; return} + if {[winfo exists .asm]} {raise .asm ; return} set cfunc *None* set win [asm_win_name $cfunc] @@ -1481,7 +1487,7 @@ proc create_asm_window {} { .asm.menubar.view.menu delete 0 last - .asm.text configure -yscrollcommand asmscrollproc + .asm.text configure -yscrollcommand ".asm.scroll set" frame .asm.row1 frame .asm.row2 @@ -1602,11 +1608,11 @@ proc reg_config_menu {} { proc create_registers_window {} { global reg_format - if [winfo exists .reg] {raise .reg ; return} + if {[winfo exists .reg]} {raise .reg ; return} # Create an initial register display list consisting of all registers - if ![info exists reg_format] { + if {![info exists reg_format]} { global reg_display_list global changed_reg_list global regena @@ -1789,25 +1795,17 @@ proc update_registers {which} { proc update_assembly {linespec} { global asm_pointers - global screen_height - global screen_top - global screen_bot global wins cfunc global current_label global win_to_file global file_to_debug_file global current_asm_label global pclist - global asm_screen_height asm_screen_top asm_screen_bot global .asm.label # Rip the linespec apart - set pc [lindex $linespec 4] - set line [lindex $linespec 3] - set filename [lindex $linespec 2] - set funcname [lindex $linespec 1] - set debug_file [lindex $linespec 0] + lassign $linespec debug_file funcname filename line pc set win [asm_win_name $cfunc] @@ -1839,8 +1837,8 @@ proc update_assembly {linespec} { -after .asm.scroll .asm.scroll configure -command "$win yview" set line [pc_to_line $pclist($cfunc) $pc] + $win see "${line}.0 linestart" update - $win yview [expr $line - $asm_screen_height / 2] } # Update the label widget in case the filename or function name has changed @@ -1853,7 +1851,7 @@ proc update_assembly {linespec} { # Update the pointer, scrolling the text widget if necessary to keep the # pointer in an acceptable part of the screen. - if [info exists asm_pointers($cfunc)] then { + if {[info exists asm_pointers($cfunc)]} then { $win configure -state normal set pointer_pos $asm_pointers($cfunc) $win configure -state normal @@ -1874,12 +1872,7 @@ proc update_assembly {linespec} { $win delete $pointer_pos "$pointer_pos + 2 char" $win insert $pointer_pos "->" - - if {$line < $asm_screen_top + 1 - || $line > $asm_screen_bot} then { - $win yview [expr $line - $asm_screen_height / 2] - } - + $win yview "${line}.0 linestart" $win configure -state disabled } } @@ -1897,16 +1890,16 @@ proc update_assembly {linespec} { proc update_ptr {} { update_listing [gdb_loc] - if [winfo exists .asm] { + if {[winfo exists .asm]} { update_assembly [gdb_loc] } - if [winfo exists .reg] { + if {[winfo exists .reg]} { update_registers changed } - if [winfo exists .expr] { + if {[winfo exists .expr]} { update_exprs } - if [winfo exists .autocmd] { + if {[winfo exists .autocmd]} { update_autocmd } } @@ -1916,45 +1909,43 @@ proc update_ptr {} { wm withdraw . proc files_command {} { - toplevel .files_window - - wm minsize .files_window 1 1 -# wm overrideredirect .files_window true - listbox .files_window.list -geometry 30x20 -setgrid true \ - -yscrollcommand {.files_window.scroll set} -relief sunken \ - -borderwidth 2 - scrollbar .files_window.scroll -orient vertical \ - -command {.files_window.list yview} -relief sunken - button .files_window.close -text Close -command {destroy .files_window} - tk_listboxSingleSelect .files_window.list - -# Get the file list from GDB, sort it, and format it as one entry per line. - - set filelist [join [lsort [gdb_listfiles]] "\n"] - -# Now, remove duplicates (by using uniq) - - set fh [open "| uniq > /tmp/gdbtk.[pid]" w] - puts $fh $filelist - close $fh - set fh [open /tmp/gdbtk.[pid]] - set filelist [split [read $fh] "\n"] - set filelist [lrange $filelist 0 [expr [llength $filelist] - 2]] - close $fh - exec rm /tmp/gdbtk.[pid] + toplevel .files_window + + wm minsize .files_window 1 1 + # wm overrideredirect .files_window true + listbox .files_window.list -geometry 30x20 -setgrid true \ + -yscrollcommand {.files_window.scroll set} -relief sunken \ + -borderwidth 2 + scrollbar .files_window.scroll -orient vertical \ + -command {.files_window.list yview} -relief sunken + button .files_window.close -text Close -command {destroy .files_window} + .files_window.list configure -selectmode single + + # Get the file list from GDB, sort it, and format it as one entry per line. + set lastSeen {}; # Value that won't appear in + # list. + set fileList {} + foreach file [lsort [gdb_listfiles]] { + if {$file != $lastSeen} then { + lappend fileList $file + set lastSeen $file + } + } + set filelist [join [lsort [gdb_listfiles]] "\n"] -# Insert the file list into the widget + # Insert the file list into the widget - eval .files_window.list insert 0 $filelist + eval .files_window.list insert 0 $filelist - pack .files_window.close -side bottom -fill x -expand no -anchor s - pack .files_window.scroll -side right -fill both - pack .files_window.list -side left -fill both -expand yes - bind .files_window.list { - set file [%W get [%W curselection]] - gdb_cmd "list $file:1,0" - update_listing [gdb_loc $file:1] - destroy .files_window} + pack .files_window.close -side bottom -fill x -expand no -anchor s + pack .files_window.scroll -side right -fill both + pack .files_window.list -side left -fill both -expand yes + bind .files_window.list { + set file [%W get [%W curselection]] + gdb_cmd "list $file:1,0" + update_listing [gdb_loc $file:1] + destroy .files_window + } } button .files -text Files -command files_command @@ -1962,17 +1953,26 @@ button .files -text Files -command files_command proc apply_filespec {label default command} { set filename [FSBox $label $default] if {$filename != ""} { - if [catch {gdb_cmd "$command $filename"} retval] { + if {[catch {gdb_cmd "$command $filename"} retval]} { tk_dialog .filespec_error "gdb : $label error" \ - "Error in command \"$command $filename\"" {} 0 Dismiss + "Error in command \"$command $filename\"" error \ + 0 Dismiss return } update_ptr } } -# Setup command window +# Run editor. +proc run_editor {editor file} { + # FIXME should use index of line in middle of window, not line at + # top. + global wins + set lineNo [lindex [split [$wins($file) index @0,0] .] 0] + exec $editor +$lineNo $file +} +# Setup command window proc build_framework {win {title GDBtk} {label {}}} { global ${win}.label @@ -1991,7 +1991,7 @@ proc build_framework {win {title GDBtk} {label {}}} { ${win}.menubar.file.menu add command -label Target... \ -command { not_implemented_yet "target" } ${win}.menubar.file.menu add command -label Edit \ - -command {exec $editor +[expr ($screen_top + $screen_bot)/2] $cfile &} + -command {run_editor $editor $cfile} ${win}.menubar.file.menu add separator ${win}.menubar.file.menu add command -label "Exec File..." \ -command {apply_filespec {Exec File} a.out exec-file} @@ -2074,11 +2074,6 @@ proc build_framework {win {title GDBtk} {label {}}} { ${win}.menubar.help.menu add command -label "Report bug" \ -command {exec send-pr} - tk_menuBar ${win}.menubar \ - ${win}.menubar.file \ - ${win}.menubar.view \ - ${win}.menubar.window \ - ${win}.menubar.help pack ${win}.menubar.file \ ${win}.menubar.view \ ${win}.menubar.window -side left @@ -2096,12 +2091,6 @@ proc build_framework {win {title GDBtk} {label {}}} { bind $win do_nothing bind $win do_nothing - bind $win "$win yview {@0,0 - 10 lines}" - bind $win "$win yview {@0,0 + 10 lines}" - bind $win "$win yview {@0,0 - 1 lines}" - bind $win "$win yview {@0,0 + 1 lines}" - bind $win "$win yview -pickplace end" - bind $win "$win yview -pickplace end" pack ${win}.label -side bottom -fill x -in ${win}.info pack ${win}.scroll -side right -fill y -in ${win}.info @@ -2115,7 +2104,7 @@ proc create_source_window {} { global wins global cfile - if [winfo exists .src] {raise .src ; return} + if {[winfo exists .src]} {raise .src ; return} build_framework .src Source "*No file*" @@ -2172,13 +2161,7 @@ proc create_source_window {} { $wins($cfile) insert 0.0 " This page intentionally left blank." $wins($cfile) configure -width 88 -state disabled \ - -yscrollcommand textscrollproc - - proc textscrollproc {args} {global screen_height screen_top screen_bot - eval ".src.scroll set $args" - set screen_height [lindex $args 1] - set screen_top [lindex $args 2] - set screen_bot [lindex $args 3]} + -yscrollcommand ".src.scroll set" } proc update_autocmd {} { @@ -2186,43 +2169,44 @@ proc update_autocmd {} { global accumulate_output catch {gdb_cmd "${.autocmd.label}"} result - if !$accumulate_output { .autocmd.text delete 0.0 end } + if {!$accumulate_output} { .autocmd.text delete 0.0 end } .autocmd.text insert end $result - .autocmd.text yview -pickplace end + .autocmd.text see end } proc create_autocmd_window {} { - global .autocmd.label + global .autocmd.label - if [winfo exists .autocmd] {raise .autocmd ; return} + if {[winfo exists .autocmd]} {raise .autocmd ; return} - build_framework .autocmd "Auto Command" "" + build_framework .autocmd "Auto Command" "" -# First, delete all the old view menu entries + # First, delete all the old view menu entries - .autocmd.menubar.view.menu delete 0 last + .autocmd.menubar.view.menu delete 0 last -# Accumulate output option + # Accumulate output option - .autocmd.menubar.view.menu add checkbutton \ - -variable accumulate_output \ - -label "Accumulate output" -onvalue 1 -offvalue 0 + .autocmd.menubar.view.menu add checkbutton \ + -variable accumulate_output \ + -label "Accumulate output" -onvalue 1 -offvalue 0 -# Now, create entry widget with label + # Now, create entry widget with label - frame .autocmd.entryframe + frame .autocmd.entryframe - entry .autocmd.entry -borderwidth 2 -relief sunken - bind .autocmd {focus .autocmd.entry} - bind .autocmd.entry {set .autocmd.label [.autocmd.entry get] - .autocmd.entry delete 0 end } + entry .autocmd.entry -borderwidth 2 -relief sunken + bind .autocmd.entry { + set .autocmd.label [.autocmd.entry get] + .autocmd.entry delete 0 end + } - label .autocmd.entrylab -text "Command: " + label .autocmd.entrylab -text "Command: " - pack .autocmd.entrylab -in .autocmd.entryframe -side left - pack .autocmd.entry -in .autocmd.entryframe -side left -fill x -expand yes + pack .autocmd.entrylab -in .autocmd.entryframe -side left + pack .autocmd.entry -in .autocmd.entryframe -side left -fill x -expand yes - pack .autocmd.entryframe -side bottom -fill x -before .autocmd.info + pack .autocmd.entryframe -side bottom -fill x -before .autocmd.info } # Return the longest common prefix in SLIST. Can be empty string. @@ -2262,109 +2246,110 @@ proc create_command_window {} { global saw_tab set saw_tab 0 - if [winfo exists .cmd] {raise .cmd ; return} + if {[winfo exists .cmd]} {raise .cmd ; return} build_framework .cmd Command "* Command Buffer *" + # Put focus on command area. + focus .cmd.text + set command_line {} gdb_cmd {set language c} gdb_cmd {set height 0} gdb_cmd {set width 0} - bind .cmd.text {focus %W} - bind .cmd.text {delete_char %W} + # Tk uses the Motifism that Delete means delete forward. I + # hate this, and I'm not gonna take it any more. + set bsBinding [bind Text ] + bind .cmd.text "delete_char %W ; $bsBinding; break" bind .cmd.text {delete_char %W} bind .cmd.text gdb_stop - bind .cmd.text {delete_line %W} + bind .cmd.text {delete_line %W ; break} bind .cmd.text { - global command_line - global saw_tab - - set saw_tab 0 - %W insert end %A - %W yview -pickplace end - append command_line %A - } + set saw_tab 0 + %W insert end %A + %W see end + append command_line %A + break + } bind .cmd.text { - global command_line - global saw_tab - - set saw_tab 0 - %W insert end \n - interactive_cmd $command_line - -# %W yview -pickplace end -# catch "gdb_cmd [list $command_line]" result -# %W insert end $result - set command_line {} -# update_ptr - %W insert end "(gdb) " - %W yview -pickplace end - } + set saw_tab 0 + %W insert end \n + interactive_cmd $command_line + + # %W see end + # catch "gdb_cmd [list $command_line]" result + # %W insert end $result + set command_line {} + # update_ptr + %W insert end "(gdb) " + %W see end + break + } bind .cmd.text { - global command_line - - %W insert end [selection get] - %W yview -pickplace end - append command_line [selection get] + %W insert end [selection get] + %W see end + append command_line [selection get] + break } bind .cmd.text { - global command_line - global saw_tab - global choices - - set choices [gdb_cmd "complete $command_line"] - set choices [string trimright $choices \n] - set choices [split $choices \n] - -# Just do completion if this is the first tab - if !$saw_tab { - set saw_tab 1 - set completion [find_completion $command_line $choices] - append command_line $completion -# Here is where the completion is actually done. If there is one match, -# complete the command and print a space. If two or more matches, complete the -# command and beep. If no match, just beep. - switch -exact [llength $choices] { - 0 {} - 1 {%W insert end "$completion " - append command_line " " - return } - default {%W insert end "$completion"} - } - puts -nonewline stdout \007 - flush stdout - %W yview -pickplace end - } else { -# User hit another consecutive tab. List the choices. Note that at this -# point, choices may contain commands with spaces. We have to lop off -# everything before (and including) the last space so that the completion -# list only shows the possibilities for the last token. - - set choices [lsort $choices] - if [regexp ".* " $command_line prefix] { - regsub -all $prefix $choices {} choices - } - %W insert end "\n[join $choices { }]\n(gdb) $command_line" - %W yview -pickplace end - } - } - proc delete_char {win} { - global command_line + set choices [gdb_cmd "complete $command_line"] + set choices [string trimright $choices \n] + set choices [split $choices \n] + + # Just do completion if this is the first tab + if {!$saw_tab} { + set saw_tab 1 + set completion [find_completion $command_line $choices] + append command_line $completion + # Here is where the completion is actually done. If there + # is one match, complete the command and print a space. + # If two or more matches, complete the command and beep. + # If no match, just beep. + switch [llength $choices] { + 0 {} + 1 { + %W insert end "$completion " + append command_line " " + return + } - tk_textBackspace $win - $win yview -pickplace insert - set tmp [expr [string length $command_line] - 2] - set command_line [string range $command_line 0 $tmp] + default { + %W insert end $completion + } + } + bell + %W see end + } else { + # User hit another consecutive tab. List the choices. + # Note that at this point, choices may contain commands + # with spaces. We have to lop off everything before (and + # including) the last space so that the completion list + # only shows the possibilities for the last token. + set choices [lsort $choices] + if {[regexp ".* " $command_line prefix]} { + regsub -all $prefix $choices {} choices + } + %W insert end "\n[join $choices { }]\n(gdb) $command_line" + %W see end + } + break } - proc delete_line {win} { - global command_line +} - $win delete {end linestart + 6 chars} end - $win yview -pickplace insert - set command_line {} - } +proc delete_char {win} { + global command_line + set tmp [expr [string length $command_line] - 2] + set command_line [string range $command_line 0 $tmp] +} + +proc delete_line {win} { + global command_line + + $win delete {end linestart + 6 chars} end + $win see insert + set command_line {} } # @@ -2405,7 +2390,7 @@ proc FSBox {{purpose "Select file:"} {defaultName ""} {cmd ""} {errorHandler ""}} { global fileselect set w .fileSelect - if [Exwin_Toplevel $w "Select File" FileSelect] { + if {[Exwin_Toplevel $w "Select File" FileSelect]} { # path independent names for the widgets set fileselect(list) $w.file.sframe.list @@ -2462,33 +2447,28 @@ proc FSBox {{purpose "Select file:"} {defaultName ""} {cmd ""} {errorHandler bind $fileselect(direntry) [list fileselect.list.cmd %W] bind $fileselect(direntry) [list fileselect.tab.dircmd] bind $fileselect(entry) [list fileselect.tab.filecmd] - - tk_listboxSingleSelect $fileselect(list) - - + + $fileselect(list) configure -selectmode single + bind $fileselect(list) { # puts stderr "button 1 release" - %W select from [%W nearest %y] $fileselect(entry) delete 0 end $fileselect(entry) insert 0 [%W get [%W nearest %y]] } bind $fileselect(list) { - %W select from [%W nearest %y] $fileselect(entry) delete 0 end $fileselect(entry) insert 0 [%W get [%W nearest %y]] } bind $fileselect(list) { # puts stderr "double button 1" - %W select from [%W nearest %y] $fileselect(entry) delete 0 end $fileselect(entry) insert 0 [%W get [%W nearest %y]] $fileselect(ok) invoke } bind $fileselect(list) { - %W select from [%W nearest %y] $fileselect(entry) delete 0 end $fileselect(entry) insert 0 [%W get [%W nearest %y]] $fileselect(ok) invoke @@ -2540,7 +2520,7 @@ proc FSBox {{purpose "Select file:"} {defaultName ""} {cmd ""} {errorHandler proc fileselect.cd { dir } { global fileselect - if [catch {cd $dir} err] { + if {[catch {cd $dir} err]} { fileselect.yck $dir cd } @@ -2551,6 +2531,7 @@ proc fileselect.yck { {tag {}} } { global fileselect $fileselect(msg) configure -text "Yck! $tag" } + proc fileselect.ok {} { global fileselect $fileselect(msg) configure -text $fileselect(text) @@ -2577,7 +2558,7 @@ proc fileselect.list.cmd {w {state normal}} { } fileselect.ok update idletasks - if [file isdirectory $dir] { + if {[file isdirectory $dir]} { fileselect.getfiles $dir $pat $state focus $fileselect(entry) } else { @@ -2590,10 +2571,10 @@ proc fileselect.ok.cmd {w cmd errorHandler} { set selname [$fileselect(entry) get] set seldir [$fileselect(direntry) get] - if [string match /* $selname] { + if {[string match /* $selname]} { set selected $selname } else { - if [string match ~* $selname] { + if {[string match ~* $selname]} { set selected $selname } else { set selected $seldir/$selname @@ -2601,12 +2582,12 @@ proc fileselect.ok.cmd {w cmd errorHandler} { } # some nasty file names may cause "file isdirectory" to return an error - if [catch {file isdirectory $selected} isdir] { + if {[catch {file isdirectory $selected} isdir]} { fileselect.yck "isdirectory failed" return } - if [catch {glob $selected} globlist] { - if ![file isdirectory [file dirname $selected]] { + if {[catch {glob $selected} globlist]} { + if {![file isdirectory [file dirname $selected]]} { fileselect.yck "bad pathname" return } @@ -2623,7 +2604,7 @@ proc fileselect.ok.cmd {w cmd errorHandler} { } else { set selected $globlist } - if [file isdirectory $selected] { + if {[file isdirectory $selected]} { fileselect.getfiles $selected $fileselect(pattern) $fileselect(entry) delete 0 end return @@ -2644,7 +2625,7 @@ proc fileselect.getfiles { dir {pat *} {state normal} } { set currentDir [pwd] fileselect.cd $dir - if [catch {set files [lsort [glob -nocomplain $pat]]} err] { + if {[catch {set files [lsort [glob -nocomplain $pat]]} err]} { $fileselect(msg) configure -text $err $fileselect(list) delete 0 end update idletasks @@ -2676,7 +2657,7 @@ proc fileselect.getfiles { dir {pat *} {state normal} } { # build a reordered list of the files: directories are displayed first # and marked with a trailing "/" - if [string compare $dir /] { + if {[string compare $dir /]} { fileselect.putfiles $files [expr {($pat == "*") ? 1 : 0}] } else { fileselect.putfiles $files @@ -2724,10 +2705,12 @@ OK to overwrite it?" destroy $w return $fileExists(ok) } + proc FileExistsCancel {} { global fileExists set fileExists(ok) 0 } + proc FileExistsOK {} { global fileExists set fileExists(ok) 1 @@ -2746,15 +2729,15 @@ proc fileselect.getfiledir { dir {basedir [pwd]} } { } else { set path [$fileselect(entry) get] } - if [catch {set listFile [glob -nocomplain $path*]}] { + if {[catch {set listFile [glob -nocomplain $path*]}]} { return $returnList } foreach el $listFile { if {$dir != 0} { - if [file isdirectory $el] { + if {[file isdirectory $el]} { lappend returnList [file tail $el] } - } elseif ![file isdirectory $el] { + } elseif {![file isdirectory $el]} { lappend returnList [file tail $el] } } @@ -2779,7 +2762,9 @@ proc fileselect.gethead { list } { } return $returnHead } - + +# FIXME this function is a crock. Can write tilde expanding function +# in terms of glob and quote_glob; do so. proc fileselect.expand.tilde { } { global fileselect @@ -2793,15 +2778,15 @@ proc fileselect.expand.tilde { } { set listmatch {} ## look in /etc/passwd - if [file exists /etc/passwd] { - if [catch {set users [exec cat /etc/passwd | sed s/:.*//]} err] { + if {[file exists /etc/passwd]} { + if {[catch {set users [exec cat /etc/passwd | sed s/:.*//]} err]} { puts "Error\#1 $err" return } set list [split $users "\n"] } if {[lsearch -exact $list "+"] != -1} { - if [catch {set users [exec ypcat passwd | sed s/:.*//]} err] { + if {[catch {set users [exec ypcat passwd | sed s/:.*//]} err]} { puts "Error\#2 $err" return } @@ -2809,7 +2794,7 @@ proc fileselect.expand.tilde { } { } $fileselect(list) delete 0 end foreach el $list { - if [string match $dir* $el] { + if {[string match $dir* $el]} { lappend listmatch $el $fileselect(list) insert end $el } @@ -2834,12 +2819,12 @@ proc fileselect.tab.dircmd { } { if {$dir == ""} { $fileselect(direntry) delete 0 end $fileselect(direntry) insert 0 [pwd] - if [string compare [pwd] "/"] { + if {[string compare [pwd] "/"]} { $fileselect(direntry) insert end / } return } - if [catch {set tmp [file isdirectory [file dirname $dir]]}] { + if {[catch {set tmp [file isdirectory [file dirname $dir]]}]} { if {[string index $dir 0] == "~"} { fileselect.expand.tilde } @@ -2849,13 +2834,13 @@ proc fileselect.tab.dircmd { } { return } set dirFile [fileselect.getfiledir 1 $dir] - if ![llength $dirFile] { + if {![llength $dirFile]} { return } if {[llength $dirFile] == 1} { $fileselect(direntry) delete 0 end $fileselect(direntry) insert 0 [file dirname $dir] - if [string compare [file dirname $dir] /] { + if {[string compare [file dirname $dir] /]} { $fileselect(direntry) insert end /[lindex $dirFile 0]/ } else { $fileselect(direntry) insert end [lindex $dirFile 0]/ @@ -2867,7 +2852,7 @@ proc fileselect.tab.dircmd { } { set headFile [fileselect.gethead $dirFile] $fileselect(direntry) delete 0 end $fileselect(direntry) insert 0 [file dirname $dir] - if [string compare [file dirname $dir] /] { + if {[string compare [file dirname $dir] /]} { $fileselect(direntry) insert end /$headFile } else { $fileselect(direntry) insert end $headFile @@ -2893,7 +2878,7 @@ proc fileselect.tab.filecmd { } { } set listFile [fileselect.getfiledir 0 $dir] puts $listFile - if ![llength $listFile] { + if {![llength $listFile]} { return } if {[llength $listFile] == 1} { @@ -2909,9 +2894,9 @@ proc fileselect.tab.filecmd { } { proc Exwin_Toplevel { path name {class Dialog} {dismiss yes}} { global exwin - if [catch {wm state $path} state] { + if {[catch {wm state $path} state]} { set t [Widget_Toplevel $path $name $class] - if ![info exists exwin(toplevels)] { + if {![info exists exwin(toplevels)]} { set exwin(toplevels) [option get . exwinPaths {}] } set ix [lsearch $exwin(toplevels) $t] @@ -2957,7 +2942,7 @@ proc Widget_Toplevel { path name {class Dialog} {x {}} {y {}} } { set self [toplevel $path -class $class] set usergeo [option get $path position Position] if {$usergeo != {}} { - if [catch {wm geometry $self $usergeo} err] { + if {[catch {wm geometry $self $usergeo} err]} { # Exmh_Debug Widget_Toplevel $self $usergeo => $err } } else { @@ -2985,17 +2970,18 @@ proc Widget_Frame {par child {class GDB} {where {top expand fill}} args } { proc Widget_AddBut {par but txt cmd {where {right padx 1}} } { # Create a Packed button. Return the button pathname set cmd2 [list button $par.$but -text $txt -command $cmd] - if [catch $cmd2 t] { + if {[catch $cmd2 t]} { puts stderr "Widget_AddBut (warning) $t" eval $cmd2 {-font fixed} } pack append $par $par.$but $where return $par.$but } + proc Widget_CheckBut {par but txt var {where {right padx 1}} } { # Create a check button. Return the button pathname set cmd [list checkbutton $par.$but -text $txt -variable $var] - if [catch $cmd t] { + if {[catch $cmd t]} { puts stderr "Widget_CheckBut (warning) $t" eval $cmd {-font fixed} } @@ -3005,16 +2991,17 @@ proc Widget_CheckBut {par but txt var {where {right padx 1}} } { proc Widget_Label { frame {name label} {where {left fill}} args} { set cmd [list label $frame.$name ] - if [catch [concat $cmd $args] t] { + if {[catch [concat $cmd $args] t]} { puts stderr "Widget_Label (warning) $t" eval $cmd $args {-font fixed} } pack append $frame $frame.$name $where return $frame.$name } + proc Widget_Entry { frame {name entry} {where {left fill}} args} { set cmd [list entry $frame.$name ] - if [catch [concat $cmd $args] t] { + if {[catch [concat $cmd $args] t]} { puts stderr "Widget_Entry (warning) $t" eval $cmd $args {-font fixed} } @@ -3024,32 +3011,40 @@ proc Widget_Entry { frame {name entry} {where {left fill}} args} { # End of fileselect.tcl. -# Setup the initial windows +# +# Create a copyright window and center it on the screen. Arrange for +# it to disappear when the user clicks it, or after a suitable period +# of time. +# +proc create_copyright_window {} { + toplevel .c + message .c.m -text [gdb_cmd {show version}] -aspect 500 -relief raised + pack .c.m -create_source_window + bind .c.m <1> {destroy .c} + # "suitable period" currently means "15 seconds". + after 15000 { + if {[winfo exists .c]} then { + destroy .c + } + } -if {[tk colormodel .src.text] == "color"} { - set highlight "-background red2 -borderwidth 2 -relief sunk" -} else { - set fg [lindex [.src.text config -foreground] 4] - set bg [lindex [.src.text config -background] 4] - set highlight "-foreground $bg -background $fg -borderwidth 0" + wm transient .c . + center_window .c } -create_command_window - -# Create a copyright window +# FIXME need to handle mono here. In Tk4 that is more complicated. +set highlight "-background red2 -borderwidth 2 -relief sunken" -update -toplevel .c -wm geometry .c +300+300 -wm overrideredirect .c true +# Setup the initial windows +create_source_window +create_command_window -message .c.m -text [gdb_cmd "show version"] -aspect 500 -relief raised -pack .c.m -bind .c.m {destroy .c} +# Make this last so user actually sees it. +create_copyright_window +# Refresh. update -if [file exists ~/.gdbtkinit] { - source ~/.gdbtkinit +if {[file exists ~/.gdbtkinit]} { + source ~/.gdbtkinit } diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 6327886c173..480445d2563 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -15,6 +15,16 @@ Mon Jan 15 09:33:00 1996 Fred Fish [] tests with "test" and enclose string in quotes. * gdb.stabs/configure: Rebuild +Thu Jan 11 09:43:14 1996 Tom Tromey + + Changes in sync with expect: + * aclocal.m4 (CY_AC_PATH_TCLH): Handle Tcl 7.5 and greater. + (CY_AC_PATH_TCLLIB): Handle Tcl 7.5 and greater. + (CY_AC_PATH_TKH): Handle Tk 4.1 and greater. + (CY_AC_PATH_TKLIB): Handle Tk 4.1 and greater. Properly quote + argument to AC_REQUIRE. + * configure: Regenerated. + Thu Jan 4 08:17:22 1996 Fred Fish * gdb.base/corefile.exp: When generating a core, discard any