File: tree.tcl

package info (click to toggle)
espresso 5.1%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 146,004 kB
  • ctags: 17,245
  • sloc: f90: 253,041; sh: 51,271; ansic: 27,494; tcl: 15,570; xml: 14,508; makefile: 2,958; perl: 2,035; fortran: 1,924; python: 337; cpp: 200; awk: 57
file content (93 lines) | stat: -rw-r--r-- 2,010 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
proc ::helpdoc::getFromTree {tree node key} {
    if { [$tree keyexists $node $key] } {
	return [$tree get $node $key]
    } 
    return ""
}


proc ::helpdoc::getDescendantNodes {tree node args} {
    # Usage: getDescendantNodes $tree $node tag1 tag2 last_tag
    # get all descendant node's pointers that matches

    set result ""
    set tag [lindex $args 0]

    foreach child [$tree children $node] {

	set _tag [getFromTree $tree $child tag]
	
	if { $tag == $_tag } {
	    if { $tag == $args } {
		append result "$child "
	    } else {
		set args1 [lrange $args 1 end]
		return [getDescendantNodes $tree $child $args1]
	    }
	}
    }
    
    return $result
}


proc ::helpdoc::getDescendantText {tree node args} {
    # Usage: getDescendantText $tree $node tag1 tag2 last_tag
    # Beware: it will get the text from all tags that matches

    set result ""
    set tag [lindex $args 0]

    foreach child [$tree children $node] {

	set _tag [getFromTree $tree $child tag]
	
	if { $tag == $_tag } {
	    if { $tag == $args } {
		append result "[getFromTree $tree $child text] "
	    } else {
		set args1 [lrange $args 1 end]
		return [getDescendantText $tree $child $args1]
	    }
	}
    }
    
    return $result
}


proc ::helpdoc::getDescendantAttribute {tree node args} {

    # Usage: getDescendantText $tree $node tag1 tag2 last_tag attribute_of_last_tag
    # Beware: it will get the requested attribute from all tags that matches

    set result ""
    set tag [lindex $args 0]
    set att [lindex $args end]
    
    foreach child [$tree children $node] {
	
	set _tag [getFromTree $tree $child tag]
	
	if { $tag == $_tag } {
	    
	    if { [llength $args] == 2 } {
		
		# ok _tag is the attribute

		set attr [getFromTree $tree $child attributes]		
		attr2array_ arr $attr
		
		if { [info exists arr($att)] } {
		    append result $arr($att)
		}
		
	    } else {
		set args1 [lrange $args 1 end]
		return [getDescendantAttribute $tree $child $args1]
	    }
	}
    }
    
    return $result
}