building a navigation panel

proc qualifies {point target} {
    #return true if point is :
    #  a toplevel
    #  a child, but not a grandchild or further descendant of target
    #  a sibling, ancestor or sibling of an ancestor of target
    set pointlength [llength $point]
    set targetlength [llength $target]
    if {$pointlength == 1} {
    # toplevel
        return true
    }
    if {$pointlength == $targetlength} {
        #are they siblings or self?
        set tmp1 [lreplace $point end end]
        set tmp2 [lreplace $target end end]
        if {$tmp1 == $tmp2} {
            return true
        } else {
    if {$pointlength < $targetlength} {
        #is $point an ancestor of $target or sibling of an ancestor
        set tmp1 $target
        while {[llength $tmp1] > $pointlength} {
            set tmp1 [lreplace $tmp1 end end]
        }
        if {$point == $tmp1} {
            #it's an ancestor
            return true
        }
        #is it the sibling of an ancestor?
        set tmp2 [lreplace $point end end]
        set tmp1 [lreplace $tmp1 end end]
        if {$tmp1 == $tmp2} {
            return true
        } else {
            return false
        }
    if {$pointlength > $targetlength} {
        #is $point a child of $target?
        set tmp1 [lreplace $point end end]
        if {$tmp1 == $target} {
            return true
        } else {
            return false
        }
    }
    return false
}

 

set data [list . ./whenwhere ./trips ./faq ./diary ./courses ./contact\
  ./anotus ./trips/lavender ./trips/canaltrip1 ./trips/canaltrip1/junk\
  ./trips/lavender/morephotos ./courses/aroma]

foreach point $data {
    lappend newlist [split [string trimleft $point "./"] "/"]
}
#puts $newlist
foreach target $newlist {
    set tmp {}
    foreach point $newlist {
        #puts "trying $point  and $target answer: [qualifies $point $target]"
        if {[qualifies $point $target]} {
            lappend tmp $point
        }
    }
    puts "\n$target\:\n\t [lsort $tmp]"
}