* tkcon.tcl: add [X] tab delete button and Console -> Delete Tab

	menu item. [Bug 970785]

diff --git a/ChangeLog b/ChangeLog
index fcaf5a5ac2308f2d533b41c57c9cba45cc4f866f..a4273428a670af2fbe1d2eab7fa39582e8da4bd1 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-06-10  Jeff Hobbs  <jeffh@ActiveState.com>
+
+       * tkcon.tcl: add [X] tab delete button and Console -> Delete Tab
+       menu item. [Bug 970785]
+
 2004-05-12  Jeff Hobbs  <jeffh@ActiveState.com>
 
        * tkcon.tcl (observe): allow observe of 'proc'

diff --git a/tkcon.tcl b/tkcon.tcl
index c7837da9e313f404a75b96fb34f4511d2c780388..002d111fafd53b578dc3e758ce4d692bdf5a9fb0 100755 (executable)
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -565,19 +565,28 @@ proc ::tkcon::InitUI {title} {
     set PRIV(base) $w
 
     catch {font create tkconfixed -family Courier -size -12}
+    catch {font create tkconfixedbold -family Courier -size -12 -weight bold}
 
     set PRIV(statusbar) [set sbar [frame $w.fstatus]]
     set PRIV(tabframe)  [frame $sbar.tabs]
+    set PRIV(X) [button $sbar.deltab -text "X" -command ::tkcon::DeleteTab \
+                    -activeforeground red -fg red -font tkconfixedbold \
+                    -highlightthickness 0 -padx 2 -pady 0 -bd 1 \
+                    -state disabled -relief flat]
+    catch {$PRIV(X) configure -overrelief raised}
     label $sbar.cursor -relief sunken -bd 1 -anchor e -width 6 \
            -textvariable ::tkcon::PRIV(StatusCursor)
     set padx [expr {![info exists ::tcl_platform(os)]
                    || ![string match "Windows CE" $::tcl_platform(os)]}]
-    grid $sbar.tabs $sbar.cursor -sticky ew -padx $padx
-    grid configure $sbar.tabs -sticky nsw
-    grid columnconfigure $sbar 0 -weight 1
+    grid $PRIV(X) $PRIV(tabframe) $sbar.cursor -sticky news -padx $padx
+    grid configure $PRIV(tabframe) -sticky nsw
+    grid configure $PRIV(X) -pady 0 -padx 0
+    grid columnconfigure $sbar 1 -weight 1
+    grid rowconfigure $sbar 0 -weight 1
+    grid rowconfigure $PRIV(tabframe) 0 -weight 1
     if {$::tcl_version >= 8.4 && [tk windowingsystem] == "aqua"} {
        # give space for the corner resize handle
-       grid columnconfigure $sbar 2 -minsize 20
+       grid columnconfigure $sbar [lindex [grid size $sbar] 0] -minsize 20
     }
 
     ## Create console tab
@@ -708,7 +717,7 @@ proc ::tkcon::InitTab {w} {
     if {$::tcl_version >= 8.4} {
        $rb configure -offrelief flat -overrelief raised
     }
-    grid $rb -row 0 -column [lindex [grid size $PRIV(tabframe)] 0]
+    grid $rb -row 0 -column [lindex [grid size $PRIV(tabframe)] 0] -sticky ns
     grid $con -row 1 -column 1 -sticky news
 
     lappend PRIV(tabs) $con
@@ -773,6 +782,8 @@ proc ::tkcon::NewTab {{con {}}} {
     InitSlave $tmp
     $tmp alias exit ::tkcon::DeleteTab $con $tmp
     set ATTACH($con) [list $tmp slave]
+    $PRIV(X) configure -state normal
+    MenuConfigure Console "Delete Tab" -state normal
     GotoTab $con
 }
 
@@ -780,6 +791,10 @@ proc ::tkcon::DeleteTab {{con {}} {slave {}}} {
     variable PRIV
 
     set numtabs [llength $PRIV(tabs)]
+    if {$numtabs <= 2} {
+       $PRIV(X) configure -state disabled
+       MenuConfigure Console "Delete Tab" -state disabled
+    }
     if {$numtabs == 1} { return }
 
     if {$con == ""} {
@@ -787,13 +802,14 @@ proc ::tkcon::DeleteTab {{con {}} {slave {}}} {
     }
     catch {unset ATTACH($con)}
     set curtab  [lsearch -exact $PRIV(tabs) $con]
-    set nexttab [expr {$curtab + 1}]
+    set PRIV(tabs) [lreplace $PRIV(tabs) $curtab $curtab]
+
+    set numtabs [llength $PRIV(tabs)]
+    set nexttab $curtab
     if {$nexttab >= $numtabs} {
-       set nexttab 0
+       set nexttab end
     }
     set nexttab [lindex $PRIV(tabs) $nexttab]
-    # splice out current tab
-    set PRIV(tabs) [lreplace $PRIV(tabs) $curtab $curtab]
 
     GotoTab $nexttab
 
@@ -1329,6 +1345,11 @@ proc ::tkcon::InitMenus {w title} {
        $w add cascade -label $m -underline 0 -menu $w.$l
        return $w.$l
     }
+    proc MenuConfigure {m l args} {
+       variable PRIV
+       eval [list $PRIV(menubar).[string tolower $m] entryconfigure $l] $args
+       eval [list $PRIV(popup).[string tolower $m] entryconfigure $l] $args
+    }
 
     foreach m [list File Console Edit Interp Prefs History Help] {
        set l [string tolower $m]
@@ -1370,6 +1391,8 @@ proc ::tkcon::InitMenus {w title} {
                -command ::tkcon::New
        $m add command -label "New Tab"         -underline 4 -accel Ctrl-T \
                -command ::tkcon::NewTab
+       $m add command -label "Delete Tab"      -underline 0 \
+               -command ::tkcon::DeleteTab -state disabled
        $m add command -label "Close Console"   -underline 0 -accel Ctrl-w \
                -command ::tkcon::Destroy
        $m add command -label "Clear Console"   -underline 1 -accel Ctrl-l \