* tkcon.tcl (::tkcon::SaveHistory): save history at each command

	to prevent loss during abnormal termination. [bachmann]

diff --git a/ChangeLog b/ChangeLog
index 666ca94501c9a727086776a9779a6a75327ba4c1..8900970275af960e4b4fd407ab359c2b7e9d6a45 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2014-09-09  Jeff Hobbs  <jeffh@ActiveState.com>
+
+       * tkcon.tcl (::tkcon::SaveHistory): save history at each command
+       to prevent loss during abnormal termination. [bachmann]
+
 2014-07-09  Jeff Hobbs  <jeffh@ActiveState.com>
 
        * tkcon.tcl (idebug): allow multi-char patterns as debug id [Lama]

diff --git a/tkcon.tcl b/tkcon.tcl
index 09fd9f4a9ed02d9f23022e00f16cb25354143e4e..f3ad06f8d76b3f968f421d44abff4cdbf03c42b0 100755 (executable)
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -1121,6 +1121,10 @@ proc ::tkcon::AddSlaveHistory cmd {
     set code [catch {EvalSlave history event $ev} lastCmd]
     if {$code || $cmd ne $lastCmd} {
        EvalSlave history add $cmd
+       # Save history every time so it's not lost in case of an abnormal termination.
+       # Do not warn in case of an error: we don't want an error message 
+       # after each command if the history file is not writable.
+       catch {SaveHistory}
     }
 }
 
@@ -2600,30 +2604,40 @@ proc ::tkcon::MainInit {} {
        }
        proc ::exit args {
            if {$::tkcon::OPT(usehistory)} {
-               if {[catch {open $::tkcon::PRIV(histfile) w} fid]} {
-                   puts stderr "unable to save history file:\n$fid"
+               if {[catch {::tkcon::SaveHistory} msg]} {
+                   puts stderr "unable to save history file:\n$msg"
                    # pause a moment, because we are about to die finally...
                    after 1000
-               } else {
-                   set max [::tkcon::EvalSlave history nextid]
-                   set id [expr {$max - $::tkcon::OPT(history)}]
-                   if {$id < 1} { set id 1 }
-                   ## FIX: This puts history in backwards!!
-                   while {($id < $max) && ![catch \
-                           {::tkcon::EvalSlave history event $id} cmd]} {
-                       if {$cmd ne ""} {
-                           puts $fid "::tkcon::EvalSlave\
-                                   history add [list $cmd]"
-                       }
-                       incr id
-                   }
-                   close $fid
                }
            }
            uplevel 1 ::tkcon::FinalExit $args
        }
     }
 
+    ## ::tkcon::SaveHistory - saves history to history file
+    ## If the history file is not writable it raises an error
+    proc ::tkcon::SaveHistory {} {
+       if {$::tkcon::OPT(usehistory)} {
+           if {[catch {open $::tkcon::PRIV(histfile) w} fid]} {
+               error $fid
+           } else {
+               set max [::tkcon::EvalSlave history nextid]
+               set id [expr {$max - $::tkcon::OPT(history)}]
+               if {$id < 1} { set id 1 }
+               ## FIX: This puts history in backwards!!
+               while {($id < $max) && ![catch \
+                       {::tkcon::EvalSlave history event $id} cmd]} {
+                   if {$cmd ne ""} {
+                       puts $fid "::tkcon::EvalSlave\
+                           history add [list $cmd]"
+                       }
+                   incr id
+               }
+               close $fid
+           }
+       }
+    }
+    
     ## ::tkcon::InterpEval - passes evaluation to another named interpreter
     ## If the interpreter is named, but no args are given, it returns the
     ## [tk appname] of that interps master (not the associated eval slave).