Version 5 of Simple Text Widget Sort

Updated 2006-02-05 22:02:56

WJG (05/Feb/2006] I've been working on wordlists recently and needed a simple sorter. Here's what I came up with.

 #---------------
 # sort.tcl
 #---------------
 # Created by William J Giddings, 2006.
 #
 # Sort list of words contained within a text widget.
 #
 # Description:
 # -----------
 # Copy the words to a tcl list, sort them and the
 # re-insert into original text.
 #
 # Usage:
 # -----
 # See demo proc for example 
 #---------------

 # set some test switches
 set DEMO(sort) yes

 #----------------
 # sort text widget wordlist
 #----------------
 proc sort {{w .txt}} {
  set str [$w get 1.0 end]
  if {$str==""} { return}

  # get the size of the list
  foreach {last tmp} [split [$w index end-1c] .] {}

  # build a tcl list of the lines of text
  set lst {} 

  for {set i 1} {$i<=$last} {incr i} {
    set str [$w get $i.0 "$i.0 lineend"]
    # trim away unecessary whitespace
    set str [string trim $str]
    if {$str==""} {continue}
    set lst [lappend lst $str]
  }

  # sort it
  set lst [lsort -dictionary $lst]

  # insert it back into the widget
  $w delete 1.0 end
  set i 0
  for {set j 0} {$j<[llength $lst]} {incr j} {
    $w insert end [lindex $lst $j]\n
  }
  # trim away the last \n
  $w delete "$j.0 lineend" end

 }

 #----------------
 # demo 
 #----------------
 proc demo {} { 
  pack [text .txt] -fill both -expand 1
  .txt insert end "Zebra\nWilderbeast\nParrot\nHampster\nBear\nAardvark"
  sort
 }

 if {$DEMO(sort)} {demo}

Here's a version that is a bit simpler and more compact:

 proc sort {{w .txt}} {
    set str [$w get 1.0 end]
    if {$str==""} { return}
    $w delete 1.0 end
    foreach l [lsort -dictionary [split $str "\n"]] {
        if {$l != ""} {
            $w insert end [string trim $l]\n
        }
    }
 }

and here's a version that ensures that generates a sorted set (in which the entries are unique):

 proc UniqueSort {{w .txt}} {
    set str [$w get 1.0 end]
    if {$str==""} { return}
    $w delete 1.0 end
    set Previous "";
    foreach l [string trim [lsort -dictionary [split $str "\n"]]] {
        if {($l != "") && ($l != $Previous)} {
            $w insert end $l\n
        }
        set Previous $l;
    }
 }

WJP