[SS] 2004-02-13. This is the lsplit command for Tcl. The command creates two different lists starting from a single list and a test expression. The first list is composed of all the elements of the original list that pass the test, the second list is composed of the elements that don't pass the test. Example of use: set mylist {this is a test for the lsplit Tcl command} lsplit $mylist x {[string length $x] < 4} left right puts $left puts $right More information inside the comments. # Split a list in two sub-lists of elements passing, or not passing # a given test. # # The signature is the following: # # lsplit listValue variable expression ?firstListVar secondListVar? # # We call the sublist of elements passing the test left-list, # and the sublist of elements not passing the test right-list. # # If lsplit is called with three arguments, # it returns [list $left-list $right-list] # # If lsplit is called with additional two arguments (five in total), # the last two arguments are used as variable names where # to store the left-list, and the right-list, and the command # returns [list [llength $left-list] [llength $right-list]]. # # This function was inspired by the Joy programming language # 'split' primitive. # # Copyright (C) 2004 Salvatore Sanfilippo # All the Rights reserved. # ################################################################################ # # This software is copyrighted by Salvatore Sanfilippo. # The following terms apply to all files associated with the software # unless explicitly disclaimed in individual files. # # The authors hereby grant permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, provided # that existing copyright notices are retained in all copies and that this # notice is included verbatim in any distributions. No written agreement, # license, or royalty fee is required for any of the authorized uses. # Modifications to this software may be copyrighted by their authors # and need not follow the licensing terms described here, provided that # the new terms are clearly indicated on the first page of each file where # they apply. # # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR # MODIFICATIONS. # # GOVERNMENT USE: If you are acquiring this software on behalf of the # U.S. government, the Government shall have only "Restricted Rights" # in the software and related documentation as defined in the Federal # Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you # are acquiring the software on behalf of the Department of Defense, the # software shall be classified as "Commercial Computer Software" and the # Government shall have only "Restricted Rights" as defined in Clause # 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the # authors grant the U.S. Government and others acting in its behalf # permission to use and distribute the software in accordance with the # terms specified in this license. proc lsplit {list var expression args} { switch -- [llength $args] { 2 {upvar [lindex $args 0] left [lindex $args 1] right} default { error [format %s%s "Wrong number of arguments. Try lsplit " "var expr ?leftListVar rightListVar?"] } } upvar $var x set left {} set right {} foreach e $list { # We take a copy of the element in 'e', # because 'expresion' is evaluated in a context # that may change the value of $x set x $e if {[uplevel expr [list $expression]]} { lappend left $e } else { lappend right $e } } if {![llength $args]} { list $left $right } else { list [llength $left] [llength $right] } }