[WJG] (06/01/18) Just before the Yultide holidays for some reason I go it into my mind to put together a simple queue command. Don't know why, I didn't needs the functionality for any projects I'm involved with. Anyway, here's what I came up with. The procedure queue will initialize a namespace ::Q:: within which a number of queues can be created, modified and accessed. Items can be accessed directly, or a the name of 'foreach' proceedure can be passed utilized to process each item in a queue, gradually nibblingly away at the front of the queue til it's all eaten (erm, processed). ====== #!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" "$@" #--------------- # Manage a queued list of items. #--------------- #/param qid queue id, a unique string #/param action action to be performes on the queue #/param value relevant value #/returns # proc queue { action {qid ""} {value ""} } { set cmds [list add clear delete destroy fetch foreach front get item lower names new prioritize raise rear reverse remove search ] if { [lsearch $cmds $action] == -1 } { set msg "No such cmd \"$action\". Must be one of: $cmds." error $msg } if { ![namespace exists ::Q] } { namespace eval ::Q {} } if { $action eq "names" } { return [string map "::Q:: {}" [info vars ::Q::*]] } if { $action ne "new" && ![info exists ::Q::$qid] } { set msg "No such queue \"$qid\". Must be one of: $cmds." error $msg } set res "" switch $action { new { # create new queue and initialize as an empty string set ::Q::$qid "" } clear { # clear the contents of an existing queue set ::Q::$qid "" } add { # append item to the end of the queue foreach item [split $value] { lappend ::Q::$qid $item } } fetch { # return complete list of items in the specified queue return [set ::Q::$qid] } foreach { set tmp [queue get $qid] while {$tmp ne ""} { $value $tmp set tmp [queue get $qid] } } get { # retrieve next item in the queue, for processing and then remove set res [lindex [set ::Q::$qid] 0] set ::Q::$qid [lrange [set ::Q::$qid] 1 end] } front { # retrieve the first item in the specified queue set res [lindex [set ::Q::$qid] 0] } item { # retrieve the item in the specified queue set res [lindex [set ::Q::$qid] $value] } last { # retrieve final item in the specified queue set res [lindex [set ::Q::$qid] end] } reverse { # reverse the items in the specified queue set ::Q::$qid [lreverse [set ::Q::$qid]] } raise - lower { # raise or lower position of indexed item in queue if { $action eq "raise" } { set pos(from) [expr $value-1] set pos(to) $value } else { set pos(from) $value set pos(to) [expr $value+1] } set tmp [lreverse [lrange [set ::Q::$qid] $pos(from) $pos(to)] ] lassign $tmp a b set ::Q::$qid [lreplace [set ::Q::$qid] $pos(from) $pos(to) $a $b ] } remove { # remove item from queue based upon contents set ::Q::$qid [lsearch -all -inline -not -exact [set ::Q::$qid] $value] } delete { # delete item from queue based upon index set ::Q::$qid [lreplace [set ::Q::$qid] $value $value] } search { # search for item in queue based upon contents, return index if found, else -1 set res [lsearch [set ::Q::$qid] $value] } prioritize { # move item to the heade of the queue set item [lindex [set ::Q::$qid] $value] set ::Q::$qid [lreplace [lreplace [set ::Q::$qid] $value $value] -1 -1 $item] } destroy { # destroy queue and its contents unset ::Q::$qid } } return $res } #--------------- # Script Main Function #--------------- # Arguments: # args # Returns: # none # proc main { args } { puts "READY..." # create sample queues queue new 001 queue new 002 queue new 003 # add items foreach item { 0 1 2 3 4 5 6 7 8 9 } { queue add 001 $item } foreach item { A B C D E F G H I J } { queue add 002 $item } queue add 003 [list "/home/apple.txt" "/home/blackberry.txt" "/home/cherry.txt"] # display contents foreach item [queue names] { puts "$item : [queue fetch $item]" } # other operations puts "'5' is item [queue search 002 H] in queue 002." puts "Item 4 in queue 002 is '[queue item 002 4]'." puts [queue remove 001 5] # shuffle the contents queue prioritize 001 5 queue raise 002 3 queue lower 001 3 queue reverse 001 # process the available queues foreach q [queue names] { puts \n while 1 { set item [queue get $q] if { $item eq "" } { break } puts ${q}:$item puts [queue fetch $q] after 50 } } queue new 004 # add items foreach item { how now brown cow she sells sea shells by the sea shore } { queue add 004 $item } proc myPuts {args} { puts ~~~>$args } queue foreach 004 myPuts puts "DONE!" } main ======