Tcl Source Code

    if {![llength $args]} {
	set args info
    }

    # Tricky stuff needed to make stack and errors come out right!
    tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}

# (unnamed) --
#
#	Callback when [::history] is destroyed. Destroys the implementation.
#
# Parameters:
#	oldName    what the command was called.
#	newName    what the command is now called (an empty string).
#	op	   the operation (= delete).
#
# Results:
#	none
#
# Side Effects:
#	The implementation of the [::history] command ceases to exist.

trace add command ::history delete [list apply {{oldName newName op} {
    variable history
    unset -nocomplain history
    foreach c [info procs ::tcl::Hist*] {
	rename $c {}
    }
    rename ::tcl::history {}
} ::tcl}]

# tcl::HistAdd --
#
#	Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
#	event		the command to add

# Commands covered:  history
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
  
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# The history command might be autoloaded...
if {[catch {history}]} {
    testConstraint history 0
} else {

# miscellaneous

test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
    catch {history gorp} msg
    set msg
} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}

# History retains references; Bug 1ae12987cb
test history-10.1 {references kept by history} -constraints history -setup {
    interp create histtest
    histtest eval {
	# Trigger any autoloading that might be present
	catch {history}
	proc refcount {x} {
	    set rep [::tcl::unsupported::representation $x]
	    regexp {with a refcount of (\d+)} $rep -> rc
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	history clear
	lappend result [refcount $obj]
    }
} -cleanup {
    interp delete histtest
} -result {1 2 1}
test history-10.2 {references kept by history} -constraints history -setup {
    interp create histtest
    histtest eval {
	# Trigger any autoloading that might be present
	catch {history}
	proc refcount {x} {
	    set rep [::tcl::unsupported::representation $x]
	    regexp {with a refcount of (\d+)} $rep -> rc
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	rename history {}
	lappend result [refcount $obj]
    }
} -cleanup {
    interp delete histtest
} -result {1 2 1}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: