summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/struct1.0/pkgIndex.tcl11
-rw-r--r--library/struct1.0/queue.tcl239
-rw-r--r--library/struct1.0/stack.tcl276
-rw-r--r--library/struct1.0/struct.tcl8
4 files changed, 0 insertions, 534 deletions
diff --git a/library/struct1.0/pkgIndex.tcl b/library/struct1.0/pkgIndex.tcl
deleted file mode 100644
index c1c4b4e..0000000
--- a/library/struct1.0/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# 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
deleted file mode 100644
index 22cf939..0000000
--- a/library/struct1.0/queue.tcl
+++ /dev/null
@@ -1,239 +0,0 @@
-# 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
deleted file mode 100644
index 50272b7..0000000
--- a/library/struct1.0/stack.tcl
+++ /dev/null
@@ -1,276 +0,0 @@
-# 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
deleted file mode 100644
index ecacdba..0000000
--- a/library/struct1.0/struct.tcl
+++ /dev/null
@@ -1,8 +0,0 @@
-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::*
-}