* doc/tree.n:

* doc/stack.n:
* doc/queue.n: docs for tree, stack, and queue.

* win/Makefile.in:
* unix/Makefile.in: Added struct1.0 to list of libraries to install.

* tests/stackstruct.test: stack tests

* tests/queue.test: queue tests

* library/struct1.0/queue.tcl: queue data structure.

* library/struct1.0/stack.tcl: stack data structure.

* library/struct1.0/pkgIndex.tcl:
* library/struct1.0/struct.tcl: data structure package


FossilOrigin-Name: 1955d2e8a3fd2d099d37801ba806677eb3ea8562

4 files changed, 534 insertions, 0 deletions

diff --git a/library/struct1.0/pkgIndex.tcl b/library/struct1.0/pkgIndex.tcl
new file mode 100644
index 0000000..c1c4b4e
--- /dev/null
+++ b/library/struct1.0/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script.  It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands.  When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded struct 1.0 [list source [file join $dir struct.tcl]]
diff --git a/library/struct1.0/queue.tcl b/library/struct1.0/queue.tcl
new file mode 100644
index 0000000..22cf939
--- /dev/null
+++ b/library/struct1.0/queue.tcl
@@ -0,0 +1,239 @@
+# queue.tcl --
+#
+#	Queue implementation for Tcl.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id: queue.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $
+
+namespace eval ::struct {}
+
+namespace eval ::struct::queue {
+    # The queues array holds all of the queues you've made
+    variable queues
+    
+    # counter is used to give a unique name for unnamed queues
+    variable counter 0
+
+    # commands is the list of subcommands recognized by the queue
+    variable commands [list \
+	    "clear"	\
+	    "destroy"	\
+	    "get"	\
+	    "peek"	\
+	    "put"	\
+	    "size"	\
+	    ]
+
+    # Only export one command, the one used to instantiate a new queue
+    namespace export queue
+}
+
+# ::struct::queue::queue --
+#
+#	Create a new queue with a given name; if no name is given, use
+#	queueX, where X is a number.
+#
+# Arguments:
+#	name	name of the queue; if null, generate one.
+#
+# Results:
+#	name	name of the queue created
+
+proc ::struct::queue::queue {{name ""}} {
+    variable queues
+    variable counter
+    
+    if { [llength [info level 0]] == 1 } {
+	incr counter
+	set name "queue${counter}"
+    }
+
+    if { ![string equal [info commands ::$name] ""] } {
+	error "command \"$name\" already exists, unable to create queue"
+    }
+
+    # Initialize the queue as empty
+    set queues($name) [list ]
+
+    # Create the command to manipulate the queue
+    interp alias {} ::$name {} ::struct::queue::QueueProc $name
+
+    return $name
+}
+
+##########################
+# Private functions follow
+
+# ::struct::queue::QueueProc --
+#
+#	Command that processes all queue object commands.
+#
+# Arguments:
+#	name	name of the queue object to manipulate.
+#	args	command name and args for the command
+#
+# Results:
+#	Varies based on command to perform
+
+proc ::struct::queue::QueueProc {name {cmd ""} args} {
+    # Make sure this queue exists
+    if { ![info exists ::struct::queue::queues($name)] } {
+	error "unknown queue \"$name\""
+    }
+
+    # Do minimal args checks here
+    if { [llength [info level 0]] == 2 } {
+	error "wrong # args: should be \"$name option ?arg arg ...?\""
+    }
+    
+    # Split the args into command and args components
+    if { [string equal [info commands ::struct::queue::_$cmd] ""] } {
+	variable commands
+	set optlist [join $commands ", "]
+	set optlist [linsert $optlist "end-1" "or"]
+	error "bad option \"$cmd\": must be $optlist"
+    }
+    return [uplevel 1 [list ::struct::queue::_$cmd $name] $args]
+}
+
+# ::struct::queue::_clear --
+#
+#	Clear a queue.
+#
+# Arguments:
+#	name	name of the queue object.
+#
+# Results:
+#	None.
+
+proc ::struct::queue::_clear {name} {
+    variable queues
+    set queues($name) [list ]
+    return
+}
+
+# ::struct::queue::_destroy --
+#
+#	Destroy a queue object by removing it's storage space and 
+#	eliminating it's proc.
+#
+# Arguments:
+#	name	name of the queue object.
+#
+# Results:
+#	None.
+
+proc ::struct::queue::_destroy {name} {
+    variable queues
+    unset queues($name)
+    interp alias {} ::$name {}
+    return
+}
+
+# ::struct::queue::_get --
+#
+#	Get an item from a queue.
+#
+# Arguments:
+#	name	name of the queue object.
+#	count	number of items to get; defaults to 1
+#
+# Results:
+#	item	first count items from the queue; if there are not enough 
+#		items in the queue, throws an error.
+
+proc ::struct::queue::_get {name {count 1}} {
+    variable queues
+    if { $count < 1 } {
+	error "invalid item count $count"
+    }
+
+    if { $count > [llength $queues($name)] } {
+	error "insufficient items in queue to fill request"
+    }
+
+    if { $count == 1 } {
+	# Handle this as a special case, so single item gets aren't listified
+	set item [lindex $queues($name) 0]
+	set queues($name) [lreplace $queues($name) 0 0]
+	return $item
+    }
+
+    # Otherwise, return a list of items
+    set index [expr {$count - 1}]
+    set result [lrange $queues($name) 0 $index]
+    set queues($name) [lreplace $queues($name) 0 $index]
+
+    return $result
+}
+
+# ::struct::queue::_peek --
+#
+#	Retrive the value of an item on the queue without removing it.
+#
+# Arguments:
+#	name	name of the queue object.
+#	count	number of items to peek; defaults to 1
+#
+# Results:
+#	items	top count items from the queue; if there are not enough items
+#		to fufill the request, throws an error.
+
+proc ::struct::queue::_peek {name {count 1}} {
+    variable queues
+    if { $count < 1 } {
+	error "invalid item count $count"
+    }
+
+    if { $count > [llength $queues($name)] } {
+	error "insufficient items in queue to fill request"
+    }
+
+    if { $count == 1 } {
+	# Handle this as a special case, so single item pops aren't listified
+	return [lindex $queues($name) 0]
+    }
+
+    # Otherwise, return a list of items
+    set index [expr {$count - 1}]
+    return [lrange $queues($name) 0 $index]
+}
+
+# ::struct::queue::_put --
+#
+#	Put an item into a queue.
+#
+# Arguments:
+#	name	name of the queue object
+#	args	items to put.
+#
+# Results:
+#	None.
+
+proc ::struct::queue::_put {name args} {
+    variable queues
+    if { [llength $args] == 0 } {
+	error "wrong # args: should be \"$name put item ?item ...?\""
+    }
+    foreach item $args {
+	lappend queues($name) $item
+    }
+    return
+}
+
+# ::struct::queue::_size --
+#
+#	Return the number of objects on a queue.
+#
+# Arguments:
+#	name	name of the queue object.
+#
+# Results:
+#	count	number of items on the queue.
+
+proc ::struct::queue::_size {name} {
+    variable queues
+    return [llength $queues($name)]
+}
diff --git a/library/struct1.0/stack.tcl b/library/struct1.0/stack.tcl
new file mode 100644
index 0000000..50272b7
--- /dev/null
+++ b/library/struct1.0/stack.tcl
@@ -0,0 +1,276 @@
+# stack.tcl --
+#
+#	Stack implementation for Tcl.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id: stack.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $
+
+namespace eval ::struct {}
+
+namespace eval ::struct::stack {
+    # The stacks array holds all of the stacks you've made
+    variable stacks
+    
+    # counter is used to give a unique name for unnamed stacks
+    variable counter 0
+
+    # commands is the list of subcommands recognized by the stack
+    variable commands [list \
+	    "clear"	\
+	    "destroy"	\
+	    "peek"	\
+	    "pop"	\
+	    "push"	\
+	    "rotate"	\
+	    "size"	\
+	    ]
+
+    # Only export one command, the one used to instantiate a new stack
+    namespace export stack
+}
+
+# ::struct::stack::stack --
+#
+#	Create a new stack with a given name; if no name is given, use
+#	stackX, where X is a number.
+#
+# Arguments:
+#	name	name of the stack; if null, generate one.
+#
+# Results:
+#	name	name of the stack created
+
+proc ::struct::stack::stack {{name ""}} {
+    variable stacks
+    variable counter
+    
+    if { [llength [info level 0]] == 1 } {
+	incr counter
+	set name "stack${counter}"
+    }
+
+    if { ![string equal [info commands ::$name] ""] } {
+	error "command \"$name\" already exists, unable to create stack"
+    }
+    set stacks($name) [list ]
+
+    # Create the command to manipulate the stack
+    interp alias {} ::$name {} ::struct::stack::StackProc $name
+
+    return $name
+}
+
+##########################
+# Private functions follow
+
+# ::struct::stack::StackProc --
+#
+#	Command that processes all stack object commands.
+#
+# Arguments:
+#	name	name of the stack object to manipulate.
+#	args	command name and args for the command
+#
+# Results:
+#	Varies based on command to perform
+
+proc ::struct::stack::StackProc {name {cmd ""} args} {
+    # Make sure this stack exists
+    if { ![info exists ::struct::stack::stacks($name)] } {
+	error "unknown stack \"$name\""
+    }
+
+    # Do minimal args checks here
+    if { [llength [info level 0]] == 2 } {
+	error "wrong # args: should be \"$name option ?arg arg ...?\""
+    }
+    
+    # Split the args into command and args components
+    if { [llength [info commands ::struct::stack::_$cmd]] == 0 } {
+	variable commands
+	set optlist [join $commands ", "]
+	set optlist [linsert $optlist "end-1" "or"]
+	error "bad option \"$cmd\": must be $optlist"
+    }
+    return [eval [list ::struct::stack::_$cmd $name] $args]
+}
+
+# ::struct::stack::_clear --
+#
+#	Clear a stack.
+#
+# Arguments:
+#	name	name of the stack object.
+#
+# Results:
+#	None.
+
+proc ::struct::stack::_clear {name} {
+    set ::struct::stack::stacks($name) [list ]
+    return
+}
+
+# ::struct::stack::_destroy --
+#
+#	Destroy a stack object by removing it's storage space and 
+#	eliminating it's proc.
+#
+# Arguments:
+#	name	name of the stack object.
+#
+# Results:
+#	None.
+
+proc ::struct::stack::_destroy {name} {
+    unset ::struct::stack::stacks($name)
+    interp alias {} ::$name {}
+    return
+}
+
+# ::struct::stack::_peek --
+#
+#	Retrive the value of an item on the stack without popping it.
+#
+# Arguments:
+#	name	name of the stack object.
+#	count	number of items to pop; defaults to 1
+#
+# Results:
+#	items	top count items from the stack; if there are not enough items
+#		to fufill the request, throws an error.
+
+proc ::struct::stack::_peek {name {count 1}} {
+    variable stacks
+    if { $count < 1 } {
+	error "invalid item count $count"
+    }
+
+    if { $count > [llength $stacks($name)] } {
+	error "insufficient items on stack to fill request"
+    }
+
+    if { $count == 1 } {
+	# Handle this as a special case, so single item pops aren't listified
+	set item [lindex $stacks($name) end]
+	return $item
+    }
+
+    # Otherwise, return a list of items
+    set result [list ]
+    for {set i 0} {$i < $count} {incr i} {
+	lappend result [lindex $stacks($name) "end-${i}"]
+    }
+    return $result
+}
+
+# ::struct::stack::_pop --
+#
+#	Pop an item off a stack.
+#
+# Arguments:
+#	name	name of the stack object.
+#	count	number of items to pop; defaults to 1
+#
+# Results:
+#	item	top count items from the stack; if the stack is empty, 
+#		returns a list of count nulls.
+
+proc ::struct::stack::_pop {name {count 1}} {
+    variable stacks
+    if { $count > [llength $stacks($name)] } {
+	error "insufficient items on stack to fill request"
+    } elseif { $count < 1 } {
+	error "invalid item count $count"
+    }
+
+    if { $count == 1 } {
+	# Handle this as a special case, so single item pops aren't listified
+	set item [lindex $stacks($name) end]
+	set stacks($name) [lreplace $stacks($name) end end]
+	return $item
+    }
+
+    # Otherwise, return a list of items
+    set result [list ]
+    for {set i 0} {$i < $count} {incr i} {
+	lappend result [lindex $stacks($name) "end-${i}"]
+    }
+
+    # Remove these items from the stack
+    incr i -1
+    set stacks($name) [lreplace $stacks($name) "end-${i}" end]
+
+    return $result
+}
+
+# ::struct::stack::_push --
+#
+#	Push an item onto a stack.
+#
+# Arguments:
+#	name	name of the stack object
+#	args	items to push.
+#
+# Results:
+#	None.
+
+proc ::struct::stack::_push {name args} {
+    if { [llength $args] == 0 } {
+	error "wrong # args: should be \"$name push item ?item ...?\""
+    }
+    foreach item $args {
+	lappend ::struct::stack::stacks($name) $item
+    }
+    return
+}
+
+# ::struct::stack::_rotate --
+#
+#	Rotate the top count number of items by step number of steps.
+#
+# Arguments:
+#	name	name of the stack object.
+#	count	number of items to rotate.
+#	steps	number of steps to rotate.
+#
+# Results:
+#	None.
+
+proc ::struct::stack::_rotate {name count steps} {
+    variable stacks
+    set len [llength $stacks($name)]
+    if { $count > $len } {
+	error "insufficient items on stack to fill request"
+    }
+
+    # Rotation algorithm:
+    # do
+    #   Find the insertion point in the stack
+    #   Move the end item to the insertion point
+    # repeat $steps times
+
+    set start [expr {$len - $count}]
+    set steps [expr {$steps % $count}]
+    for {set i 0} {$i < $steps} {incr i} {
+	set item [lindex $stacks($name) end]
+	set stacks($name) [lreplace $stacks($name) end end]
+	set stacks($name) [linsert $stacks($name) $start $item]
+    }
+    return
+}
+
+# ::struct::stack::_size --
+#
+#	Return the number of objects on a stack.
+#
+# Arguments:
+#	name	name of the stack object.
+#
+# Results:
+#	count	number of items on the stack.
+
+proc ::struct::stack::_size {name} {
+    return [llength $::struct::stack::stacks($name)]
+}
diff --git a/library/struct1.0/struct.tcl b/library/struct1.0/struct.tcl
new file mode 100644
index 0000000..ecacdba
--- /dev/null
+++ b/library/struct1.0/struct.tcl
@@ -0,0 +1,8 @@
+package provide struct 1.0
+source [file join [file dirname [info script]] stack.tcl]
+source [file join [file dirname [info script]] queue.tcl]
+namespace eval struct {
+	namespace export *
+	namespace import stack::*
+	namespace import queue::*
+}