aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Tromey <tromey@redhat.com>1996-01-24 06:27:59 +0000
committerTom Tromey <tromey@redhat.com>1996-01-24 06:27:59 +0000
commit4e327047ce195fe703b5ee64badca4631883cbe0 (patch)
tree6fbc7ddd69145ab5acaa9497e766d5d47f0fee1e
parent5a8d8b8db7f824edb04c5ca2692dd644bc943da8 (diff)
downloadgdb-4e327047ce195fe703b5ee64badca4631883cbe0.zip
gdb-4e327047ce195fe703b5ee64badca4631883cbe0.tar.gz
gdb-4e327047ce195fe703b5ee64badca4631883cbe0.tar.bz2
Updated for Tcl 7.5a2 and Tk 4.1a2
-rw-r--r--gdb/ChangeLog197
-rw-r--r--gdb/Makefile.in2
-rw-r--r--gdb/README.GDBTK4
-rw-r--r--gdb/aclocal.m4684
-rwxr-xr-xgdb/configure752
-rw-r--r--gdb/configure.in4
-rw-r--r--gdb/gdbtk.c17
-rw-r--r--gdb/gdbtk.tcl1111
-rw-r--r--gdb/testsuite/ChangeLog10
9 files changed, 1873 insertions, 908 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1441d3c..e8ccefe 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -87,14 +87,6 @@ Wed Jan 17 13:22:27 1996 Stan Shebs <shebs@andros.cygnus.com>
* 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 <jsmith@cygnus.co.uk>
* 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 <jsmith@cygnus.co.uk>
(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 <tromey@creche.cygnus.com>
+
+ * 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 <shebs@andros.cygnus.com>
* 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 <tromey@creche.cygnus.com>
+
+ * 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 <fnf@cirdan.cygnus.com>
* 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 <bothner@kalessin.cygnus.com>
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 <fnf@cygnus.com>
+start-sanitize-gdbtk
+Thu Jan 11 10:08:14 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * 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 <brendan@lisa.cygnus.com>
* configure.in, configure: Recognize rs6000-*-aix4*.
@@ -268,6 +228,47 @@ Wed Jan 10 11:25:37 1996 Fred Fish <fnf@cygnus.com>
* 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 <tromey@creche.cygnus.com>
+
+ * 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 34fada9..975eeda 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 4756b0e..d2aecdd 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 19ba7ed..d23d084 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 <rob@cygnus.com> 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 <stdio.h>
+#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 <stdio.h>
+#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 c3d8d8b..46d25f3 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 <<EOF
-#line 620 "configure"
+#line 628 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
@@ -630,7 +638,7 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 634 "configure"
+#line 642 "configure"
#include "confdefs.h"
#include <assert.h>
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 <<EOF
-#line 661 "configure"
+#line 669 "configure"
#include "confdefs.h"
#ifdef _AIX
yes
@@ -684,7 +692,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
-#line 688 "configure"
+#line 696 "configure"
#include "confdefs.h"
#include <minix/config.h>
EOF
@@ -1018,7 +1026,7 @@ else
ac_cv_c_cross=yes
else
cat > conftest.$ac_ext <<EOF
-#line 1022 "configure"
+#line 1030 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
@@ -1040,7 +1048,7 @@ if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1044 "configure"
+#line 1052 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
@@ -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
-#line 1066 "configure"
+#line 1074 "configure"
#include "confdefs.h"
#include <string.h>
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
-#line 1084 "configure"
+#line 1092 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1101,7 +1109,7 @@ if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
-#line 1105 "configure"
+#line 1113 "configure"
#include "confdefs.h"
#include <ctype.h>
#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
-#line 1143 "configure"
+#line 1151 "configure"
#include "confdefs.h"
#include <$ac_hdr>
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 <<EOF
-#line 1176 "configure"
+#line 1184 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
@@ -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 <<EOF
-#line 1234 "configure"
+#line 1242 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1282,7 +1290,7 @@ else
ac_cv_func_mmap=no
else
cat > conftest.$ac_ext <<EOF
-#line 1286 "configure"
+#line 1294 "configure"
#include "confdefs.h"
/* Thanks to Mike Haertel and Jim Avera for this test. */
@@ -1516,7 +1524,7 @@ test -z "$x_direct_test_library" && x_direct_test_library=Xt
test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
cat > conftest.$ac_ext <<EOF
-#line 1520 "configure"
+#line 1528 "configure"
#include "confdefs.h"
#include <$x_direct_test_include>
EOF
@@ -1579,7 +1587,7 @@ rm -f conftest*
ac_save_LIBS="$LIBS"
LIBS="-l$x_direct_test_library $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1583 "configure"
+#line 1591 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1698,7 +1706,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lICE $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1702 "configure"
+#line 1710 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1742,7 +1750,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldnet $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1746 "configure"
+#line 1754 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1777,7 +1785,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldnet_stub $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1781 "configure"
+#line 1789 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1817,7 +1825,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lnsl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1821 "configure"
+#line 1829 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1856,7 +1864,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1860 "configure"
+#line 1868 "configure"
#include "confdefs.h"
int main() { return 0; }
@@ -1888,34 +1896,82 @@ fi
+
#
-# 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.
+# 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
#
-echo "checking for Tk source directory" 1>&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 <<EOF
-#line 1917 "configure"
+#line 1973 "configure"
#include "confdefs.h"
-#include <tk.h>
+#include <tclInt.h>
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 <<EOF
+#line 2030 "configure"
+#include "confdefs.h"
+
+#include <stdio.h>
+#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 <<EOF
+#line 2190 "configure"
+#include "confdefs.h"
+
+ Tcl_AppInit()
+ { exit(0); }
+EOF
+eval $ac_link
+if test -s conftest && (./conftest; exit) 2>/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 <<EOF
-#line 2019 "configure"
+#line 2306 "configure"
#include "confdefs.h"
-#include <tclInt.h>
+#include <tk.h>
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 <<EOF
+#line 2370 "configure"
+#include "confdefs.h"
+
+#include <stdio.h>
+#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 <<EOF
+#line 2551 "configure"
+#include "confdefs.h"
-if test x"$TCLLIB" = x ; then
- TCLLIB="# no Tcl library found"
- echo "configure: warning: Can't find Tcl library" 1>&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 959e7b4..b215445 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 dd99f69..aaf9193 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 f35dbf5..c7b4ec1 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
@@ -629,20 +688,6 @@ proc gdbtk_tcl_idle {} {
#
# 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:
-#
# pc_to_line (pclist pc) - convert PC to a line number.
#
# Description:
@@ -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 <Any-ButtonRelease-1> {
- 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 <FocusIn> "expr_update_button $expr_num"
+ bind $e.$frame.$f <FocusOut> "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 <Any-Leave> {}
- } else {
- set delete_expr_flag 1
- bind .expr.delete <Any-Leave> 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 <Any-Leave> {}
- 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 <Enter> {focus .expr.entry}
- bind .expr.entry <Key-Return> {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 <Return> {
+ 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 <Key-Up> "$win yview {@0,0 - 1 lines}"
bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
bind $win <Key-Home> {update_listing [gdb_loc]}
- bind $win <Key-End> "$win yview -pickplace end"
+ bind $win <Key-End> "$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 <Key-Alt_R> do_nothing
bind $win <Key-Alt_L> do_nothing
- bind $win <Key-Prior> "$win yview {@0,0 - 10 lines}"
- bind $win <Key-Next> "$win yview {@0,0 + 10 lines}"
- bind $win <Key-Up> "$win yview {@0,0 - 1 lines}"
- bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
- bind $win <Key-Home> {update_assembly [gdb_loc]}
- bind $win <Key-End> "$win yview -pickplace end"
bind $win n {interactive_cmd nexti}
bind $win s {interactive_cmd stepi}
@@ -1317,26 +1354,6 @@ proc create_asm_win {funcname pc} {
#
# 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:
-#
# update_listing (linespec) - Update the listing window according to
# LINESPEC.
#
@@ -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 <Any-ButtonRelease-1> {
- 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 <Any-ButtonRelease-1> {
+ 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 <Key-Alt_R> do_nothing
bind $win <Key-Alt_L> do_nothing
- bind $win <Key-Prior> "$win yview {@0,0 - 10 lines}"
- bind $win <Key-Next> "$win yview {@0,0 + 10 lines}"
- bind $win <Key-Up> "$win yview {@0,0 - 1 lines}"
- bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
- bind $win <Key-Home> "$win yview -pickplace end"
- bind $win <Key-End> "$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 <Enter> {focus .autocmd.entry}
- bind .autocmd.entry <Key-Return> {set .autocmd.label [.autocmd.entry get]
- .autocmd.entry delete 0 end }
+ entry .autocmd.entry -borderwidth 2 -relief sunken
+ bind .autocmd.entry <Key-Return> {
+ 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 <Enter> {focus %W}
- bind .cmd.text <Delete> {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 <BackSpace>]
+ bind .cmd.text <Delete> "delete_char %W ; $bsBinding; break"
bind .cmd.text <BackSpace> {delete_char %W}
bind .cmd.text <Control-c> gdb_stop
- bind .cmd.text <Control-u> {delete_line %W}
+ bind .cmd.text <Control-u> {delete_line %W ; break}
bind .cmd.text <Any-Key> {
- 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 <Key-Return> {
- 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 <Button-2> {
- 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 <Key-Tab> {
- 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) <Return> [list fileselect.list.cmd %W]
bind $fileselect(direntry) <Tab> [list fileselect.tab.dircmd]
bind $fileselect(entry) <Tab> [list fileselect.tab.filecmd]
-
- tk_listboxSingleSelect $fileselect(list)
-
-
+
+ $fileselect(list) configure -selectmode single
+
bind $fileselect(list) <Button-1> {
# 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) <Key> {
- %W select from [%W nearest %y]
$fileselect(entry) delete 0 end
$fileselect(entry) insert 0 [%W get [%W nearest %y]]
}
bind $fileselect(list) <Double-ButtonPress-1> {
# 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) <Return> {
- %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 <Leave> {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 6327886..480445d 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -15,6 +15,16 @@ Mon Jan 15 09:33:00 1996 Fred Fish <fnf@cygnus.com>
[] tests with "test" and enclose string in quotes.
* gdb.stabs/configure: Rebuild
+Thu Jan 11 09:43:14 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ 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 <fnf@cygnus.com>
* gdb.base/corefile.exp: When generating a core, discard any