File: Servicons.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 (144 lines) | stat: -rw-r--r-- 4,353 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
#  Servicons.tcl --
#  
#      This file is part of The Coccinella application. 
#      It implements handling and parsing of service (disco) icons.
#      Icons are specified as in 
#      http://www.xmpp.org/registrar/disco-categories.html
#      where elements like <identity category='client' type='web'/>
#      are mapped to a lookup key client/web and so on.
#      
#  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: Servicons.tcl,v 1.21 2008-06-09 09:51:00 matben Exp $

# @@@ TODO: Make servicon sets configurable. See Rosticons.

package require Icondef

package provide Servicons 1.0

namespace eval ::Servicons {

    # Other init hooks depend on us!
    ::hooks::register initHook          ::Servicons::ThemeInitHook    20
    ::hooks::register themeChangedHook  ::Servicons::ThemeChangedHook

    # 'imagesD' contains all available mappings from 'category' and 'type'
    # to images, even if they aren't used.
    variable imagesD [dict create]
    
    # 'tmpImagesD' is for temporary storage only (preferences) and maps
    # from 'themeName', 'category', and 'type' to images.
    variable tmpImagesD [dict create]

    variable stateD [dict create]
        
    variable alias
    array set alias {
	services/jabber       server/im
	pubsub/generic        pubsub/service
	search/text           directory/user
    }
}

proc ::Servicons::ThemeInitHook {} {
    global jprefs
    variable priv
    variable stateD

    # @@@ TODO
    set jprefs(disco,themeName) ""
    set names [::Theme::GetAllWithFilter service]
    
    
}

# Idea for custom themes different from major theme selection:
# 1) Must have image auto naming or name them ourself.
# 2) Search icons as:
#    set paths [list [::Theme::GetPath $jprefs(disco,themeName)] \
#       [::Theme::GetPresentSearchPaths]  
#    set image [::Theme::MakeIconFromPaths $spec $name $paths]
# 3) Naming can be as: ::service::$pec
# 4) When switching theme then just delete all ::service::* images.
# 5) As an elternative just let 'imagesD' be a cache for image names
#    created for a specific theme and then delete them when switched to
#    a new theme. Or have some image copy mechanism from new to old.

proc ::Servicons::ThemeGet {key} {
    variable imagesD
    variable priv
    variable alias
    
    set key [string map [array get alias] $key]
    lassign [split $key /] category type
        
    # This is a fast lookup mechanism.
    if {[dict exists $imagesD $category $type]} {
	return [dict get $imagesD $category $type]
    }

    # gadu-gadu shall map to gadugadu but only for image lookup.
    set mtype [string map {"-" ""} $type]
    
    if {$category eq "gateway"} {
	set spec icons/16x16/protocol-$mtype
    } else {
	set spec icons/16x16/service-$category-$mtype
    }
    set image [::Theme::FindIcon $spec]
    if {$image ne ""} {
	dict set imagesD $category $type $image 
    }
    return $image
}

proc ::Servicons::ThemeGetFromTypeList {typeL} {

    set len [llength $typeL]
    if {$len == 0} {
	return 
    } elseif {$len == 1} {
	return [ThemeGet [lindex $typeL 0]]
    } else {
	
	# Do a priority lookup.
	foreach cat {server gateway} {
	    set service [lsearch -glob -inline $typeL $cat/*]
	    if {$service ne ""} {
		return [ThemeGet $service]
	    }
	}
	foreach type $typeL {
	    set image [ThemeGet $type]
	    if {$image ne ""} {
		return $image
	    }
	}
    }
    return
}

proc ::Servicons::ThemeChangedHook {} {
    variable imagesD
    
    # We must clear out our cached info since that is outdated.
    # NB: We never delete any iamges.
    unset imagesD
    set imagesD [dict create]
}

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