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