File: Rosticons.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, buster, sid, trixie
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (792 lines) | stat: -rw-r--r-- 22,939 bytes parent folder | download | duplicates (4)
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
#  Rosticons.tcl --
#  
#      This file is part of The Coccinella application. 
#      It implements handling and parsing of roster icons.
#      
#  Copyright (c) 2005-2008  Mats Bengtsson
#  
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#  
# $Id: Rosticons.tcl,v 1.55 2008-08-14 10:52:34 matben Exp $

#  From disco-categories:
#
#  The "gateway" category consists of translators between Jabber/XMPP services 
#  and non-Jabber services. 
#
#   aim         Gateway to AOL IM               <identity category='gateway' type='aim'/> 
#   gadu-gadu   Gateway to the Gadu-Gadu        <identity category='gateway' type='gadu-gadu'/> 
#   http-ws     Gateway that provides HTTP Web Services access  <identity category='gateway' type='http-ws'/> 
#   icq         Gateway to ICQ                  <identity category='gateway' type='icq'/> 
#   msn         Gateway to MSN Messenger        <identity category='gateway' type='msn'/> 
#   qq          Gateway to the QQ IM service    <identity category='gateway' type='qq'/> 
#   sms         Gateway to Short Message Service  <identity category='gateway' type='sms'/> 
#   smtp        Gateway to the SMTP (email) network  <identity category='gateway' type='smtp'/> 
#   tlen        Gateway to the Tlen IM service  <identity category='gateway' type='tlen'/> 
#   yahoo       Gateway to Yahoo! Instant Messenger  <identity category='gateway' type='yahoo'/> 

package require Icondef

package provide Rosticons 1.0

namespace eval ::Rosticons {

    # Define all hooks for inits and preference settings.
    ::hooks::register prefsInitHook          ::Rosticons::InitPrefsHook
    ::hooks::register prefsBuildHook         ::Rosticons::BuildPrefsHook
    ::hooks::register prefsSaveHook          ::Rosticons::SavePrefsHook
    ::hooks::register prefsCancelHook        ::Rosticons::CancelPrefsHook
    ::hooks::register prefsUserDefaultsHook  ::Rosticons::UserDefaultsHook
    
    ::hooks::register themeChangedHook       ::Rosticons::ThemeChangedHook
    
    # The presence/show states.
    variable pstates
    set pstates(pres) {online offline invisible away chat dnd xa}

    # Application tree icon name.
    set pstates(app) {
	group-root-online group-root-offline 
	group-transport   group-pending 
	group-online      group-offline 
	folder-open       folder-closed  folder
    }
    set pstates(phone) {online ring talk}
    
    # 'imagesD' contains all available mappings from 'type' and 'status'
    # to images, even if they aren't used.
    variable imagesD [dict create]
    
    # 'tmpImagesD' is for temporary storage only (preferences) and maps
    # from 'themeName', 'type', and 'status' to images.
    variable tmpImagesD [dict create]

    variable stateD [dict create]

    # Define which iconsets that shall be active by default.
    set ::config(rost,theme,use,application) 1
    set ::config(rost,theme,use,phone)       1
    set ::config(rost,theme,use,user)        1
    
    # Define which icons must always be displayed.
    set ::config(rost,theme,must,application) 1
    set ::config(rost,theme,must,phone)       1
    set ::config(rost,theme,must,user)        1

    variable inited 0
}

proc ::Rosticons::Init {} {
    variable inited
    
    if {$inited} { return }
     
    # Investigates all sets available per 'type' and 'name' but doesn't
    # process anything.
    set types [ThemeGetAllTypes]
    set inited 1
}

proc ::Rosticons::ThemeExists {key} {
    variable imagesD
    lassign [split $key /] type sub
    return [dict exists imagesD $type $sub]
}

proc ::Rosticons::ThemeGetTypes {} {
    variable stateD   
    return [dict keys [dict get $stateD types]]
}

proc ::Rosticons::ThemeGetAllTypes {} {
    variable stateD
    
    # This should reset these states?
    dict set stateD types [list]
    dict set stateD paths [list]
    set typeD [dict create]
    
    foreach path [::Theme::GetAllThemePaths] {
	set name [file tail $path]
	set infoL [::Theme::GetInfo $path]
	set anyRoster 0
	foreach info $infoL {
	    if {[string match roster-* $info]} {
		set type [string map {"roster-" ""} $info]
		dict lappend typeD $type $name
		set anyRoster 1
	    }
	}
	if {$anyRoster} {
	    dict set stateD paths $name $path		
	}
    }
    dict set stateD types $typeD
      
    # Compile info.
    # 1) get all types:
    set types [dict keys [dict get $stateD types]]

    # 2) get all names for each type:
#     foreach type $types {
# 	set names [dict get $stateD types $type]
#     }
    return $types
}

# Rosticons::ThemeGet --
# 
#       Returns the image to use for this key.
#       
# Arguments:
#       typekey         type/subtype, ex: user/online, icq/xa, 
#                       application/* and phone/* are special
#       
# Results:
#       a valid image or empty.

proc ::Rosticons::ThemeGet {typekey args} {
    global jprefs
    variable stateD
    variable imagesD
    
    array set argsA {
	-forcethemed 0
    }
    array set argsA $args
        
    set typekey [string tolower $typekey]
    lassign [split $typekey /] type sub
    set sub [string map {available online unavailable offline} $sub]
    set suborig $sub
    
    if {$type eq "application"} {
	if {$jprefs(rost,theme,use,$type)} {
	    if {[dict exists $imagesD $type $sub]} {
		return [dict get $imagesD $type $sub]
	    }
	}
    } elseif {$type eq "phone"} {
	if {$jprefs(rost,theme,use,$type)} {
	    set sub [string map {dialed talk} $sub]
	    set sub [string map {on_phone talk} $sub]
	    set sub [string map {hang_up talk} $sub]
	    if {[dict exists $imagesD $type $sub]} {
		return [dict get $imagesD $type $sub]
	    }
	}
    } else {
	
	# Check if this type is active. Use 'user' as fallback.
	if {![info exists jprefs(rost,theme,use,$type)]} {
	    set type "user"
	}
	if {!$argsA(-forcethemed) && !$jprefs(rost,theme,use,$type)} {
	    set type "user"
	}	
	set key $type/$sub
	if {[dict exists $imagesD $type $sub]} {
	    return [dict get $imagesD $type $sub]
	}
	
	# See if we can match the 'type'. Use 'user' as fallback.
	set types [dict keys [dict get $stateD types]]
	if {$type ni $types} {
	    set type "user"
	}
	
	# First try to find a fallback for the sub part.
	set sub [string map {invisible offline} $sub]
	set sub [string map {ask offline} $sub]
	set sub [string map {chat online} $sub]
	if {[dict exists $imagesD $type $sub]} {
	    return [dict get $imagesD $type $sub]
	}
	set sub [string map {xa away} $sub]
	set sub [string map {dnd away} $sub]
	if {[dict exists $imagesD $type $sub]} {
	    return [dict get $imagesD $type $sub]
	}
	set sub [string map {away online} $sub]
	if {[dict exists $imagesD $type $sub]} {
	    return [dict get $imagesD $type $sub]
	}
	
	# If still not matched select type=user which must be there.
	set sub $suborig
	if {[dict exists $imagesD user $sub]} {
	    return [dict get $imagesD user $sub]
	}
	set sub [string map {invisible offline} $sub]
	set sub [string map {ask offline} $sub]
	set sub [string map {chat online} $sub]
	if {[dict exists $imagesD user $sub]} {
	    return [dict get $imagesD user $sub]
	}
	set sub [string map {xa away} $sub]
	set sub [string map {dnd away} $sub]
	if {[dict exists $imagesD user $sub]} {
	    return [dict get $imagesD user $sub]
	}
    }
    return
}

proc ::Rosticons::ThemeLoadSetTmp {type name} {
    if {$type eq "application"} {
	ThemeLoadApplicationTmp $name
    } elseif {$type eq "phone"} {
	ThemeLoadPhoneTmp $name
    } else {
	ThemeLoadTypeTmp $type $name
    }
}

# Rosticons::ThemeLoadApplicationTmp --
#
#       Loads all 'application' type roster icons from a set.
#       It uses fallbacks to ordinary themes.

proc ::Rosticons::ThemeLoadApplicationTmp {name} {
    variable stateD
    variable tmpImagesD
    variable pstates

    set type "application"
    dict set tmpImagesD $name $type [list]
    
    # Here we start searching the roster theme 'name' and use fallbacks.
    set path [list [::Theme::GetPath $name]]
    set paths [concat $path [::Theme::GetPresentSearchPaths]]
    foreach app $pstates(app) {
	set spec icons/16x16/$app
	set image [::Theme::MakeIconFromPaths $spec "" $paths]
	if {$image ne ""} {
	    dict set tmpImagesD $name $type $app $image 
	}
    }
    return
}

proc ::Rosticons::ThemeLoadPhoneTmp {name} {
    variable stateD
    variable tmpImagesD
    variable pstates

    set type "phone"
    dict set tmpImagesD $name $type [list]
     
    set paths [list [::Theme::GetPath $name]]
    foreach key $pstates(phone) {
	set spec icons/16x16/phone-$key
	set image [::Theme::MakeIconFromPaths $spec "" $paths]
	if {$image ne ""} {
	    dict set tmpImagesD $name $type $key $image 
	}
    }
    return
}

# Rosticons::ThemeLoadTypeTmp --
#
#       Creates all relevant images from an iconset.

proc ::Rosticons::ThemeLoadTypeTmp {type name} {
    variable stateD
    variable tmpImagesD
    variable pstates
    
    dict set tmpImagesD $name $type [list]
    if {$type eq "user"} {
	set isUser 1
    } else {
	set isUser 0
    }
    
    # If an iconset is missing an icon for one of the states,
    # do the fallback within the theme and not to any other theme.
    set paths [list [::Theme::GetPath $name]]
    
    # gadu-gadu shall map to gadugadu but only for image lookup.
    set mtype [string map {"-" ""} $type]
    foreach key $pstates(pres) {
	# We keep an alternative lookup mechanism here.
	# set spec icons/16x16/$type-$key
	if {$isUser} {
	    set spec icons/16x16/user-$key
	} else {
	    set spec icons/16x16/user-$key-$mtype
	}
	
	# Since we create new images we must do garbage collecting ourselfes.
	set image [::Theme::MakeIconFromPaths $spec "" $paths]
	if {$image ne ""} {
	    dict set tmpImagesD $name $type $key $image 
	}
    }
    return
}

# Rosticons::ThemeSetFromTmp --
# 
#       Sets the specified iconset. It just copies the relevant dict elements
#       from 'tmpImagesD' to 'imagesD'.
#       The corresponding entries of 'tmpImagesD' are unset since images copied.

proc ::Rosticons::ThemeSetFromTmp {type name} {
    variable imagesD
    variable tmpImagesD

    dict for {key image} [dict get $tmpImagesD $name $type] {
	dict set imagesD $type $key $image
    }
    dict unset tmpImagesD $name $type
}

# Preference hooks -------------------------------------------------------------

proc ::Rosticons::InitPrefsHook {} {
    global config this jprefs
    variable stateD

    set jprefs(rost,haveWBicons) 1
    
    # We need to do this here since we depend on it.
    Init
    
    # Find all types dynamically...
    set types [dict keys [dict get $stateD types]]
    
    # Define all our prefs settings.
    set plist [list]
    foreach type $types {
	set names [dict get $stateD types $type]
	set key "rost,theme,name,$type"
	set jprefs($key) [lindex $names 0]
	set name  jprefs($key)
	set rsrc  jprefs_rost_theme_name_$type
	set value [set $name]
	lappend plist [list $name $rsrc $value]

	set key "rost,theme,use,$type"
	if {[info exists config($key)] && $config($key)} {
	    set jprefs($key) $config($key)
	} else {
	    set jprefs($key) 0	    
	}
	
	# Add only the ones that can be optional.
	set must 0
	set key "rost,theme,must,$type"
	if {[info exists config($key)] && $config($key)} {
	    set must 1
	}
	if {!$must} {
	    set name  jprefs(rost,theme,use,$type)
	    set rsrc  jprefs_rost_theme_use_$type
	    set value [set $name]
	    lappend plist [list $name $rsrc $value]
	}
    }    
    ::PrefUtils::Add $plist
    
    VerifyAndLoad
}

proc ::Rosticons::VerifyAndLoad {} {
    global this jprefs
    variable stateD
    
    set types [dict keys [dict get $stateD types]]
    
    # Treat each 'type' in turn. Verify that exists.
    # This must be done after we have read and set our preferences.
    foreach type $types {
 	set key "rost,theme,name,$type"
 	set name $jprefs($key)
 	if {[::Theme::GetPath $name] eq ""} {
	    
	    # Theme doesn't exist. Try to find a fallback theme.
	    set names [dict get $stateD types $type]
	    set jprefs($key) [lindex $names 0]
	    set jprefs(rost,theme,use,$type) 0
 	}
	ThemeLoadSetTmp $type $name
	ThemeSetFromTmp $type $name
    }
}

proc ::Rosticons::BuildPrefsHook {wtree nbframe} {
    
    # TRANSLATORS: themes for the contact icons (different presence state icons); see preferences
    ::Preferences::NewTableItem {Jabber "Theme Rosticons"} [mc "Contact Icons"]
    
    set wpage [$nbframe page "Theme Rosticons"]    
    TBuildPrefsPage $wpage
}

proc ::Rosticons::TBuildPrefsPage {wpage} {
    variable wselect
    variable wshow
 
    set wc $wpage.c
    ttk::frame $wc -padding [option get . notebookPageSmallPadding {}]
    pack $wc -side top -fill both -expand 1 \
      -anchor [option get . dialogAnchor {}]
    
    set box $wc.b
    ttk::frame $wc.b
    pack $box -side top
    
    # Style selection tree:
    set lbox $box.l
    set wysc    $lbox.ysc
    set wselect $lbox.t   

    frame $lbox -relief sunken -bd 1    
    
    ttk::scrollbar $wysc -orient vertical -command [list $wselect yview]
    TPTreeSelect $wselect $wysc

    grid  $wselect  -row 0 -column 0 -sticky news
    grid  $wysc     -row 0 -column 1 -sticky ns
    grid columnconfigure $lbox 0 -weight 1   
     
    TPFillTree $wselect

    # Show iconset tree:
    set rbox $box.r
    set wysc  $rbox.ysc
    set wshow $rbox.t    

    frame $rbox -relief sunken -bd 1    
    
    ttk::scrollbar $wysc -orient vertical -command [list $wselect yview]
    PTreeShow $wshow $wysc

    grid  $wshow  -row 0 -column 0 -sticky news
    grid  $wysc   -row 0 -column 1 -sticky ns
    grid columnconfigure $rbox 0 -weight 1   
        
    set msg $box.msg
    ttk::label $msg -text [mc "Select iconsets for each group. A deselected group will use the normal iconset."]

    grid  $lbox  x  $rbox  -sticky ew
    grid  $msg   -  -      -sticky w -pady 4
    grid columnconfigure $box 1 -minsize 12
    
    $wselect selection add user
    
    bind $wpage <Destroy> [namespace current]::PFree
}

proc ::Rosticons::TPTreeSelect {T wysc} {
    global  this
    
    treectrl $T -selectmode single  \
      -showroot 0 -showrootbutton 0 -showbuttons 1 -showheader 0  \
      -borderwidth 0 -highlightthickness 0 -indent 10 \
      -yscrollcommand [list $wysc set]
       
    # This is a dummy option.
    set itemBackground [option get $T itemBackground {}]
    set fill [list $this(sysHighlight) {selected focus} gray {selected !focus}]
    set bd [option get $T columnBorderWidth {}]
    set bg [option get $T columnBackground {}]
    set fg [option get $T textColor {}]
    
    $T column create -tags cButton -resize 0 -borderwidth $bd  \
      -background $bg -textcolor $fg -squeeze 1
    $T column create -tags cTree   -resize 0 -borderwidth $bd  \
      -background $bg -textcolor $fg -expand 1
    $T configure -treecolumn cTree

    $T element create eText text -lines 1
    $T element create eButton window
    $T element create eBorder rect -open new -outline white -outlinewidth 1 \
      -fill $fill -showfocus 1

    set S [$T style create styButton]
    $T style elements $S {eBorder eButton}
    $T style layout $S eButton
    $T style layout $S eBorder -detach yes -iexpand xy -indent 0

    set S [$T style create styStd]
    $T style elements $S {eBorder eText}
    $T style layout $S eText -padx 4 -squeeze x -expand ns -ipady 2
    $T style layout $S eBorder -detach yes -iexpand xy -indent 0

    set S [$T style create styTag]
    $T style elements $S {eText}

    $T column configure cButton -itemstyle styButton
    $T column configure cTree -itemstyle styStd

    $T notify bind $T <Selection>  { ::Rosticons::TPOnSelect %T }
}

proc ::Rosticons::TPOnSelect {T} {
    variable ptmp
    
    set item [$T selection get]
    if {[llength $item] == 1} {
	set tag [lindex [$T item tag names $item] 0]
	if {[llength $tag] == 1} {
	    set type $tag
	    set name $ptmp(name,$type)
	    TPFillKeyImageTree $type $name   
	} elseif {[llength $tag] == 2} {
	    lassign $tag type name
	    TPFillKeyImageTree $type $name   
	}
    }
}

proc ::Rosticons::TPFillTree {T} {
    global config jprefs
    variable stateD
    variable ptmp
    
    set types [dict keys [dict get $stateD types]]

    foreach type $types {
	set ptmp(use,$type)  $jprefs(rost,theme,use,$type)
	set ptmp(name,$type) $jprefs(rost,theme,name,$type)
    }
   
    set i 0

    foreach type $types {
	set wcheck $T.[incr i]
	checkbutton $wcheck -bg white -highlightthickness 0 \
	  -variable [namespace current]::ptmp(use,$type)

	set key "rost,theme,must,$type"
	if {[info exists config($key)] && $config($key)} {
	    $wcheck configure -state disabled
	}

	if {$type eq "user"} {
	    set typeName [mc "Standard"]
	} elseif {$type eq "application"} {
	    set typeName [mc "Groups"]
	} elseif {$type eq "phone"} {
	    set typeName [mc "Phone"]
	} elseif {$type eq "smtp"} {
	    set typeName [mc "Email"]
	} else {
	    set typeName [::Roster::GetNameFromTrpt $type]
	}
	set pitem [$T item create -open 1 -button 1 -parent root -tags $type]
	$T item element configure $pitem cButton eButton -window $wcheck
	$T item element configure $pitem cTree eText -text $typeName \
	  -font CociSmallBoldFont

	set names [dict get $stateD types $type]
    
	foreach name $names {
	    set wradio $T.[incr i]
	    radiobutton $wradio -bg white -highlightthickness 0 \
	      -variable [namespace current]::ptmp(name,$type)  \
	      -value $name
	    
	    if {$name eq "default"} {
		set str [mc "Default"]
	    } else {
		set str $name
	    }
	    
	    set tag [list $type $name]
	    set item [$T item create -parent $pitem -tags [list $tag]]
	    $T item element configure $item cButton eButton -window $wradio
	    $T item element configure $item cTree eText -text $str
	}
	if {[llength $names] == 1} {
	    $wradio configure -state disabled
	}
    }    
}

proc ::Rosticons::PTreeShow {T wysc} {
    
    treectrl $T -showroot 0 -showrootbutton 0 -showbuttons 1 -showheader 1 \
      -borderwidth 0 -highlightthickness 0 -indent 10  \
      -yscrollcommand [list $wysc set]
 
    set bd [option get $T columnBorderWidth {}]
    set bg [option get $T columnBackground {}]
    set fg [option get $T textColor {}]
   
    $T column create -tags cKey   -text [mc "Key"] -expand 1 -squeeze 1  \
      -borderwidth $bd -background $bg -textcolor $fg
    $T column create -tags cImage -text [mc "Icon"] -expand 1 -justify center  \
      -borderwidth $bd -background $bg -textcolor $fg

    $T element create eText text -lines 1
    $T element create eImage image

    set S [$T style create styText]
    $T style elements $S {eText}
    $T style layout $S eText -padx 6 -pady 2

    set S [$T style create styImage]
    $T style elements $S {eImage}
    $T style layout $S eImage -padx 6 -pady 2 -expand ew

    $T column configure cKey -itemstyle styText
    $T column configure cImage -itemstyle styImage
}

proc ::Rosticons::TPFillKeyImageTree {type name} {
    variable wselect
    variable wshow
    variable tmpImagesD
    variable stateD
    
    # All images used here are created new. Never share any imagesD.
    if {![dict exists $tmpImagesD $name $type]} {
	ThemeLoadSetTmp $type $name
    }
    set T $wshow
    $T item delete all
    
    dict for {key image} [dict get $tmpImagesD $name $type] {
	set item [$T item create -parent root]
	$T item element configure $item cKey eText -text $key
	$T item element configure $item cImage eImage -image $image
    }
}

proc ::Rosticons::SavePrefsHook {} {
    global jprefs
    variable ptmp
    variable stateD
    variable tmpImagesD
    variable imagesD
    
    set changed [PChanged]
    set types [dict keys [dict get $stateD types]]
    
    set prevImagesD $imagesD

    foreach type $types {
	if {$jprefs(rost,theme,name,$type) ne $ptmp(name,$type)} {
	    set name $ptmp(name,$type)
	    if {![dict exists $tmpImagesD $name $type]} {
		ThemeLoadSetTmp $type $name
	    }
	    ThemeSetFromTmp $type $name
	}
	set jprefs(rost,theme,use,$type)  $ptmp(use,$type)
	set jprefs(rost,theme,name,$type) $ptmp(name,$type)
    }
    if {$changed} {
	# @@@ Move this to hook???
	::Roster::RepopulateTree
	::hooks::run rosterIconsChangedHook
    
	# Garbage collect old images. Be sure that all users of roster icons
	# use the 'rosterIconsChangedHook' to refresh new icons.
	GarbageCollect $prevImagesD $imagesD
    }
}

proc ::Rosticons::GarbageCollect {prevImagesD imagesD} {
       
    # Garbage collect old images. Be sure that all users of roster icons
    # use the 'rosterIconsChangedHook' to refresh new icons.
    dict for {type typeD} $imagesD {
	dict for {pres image} $typeD {
	    set prevImage [dict get $prevImagesD $type $pres]
	    if {$prevImage ne $image} {
		
		# There is no danger with this since if inuse
		# it wont get deleted until widget is.
		image delete $prevImage
	    }
	}
    }
}

proc ::Rosticons::CancelPrefsHook {} {
    if {[PChanged]} {
	::Preferences::HasChanged
    }
}

proc ::Rosticons::PChanged {} {
    global jprefs
    variable ptmp
    variable stateD
    
    set changed 0
    set types [dict keys [dict get $stateD types]]
    foreach type $types {
	if {$jprefs(rost,theme,use,$type) ne $ptmp(use,$type)} {
	    set changed 1
	    break
	}
	if {$jprefs(rost,theme,name,$type) ne $ptmp(name,$type)} {
	    set changed 1
	    break
	}
    }
    return $changed
}

proc ::Rosticons::UserDefaultsHook {} {
    # @@@ TODO
}

proc ::Rosticons::PFree {} {
    variable ptmp
    variable tmpImagesD

    dict for {name typeD} $tmpImagesD {
	dict for {type imagesD} $typeD {
	    dict for {key image} $imagesD {
		image delete $image
	    }
	}
    }
    unset tmpImagesD
    unset -nocomplain ptmp
    set tmpImagesD [dict create]
}

proc ::Rosticons::ThemeChangedHook {} {
    global prefs jprefs
    variable stateD
    variable imagesD

    set prevImagesD $imagesD

    # Loop through each type and switch roster icon theme if new theme
    # supports it.
    set name $prefs(themeName)
    set path [::Theme::GetPath $name]
    set infoL [::Theme::GetInfo $path]
    dict for {type nameL} [dict get $stateD types] {
	if {$jprefs(rost,theme,name,$type) eq $name} { 
	    continue 
	}
	if {"roster-$type" in $infoL} {
	    ThemeLoadSetTmp $type $name
	    ThemeSetFromTmp $type $name	
	}
    }    
    GarbageCollect $prevImagesD $imagesD
}

#-------------------------------------------------------------------------------