Updated for Tcl 7.5a2 and Tk 4.1a2
authorTom Tromey <tromey@redhat.com>
Wed, 24 Jan 1996 06:27:59 +0000 (06:27 +0000)
committerTom Tromey <tromey@redhat.com>
Wed, 24 Jan 1996 06:27:59 +0000 (06:27 +0000)
gdb/ChangeLog
gdb/Makefile.in
gdb/README.GDBTK
gdb/aclocal.m4
gdb/configure
gdb/configure.in
gdb/gdbtk.c
gdb/gdbtk.tcl
gdb/testsuite/ChangeLog

index 1441d3ce33ee28cfbf13cbf11cedfd3c79a6ba0a..e8ccefe3f6f2384a23c11947c9d7489298d27375 100644 (file)
@@ -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 
index 34fada98c2a4d1e98a839c8453d33cabfe6a5772..975eeda2d9b4e3763a4f32e726f243ccabe69720 100644 (file)
@@ -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
index 4756b0ecde847cb46b64b39d261def046236eb23..d2aecdd1d0f98a26a805ec9134db8216e6cba177 100644 (file)
@@ -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".
index 19ba7edec847d724743741e1fc8f28631a48ca9d..d23d084cecdfe30a9b3de464f15a1f74cad2c2b9 100644 (file)
-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
+])
index c3d8d8b3ad9b712ea5bb8d37695000f0b4fe3460..46d25f3abcadb958dced04a551c4d81dee519b8e 100755 (executable)
@@ -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
index 959e7b4bb10d8b78fcd8d883faa0c8cca6288698..b21544599f0e5302d9cf6477291ff2368d5d5aaa 100644 (file)
@@ -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
 
index dd99f6944277c7b3d3665f2216216ea7aae5f955..aaf919344bf008bc185d23a9b9b950cf60b281cf 100644 (file)
@@ -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);
index f35dbf54c496c75bb4f6a8a8f6f5c73576103f9a..c7b4ec12511929135df79a943525e1a63a9dd465 100644 (file)
 
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 set cfile Blank
 set wins($cfile) .src.text
 set current_label {}
-set screen_height 0
-set screen_top 0
-set screen_bot 0
 set cfunc NIL
 set line_numbers 1
 set breakpoint_file(-1) {[garbage]}
@@ -35,14 +32,76 @@ set expr_update_list(0) 0
 #option add *Foreground Black
 #option add *Background White
 #option add *Font -*-*-medium-r-normal--18-*-*-*-m-*-*-1
-tk colormodel . monochrome
 
 proc echo string {puts stdout $string}
 
-if [info exists env(EDITOR)] then {
-       set editor $env(EDITOR)
-       } else {
-       set editor emacs
+# Assign elements from LIST to variables named in ARGS.  FIXME replace
+# with TclX version someday.
+proc lassign {list args} {
+  set len [expr {[llength $args] - 1}]
+  while {$len >= 0} {
+    upvar [lindex $args $len] local
+    set local [lindex $list $len]
+    decr len
+  }
+}
+
+#
+# Local procedure:
+#
+#      decr (var val) - compliment to incr
+#
+# Description:
+#
+#
+proc decr {var {val 1}} {
+  upvar $var num
+  set num [expr {$num - $val}]
+  return $num
+}
+
+#
+# Center a window on the screen.
+#
+proc center_window toplevel {
+  # Withdraw and update, to ensure geometry computations are finished.
+  wm withdraw $toplevel
+  update idletasks
+
+  set x [expr {[winfo screenwidth $toplevel] / 2
+              - [winfo reqwidth $toplevel] / 2
+              - [winfo vrootx $toplevel]}]
+  set y [expr {[winfo screenheight $toplevel] / 2
+              - [winfo reqheight $toplevel] / 2
+              - [winfo vrooty $toplevel]}]
+  wm geometry $toplevel +${x}+${y}
+  wm deiconify $toplevel
+}
+
+#
+# Rearrange the bindtags so the widget comes after the class.  I was
+# always for Ousterhout putting the class bindings first, but no...
+#
+proc bind_widget_after_class {widget} {
+  set class [winfo class $widget]
+  set newList {}
+  foreach tag [bindtags $widget] {
+    if {$tag == $widget} {
+      # Nothing.
+    } {
+      lappend newList $tag
+      if {$tag == $class} {
+       lappend newList $widget
+      }
+    }
+  }
+  bindtags $widget $newList
+}
+
+if {[info exists env(EDITOR)]} then {
+  set editor $env(EDITOR)
+} else {
+  set editor emacs
 }
 
 # GDB callbacks
@@ -64,13 +123,13 @@ if [info exists env(EDITOR)] then {
 #
 
 proc gdbtk_tcl_fputs {arg} {
-       .cmd.text insert end "$arg"
-       .cmd.text yview -pickplace end
+  .cmd.text insert end "$arg"
+  .cmd.text see end
 }
 
 proc gdbtk_tcl_fputs_error {arg} {
-       .cmd.text insert end "$arg"
-       .cmd.text yview -pickplace end
+  .cmd.text insert end "$arg"
+  .cmd.text see end
 }
 
 #
@@ -84,8 +143,8 @@ proc gdbtk_tcl_fputs_error {arg} {
 #
 
 proc gdbtk_tcl_flush {} {
-       .cmd.text yview -pickplace end
-       update idletasks
+  .cmd.text see end
+  update idletasks
 }
 
 #
@@ -101,8 +160,12 @@ proc gdbtk_tcl_flush {} {
 #
 
 proc gdbtk_tcl_query {message} {
-       tk_dialog .query "gdb : query" "$message" {} 1 "No" "Yes"
-       }
+  # FIXME We really want a Help button here.  But Tk's brain-damaged
+  # modal dialogs won't really allow it.  Should have async dialog
+  # here.
+  set result [tk_dialog .query "gdb : query" "$message" questhead 0 Yes No]
+  return [expr {!$result}]
+}
 
 #
 # GDB Callback:
@@ -114,8 +177,9 @@ proc gdbtk_tcl_query {message} {
 #      Not yet implemented.
 #
 
-proc gdbtk_tcl_start_variable_annotation {valaddr ref_type stor_cl cum_expr field type_cast} {
-       echo "gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast"
+proc gdbtk_tcl_start_variable_annotation {valaddr ref_type stor_cl
+                                         cum_expr field type_cast} {
+  echo "gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast"
 }
 
 #
@@ -170,7 +234,7 @@ proc gdbtk_tcl_breakpoint {action bpnum} {
 proc create_breakpoints_window {} {
        global bpframe_lasty
 
-       if [winfo exists .breakpoints] {raise .breakpoints ; return}
+       if {[winfo exists .breakpoints]} {raise .breakpoints ; return}
 
        build_framework .breakpoints "Breakpoints" ""
 
@@ -185,11 +249,13 @@ proc create_breakpoints_window {} {
 # Replace text with a canvas and fix the scrollbars
 
        destroy .breakpoints.text
-       canvas .breakpoints.c -relief sunken -bd 2 \
-               -cursor hand2 -yscrollcommand {.breakpoints.scroll set}
-       .breakpoints.scroll configure -command {.breakpoints.c yview}
        scrollbar .breakpoints.scrollx -orient horizontal \
                -command {.breakpoints.c xview} -relief sunken
+       canvas .breakpoints.c -relief sunken -bd 2 \
+               -cursor hand2 \
+               -yscrollcommand {.breakpoints.scroll set} \
+               -xscrollcommand {.breakpoints.scrollx set}
+       .breakpoints.scroll configure -command {.breakpoints.c yview}
 
        pack .breakpoints.scrollx -side bottom -fill x -in .breakpoints.info
        pack .breakpoints.c -side left -expand yes -fill both \
@@ -207,107 +273,100 @@ proc create_breakpoints_window {} {
 # Create a frame for bpnum in the .breakpoints canvas
 
 proc add_breakpoint_frame bpnum {
-       global bpframe_lasty
-       global enabled
-       global disposition
-
-       if ![winfo exists .breakpoints] return
-
-       set bpinfo [gdb_get_breakpoint_info $bpnum]
-
-       set file [lindex $bpinfo 0]
-       set line [lindex $bpinfo 1]
-       set pc [lindex $bpinfo 2]
-       set type [lindex $bpinfo 3]
-       set enabled($bpnum) [lindex $bpinfo 4]
-       set disposition($bpnum) [lindex $bpinfo 5]
-       set silent [lindex $bpinfo 6]
-       set ignore_count [lindex $bpinfo 7]
-       set commands [lindex $bpinfo 8]
-       set cond [lindex $bpinfo 9]
-       set thread [lindex $bpinfo 10]
-       set hit_count [lindex $bpinfo 11]
-
-       set f .breakpoints.c.$bpnum
-
-       if ![winfo exists $f] {
-               frame $f -relief sunken -bd 2
-
-               label $f.id -text "#$bpnum     $file:$line    ($pc)" \
-                       -relief flat -bd 2 -anchor w
-               frame $f.hit_count
-               label $f.hit_count.label -text "Hit count:" -relief flat \
-                       -bd 2 -anchor w -width 11
-               label $f.hit_count.val -text $hit_count -relief flat \
-                       -bd 2 -anchor w
-               checkbutton $f.hit_count.enabled -text Enabled \
-                       -variable enabled($bpnum) -anchor w -relief flat
-                       
-               pack $f.hit_count.label $f.hit_count.val -side left
-               pack $f.hit_count.enabled -side right
-
-               frame $f.thread
-               label $f.thread.label -text "Thread: " -relief flat -bd 2 \
-                       -width 11 -anchor w
-               entry $f.thread.entry -bd 2 -relief sunken -width 10
-               $f.thread.entry insert end $thread
-               pack $f.thread.label -side left
-               pack $f.thread.entry -side left -fill x
-
-               frame $f.cond
-               label $f.cond.label -text "Condition: " -relief flat -bd 2 \
-                       -width 11 -anchor w
-               entry $f.cond.entry -bd 2 -relief sunken
-               $f.cond.entry insert end $cond
-               pack $f.cond.label -side left
-               pack $f.cond.entry -side left -fill x -expand yes
-
-               frame $f.ignore_count
-               label $f.ignore_count.label -text "Ignore count: " \
-                       -relief flat -bd 2 -width 11 -anchor w
-               entry $f.ignore_count.entry -bd 2 -relief sunken -width 10
-               $f.ignore_count.entry insert end $ignore_count
-               pack $f.ignore_count.label -side left
-               pack $f.ignore_count.entry -side left -fill x
-
-               frame $f.disps
-
-               label $f.disps.label -text "Disposition: " -relief flat -bd 2 \
-                       -anchor w -width 11
-
-               radiobutton $f.disps.delete -text Delete \
-                       -variable disposition($bpnum) -anchor w -relief flat \
-                       -command "gdb_cmd \"delete break $bpnum\""
-
-               radiobutton $f.disps.disable -text Disable \
-                       -variable disposition($bpnum) -anchor w -relief flat \
-                       -command "gdb_cmd \"disable break $bpnum\""
-
-               radiobutton $f.disps.donttouch -text "Leave alone" \
-                       -variable disposition($bpnum) -anchor w -relief flat \
-                       -command "gdb_cmd \"enable break $bpnum\""
-
-               pack $f.disps.label $f.disps.delete $f.disps.disable \
-                       $f.disps.donttouch -side left -anchor w
-               text $f.commands -relief sunken -bd 2 -setgrid true \
-                       -cursor hand2 -height 3 -width 30
-
-               foreach line $commands {
-                               $f.commands insert end "${line}\n"
-               }
+  global bpframe_lasty
+  global enabled
+  global disposition
+
+  if {![winfo exists .breakpoints]} return
+
+  set bpinfo [gdb_get_breakpoint_info $bpnum]
+
+  lassign $bpinfo file line pc type enabled($bpnum) disposition($bpnum) \
+    silent ignore_count commands cond thread hit_count
+
+  set f .breakpoints.c.$bpnum
+
+  if {![winfo exists $f]} {
+    frame $f -relief sunken -bd 2
+
+    label $f.id -text "#$bpnum     $file:$line    ($pc)" \
+      -relief flat -bd 2 -anchor w
+    frame $f.hit_count
+    label $f.hit_count.label -text "Hit count:" -relief flat \
+      -bd 2 -anchor w -width 11
+    label $f.hit_count.val -text $hit_count -relief flat \
+      -bd 2 -anchor w
+    checkbutton $f.hit_count.enabled -text Enabled \
+      -variable enabled($bpnum) -anchor w -relief flat
+
+    pack $f.hit_count.label $f.hit_count.val -side left
+    pack $f.hit_count.enabled -side right
+
+    frame $f.thread
+    label $f.thread.label -text "Thread: " -relief flat -bd 2 \
+      -width 11 -anchor w
+    entry $f.thread.entry -bd 2 -relief sunken -width 10
+    $f.thread.entry insert end $thread
+    pack $f.thread.label -side left
+    pack $f.thread.entry -side left -fill x
+
+    frame $f.cond
+    label $f.cond.label -text "Condition: " -relief flat -bd 2 \
+      -width 11 -anchor w
+    entry $f.cond.entry -bd 2 -relief sunken
+    $f.cond.entry insert end $cond
+    pack $f.cond.label -side left
+    pack $f.cond.entry -side left -fill x -expand yes
+
+    frame $f.ignore_count
+    label $f.ignore_count.label -text "Ignore count: " \
+      -relief flat -bd 2 -width 11 -anchor w
+    entry $f.ignore_count.entry -bd 2 -relief sunken -width 10
+    $f.ignore_count.entry insert end $ignore_count
+    pack $f.ignore_count.label -side left
+    pack $f.ignore_count.entry -side left -fill x
+
+    frame $f.disps
+
+    label $f.disps.label -text "Disposition: " -relief flat -bd 2 \
+      -anchor w -width 11
+
+    radiobutton $f.disps.delete -text Delete \
+      -variable disposition($bpnum) -anchor w -relief flat \
+      -command "gdb_cmd \"delete break $bpnum\"" \
+      -value delete
+
+    radiobutton $f.disps.disable -text Disable \
+      -variable disposition($bpnum) -anchor w -relief flat \
+      -command "gdb_cmd \"disable break $bpnum\"" \
+      -value disable
+
+    radiobutton $f.disps.donttouch -text "Leave alone" \
+      -variable disposition($bpnum) -anchor w -relief flat \
+      -command "gdb_cmd \"enable break $bpnum\"" \
+      -value donttouch
+
+    pack $f.disps.label $f.disps.delete $f.disps.disable \
+      $f.disps.donttouch -side left -anchor w
+    text $f.commands -relief sunken -bd 2 -setgrid true \
+      -cursor hand2 -height 3 -width 30
+
+    foreach line $commands {
+      $f.commands insert end "${line}\n"
+    }
 
-               pack $f.id -side top -anchor nw -fill x
-               pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \
-                               $f.commands -side top -fill x -anchor nw
-       }
+    pack $f.id -side top -anchor nw -fill x
+    pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \
+      $f.commands -side top -fill x -anchor nw
+  }
 
-       set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw]
-       update
-       set bbox [.breakpoints.c bbox $tag]
+  set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw]
+  update
+  set bbox [.breakpoints.c bbox $tag]
 
-       set bpframe_lasty [lindex $bbox 3]
+  set bpframe_lasty [lindex $bbox 3]
 
-       .breakpoints.c configure -width [lindex $bbox 2]
+  .breakpoints.c configure -width [lindex $bbox 2]
 }
 
 # Delete a breakpoint frame
@@ -315,7 +374,7 @@ proc add_breakpoint_frame bpnum {
 proc delete_breakpoint_frame bpnum {
        global bpframe_lasty
 
-       if ![winfo exists .breakpoints] return
+       if {![winfo exists .breakpoints]} return
 
 # First, clear the canvas
 
@@ -367,26 +426,26 @@ proc create_breakpoint {bpnum file line pc} {
        set breakpoint_file($bpnum) $file
        set breakpoint_line($bpnum) $line
        set pos_to_breakpoint($file:$line) $bpnum
-       if ![info exists pos_to_bpcount($file:$line)] {
+       if {![info exists pos_to_bpcount($file:$line)]} {
                set pos_to_bpcount($file:$line) 0
        }
        incr pos_to_bpcount($file:$line)
        set pos_to_breakpoint($pc) $bpnum
-       if ![info exists pos_to_bpcount($pc)] {
+       if {![info exists pos_to_bpcount($pc)]} {
                set pos_to_bpcount($pc) 0
        }
        incr pos_to_bpcount($pc)
        
 # If there's a window for this file, update it
 
-       if [info exists wins($file)] {
+       if {[info exists wins($file)]} {
                insert_breakpoint_tag $wins($file) $line
        }
 
 # If there's an assembly window, update that too
 
        set win [asm_win_name $cfunc]
-       if [winfo exists $win] {
+       if {[winfo exists $win]} {
                insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc]
        }
 
@@ -436,7 +495,7 @@ proc delete_breakpoint {bpnum file line pc} {
 
 # If there's a window for this file, update it
 
-                       if [info exists wins($file)] {
+                       if {[info exists wins($file)]} {
                                delete_breakpoint_tag $wins($file) $line
                        }
                }
@@ -451,7 +510,7 @@ proc delete_breakpoint {bpnum file line pc} {
                        catch "unset pos_to_breakpoint($pc)"
 
                        set win [asm_win_name $cfunc]
-                       if [winfo exists $win] {
+                       if {[winfo exists $win]} {
                                delete_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc]
                        }
                }
@@ -477,20 +536,20 @@ proc enable_breakpoint {bpnum file line pc} {
        global cfunc pclist
        global enabled
 
-       if [info exists wins($file)] {
+       if {[info exists wins($file)]} {
                $wins($file) tag configure $line -fgstipple {}
        }
 
 # If there's an assembly window, update that too
 
        set win [asm_win_name $cfunc]
-       if [winfo exists $win] {
+       if {[winfo exists $win]} {
                $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple {}
        }
 
 # If there's a breakpoint window, update that too
 
-       if [winfo exists .breakpoints] {
+       if {[winfo exists .breakpoints]} {
                set enabled($bpnum) 1
        }
 }
@@ -512,20 +571,20 @@ proc disable_breakpoint {bpnum file line pc} {
        global cfunc pclist
        global enabled
 
-       if [info exists wins($file)] {
+       if {[info exists wins($file)]} {
                $wins($file) tag configure $line -fgstipple gray50
        }
 
 # If there's an assembly window, update that too
 
        set win [asm_win_name $cfunc]
-       if [winfo exists $win] {
+       if {[winfo exists $win]} {
                $win tag configure [pc_to_line $pclist($cfunc) $pc] -fgstipple gray50
        }
 
 # If there's a breakpoint window, update that too
 
-       if [winfo exists .breakpoints] {
+       if {[winfo exists .breakpoints]} {
                set enabled($bpnum) 0
        }
 }
@@ -578,7 +637,7 @@ proc delete_breakpoint_tag {win line} {
 }
 
 proc gdbtk_tcl_busy {} {
-       if [winfo exists .src] {
+       if {[winfo exists .src]} {
                .src.start configure -state disabled
                .src.stop configure -state normal
                .src.step configure -state disabled
@@ -589,7 +648,7 @@ proc gdbtk_tcl_busy {} {
                .src.down configure -state disabled
                .src.bottom configure -state disabled
        }
-       if [winfo exists .asm] {
+       if {[winfo exists .asm]} {
                .asm.stepi configure -state disabled
                .asm.nexti configure -state disabled
                .asm.continue configure -state disabled
@@ -602,7 +661,7 @@ proc gdbtk_tcl_busy {} {
 }
 
 proc gdbtk_tcl_idle {} {
-       if [winfo exists .src] {
+       if {[winfo exists .src]} {
                .src.start configure -state normal
                .src.stop configure -state disabled
                .src.step configure -state normal
@@ -614,7 +673,7 @@ proc gdbtk_tcl_idle {} {
                .src.bottom configure -state normal
        }
 
-       if [winfo exists .asm] {
+       if {[winfo exists .asm]} {
                .asm.stepi configure -state normal
                .asm.nexti configure -state normal
                .asm.continue configure -state normal
@@ -626,20 +685,6 @@ proc gdbtk_tcl_idle {} {
        return
 }
 
-#
-# Local procedure:
-#
-#      decr (var val) - compliment to incr
-#
-# Description:
-#
-#
-proc decr {var {val 1}} {
-       upvar $var num
-       set num [expr $num - $val]
-       return $num
-}
-
 #
 # Local procedure:
 #
@@ -660,7 +705,7 @@ proc pc_to_line {pclist pc} {
                if {$pc < $linepc} { decr line ; return $line }
                incr line
        }
-       return [expr $line - 1]
+       return [expr {$line - 1}]
 }
 
 #
@@ -683,11 +728,13 @@ proc pc_to_line {pclist pc} {
 #              to notify us of where the breakpoint needs to show up.
 #
 
-menu .file_popup -cursor hand2
+menu .file_popup -cursor hand2 -tearoff 0
 .file_popup add command -label "Not yet set" -state disabled
 .file_popup add separator
-.file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &}
-.file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"}
+.file_popup add command -label "Edit" \
+  -command {exec $editor +$selected_line $selected_file &}
+.file_popup add command -label "Set breakpoint" \
+  -command {gdb_cmd "break $selected_file:$selected_line"}
 
 # Use this procedure to get the GDB core to execute the string `cmd'.  This is
 # a wrapper around gdb_cmd, which will catch errors, and send output to the
@@ -696,7 +743,7 @@ menu .file_popup -cursor hand2
 proc interactive_cmd {cmd} {
        catch {gdb_cmd "$cmd"} result
        .cmd.text insert end $result
-       .cmd.text yview -pickplace end
+       .cmd.text see end
        update_ptr
 }
 
@@ -707,28 +754,14 @@ proc interactive_cmd {cmd} {
 #
 # Description:
 #
-#      This defines the binding for the file popup menu.  Currently, there is
-#      only one, which is activated when Button-1 is released.  This causes
-#      the menu to be unposted, releases the grab for the menu, and then
-#      unhighlights the line under the cursor.  After that, the selected menu
-#      item is invoked.
+#      This defines the binding for the file popup menu.  It simply
+#       unhighlights the line under the cursor.
 #
 
 bind .file_popup <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}
@@ -1314,26 +1351,6 @@ proc create_asm_win {funcname pc} {
        return $win
 }
 
-#
-# Local procedure:
-#
-#      asmscrollproc (WINHEIGHT SCREENHEIGHT SCREENTOP SCREENBOT) - Update the
-#      asm window scrollbar.
-#
-# Description:
-#
-#      This procedure is called to update the assembler window's scrollbar.
-#
-
-proc asmscrollproc {args} {
-       global asm_screen_height asm_screen_top asm_screen_bot
-
-       eval ".asm.scroll set $args"
-       set asm_screen_height [lindex $args 1]
-       set asm_screen_top [lindex $args 2]
-       set asm_screen_bot [lindex $args 3]
-}
-
 #
 # Local procedure:
 #
@@ -1373,9 +1390,6 @@ proc asmscrollproc {args} {
 
 proc update_listing {linespec} {
        global pointers
-       global screen_height
-       global screen_top
-       global screen_bot
        global wins cfile
        global current_label
        global win_to_file
@@ -1384,10 +1398,7 @@ proc update_listing {linespec} {
 
 # Rip the linespec apart
 
-       set line [lindex $linespec 3]
-       set filename [lindex $linespec 2]
-       set funcname [lindex $linespec 1]
-       set debug_file [lindex $linespec 0]
+        lassign $linespec debug_file funcname filename line
 
 # Sometimes there's no source file for this location
 
@@ -1402,7 +1413,7 @@ proc update_listing {linespec} {
 
 # Create a text widget for this file if necessary
 
-               if ![info exists wins($cfile)] then {
+               if {![info exists wins($cfile)]} then {
                        set wins($cfile) [create_file_win $cfile $debug_file]
                        if {$wins($cfile) != ".src.nofile"} {
                                set win_to_file($wins($cfile)) $cfile
@@ -1420,7 +1431,7 @@ proc update_listing {linespec} {
 
                .src.scroll configure -command "$wins($cfile) yview"
 
-               $wins($cfile) yview [expr $line - $screen_height / 2]
+               $wins($cfile) see "${line}.0 linestart"
                }
 
 # Update the label widget in case the filename or function name has changed
@@ -1435,7 +1446,7 @@ proc update_listing {linespec} {
 # Update the pointer, scrolling the text widget if necessary to keep the
 # pointer in an acceptable part of the screen.
 
-       if [info exists pointers($cfile)] then {
+       if {[info exists pointers($cfile)]} then {
                $wins($cfile) configure -state normal
                set pointer_pos $pointers($cfile)
                $wins($cfile) configure -state normal
@@ -1447,12 +1458,7 @@ proc update_listing {linespec} {
 
                $wins($cfile) delete $pointer_pos "$pointer_pos + 2 char"
                $wins($cfile) insert $pointer_pos "->"
-
-               if {$line < $screen_top + 1
-                   || $line > $screen_bot} then {
-                       $wins($cfile) yview [expr $line - $screen_height / 2]
-                       }
-
+               $wins($cfile) see "${line}.0 linestart"
                $wins($cfile) configure -state disabled
                }
 }
@@ -1470,7 +1476,7 @@ proc update_listing {linespec} {
 proc create_asm_window {} {
        global cfunc
 
-       if [winfo exists .asm] {raise .asm ; return}
+       if {[winfo exists .asm]} {raise .asm ; return}
 
        set cfunc *None*
        set win [asm_win_name $cfunc]
@@ -1481,7 +1487,7 @@ proc create_asm_window {} {
 
        .asm.menubar.view.menu delete 0 last
 
-       .asm.text configure -yscrollcommand asmscrollproc
+       .asm.text configure -yscrollcommand ".asm.scroll set"
 
        frame .asm.row1
        frame .asm.row2
@@ -1602,11 +1608,11 @@ proc reg_config_menu {} {
 proc create_registers_window {} {
        global reg_format
 
-       if [winfo exists .reg] {raise .reg ; return}
+       if {[winfo exists .reg]} {raise .reg ; return}
 
 # Create an initial register display list consisting of all registers
 
-       if ![info exists reg_format] {
+       if {![info exists reg_format]} {
                global reg_display_list
                global changed_reg_list
                global regena
@@ -1789,25 +1795,17 @@ proc update_registers {which} {
 
 proc update_assembly {linespec} {
        global asm_pointers
-       global screen_height
-       global screen_top
-       global screen_bot
        global wins cfunc
        global current_label
        global win_to_file
        global file_to_debug_file
        global current_asm_label
        global pclist
-       global asm_screen_height asm_screen_top asm_screen_bot
        global .asm.label
 
 # Rip the linespec apart
 
-       set pc [lindex $linespec 4]
-       set line [lindex $linespec 3]
-       set filename [lindex $linespec 2]
-       set funcname [lindex $linespec 1]
-       set debug_file [lindex $linespec 0]
+       lassign $linespec debug_file funcname filename line pc
 
        set win [asm_win_name $cfunc]
 
@@ -1839,8 +1837,8 @@ proc update_assembly {linespec} {
                        -after .asm.scroll
                .asm.scroll configure -command "$win yview"
                set line [pc_to_line $pclist($cfunc) $pc]
+               $win see "${line}.0 linestart"
                update
-               $win yview [expr $line - $asm_screen_height / 2]
                }
 
 # Update the label widget in case the filename or function name has changed
@@ -1853,7 +1851,7 @@ proc update_assembly {linespec} {
 # Update the pointer, scrolling the text widget if necessary to keep the
 # pointer in an acceptable part of the screen.
 
-       if [info exists asm_pointers($cfunc)] then {
+       if {[info exists asm_pointers($cfunc)]} then {
                $win configure -state normal
                set pointer_pos $asm_pointers($cfunc)
                $win configure -state normal
@@ -1874,12 +1872,7 @@ proc update_assembly {linespec} {
 
                $win delete $pointer_pos "$pointer_pos + 2 char"
                $win insert $pointer_pos "->"
-
-               if {$line < $asm_screen_top + 1
-                   || $line > $asm_screen_bot} then {
-                       $win yview [expr $line - $asm_screen_height / 2]
-                       }
-
+               $win yview "${line}.0 linestart"
                $win configure -state disabled
                }
 }
@@ -1897,16 +1890,16 @@ proc update_assembly {linespec} {
 
 proc update_ptr {} {
        update_listing [gdb_loc]
-       if [winfo exists .asm] {
+       if {[winfo exists .asm]} {
                update_assembly [gdb_loc]
        }
-       if [winfo exists .reg] {
+       if {[winfo exists .reg]} {
                update_registers changed
        }
-       if [winfo exists .expr] {
+       if {[winfo exists .expr]} {
                update_exprs
        }
-       if [winfo exists .autocmd] {
+       if {[winfo exists .autocmd]} {
                update_autocmd
        }
 }
@@ -1916,45 +1909,43 @@ proc update_ptr {} {
 wm withdraw .
 
 proc files_command {} {
-       toplevel .files_window
-
-       wm minsize .files_window 1 1
-#      wm overrideredirect .files_window true
-       listbox .files_window.list -geometry 30x20 -setgrid true \
-               -yscrollcommand {.files_window.scroll set} -relief sunken \
-               -borderwidth 2
-       scrollbar .files_window.scroll -orient vertical \
-               -command {.files_window.list yview} -relief sunken
-       button .files_window.close -text Close -command {destroy .files_window}
-       tk_listboxSingleSelect .files_window.list
-
-# Get the file list from GDB, sort it, and format it as one entry per line.
-
-       set filelist [join [lsort [gdb_listfiles]] "\n"]
-
-# Now, remove duplicates (by using uniq)
-
-       set fh [open "| uniq > /tmp/gdbtk.[pid]" w]
-       puts $fh $filelist
-       close $fh
-       set fh [open /tmp/gdbtk.[pid]]
-       set filelist [split [read $fh] "\n"]
-       set filelist [lrange $filelist 0 [expr [llength $filelist] - 2]]
-       close $fh
-       exec rm /tmp/gdbtk.[pid]
+  toplevel .files_window
+
+  wm minsize .files_window 1 1
+  #    wm overrideredirect .files_window true
+  listbox .files_window.list -geometry 30x20 -setgrid true \
+    -yscrollcommand {.files_window.scroll set} -relief sunken \
+    -borderwidth 2
+  scrollbar .files_window.scroll -orient vertical \
+    -command {.files_window.list yview} -relief sunken
+  button .files_window.close -text Close -command {destroy .files_window}
+  .files_window.list configure -selectmode single
+
+  # Get the file list from GDB, sort it, and format it as one entry per line.
+  set lastSeen {};                     # Value that won't appear in
+                                       # list.
+  set fileList {}
+  foreach file [lsort [gdb_listfiles]] {
+    if {$file != $lastSeen} then {
+      lappend fileList $file
+      set lastSeen $file
+    }
+  }
+  set filelist [join [lsort [gdb_listfiles]] "\n"]
 
-# Insert the file list into the widget
+  # Insert the file list into the widget
 
-       eval .files_window.list insert 0 $filelist
+  eval .files_window.list insert 0 $filelist
 
-       pack .files_window.close -side bottom -fill x -expand no -anchor s
-       pack .files_window.scroll -side right -fill both
-       pack .files_window.list -side left -fill both -expand yes
-       bind .files_window.list <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
 }
index 6327886c1731c4edf2ae72c3bd916f4d09913f16..480445d2563229e5fe3ee245af15423788a19b2c 100644 (file)
@@ -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
This page took 0.075652 seconds and 4 git commands to generate.