Posted to tcl by steveb at Fri Nov 25 12:55:41 GMT 2022view raw

  1. proc qualifies {point target} {
  2. #return true if point is :
  3. # a toplevel
  4. # a child, but not a grandchild or further descendant of target
  5. # a sibling, ancestor or sibling of an ancestor of target
  6. set pointlength [llength $point]
  7. set targetlength [llength $target]
  8. if {$pointlength == 1} {
  9. # toplevel
  10. return true
  11. }
  12. if {$pointlength == $targetlength} {
  13. #are they siblings or self?
  14. set tmp1 [lreplace $point end end]
  15. set tmp2 [lreplace $target end end]
  16. if {$tmp1 == $tmp2} {
  17. return true
  18. } else {
  19. if {$pointlength < $targetlength} {
  20. #is $point an ancestor of $target or sibling of an ancestor
  21. set tmp1 $target
  22. while {[llength $tmp1] > $pointlength} {
  23. set tmp1 [lreplace $tmp1 end end]
  24. }
  25. if {$point == $tmp1} {
  26. #it's an ancestor
  27. return true
  28. }
  29. #is it the sibling of an ancestor?
  30. set tmp2 [lreplace $point end end]
  31. set tmp1 [lreplace $tmp1 end end]
  32. if {$tmp1 == $tmp2} {
  33. return true
  34. } else {
  35. return false
  36. }
  37. if {$pointlength > $targetlength} {
  38. #is $point a child of $target?
  39. set tmp1 [lreplace $point end end]
  40. if {$tmp1 == $target} {
  41. return true
  42. } else {
  43. return false
  44. }
  45. }
  46. return false
  47. }
  48.  
  49.  
  50.  
  51. set data [list . ./whenwhere ./trips ./faq ./diary ./courses ./contact\
  52. ./anotus ./trips/lavender ./trips/canaltrip1 ./trips/canaltrip1/junk\
  53. ./trips/lavender/morephotos ./courses/aroma]
  54.  
  55. foreach point $data {
  56. lappend newlist [split [string trimleft $point "./"] "/"]
  57. }
  58. #puts $newlist
  59. foreach target $newlist {
  60. set tmp {}
  61. foreach point $newlist {
  62. #puts "trying $point and $target answer: [qualifies $point $target]"
  63. if {[qualifies $point $target]} {
  64. lappend tmp $point
  65. }
  66. }
  67. puts "\n$target\:\n\t [lsort $tmp]"
  68. }