2 # Fubar plug-in to handle phonebook
3 if [catch {package require Img} msg] {
4 puts stderr "Failed to load IMG package: $msg"
9 if {![file exists ~/.phonebook.vcf]} {
10 error "Phonebook file $env(HOME)/.phonebook.vcf not found"
12 namespace eval phonebook {
13 # Returns true if phonebook was reread, false if it is not changed
15 proc read_phonebook {} {
17 variable phonebookstamp
18 if {[info exists phonebookstamp]&&[file mtime ~/.phonebook.vcf]<$phonebookstamp} {
21 if {[info exists phones]} {unset phones}
22 set f [open ~/.phonebook.vcf r]
23 fconfigure $f -encoding utf-8
25 while {[gets $f line]>=0} {
26 if {![string length $line]} continue
27 if {$state eq "photo"} {
28 if {![regexp ":" $line]} {
29 set index [lindex [array names cur_record "PHOTO*"] 0]
30 append cur_record($index) "$line\n"
36 foreach {field value} [split $line :] break
37 set list [split $field ";"]
38 if {[llength $list>1]} {
39 set field [lindex $list 0]
40 if {$field != "N" && $field != "FN" } {
41 foreach opt [lrange $list 1 end] {
42 if {[string match CHARSET=* $opt]||
43 [string match ENCODING=* $opt]||
44 $opt eq "PREF"} continue
49 if {$field eq "END"} {
50 assemble_record cur_record
52 array unset cur_record
53 } elseif {$field eq "BEGIN"} {
54 if {[info exists currecord]} {
55 array unset cur_record
59 if {[string match "PHOTO*" $field]} {
60 set cur_record($field) "$value\n"
63 set cur_record($field) ""
64 foreach subval [split $value ";"] {
65 set cur_record($field) "$subval $cur_record($field)"
71 set phonebookstamp [clock seconds]
75 proc assemble_record {var} {
78 if {[info exists record(FN)]} {
80 } elseif {[info exists record(N)]} {
82 } elseif {[info exists record(NICKNAME)]} {
83 set index $record(NICKNAME)
85 if [info exists record(ORG)] { append index ",$record(ORG)"}
86 if [info exists record(TITLE)] { append index ",$record(TITLE)"}
87 if {![info exists index]} {
88 after idle "error \"record [array get record] has no name\""
90 set phones($index) [array get record]
94 wm title $w "Phone book"
96 entry $w.search.pattern
97 button $w.search.loc -text "Find"\
98 -command [list ::phonebook::position $w]
99 button $w.search.filter -text "Filter"\
100 -command [list ::phonebook::filter $w]
101 button $w.search.new -text "New"\
102 -command [list ::phonebook::new_rec $w]
103 bind $w.search.pattern <Key-Return> [list $w.search.loc invoke]
104 bind $w.search.pattern <Control-Return> [list $w.search.filter invoke]
105 bind $w.search.pattern <Control-n> [list $w.search.new invoke]
106 pack $w.search.pattern -side left -fill x -expand y
107 pack $w.search.loc $w.search.filter $w.search.new -side left
108 listbox $w.list -yscrollcommand "$w.y set" -width 20
109 bind $w.list <<ListboxSelect>> "::phonebook::show_record $w \[%W get \[%W curselection\]\]"
110 bind $w.list <Key> [list ::phonebook::keyEvent $w.search.pattern %k %s %A %K]
111 scrollbar $w.y -orient vert -command "$w.list yview"
113 foreach {name title} {name "Name" org "Organization" title "Title"
114 telcell "Tel. Cell" telwork "Tel. Work" telhome "Tel. Home" telother
115 "Other" fax "Fax" email "E-Mail"} {
116 label $w.record.l$name -text $title -anchor e
117 label $w.record.$name -anchor w
118 grid $w.record.l$name $w.record.$name -sticky news
120 label $w.record.image
121 button $w.record.edit -text Edit -command "::phonebook::edit_record"
122 button $w.record.mail -text Mail -state disabled -command "::phonebook::mail_to"
123 grid $w.record.image - -sticky news
124 grid $w.record.mail $w.record.edit -sticky ns
125 grid columnconfigure $w.record 1 -weight 1
126 grid columnconfigure $w.record 0 -weight 0
127 grid $w.search - - -sticky news
128 grid $w.list $w.y $w.record -sticky news
129 grid columnconfigure $w 0 -weight 1
130 grid columnconfigure $w 1 -weight 0
131 grid columnconfigure $w 2 -weight 1
133 proc keyEvent {window keycode state char keysym} {
134 if {![string length $char]} return;#ignore noncharacter keys
136 event generate $window <KeyPress> -keycode $keycode -keysym $keysym\
137 -state $state -when tail
139 proc show_record {w index} {
142 if {[info exists phones($index)]} {
143 array set record $phones($index)
147 if {[info exists current]} {unset current}
150 $w.record.name configure -text $index
151 set_if_exists $w.record.org record(ORG)
152 set_if_exists $w.record.title record(TITLE)
153 set_if_exists $w.record.telcell "record(TEL CELL)"
154 set_if_exists $w.record.telhome "record(TEL HOME)"
155 set_if_exists $w.record.telwork "record(TEL WORK)"
156 set_if_exists $w.record.telother "record(TEL)"
157 set_if_exists $w.record.fax "record(TEL FAX)"
158 set_if_exists $w.record.email "record(EMAIL INTERNET)"
159 if {[info exists "record(EMAIL INTERNET)"]} {
160 $w.record.mail configure -state normal
162 $w.record.mail configure -state disabled
165 if {[llength [set img_index [lindex [array names record PHOTO*] 0]]]} {
166 if {![regexp {TYPE=([^[:space:]]+)} $img_index msg fmt]} {
169 if {!$::noImg || $fmt eq "GIF" || $fmt eq "PPM"} {
170 $w.record.image configure -image [image create photo -format $fmt -data $record($img_index)]
176 $w.record.image configure -image ""
180 proc set_if_exists {w var} {
182 if {[info exists v]} {
183 $w configure -text $v
185 $w configure -text {}
189 proc fill_window {w} {
194 set list [lsort [array names phones]]
195 if {[info exists filter]} {
196 set list [lsearch -all -inline -regexp $list $filter ]
199 eval $w.list insert 0 $list
200 if {![info exists current]||[set index [lsearch -exact $list $current]]<0} {
203 $w.list selection clear 0 end
204 $w.list selection set $index
205 event generate $w.list <<ListboxSelect>>
206 after idle "$w.list see $index;focus $w.list"
207 focus $w.search.pattern
211 set pattern [$w.search.pattern get]
212 set list [$w.list get 0 end]
213 set index [lsearch -regexp $list $pattern]
215 $w.list selection clear 0 end
216 $w.list selection set $index
217 event generate $w.list <<ListboxSelect>>
218 after idle "$w.list see $index;focus $w.list"
224 set filter [$w.search.pattern get]
225 if {![string length $filter]} {
231 # Create an interface
233 if {$::argv0 ne [info script]} {
235 $m add command -label "Phone..." -command\
236 "create_or_raise .phonebook ::phonebook::mkwindow; ::phonebook::fill_window .phonebook"
238 button .b -text "Phonebook" -command "toplevel .phonebook;
239 ::phonebook::mkwindow .phonebook
240 ::phonebook::fill_window .phonebook"
248 array set r $phones($current)
249 if {![info exists "r(EMAIL INTERNET)"]} {
252 set address ${r(EMAIL INTERNET)}
253 exec $CONFIGDIR/mail $address &
262 proc edit_record {} {
270 proc edit_window {} {