1# node.tcl -- 2# 3# Package that defines the menubar::Node class. This class is a 4# privite class used by the menubar::Tree class. 5# 6# Copyright (c) 2009 Tom Krehbiel <tomk@users.sourceforge.net> 7# 8# See the file "license.terms" for information on usage and redistribution 9# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10# 11# RCS: @(#) $Id: node.tcl,v 1.4 2010/01/06 20:55:54 tomk Exp $ 12 13package require TclOO 14 15package provide menubar::node 0.5 16 17# -------------------------------------------------- 18# 19# manubar::Node class - used by menubar::Tree class 20# 21# -------------------------------------------------- 22 23# -- 24# parent - contains the parent node instance 25# children - contains list of child node instances 26# attrs - a dictionary of attribute/value pairs 27oo::class create ::menubar::node { 28 29 # -- 30 # create a named node 31 constructor { pnode } { 32 variable parent 33 variable children 34 variable attrs 35 36 set parent ${pnode} 37 set children {} 38 set attrs [dict create] 39 } 40 41 # -- 42 # If 'pnode' isn't blank, set the node's parent to its 43 # value; return the current parent. 44 method parent { {pnode ""} } { 45 variable parent 46 if { ${pnode} ne "" } { 47 set parent ${pnode} 48 } 49 return ${parent} 50 } 51 52 # -- 53 # If 'clist' is empty then return the current childern list else 54 # set the node's children to 'clist' and return the current childern list. 55 # If the option '-force' is found then set the node's children even 56 # if 'clist' is blank. 57 method children { {clist ""} args } { 58 variable children 59 if { [llength ${clist}] != 0 || "-force" in ${args} } { 60 set children ${clist} 61 } 62 return ${children} 63 } 64 65 # -- 66 # Insert a list of node instances ('args') into the 67 # child list at location 'index'. 68 method insert { index args } { 69 variable children 70 set children [linsert ${children} ${index} {*}${args}] 71 return 72 } 73 74 # -- 75 # If 'kdict' isn't blank set the node attributes to its 76 # value; return the current value of attributes. 77 method attrs { {kdict ""} {force ""} } { 78 variable attrs 79 if { ${kdict} ne "" || ${force} eq "-force" } { 80 set attrs ${kdict} 81 } 82 return ${attrs} 83 } 84 85 # -- 86 # Return the node's attributes as a dict of key/value pairs. If 87 # globpat exists, only keys that match the glob pattern will be 88 # returned. 89 method attrs.filter { {globpat ""} } { 90 variable attrs 91 if { ${globpat} eq "" } { 92 return ${attrs} 93 } else { 94 return [dict filter ${attrs} key ${globpat}] 95 } 96 } 97 98 # -- 99 # Return the node's attribute keys as a list. If globpat exists, 100 # only return keys that match the glob pattern. 101 method attr.keys { {globpat ""} } { 102 variable attrs 103 if { ${globpat} eq "" } { 104 return [dict keys ${attrs}] 105 } else { 106 return [dict keys ${attrs} ${globpat}] 107 } 108 } 109 110 # -- 111 # Set the value of the attribute 'key' to 'value'. If 'key 112 # doesn't exist add it to the node. 113 method attr.set { key value } { 114 variable attrs 115 dict set attrs ${key} ${value} 116 return ${value} 117 } 118 119 # -- 120 # 121 method attr.unset { key } { 122 variable attrs 123 dict unset attrs ${key} 124 return 125 } 126 127 # -- 128 # Return true of attribute 'key' exists for node else return false. 129 method attr.exists { key } { 130 variable attrs 131 return [dict exist ${attrs} ${key}] 132 } 133 134 # -- 135 # Return the value of the attribute 'key' for node. 136 method attr.get { key } { 137 variable attrs 138 if { [dict exist ${attrs} ${key}] } { 139 return [dict get ${attrs} ${key}] 140 } 141 error "attribute '${key}' - not found" 142 } 143 144 # -- 145 # Do a string append of 'value' to the value of attribute 'key' for 146 # node. Return the resulting string value. 147 method attr.append { key value } { 148 variable attrs 149 dict append attrs ${key} ${value} 150 return 151 } 152 153 # -- 154 # Do a list append of 'value' to the value of attribute 'key' for 155 # node. Return the resulting list value. 156 method attr.lappend { key value } { 157 variable attrs 158 dict lappend attrs ${key} ${value} 159 return 160 } 161} 162