1# ----------------------------------------------------------------------------
2#  dynhelp.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: dynhelp.tcl,v 1.22 2009/09/03 17:23:30 oehhar Exp $
5# ----------------------------------------------------------------------------
6#  Index of commands:
7#     - DynamicHelp::configure
8#     - DynamicHelp::include
9#     - DynamicHelp::sethelp
10#     - DynamicHelp::register
11#     - DynamicHelp::_motion_balloon
12#     - DynamicHelp::_motion_info
13#     - DynamicHelp::_leave_info
14#     - DynamicHelp::_menu_info
15#     - DynamicHelp::_show_help
16#     - DynamicHelp::_init
17# ----------------------------------------------------------------------------
18
19namespace eval DynamicHelp {
20    Widget::define DynamicHelp dynhelp -classonly
21
22    if {$::tcl_version >= 8.5} {
23        set fontdefault TkTooltipFont
24    } elseif {$Widget::_aqua} {
25        set fontdefault {helvetica 11}
26    } else {
27        set fontdefault {helvetica 8}
28    }
29
30    Widget::declare DynamicHelp [list\
31        {-foreground     TkResource black         0 label}\
32        {-topbackground  TkResource black         0 {label -foreground}}\
33        {-background     TkResource "#FFFFC0"     0 label}\
34        {-borderwidth    TkResource 1             0 label}\
35        {-justify        TkResource left          0 label}\
36        [list -font      TkResource $fontdefault  0 label]\
37        {-delay          Int        600           0 "%d >= 100 & %d <= 2000"}\
38	{-state          Enum       "normal"      0 {normal disabled}}\
39        {-padx           TkResource 1             0 label}\
40        {-pady           TkResource 1             0 label}\
41        {-bd             Synonym    -borderwidth}\
42        {-bg             Synonym    -background}\
43        {-fg             Synonym    -foreground}\
44        {-topbg          Synonym    -topbackground}\
45    ]
46
47    proc use {} {}
48
49    variable _registered
50    variable _canvases
51    variable _texts
52
53    variable _top     ".help_shell"
54    variable _id      ""
55    variable _delay   600
56    variable _current_balloon ""
57    variable _current_variable ""
58    variable _saved
59
60    Widget::init DynamicHelp $_top {}
61
62    bind BwHelpBalloon <Enter>   {DynamicHelp::_motion_balloon enter  %W %X %Y}
63    bind BwHelpBalloon <Motion>  {DynamicHelp::_motion_balloon motion %W %X %Y}
64    bind BwHelpBalloon <Leave>   {DynamicHelp::_motion_balloon leave  %W %X %Y}
65    bind BwHelpBalloon <Button>  {DynamicHelp::_motion_balloon button %W %X %Y}
66    bind BwHelpBalloon <Destroy> {DynamicHelp::_unset_help %W}
67
68    bind BwHelpVariable <Enter>   {DynamicHelp::_motion_info %W}
69    bind BwHelpVariable <Leave>   {DynamicHelp::_leave_info  %W}
70    bind BwHelpVariable <Destroy> {DynamicHelp::_unset_help  %W}
71
72    bind BwHelpMenu <<MenuSelect>> {DynamicHelp::_menu_info select %W}
73    bind BwHelpMenu <Unmap>        {DynamicHelp::_menu_info unmap  %W}
74    bind BwHelpMenu <Destroy>      {DynamicHelp::_unset_help %W}
75}
76
77
78# ----------------------------------------------------------------------------
79#  Command DynamicHelp::configure
80# ----------------------------------------------------------------------------
81proc DynamicHelp::configure { args } {
82    variable _top
83    variable _delay
84
85    set res [Widget::configure $_top $args]
86    if { [Widget::hasChanged $_top -delay val] } {
87        set _delay $val
88    }
89
90    return $res
91}
92
93
94# ----------------------------------------------------------------------------
95#  Command DynamicHelp::include
96# ----------------------------------------------------------------------------
97proc DynamicHelp::include { class type } {
98    set helpoptions [list \
99	    [list -helptext String "" 0] \
100	    [list -helpvar  String "" 0] \
101	    [list -helpcmd  String "" 0] \
102	    [list -helptype Enum $type 0 [list balloon variable]] \
103	    ]
104    Widget::declare $class $helpoptions
105}
106
107
108# ----------------------------------------------------------------------------
109#  Command DynamicHelp::sethelp
110# ----------------------------------------------------------------------------
111proc DynamicHelp::sethelp { path subpath {force 0}} {
112    foreach {ctype ctext cvar} [Widget::hasChangedX $path \
113	    -helptype -helptext -helpvar] break
114    if { $force || $ctype || $ctext || $cvar } {
115	set htype [Widget::cget $path -helptype]
116        switch $htype {
117            balloon {
118                return [register $subpath balloon \
119			[Widget::cget $path -helptext]]
120            }
121            variable {
122                return [register $subpath variable \
123			[Widget::cget $path -helpvar] \
124			[Widget::cget $path -helptext]]
125            }
126        }
127        return [register $subpath $htype]
128    }
129}
130
131# ----------------------------------------------------------------------------
132#  Command DynamicHelp::register
133#
134#  DynamicHelp::register path balloon  ?itemOrTag? text
135#  DynamicHelp::register path variable ?itemOrTag? text varName
136#  DynamicHelp::register path menu varName
137#  DynamicHelp::register path menuentry index text
138# ----------------------------------------------------------------------------
139proc DynamicHelp::register { path type args } {
140    variable _registered
141
142    set len [llength $args]
143    if {$type == "balloon"  && $len > 1} {
144	switch -exact -- [winfo class $path] {
145	    "Canvas" { set type canvasBalloon  }
146	    "Text" -
147	    "Ctext" { set type textBalloon }
148	}
149    }
150    if {$type == "variable" && $len > 2} {
151	switch -exact -- [winfo class $path] {
152	    "Canvas" { set type canvasVariable }
153	    "Text" -
154	    "Ctext" { set type textVariable }
155	}
156    }
157
158    if { ![winfo exists $path] } {
159        _unset_help $path
160        return 0
161    }
162
163    switch $type {
164        balloon {
165            set text [lindex $args 0]
166	    if {$text == ""} {
167		if {[info exists _registered($path,balloon)]} {
168		    unset _registered($path,balloon)
169		}
170		return 0
171	    }
172
173	    _add_balloon $path $text
174        }
175
176        canvasBalloon {
177            set tagOrItem  [lindex $args 0]
178            set text       [lindex $args 1]
179	    if {$text == ""} {
180		if {[info exists _registered($path,$tagOrItem,balloon)]} {
181		    unset _registered($path,$tagOrItem,balloon)
182		}
183		return 0
184	    }
185
186	    _add_canvas_balloon $path $text $tagOrItem
187        }
188
189        textBalloon {
190            set tagOrItem  [lindex $args 0]
191            set text       [lindex $args 1]
192	    if {$text == ""} {
193		if {[info exists _registered($path,$tagOrItem,balloon)]} {
194		    unset _registered($path,$tagOrItem,balloon)
195		}
196		return 0
197	    }
198
199	    _add_text_balloon $path $text $tagOrItem
200        }
201
202        variable {
203            set var  [lindex $args 0]
204            set text [lindex $args 1]
205	    if {$text == "" || $var == ""} {
206		if {[info exists _registered($path,variable)]} {
207		    unset _registered($path,variable)
208		}
209		return 0
210	    }
211
212	    _add_variable $path $text $var
213        }
214
215        canvasVariable {
216            set tagOrItem  [lindex $args 0]
217            set var        [lindex $args 1]
218            set text       [lindex $args 2]
219	    if {$text == "" || $var == ""} {
220		if {[info exists _registered($path,$tagOrItem,variable)]} {
221		    unset _registered($path,$tagOrItem,variable)
222		}
223		return 0
224	    }
225
226	    _add_canvas_variable $path $text $var $tagOrItem
227        }
228
229        textVariable {
230            set tagOrItem  [lindex $args 0]
231            set var        [lindex $args 1]
232            set text       [lindex $args 2]
233	    if {$text == "" || $var == ""} {
234		if {[info exists _registered($path,$tagOrItem,variable)]} {
235		    unset _registered($path,$tagOrItem,variable)
236		}
237		return 0
238	    }
239
240	    _add_text_variable $path $text $var $tagOrItem
241        }
242
243        menu {
244            set var [lindex $args 0]
245	    if {$var == ""} {
246		set cpath [BWidget::clonename $path]
247		if {[winfo exists $cpath]} { set path $cpath }
248		if {[info exists _registered($path)]} {
249		    unset _registered($path)
250		}
251		return 0
252	    }
253
254	    _add_menu $path $var
255        }
256
257        menuentry {
258            set cpath [BWidget::clonename $path]
259            if { [winfo exists $cpath] } { set path $cpath }
260            if {![info exists _registered($path)]} { return 0 }
261
262            set text  [lindex $args 1]
263            set index [lindex $args 0]
264	    if {$text == "" || $index == ""} {
265		set idx [lsearch $_registered($path) [list $index *]]
266		set _registered($path) [lreplace $_registered($path) $idx $idx]
267		return 0
268	    }
269
270	    _add_menuentry $path $text $index
271        }
272
273        default {
274            _unset_help $path
275	    return 0
276        }
277    }
278
279    return 1
280}
281
282
283proc DynamicHelp::add { path args } {
284    variable _registered
285
286    array set data {
287        -type     balloon
288        -text     ""
289        -item     ""
290        -index    -1
291        -command  ""
292        -variable ""
293    }
294    if {[winfo exists $path] && [winfo class $path] == "Menu"} {
295	set data(-type) menu
296    }
297    array set data $args
298
299    set item $path
300
301    switch -- $data(-type) {
302        "balloon" {
303            if {$data(-item) != ""} {
304		switch -exact -- [winfo class $path] {
305		    "Canvas" {
306			_add_canvas_balloon $path $data(-text) $data(-item)
307			set item $path,$data(-item)
308		    }
309		    "Text" -
310		    "Ctext" {
311			_add_text_balloon $path $data(-text) $data(-item)
312			set item $path,$data(-item)
313		    }
314		    default {
315			_add_balloon $path $data(-text)
316		    }
317		}
318            } else {
319                _add_balloon $path $data(-text)
320            }
321
322	    if {$data(-variable) != ""} {
323		set _registered($item,balloonVar) $data(-variable)
324	    }
325        }
326
327        "variable" {
328            set var $data(-variable)
329            if {$data(-item) != ""} {
330		switch -exact -- [winfo class $path] {
331		    "Canvas" {
332			_add_canvas_variable $path $data(-text) $var $data(-item)
333			set item $path,$data(-item)
334		    }
335		    "Text" -
336		    "Ctext" {
337			_add_text_variable $path $data(-text) $var $data(-item)
338			set item $path,$data(-item)
339		    }
340		    default {
341			_add_variable $path $data(-text) $var
342		    }
343		}
344            } else {
345                _add_variable $path $data(-text) $var
346            }
347        }
348
349        "menu" {
350            if {$data(-index) != -1} {
351                set cpath [BWidget::clonename $path]
352                if { [winfo exists $cpath] } { set path $cpath }
353                if {![info exists _registered($path)]} { return 0 }
354                _add_menuentry $path $data(-text) $data(-index)
355                set item $path,$data(-index)
356            } else {
357                _add_menu $path $data(-variable)
358            }
359        }
360
361        default {
362            return 0
363        }
364    }
365
366    if {$data(-command) != ""} {set _registered($item,command) $data(-command)}
367
368    return 1
369}
370
371
372proc DynamicHelp::delete { path } {
373    _unset_help $path
374}
375
376
377proc DynamicHelp::_add_bind_tag { path tag } {
378    set evt [bindtags $path]
379    set idx [lsearch $evt $tag]
380    set evt [lreplace $evt $idx $idx]
381    lappend evt $tag
382    bindtags $path $evt
383}
384
385
386proc DynamicHelp::_add_balloon { path text } {
387    variable _registered
388    set _registered($path,balloon) $text
389    _add_bind_tag $path BwHelpBalloon
390}
391
392
393proc DynamicHelp::_add_canvas_balloon { path text tagOrItem } {
394    variable _canvases
395    variable _registered
396
397    set _registered($path,$tagOrItem,balloon) $text
398
399    if {![info exists _canvases($path,balloon)]} {
400        ## This canvas doesn't have the bindings yet.
401
402        _add_bind_tag $path BwHelpBalloon
403
404        $path bind BwHelpBalloon <Enter> \
405            {DynamicHelp::_motion_balloon enter  %W %X %Y 1}
406        $path bind BwHelpBalloon <Motion> \
407            {DynamicHelp::_motion_balloon motion %W %X %Y 1}
408        $path bind BwHelpBalloon <Leave> \
409            {DynamicHelp::_motion_balloon leave  %W %X %Y 1}
410        $path bind BwHelpBalloon <Button> \
411            {DynamicHelp::_motion_balloon button %W %X %Y 1}
412
413        set _canvases($path,balloon) 1
414    }
415
416    $path addtag BwHelpBalloon withtag $tagOrItem
417}
418
419
420proc DynamicHelp::_add_text_balloon { path text tagOrItem } {
421    variable _texts
422    variable _registered
423
424    set _registered($path,$tagOrItem,balloon) $text
425
426    if { ![info exists _texts($path,$tagOrItem,balloon)] } {
427        $path tag bind $tagOrItem <Enter> \
428            [list DynamicHelp::_motion_balloon enter  $path %X %Y 0 1]
429        $path tag bind $tagOrItem <Motion> \
430            [list DynamicHelp::_motion_balloon motion $path %X %Y 0 1]
431        $path tag bind $tagOrItem <Leave> \
432            [list DynamicHelp::_motion_balloon leave  $path %X %Y 0 1]
433        $path tag bind $tagOrItem <Button> \
434            [list DynamicHelp::_motion_balloon button $path %X %Y 0 1]
435
436        set _texts($path,$tagOrItem,balloon) 1
437    }
438}
439
440
441proc DynamicHelp::_add_variable { path text varName } {
442    variable _registered
443    set _registered($path,variable) [list $varName $text]
444    _add_bind_tag $path BwHelpVariable
445}
446
447
448proc DynamicHelp::_add_canvas_variable { path text varName tagOrItem } {
449    variable _canvases
450    variable _registered
451
452    set _registered($path,$tagOrItem,variable) [list $varName $text]
453
454    if {![info exists _canvases($path,variable)]} {
455        ## This canvas doesn't have the bindings yet.
456
457        _add_bind_tag $path BwHelpVariable
458
459        $path bind BwHelpVariable <Enter> \
460            {DynamicHelp::_motion_info %W 1}
461        $path bind BwHelpVariable <Motion> \
462            {DynamicHelp::_motion_info %W 1}
463        $path bind BwHelpVariable <Leave> \
464            {DynamicHelp::_leave_info  %W 1}
465
466        set _canvases($path,variable) 1
467    }
468
469    $path addtag BwHelpVariable withtag $tagOrItem
470}
471
472
473proc DynamicHelp::_add_text_variable { path text varName tagOrItem } {
474    variable _texts
475    variable _registered
476
477    set _registered($path,$tagOrItem,variable) [list $varName $text]
478
479    if {![info exists _texts($path,$tagOrItem,variable)]} {
480
481        $path tag bind $tagOrItem <Enter> \
482            [list DynamicHelp::_motion_info $path 0 1]
483        $path tag bind $tagOrItem <Motion> \
484            [list DynamicHelp::_motion_info $path 0 1]
485        $path tag bind $tagOrItem <Leave> \
486            [list DynamicHelp::_leave_info  $path 0 1]
487
488        set _texts($path,$tagOrItem,variable) 1
489    }
490}
491
492
493proc DynamicHelp::_add_menu { path varName } {
494    variable _registered
495
496    set cpath [BWidget::clonename $path]
497    if { [winfo exists $cpath] } { set path $cpath }
498
499    set _registered($path) [list $varName]
500    _add_bind_tag $path BwHelpMenu
501}
502
503
504proc DynamicHelp::_add_menuentry { path text index } {
505    variable _registered
506
507    set idx  [lsearch $_registered($path) [list $index *]]
508    set list [list $index $text]
509    if { $idx == -1 } {
510	lappend _registered($path) $list
511    } else {
512	set _registered($path) \
513	    [lreplace $_registered($path) $idx $idx $list]
514    }
515}
516
517
518# ----------------------------------------------------------------------------
519#  Command DynamicHelp::_motion_balloon
520# ----------------------------------------------------------------------------
521proc DynamicHelp::_motion_balloon { type path x y {isCanvasItem 0} {isTextItem 0} } {
522    variable _top
523    variable _id
524    variable _delay
525    variable _current_balloon
526
527    set w $path
528    if {$isCanvasItem} {
529	set path [_get_canvas_path $path balloon]
530    } elseif {$isTextItem} {
531	set path [_get_text_path $path balloon]
532    }
533
534    if { $_current_balloon != $path && $type == "enter" } {
535        set _current_balloon $path
536        set type "motion"
537        destroy $_top
538    }
539    if { $_current_balloon == $path } {
540        if { $_id != "" } {
541            after cancel $_id
542            set _id ""
543        }
544        if { $type == "motion" } {
545            if { ![winfo exists $_top] } {
546                set cmd [list DynamicHelp::_show_help $path $w $x $y]
547                set _id [after $_delay $cmd]
548            }
549            # Bug 923942 proposes to destroy on motion to remove dynhelp on motion.
550            # this might be an optional behaviour in future versions
551        } else {
552            destroy $_top
553            set _current_balloon ""
554        }
555    }
556}
557
558
559# ----------------------------------------------------------------------------
560#  Command DynamicHelp::_motion_info
561# ----------------------------------------------------------------------------
562proc DynamicHelp::_motion_info { path {isCanvasItem 0} {isTextItem 0} } {
563    variable _saved
564    variable _registered
565    variable _current_variable
566
567    if {$isCanvasItem} {
568	set path [_get_canvas_path $path variable]
569    } elseif {$isTextItem} {
570	set path [_get_text_path $path variable]
571    }
572
573    if { $_current_variable != $path
574        && [info exists _registered($path,variable)] } {
575
576        set varName [lindex $_registered($path,variable) 0]
577        if {![info exists _saved]} { set _saved [GlobalVar::getvar $varName] }
578        set string [lindex $_registered($path,variable) 1]
579        if {[info exists _registered($path,command)]} {
580            set string [uplevel #0 $_registered($path,command)]
581        }
582        GlobalVar::setvar $varName $string
583        set _current_variable $path
584    }
585}
586
587
588# ----------------------------------------------------------------------------
589#  Command DynamicHelp::_leave_info
590#    Leave event may be called twice (in case of pointer grab)
591# ----------------------------------------------------------------------------
592proc DynamicHelp::_leave_info { path {isCanvasItem 0} {isTextItem 0} } {
593    variable _saved
594    variable _registered
595    variable _current_variable
596
597    if {$isCanvasItem} {
598	set path [_get_canvas_path $path variable]
599    } elseif {$isTextItem} {
600	set path [_get_text_path $path variable]
601    }
602
603    if { [string equal $_current_variable $path] \
604         && [info exists _registered($path,variable)] } {
605        set varName [lindex $_registered($path,variable) 0]
606        GlobalVar::setvar $varName $_saved
607        unset _saved
608        set _current_variable ""
609    }
610}
611
612
613# ----------------------------------------------------------------------------
614#  Command DynamicHelp::_menu_info
615# ----------------------------------------------------------------------------
616# We have to check for unmap event on Unix. On Windows, unmap
617# is not delivered, but <<MenuSelect>> is triggered appropriately when menu
618# is unmapped.
619proc DynamicHelp::_menu_info { event path } {
620    variable _registered
621
622    if { [info exists _registered($path)] } {
623        set index   [$path index active]
624        set varName [lindex $_registered($path) 0]
625        if { ![string equal $event "unmap"] &&
626             ![string equal $index "none"] &&
627             [set idx [lsearch $_registered($path) [list $index *]]] != -1 } {
628	    set string [lindex [lindex $_registered($path) $idx] 1]
629	    if {[info exists _registered($path,$index,command)]} {
630		set string [uplevel #0 $_registered($path,$index,command)]
631	    }
632            GlobalVar::setvar $varName $string
633        } else {
634            GlobalVar::setvar $varName ""
635        }
636    }
637}
638
639
640# ----------------------------------------------------------------------------
641#  Command DynamicHelp::_show_help
642# ----------------------------------------------------------------------------
643proc DynamicHelp::_show_help { path w x y } {
644    variable _top
645    variable _registered
646    variable _id
647    variable _delay
648
649    if { [Widget::getoption $_top -state] == "disabled" } { return }
650
651    if { [info exists _registered($path,balloon)] } {
652        destroy  $_top
653
654        set string $_registered($path,balloon)
655
656	if {[info exists _registered($path,balloonVar)]} {
657	    upvar #0 $_registered($path,balloonVar) var
658	    if {[info exists var]} { set string $var }
659	}
660
661        if {[info exists _registered($path,command)]} {
662            set string [uplevel #0 $_registered($path,command)]
663        }
664
665	if {$string == ""} { return }
666
667        toplevel $_top -relief flat \
668            -bg [Widget::getoption $_top -topbackground] \
669            -bd [Widget::getoption $_top -borderwidth] \
670            -screen [winfo screen $w]
671
672        wm withdraw $_top
673	if { $Widget::_aqua } {
674	    ::tk::unsupported::MacWindowStyle style $_top help none
675	} else {
676	    wm overrideredirect $_top 1
677	}
678
679	catch { wm attributes $_top -topmost 1 }
680
681        label $_top.label -text $string \
682            -relief flat -bd 0 -highlightthickness 0 \
683	    -padx       [Widget::getoption $_top -padx] \
684	    -pady       [Widget::getoption $_top -pady] \
685            -foreground [Widget::getoption $_top -foreground] \
686            -background [Widget::getoption $_top -background] \
687            -font       [Widget::getoption $_top -font] \
688            -justify    [Widget::getoption $_top -justify]
689
690
691        pack $_top.label -side left
692        update idletasks
693
694	if {![winfo exists $_top]} {return}
695
696        set  scrwidth  [winfo vrootwidth  .]
697        set  scrheight [winfo vrootheight .]
698        set  width     [winfo reqwidth  $_top]
699        set  height    [winfo reqheight $_top]
700
701        # On windows multi screen configurations, coordinates may get outside
702        # the main screen. We suppose that all screens have the same size
703        # because it is not possible to query the size of the other screens.
704
705        set screenx [expr {$x % $scrwidth} ]
706        set screeny [expr {$y % $scrheight} ]
707
708        # Increment the required size by the deplacement from the passed point
709        incr width 8
710        incr height 12
711
712        if { $screenx+$width > $scrwidth } {
713            set x [expr {$x + ($scrwidth - $screenx) - ($width - 8)}]
714        } else {
715            incr x 8
716        }
717        if { $screeny+$height > $scrheight } {
718            set y [expr {$y - $height}]
719        } else {
720            incr y 12
721        }
722
723        wm geometry  $_top "+$x+$y"
724        update idletasks
725
726	if {![winfo exists $_top]} { return }
727        wm deiconify $_top
728        raise $_top
729    }
730}
731
732# ----------------------------------------------------------------------------
733#  Command DynamicHelp::_unset_help
734# ----------------------------------------------------------------------------
735proc DynamicHelp::_unset_help { path } {
736    variable _canvases
737    variable _texts
738    variable _registered
739    variable _top
740    variable _current_balloon
741
742    if {[info exists _registered($path)]} { unset _registered($path) }
743    if {[winfo exists $path]} {
744	set cpath [BWidget::clonename $path]
745	if {[info exists _registered($cpath)]} { unset _registered($cpath) }
746    }
747    array unset _canvases   $path,*
748    array unset _texts      $path,*
749    array unset _registered $path,*
750    if {[string equal $path $_current_balloon]} {destroy $_top}
751}
752
753# ----------------------------------------------------------------------------
754#  Command DynamicHelp::_get_canvas_path
755# ----------------------------------------------------------------------------
756proc DynamicHelp::_get_canvas_path { path type {item ""} } {
757    variable _registered
758
759    if {$item == ""} { set item [$path find withtag current] }
760
761    ## Check the tags related to this item for the one that
762    ## represents our text.  If we have text specific to this
763    ## item or for 'all' items, they override any other tags.
764    eval [list lappend tags $item all] [$path itemcget $item -tags]
765    foreach tag $tags {
766	set check $path,$tag
767	if {![info exists _registered($check,$type)]} { continue }
768	return $check
769    }
770
771    return $path
772}
773
774# ----------------------------------------------------------------------------
775#  Command DynamicHelp::_get_text_path
776# ----------------------------------------------------------------------------
777proc DynamicHelp::_get_text_path { path type {item ""} } {
778    variable _registered
779
780    if {$item == ""} { set item [$path tag names current] }
781
782    ## Check the tags related to this item for the one that
783    ## represents our text.  If we have text specific to this
784    ## item or for 'all' items, they override any other tags.
785    eval [list lappend tags $item all] $item
786    foreach tag $tags {
787	set check $path,$tag
788	if {![info exists _registered($check,$type)]} { continue }
789	return $check
790    }
791
792    return $path
793}
794