summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-08-25 21:37:29 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-08-25 21:37:29 (GMT)
commitbbc1a01f8e4cbb285dfd5bf13c65230feef8fe05 (patch)
tree369339edc873d119580da638e82692cf268a7d2c /tests
parentd7da458e608be0b0dddf1f8a42537dfdb91316f3 (diff)
downloadtcl-bbc1a01f8e4cbb285dfd5bf13c65230feef8fe05.zip
tcl-bbc1a01f8e4cbb285dfd5bf13c65230feef8fe05.tar.gz
tcl-bbc1a01f8e4cbb285dfd5bf13c65230feef8fe05.tar.bz2
D'oh! Put the correct value in... :^}
Diffstat (limited to 'tests')
-rw-r--r--tests/namespace.test4
1 files changed, 2 insertions, 2 deletions
diff --git a/tests/namespace.test b/tests/namespace.test
index a19f3c4..0235d74 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: namespace.test,v 1.30 2004/08/25 21:35:21 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.31 2004/08/25 21:37:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -1674,7 +1674,7 @@ test namespace-47.7 {ensemble: unknown handler and namespace import} {
bar y 456
namespace delete foo
set result
-} {1 {bar is not an ensemble command} XXX 123 ::bar {y 456} YYY 456}
+} {1 {bar is not an ensemble command} XXX 123 ::foo::bar {y 456} YYY 456}
# cleanup
catch {rename cmd1 {}}
generated by cgit v0.12 at 2024-11-02 05:29:43 (GMT)
id='n172' href='#n172'>172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 
# history.tcl --
#
# Implementation of the history command.
#
# RCS: @(#) $Id: history.tcl,v 1.7 2005/07/23 04:12:49 dgp Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# The tcl::history array holds the history list and
# some additional bookkeeping variables.
#
# nextid	the index used for the next history list item.
# keep		the max size of the history list
# oldest	the index of the oldest item in the history.

namespace eval tcl {
    variable history
    if {![info exists history]} {
	array set history {
	    nextid	0
	    keep	20
	    oldest	-20
	}
    }
}

# history --
#
#	This is the main history command.  See the man page for its interface.
#	This does argument checking and calls helper procedures in the
#	history namespace.

proc history {args} {
    set len [llength $args]
    if {$len == 0} {
	return [tcl::HistInfo]
    }
    set key [lindex $args 0]
    set options "add, change, clear, event, info, keep, nextid, or redo"
    switch -glob -- $key {
	a* { # history add

	    if {$len > 3} {
		return -code error "wrong # args: should be \"history add event ?exec?\""
	    }
	    if {![string match $key* add]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 3} {
		set arg [lindex $args 2]
		if {! ([string match e* $arg] && [string match $arg* exec])} {
		    return -code error "bad argument \"$arg\": should be \"exec\""
		}
	    }
	    return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
	}
	ch* { # history change

	    if {($len > 3) || ($len < 2)} {
		return -code error "wrong # args: should be \"history change newValue ?event?\""
	    }
	    if {![string match $key* change]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 2} {
		set event 0
	    } else {
		set event [lindex $args 2]
	    }

	    return [tcl::HistChange [lindex $args 1] $event]
	}
	cl* { # history clear

	    if {($len > 1)} {
		return -code error "wrong # args: should be \"history clear\""
	    }
	    if {![string match $key* clear]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistClear]
	}
	e* { # history event

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history event ?event?\""
	    }
	    if {![string match $key* event]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 1} {
		set event -1
	    } else {
		set event [lindex $args 1]
	    }
	    return [tcl::HistEvent $event]
	}
	i* { # history info

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history info ?count?\""
	    }
	    if {![string match $key* info]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistInfo [lindex $args 1]]
	}
	k* { # history keep

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history keep ?count?\""
	    }
	    if {$len == 1} {
		return [tcl::HistKeep]
	    } else {
		set limit [lindex $args 1]
		if {[catch {expr {~$limit}}] || ($limit < 0)} {
		    return -code error "illegal keep count \"$limit\""
		}
		return [tcl::HistKeep $limit]
	    }
	}
	n* { # history nextid

	    if {$len > 1} {
		return -code error "wrong # args: should be \"history nextid\""
	    }
	    if {![string match $key* nextid]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [expr {$tcl::history(nextid) + 1}]
	}
	r* { # history redo

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history redo ?event?\""
	    }
	    if {![string match $key* redo]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistRedo [lindex $args 1]]
	}
	default {
	    return -code error "bad option \"$key\": must be $options"
	}
    }
}

# tcl::HistAdd --
#
#	Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
#	command		the command to add
#	exec		(optional) a substring of "exec" causes the
#			command to be evaled.
# Results:
# 	If executing, then the results of the command are returned
#
# Side Effects:
#	Adds to the history list

 proc tcl::HistAdd {command {exec {}}} {
    variable history

    # Do not add empty commands to the history
    if {[string trim $command] eq ""} {
	return ""
    }

    set i [incr history(nextid)]
    set history($i) $command
    set j [incr history(oldest)]
    unset -nocomplain history($j)
    if {[string match e* $exec]} {
	return [uplevel #0 $command]
    } else {
	return {}
    }
}

# tcl::HistKeep --
#
#	Set or query the limit on the length of the history list
#
# Parameters:
#	limit	(optional) the length of the history list
#
# Results:
#	If no limit is specified, the current limit is returned
#
# Side Effects:
#	Updates history(keep) if a limit is specified

 proc tcl::HistKeep {{limit {}}} {
    variable history
    if {$limit eq ""} {
	return $history(keep)
    } else {
	set oldold $history(oldest)
	set history(oldest) [expr {$history(nextid) - $limit}]
	for {} {$oldold <= $history(oldest)} {incr oldold} {
	    unset -nocomplain history($oldold)
	}
	set history(keep) $limit
    }
}

# tcl::HistClear --
#
#	Erase the history list
#
# Parameters:
#	none
#
# Results:
#	none
#
# Side Effects:
#	Resets the history array, except for the keep limit

 proc tcl::HistClear {} {
    variable history
    set keep $history(keep)
    unset history
    array set history [list \
	nextid	0	\
	keep	$keep	\
	oldest	-$keep	\
    ]
}

# tcl::HistInfo --
#
#	Return a pretty-printed version of the history list
#
# Parameters:
#	num	(optional) the length of the history list to return
#
# Results:
#	A formatted history list

 proc tcl::HistInfo {{num {}}} {
    variable history
    if {$num eq ""} {
	set num [expr {$history(keep) + 1}]
    }
    set result {}
    set newline ""
    for {set i [expr {$history(nextid) - $num + 1}]} \
	    {$i <= $history(nextid)} {incr i} {
	if {![info exists history($i)]} {
	    continue
	}
        set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
	append result $newline[format "%6d  %s" $i $cmd]
	set newline \n
    }
    return $result
}

# tcl::HistRedo --
#
#	Fetch the previous or specified event, execute it, and then
#	replace the current history item with that event.
#
# Parameters:
#	event	(optional) index of history item to redo.  Defaults to -1,
#		which means the previous event.
#
# Results:
#	Those of the command being redone.
#
# Side Effects:
#	Replaces the current history list item with the one being redone.

 proc tcl::HistRedo {{event -1}} {
    variable history
    if {$event eq ""} {
	set event -1
    }
    set i [HistIndex $event]
    if {$i == $history(nextid)} {
	return -code error "cannot redo the current event"
    }
    set cmd $history($i)
    HistChange $cmd 0
    uplevel #0 $cmd
}

# tcl::HistIndex --
#
#	Map from an event specifier to an index in the history list.
#
# Parameters:
#	event	index of history item to redo.
#		If this is a positive number, it is used directly.
#		If it is a negative number, then it counts back to a previous
#		event, where -1 is the most recent event.
#		A string can be matched, either by being the prefix of
#		a command or by matching a command with string match.
#
# Results:
#	The index into history, or an error if the index didn't match.

 proc tcl::HistIndex {event} {
    variable history
    if {[catch {expr {~$event}}]} {
	for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
		{incr i -1} {
	    if {[string match $event* $history($i)]} {
		return $i;
	    }
	    if {[string match $event $history($i)]} {
		return $i;
	    }
	}
	return -code error "no event matches \"$event\""
    } elseif {$event <= 0} {
	set i [expr {$history(nextid) + $event}]
    } else {
	set i $event
    }
    if {$i <= $history(oldest)} {
	return -code error "event \"$event\" is too far in the past"
    }
    if {$i > $history(nextid)} {
	return -code error "event \"$event\" hasn't occured yet"
    }
    return $i
}

# tcl::HistEvent --
#
#	Map from an event specifier to the value in the history list.
#
# Parameters:
#	event	index of history item to redo.  See index for a
#		description of possible event patterns.
#
# Results:
#	The value from the history list.

 proc tcl::HistEvent {event} {
    variable history
    set i [HistIndex $event]
    if {[info exists history($i)]} {
	return [string trimright $history($i) \ \n]
    } else {
	return "";
    }
}

# tcl::HistChange --
#
#	Replace a value in the history list.
#
# Parameters:
#	cmd	The new value to put into the history list.
#	event	(optional) index of history item to redo.  See index for a
#		description of possible event patterns.  This defaults
#		to 0, which specifies the current event.
#
# Side Effects:
#	Changes the history list.

 proc tcl::HistChange {cmd {event 0}} {
    variable history
    set i [HistIndex $event]
    set history($i) $cmd
}
generated by cgit v0.12 at 2024-11-02 05:29:42 (GMT)