1 # vim: ft=tcl foldmarker=<<<,>>>
3 option add Browse_treeview_flat.width
130 widgetDefault
4 option add Browse_treeview_flat.height
200 widgetDefault
6 class tlc
::Browse_treeview_flat {
7 inherit tlc
::Mywidget tlc
::Browsegeneric tlc
::Baselog
12 itk_option define
-actionspos actionsPos ActionsPos
\
13 {11,10 -fill x
} need_relayout
14 itk_option define
-actions_orient actionsOrient ActionsOrient h
15 itk_option define
-action_buttonwidth actionButtonWidth ActionButtonWidth
9
16 itk_option define
-column_widths columnWidths ColumnWidths
{}
17 itk_option define
-yscrollmode yScrollMode YScrollMode static
18 itk_option define
-xscrollmode xScrollMode XScrollMode dynamic
21 # inherited, overridden interface
27 method select_items
{itemlist
}
28 method get_selected_items
{}
29 method action_add
{args
}
30 method action_attach_signal
{label signal
{sense normal
}}
31 method action_add_supported
{}
32 method action_tips
{args
}
33 method filter_add
{label varinfo
{matchcode
1}}
34 method filter_add_standard
{label varinfo matchcode
}
35 method filter_data
{args
}
36 method filter_item
{item
}
37 method filter_add_cb
{cb
}
39 # specific to this implementation
40 variable hide_id_col
0
42 variable col_justifies
""
43 variable col_paddings
""
44 variable col_widths
""
45 variable hidden_cols
{}
46 variable item_bindings
{}
47 # for the inbuilt functions: choose case insenstivity or not
48 # for the inbuilt functions: toggle display of case-sensitive checkbutton
49 variable trim_filter
0
50 variable filter_mode
1
51 variable tree_style
"" {style_tree
}
53 method sortcolumn
{colname
}
54 method hideshowcol
{colname hidden
}
55 method filter
{searchstring
{matchcode
""} {filternames
{}}}
57 method get_criteria_form
{}
58 method reload_from_criteria_form
{}
60 method getsite
{sitename
}
61 method gen_popup
{{pop_commands
""}}
62 method style_tree
{{stylename
""}}
64 method column_configure
{colname args
}
65 method component_actions
{}
76 variable shadowdata
{}
77 variable treeheaders
{}
78 variable hidden_nodes
""
81 variable itemform_header
""
82 variable last_headers
{}
83 variable current_edit
{}
84 variable filterform
{}
85 variable filterform_schema
{}
88 variable filter_after_id
""
90 variable or_filter_ok_ids
""
91 variable filtered_nodes
92 variable filter_cbs
{}
93 variable cached_col_widths
94 variable selection_present
95 variable delayed_select_afterid
""
97 method onclick
{nodeid numclicks
}
98 method selection_changed
{}
99 method render_filters
{}
100 method form_filter
{{form_data
{}}}
101 method partial_match
{filterarray rowarray type
102 {applicable_cols
{}} {filternames
{}}}
103 method cache_col_widths
{}
104 method restore_col_widths
{}
105 method process_delayed_select
{data row row_id
}
110 configbody tlc
::Browse_treeview_flat::yscrollmode { #<<<1
111 $w.treeframe.hs configure
-mode $itk_option(-yscrollmode)
115 configbody tlc
::Browse_treeview_flat::xscrollmode { #<<<1
116 $w.treeframe.hs configure
-mode $itk_option(-xscrollmode)
120 configbody tlc
::Browse_treeview_flat::actions_orient { #<<<1
121 if {[winfo exists
$w.actionsframe.actions
]} {
122 $w.actionsframe.actions configure
-orient $itk_option(-actions_orient)
127 configbody tlc
::Browse_treeview_flat::action_buttonwidth { #<<<1
128 #puts "Browse_treeview_flat: Reconfiguring action_buttonwidth: ($itk_option(-action_buttonwidth))"
129 if {[winfo exists
$w.actionsframe.actions
]} {
130 $w.actionsframe.actions configure
\
131 -buttonwidth $itk_option(-action_buttonwidth)
136 configbody tlc
::Browse_treeview_flat::column_widths { #<<<1
137 foreach {colname width
} $itk_option(-column_widths) {
138 catch {$tv column configure
$colname -width $width}
144 body tlc
::Browse_treeview_flat::constructor {args
} { #<<<1
145 tlc
::Signal #auto selection_present -name "$this selection_present"
147 set datatree
[blt
::tree create
]
148 # (a) create the treeview <<<
150 set f
[frame $w.treeframe
]
152 # puts "constructing:
153 # blt::treeview $f.list -width 130 -height 200 \\
154 # -xscrollcommand [list $f.hs set] \\
155 # -yscrollcommand [list $f.vs set] \\
157 # -exportselection 1 \\
158 # -selectcommand [code $this selection_changed] \\
164 itk_component add listview
{
165 blt
::treeview $f.
list$::fooseq
167 keep
-takefocus -selectmode -width -height
169 set tv
$itk_component(listview
)
171 -xscrollcommand [list $f.hs
set] \
172 -yscrollcommand [list $f.vs
set] \
175 -selectcommand [code
$this selection_changed
] \
179 $tv style checkbox check
\
180 -onvalue 1 -offvalue 0 \
183 $tv column configure treeView
-hide 1
184 tlc
::myscrollbar_win32 $f.hs
-orient h
-command [list $tv xview
] -mode static
185 tlc
::myscrollbar_win32 $f.vs
-orient v
-command [list $tv yview
] -mode static
192 blt
::table configure
$f r2 c2
-resize none
195 # Setup mousewheel x and y scrolling <<<
196 bind $tv <Button-4
> {if {!$tk_strictMotif} {%W yview scroll
-2 units
}}
197 bind $tv <Button-5
> {if {!$tk_strictMotif} {%W yview scroll
2 units
}}
198 bind $tv <Control-Button-4
> {if {!$tk_strictMotif} {%W xview scroll
-2 units
}}
199 bind $tv <Control-Button-5
> {if {!$tk_strictMotif} {%W xview scroll
2 units
}}
200 bind $tv <Key-F5
> [code
$this refresh
]
201 bind $w <Key-F5
> [code
$this refresh
]
202 # Setup mousewheel x and y scrolling >>>
203 # (a) create the treeview >>>
205 eval itk_initialize
$args
207 # (b) create the criteria form (server-side searching) <<<
208 set f
[frame $w.criteriaframe
]
209 if {$show_criteria} {
210 label $f.criterialabel
-text $criteria_label
212 set cf
[tlc
::Form $f.criteriaform
-schema [$datasource get_criteria
]]
213 $f.criteriaform set_data
[$datasource get_criteria_values
]
215 tlc
::Tools $f.criteria_tools
216 $f.criteria_tools add
"Refresh" \
217 [code
$this reload_from_criteria_form
] right
218 $f.criteria_tools attach_signal
"Refresh" \
219 [$f.criteriaform dirty_gate_ref
]
221 if {$criteria_label != ""} {
223 $f.criterialabel
1,1 -fill x
\
227 $f.criteriaform
2,1 -fill x
-anchor n
\
228 $f.criteria_tools
3,1 -fill x
229 blt
::table configure
$f r1 r3
-resize none
231 # (b) create the criteria form (server-side searching) >>>
233 # (c) create the toolbar (if necessary) <<<
234 set tb
[tlc
::Tools $w.actionsframe
]
235 # (c) create the toolbar (if necessary) >>>
237 # (d) the filter (client-side searching) <<<
238 set filterframe
[frame $w.filterframe
]
239 # (d) the filter (client-side searching) >>>
241 # (e) layout with table <<<
243 # (e) end layout with table >>>
245 # get an item dialogue
246 set itemform
[tlc
::Formdialog $w.itemform
-mode schema
]
250 body tlc
::Browse_treeview_flat::destructor {} { #<<<1
251 #destroy $w.treeframe.list ;# DIE DIE DIE
252 after cancel
$delayed_select_afterid; set delayed_select_afterid
""
253 if {[winfo exists
$w.itemform
]} {
259 body tlc
::Browse_treeview_flat::refresh {} { #<<<1
262 after idle
[code
$this onclick
"" 1] ;# Fake click to blank any existing selection
264 # get data to load <<<
265 set cv
[$datasource get_criteria_values
]
266 set list_data
[$datasource get_labelled_list
$cv headers
]
267 set last_headers
$headers
268 # get data to load >>>
272 # if the data's headers have changed, update the treeview columns <<<
273 if {$headers != $treeheaders} {
274 set tmp
[lrange [$tv column names
] 1 end
]
276 # the first "name" returned should be treeview,
277 # but is something not quite
278 # that; still we don't want to remove it
279 # (unless we are seeking segfaults)
280 # note that the placement of this column is only because
281 # i have chosen to insert
282 # after it -- it's not a hard rule that the first col
283 # is the treeview >>>
284 # remove old headers <<<
286 $tv column delete
$col
288 # remove old headers >>>
289 # get format options for headers <<<
290 # (which may have, conceivably, changed, if the field list has changed)
291 foreach col
$headers {
296 array set jus
$col_justifies
297 array set pad
$col_paddings
298 array set wid
$col_widths
299 #array set colwidths $itk_option(-column_widths)
300 array set wid
$itk_option(-column_widths)
301 # get format options for headers >>>
302 # Get id column and name <<<
303 set id_col
[$datasource get_id_column
]
304 set id_col_name
[lindex $id_col 1]
305 #puts "Browse_treeview_flat::refresh: id_col: ($id_col) id_col_name: ($id_col_name)"
306 # Get id column and name >>>
308 foreach col
$headers {
310 -justify $jus($col) \
313 -hide [expr {[lsearch $hidden_cols $col] != -1}] \
314 -command [code
$this sortcolumn
$col]]
316 if {[lsearch $checkvars $col] >= 0} {
317 lappend colargs
-style check
321 set curr_id
[eval [list $tv column insert end
$col] $colargs]
323 error "Error inserting column ($col): $msg\n\tAll: ([$tv column names])\n$::errorInfo"
326 #if {[info exists colwidths($col)]} {
327 # $tv column configure $col -width $colwidths($col)
331 # if the data's headers have changed, update the treeview columns >>>
333 # Handle the id column (hide, etc) <<<
334 set id_colname
[lindex [$datasource get_id_column
] 1]
335 if {$hide_id_col && $id_colname != ""} {
336 $tv column configure
$id_colname -hide [expr {$hide_id_col}]
338 # Handle the id column (hide, etc) >>>
340 # load up the data <<<
343 foreach row
$list_data {
344 set tmpid
[$datatree insert root
-data $row]
345 lappend shadowdata
$row
346 $tv bind $tmpid <Button-1
> [code
$this onclick
$tmpid 1]
347 $tv bind $tmpid <Double-Button-1
> [code
$this onclick
$tmpid 2]
348 $tv bind $tmpid <Key-F5
> [code
$this refresh
]
349 foreach {binding action
} $item_bindings {
350 $tv bind $tmpid $binding $action
352 set m
[expr {($m + 1) % 2}]
354 # load up the data >>>
356 # Re-apply the filter
363 body tlc
::Browse_treeview_flat::clear {} { #<<<1
364 $datatree delete root
368 body tlc
::Browse_treeview_flat::sortcolumn {colname
} { #<<<1
369 # sort the treeview on a certain column
370 # unscrupulously ripped from the blt treeview demo
371 set old
[$tv sort cget
-column]
373 if {"$old" == "$colname"} {
374 set decreasing
[$tv sort cget
-decreasing]
375 set decreasing
[expr !$decreasing]
377 $tv sort configure
-decreasing $decreasing -column $colname -mode integer
378 if {![$tv cget
-flat]} {
379 $tv configure
-flat yes
382 style_tree
$tree_style
385 blt
::busy release
$tv
389 body tlc
::Browse_treeview_flat::hideshowcol {colname hidden
} { #<<<1
391 set hidden_cols
[lsort -unique [concat $hidden_cols [list $colname]]]
393 set idx
[lsearch $hidden_cols $colname]
395 set hidden_cols
[lreplace $hidden_cols $idx $idx]
398 catch {$tv configure
$colname -hide $hidden}
401 body tlc
::Browse_treeview_flat::add_item {} { #<<<1
402 # populate with defaults
403 array set res
[$datasource get_defaults
]
404 if {![$itemform ask res
[$datasource get_item_schema
]]} return
405 array set res
[$datasource add_item
[array get res
]]
408 foreach header
[$datasource get_headers
] {
409 if {[info exists res
($header)]} {
410 lappend row
$res($header)
415 set row_id
[lindex $row [lindex $id_col 0]]
416 invoke_handlers onadd_array
[array get res
]
417 invoke_handlers onadd
$row
418 invoke_handlers onadd_id
$row_id
421 body tlc
::Browse_treeview_flat::update_item {} { #<<<1
422 set oldrows
[get_selected_items
]
423 # check that the oldrow only contains one row: updating multiple rows is not supported
424 if {[llength $oldrows] > 1} {
425 log debug
"multiple row updates are not supported"
427 set oldrow
[lindex $oldrows 0]
428 array set res
$oldrow
429 if {![$itemform ask res
[$datasource get_item_schema
]]} return
431 array set res
[$datasource update_item
$oldrow [array get res
]]
435 foreach header
[$datasource get_headers
] {
436 lappend row
$res($header)
438 set row_id
[lindex $row [lindex $id_col 0]]
440 invoke_handlers onupdate_array
[array get res
]
441 invoke_handlers onupdate
$row
442 invoke_handlers onupdate_id
$row_id
446 body tlc
::Browse_treeview_flat::remove_item {} { #<<<1
447 # set up a mini-description of the item
448 set sel_items
[get_selected_items
]
449 if {[llength $sel_items]>1} {
451 set msg
"Are you sure you would like to remove these items?"
454 set msg
"Are you sure you would like to remove this item?"
456 if {[.confirm ask
$msg "Ok" "Cancel"] == "Ok"} {
457 set h
[$datasource get_headers
]
458 foreach item
$sel_items {
459 $datasource remove_item
$item
461 foreach header
[$datasource get_headers
] {
462 if {[info exists res
($header)]} {
463 lappend row
$res($header)
468 set row_id
[lindex $row [lindex $id_col 0]]
469 invoke_handlers ondelete_array
$item
470 invoke_handlers ondelete
$row
471 invoke_handlers ondelete_id
$row_id
477 body tlc
::Browse_treeview_flat::select_items {itemlist
} { #<<<1
480 body tlc
::Browse_treeview_flat::getsite {sitename
} { #<<<1
481 # returns a site referenced by a keyword -- to be used by a parent that wishes to inject something into one of the sites
482 switch -- [string tolower
$sitename] {
483 "criteria" {return $w.criteriaframe
}
484 "actions" {return $w.actionframe
}
485 "filter" {return $w.filterframe
}
487 "list" {return $w.treeframe
}
489 log
error "Unable to return reference to site $sitename -- site should be one of: criteria,actions,filter,tree|list"
495 body tlc
::Browse_treeview_flat::filter {searchstring
{matchcode
{}} {filternames
{} }} { #<<<1
496 # comments about the function <<<
497 # for each node in the current treeview, we see if it matches up with
498 # the search string, and if so, it gets to stay.
499 # If not, it gets dumped in the removed_nodes variable (which is just
501 # This variable is also checked for matches, which are added back
502 # into the tree if found
504 # set up the filter array
505 if {$filterform != ""} {
506 array set filter
[$filterform get_data
]
508 log
error "filterform does not exist: ($filterform)"
511 switch -- $filter_mode {
515 foreach node
[$datatree children root
] {
516 set rawrow
[$datatree get
$node]
517 if {[llength $rawrow] > 0} {
518 array set row
$rawrow
519 if {![expr $matchcode]} {
520 $datatree delete
$node
527 error "Bad filter_mode $filter_mode: only \"and\" is supported"
532 body tlc
::Browse_treeview_flat::get_criteria_form {} { #<<<1
536 body tlc
::Browse_treeview_flat::reload_from_criteria_form {} { #<<<1
537 $datasource set_criteria_values
[$cf get_data
]
539 $w.criteriaframe.criteriaform mark_dirty
0
542 body tlc
::Browse_treeview_flat::get_selected_items {} { #<<<1
543 set sel_ids
[$tv curselection
]
545 foreach id
$sel_ids {
546 lappend ret
[$datatree get
$id]
552 body tlc
::Browse_treeview_flat::onclick {nodeid numclicks
} { #<<<1
554 set data
[$datatree get
$nodeid]
561 foreach h
$last_headers {
562 if {![info exists tmp
($h)]} {
569 set row_id
[$datasource extract_id
$row]
572 switch -- $numclicks {
573 1 {set cb
"onselect"}
574 2 {set cb
"doubleclick"}
575 default {error "mad number of clicks sent through: ($numclicks)"}
578 #puts "onclick: nodeid: ($nodeid) data: ($data) selection present: ([$tv selection present])"
579 $item_selected set_state
[expr {$nodeid != ""}]
581 if {$delayed_select_afterid != ""} {
582 set pending
[lindex [after info $delayed_select_afterid] 0]
583 if {$pending != ""} {
587 set delayed_select_afterid
[after idle
\
588 [code
$this process_delayed_select
$data $row $row_id]]
592 body tlc
::Browse_treeview_flat::action_add {args
} { #<<<1
593 set label [lindex $args 0]
594 if {![winfo exists
$w.actionsframe.actions
]} {
595 set f
$w.actionsframe
596 #puts "\n\nBrowse_treeview_flat::action_add:\n\torient: ($itk_option(-actions_orient))\n\tbuttonwidth: ($itk_option(-action_buttonwidth))\n\n"
597 set tb
[tlc
::Tools $f.actions
\
598 -buttonwidth $itk_option(-action_buttonwidth) \
599 -orient $itk_option(-actions_orient)]
600 blt
::table $f $f.actions
1,1 -fill both
603 switch -- [string tolower
[lindex $args 1]] {
607 if {[$datasource can_do insert
]} {
608 set title
[lindex $args 0]
609 set ltitle
[expr {[string length
$title]?
"$title":"Add New"}]
610 $tb add
$ltitle [code
$this add_item
]
611 lappend actions
"$ltitle" "[code $this add_item]"
613 error "Datasource can't do insert; refusing to create add\
620 if {[$datasource can_do delete
]} {
621 set title
[lindex $args 0]
622 set ltitle
[expr {[string length
$title] ?
"$title" : "Delete"}]
623 $tb add
$ltitle [code
$this remove_item
]
624 $tb attach_signal
$ltitle [selected_ref
]
625 lappend actions
"$ltitle" "[code $this remove_item]"
627 error "Datasource can't do delete; refusing to create delete\
634 if {[$datasource can_do
update]} {
635 set title
[lindex $args 0]
636 set ltitle
[expr {[string length
$title] ?
"$title" : "Update"}]
637 $tb add
$ltitle [code
$this update_item
]
638 $tb attach_signal
$ltitle [selected_ref
]
639 lappend actions
"$ltitle" "[code $this update_item]"
641 error "Datasource can't do update; refusing to create update\
646 set title
[lindex $args 0]
647 set ltitle
[expr {[string length
$title] ?
"$title" : "Refresh"}]
648 $tb add
$ltitle [code
$this refresh
]
649 lappend actions
"$ltitle" "[code $this refresh]"
652 eval [list $tb add
] $args
653 lappend actions
"[lindex $args 0]" "[lindex $args 1]"
658 body tlc
::Browse_treeview_flat::action_add_supported {} { #<<<
659 foreach action
"insert update delete" {
660 if {[$datasource can_do
$action]} {
661 action_add
"" $action
664 action_add
"" "refresh"
667 body tlc
::Browse_treeview_flat::action_attach_signal {label signal
{sense normal
}} { #<<<1
668 #puts "Browse_treeview_flat::action_attach_signal ($label) ($signal) ($sense)"
669 $tb attach_signal
$label $signal $sense
673 body tlc
::Browse_treeview_flat::action_tips {args
} { #<<<1
674 eval [list $tb set_tips
] $args
678 body tlc
::Browse_treeview_flat::selection_changed {} { #<<<1
679 $selection_present set_state
[$tv selection present
]
682 body tlc
::Browse_treeview_flat::gen_popup {{pop_commands
""}} { #<<<1
684 if {$pop_follows_actions} {
685 foreach {action cmd
} $actions {
686 lappend menu_schema
"$action" "command [list $cmd]"
689 #puts "generating popup with schema: ($menu_schema $pop_commands)"
690 Mymenu
$w.pop
-schema "$menu_schema $pop_commands"
691 bind $tv <Button-3
> [list tk_popup $w.pop
%X
%Y
]
694 body tlc
::Browse_treeview_flat::filter_add {label varinfo
{matchcode
1}} { #<<<1
695 set varname
[lindex $varinfo 0]
696 lappend filterform_schema
$label $varinfo
697 set filtercode
($varname) $matchcode
698 set last_filter
($varname) ""
699 set filter_after_id
[after idle
[code
$this render_filters
]]
703 body tlc
::Browse_treeview_flat::filter_add_standard {label varinfo matchcode
} { #<<<1
704 # implement some fairly standard search capabilities
705 set orig_matchcode
$matchcode
708 switch -- [lindex $matchcode 0] {
712 set matchcode
{[eval partial_match
[list [array get filter
]] \
713 [list [array get row
]] "left" \
715 [list $filternames]]}
721 set matchcode
{[partial_match
[list [array get filter
]] \
722 [list [array get row
]] "right" \
724 [list $filternames]]}
730 set matchcode
{[partial_match
[list [array get filter
]] \
731 [list [array get row
]] "exact" \
733 [list $filternames]]}
740 set matchcode
{[eval partial_match
[list [array get filter
]] \
741 [list [array get row
]] "partial" \
743 [list $filternames]]}
746 default { ;# default is to leave the match code alone
751 set repidx
[lsearch $matchcode "%%foo%%"]
752 set matchcode
[lreplace $matchcode $repidx $repidx [lrange $orig_matchcode 1 end
]]
755 return [filter_add
$label $varinfo $matchcode]
759 body tlc
::Browse_treeview_flat::render_filters {} { #<<<1
760 after cancel
$filter_after_id
761 set filter_after_id
""
762 if {$filter_label != ""} {
763 label $filterframe.filterheader
-text $filter_label
764 blt
::table $filterframe \
765 $filterframe.filterheader
1,1 -columnspan 2
767 if {[winfo exists
$filterframe.filterform
]} {
768 $filterframe.filterform configure
-schema $filterform_schema
770 set filterform
[tlc
::Form $filterframe.filterform
-schema $filterform_schema]
773 blt
::table $filterframe \
774 $filterframe.filterform
2,1 -columnspan 2
775 blt
::table configure
$filterframe r1 r2
-resize none
777 if {$filter_allow_sense_change} {
778 label $filterframe.insensitivelabel
-text "Filter is case insensitive:"
779 checkbutton $filterframe.insensitive
-variable $filter_insensitive
780 blt
::table $filterframe \
781 $filterframe.insensitivelabel
3,1 -anchor ne
\
782 $filterframe.insensitive
3,2 -anchor nw
783 blt
::table configure
$filterframe r3
-resize none
786 if {$filter_allow_mode_change && [llength [array names filtercode
]] > 1} {
787 label $filterframe.modelabel
-text "Require all conditions be met."
788 checkbutton $filterframe.mode
\
789 -command [code
$this form_filter
] \
790 -variable [scope filter_mode
]
791 blt
::table $filterframe \
792 $filterframe.modelabel
4,1 -anchor ne
\
793 $filterframe.mode
4,2 -anchor nw
794 blt
::table configure
$filterframe r4
-resize none
796 $filterform register_handler onchange
[code
$this form_filter
]
799 body tlc
::Browse_treeview_flat::form_filter {{form_data
{}}} { #<<<1
800 if {[llength $form_data] == 0 && $filterform != ""} {
801 set form_data
[$filterform get_data
]
803 set form_data
$form_data
805 # initial filtering method notes: <<<
806 # we have two possible filter methods: and and or (keeping it simple)
807 # for the case of an or, we start with a blank datatree and add in
808 # the elements from the shadowtree that make the grade.
809 # for the case of an and, we start with a filled datatree and remove
810 # items that violate the filtering rules
812 set required_filters
{}
813 array set lfilters
$form_data
814 foreach {filter value
} [array get lfilters
] {
816 lappend required_filters
$filter
820 switch -- $filter_mode {
824 $datatree delete root
825 foreach dataarray
$shadowdata {
826 set tmpid
[$datatree insert root
\
828 $tv bind $tmpid <Button-1
> [code
$this onclick
$tmpid 1]
829 $tv bind $tmpid <Double-Button-1
> \
830 [code
$this onclick
$tmpid 2]
831 $tv bind $tmpid <Key-F5
> [code
$this refresh
]
832 foreach {binding action
} $item_bindings {
833 $tv bind $tmpid $binding $action
836 log debug
"populated"
839 foreach filter
$required_filters {
840 filter
$lfilters($filter) $filtercode($filter) $filter
842 foreach cb
$filter_cbs {
843 foreach node
[$datatree children root
] {
844 set rawrow
[$datatree get
$node]
845 if {[llength $rawrow] > 0} {
846 if {![$cb $rawrow]} {
847 $datatree delete
$node
858 body tlc
::Browse_treeview_flat::partial_match {filterarray rowarray type
859 {applicable_cols
{}} {filternames
{}}} {
860 array set afilter
$filterarray
861 array set arow
$rowarray
862 if {[llength $applicable_cols] == 0} {
863 foreach idx
[array names afilter
] {
864 lappend applicable_cols
$idx
867 if {[llength $filternames] == 0} {set filternames
[array names afilter
]}
870 "partial" {set pre
"*"; set post
"*"}
871 "left" {set pre
""; set post
"*"}
872 "right" {set pre
"*"; set post
""}
874 default {set pre
""; set post
""}
877 if {$trim_filter} {set val
[string trim
$val]}
878 # ok, bear with me: i'm trying to keep the miniumum of checks on the
879 # inner loop, so there are a lot of variations on a theme here
880 if {$filter_insensitive} {
881 foreach idx
$filternames {
882 if {[lsearch $applicable_cols $idx] > -1} {
883 if {[info exists arow
($idx)]} {
884 if {$afilter($idx) != ""} {
885 if {[eval string match
-nocase \
886 {${pre
}$afilter($idx)${post
}} \
887 {$arow($idx)} ] == 1} {
895 foreach {idx val
} $filternames {
896 if {[lsearch $applicable_cols $idx] > -1} {
897 if {[info exists arow
($idx)]} {
898 if {$afilter($idx) != ""} {
899 if {[eval string match
\
900 {${pre
}$afilter($idx)${post
}} \
901 {$arow($idx)} ] == 1} {
910 switch -- $filter_mode {
912 1 {return [expr {[llength $applicable_cols] == $hits ?
1 : 0}]}
914 0 {return [expr {$hits > 0 ?
1 : 0}]}
918 body tlc
::Browse_treeview_flat::cache_col_widths {} { #<<<1
919 foreach col
[$tv column names
] {
920 set cached_col_widths
($col) [$tv column cget
$col -width]
924 body tlc
::Browse_treeview_flat::restore_col_widths {} { #<<<1
925 foreach col
[$tv column names
] {
926 if {[info exists cached_col_widths
($col)]} {
927 $tv column configure
$col -width $cached_col_widths($col)
932 body tlc
::Browse_treeview_flat::style_tree {{stylename
""}} { #<<<1
933 switch -- $stylename {
941 foreach col
[$tv column names
] {
942 $tv column configure
$col \
943 -titlerelief raised
\
944 -titlebackground "#e5e5e5" \
945 -activetitlebackground "#e5e5e5" \
946 -titleforeground "#000000" \
948 -background "#f5f5f5" \
949 -titleborderwidth 1 \
955 # tries to make the listview fit in with the chrome of the system
956 set chrome
[$tlc::theme setting background
]
957 set fg
[$tlc::theme setting foreground
]
960 -selectbackground [$tlc::theme setting selectbackground
] \
963 -background $tlc::config(textbackground
)
964 foreach col
[$tv column names
] {
965 $tv column configure
$col \
966 -titlerelief raised
\
967 -background $tlc::config(textbackground
) \
968 -titlebackground $chrome \
969 -activetitlebackground $chrome \
970 -titleforeground $fg \
972 -activetitlebackground $chrome
979 body tlc
::Browse_treeview_flat::get_tv_ref {} { #<<<1
984 body tlc
::Browse_treeview_flat::column_configure {colname args
} { #<<<1
985 if {[refresh_pending
]} {
988 return [eval [list $tv column configure
$colname] $args]
992 body tlc
::Browse_treeview_flat::relayout {} { #<<<1
993 eval [list blt
::table $w $w.treeframe
] $listpos
994 eval [list blt
::table $w $w.filterframe
] $filterpos
995 set coords
[split [lindex $filterpos 0] ","]
997 eval [list blt
::table $w $w.criteriaframe
] $criteriapos
998 set coords
[split [lindex $criteriapos 0] ","]
1000 eval [list blt
::table $w $w.actionsframe
] $itk_option(-actionspos)
1001 set coords
[split [lindex $itk_option(-actionspos) 0], ","]
1003 # Restrict row and col growth to those containing the list <<<
1004 array set targets
{}
1005 foreach child
[blt
::table search
$w -pattern *] {
1006 set table_info
[blt
::table info $w $child]
1007 foreach {row col
} [split [lindex $table_info 0] ,] break
1008 set targets
(r
$row) 1
1009 set targets
(c
$col) 1
1011 eval [list blt
::table configure
$w] [array names targets
] -resize none
1012 foreach {row col
} [split [lindex [blt
::table info $w $w.treeframe
] 0] ,] break
1013 blt
::table configure
$w r
$row c
$col -resize both
1014 # Restrict row and col growth to those containing the list >>>
1018 body tlc
::Browse_treeview_flat::component_actions {} { #<<<1
1019 if {[winfo exists
$w.actionsframe.actions
]} {
1020 return $w.actionsframe.actions
1022 error "No actions configured"
1027 body tlc
::Browse_treeview_flat::filter_data {args
} { #<<<1
1028 if {$filter_after_id != ""} {render_filters
}
1029 switch -- [llength $args] {
1031 if {$filterform != ""} {
1032 return [$filterform get_data
]
1034 log
error "filterform does not exist: ($filterform)"
1040 if {$filterform != ""} {
1041 return [$filterform set_data
[lindex $args 0]]
1043 log
error "filterform does not exist: ($filterform)"
1049 error "Incorrect number of arguments: ($args) must be ?newdata?"
1055 body tlc
::Browse_treeview_flat::filter_item {item
} { #<<<1
1056 return [$filterform path
$item]
1060 body tlc
::Browse_treeview_flat::filter_add_cb {cb
} { #<<<1
1061 lappend filter_cbs
$cb
1067 body tlc
::Browse_treeview_flat::process_delayed_select {data row row_id
} { #<<<1
1068 after cancel
$delayed_select_afterid; set delayed_select_afterid
""
1070 invoke_handlers
${cb
}_array
$data
1071 invoke_handlers
$cb $row
1072 invoke_handlers
${cb
}_id
$row_id