plugins/phone_vcf

   1 #!/usr/bin/wish
   2 # Fubar plug-in to handle phonebook
   3 package require Img
   4 if {![file exists ~/.phonebook.vcf]} {
   5         error "Phonebook file $env(HOME)/.phonebook.vcf not found"
   6 }
   7 namespace eval phonebook {
   8         # Returns true if phonebook was reread, false if it is not changed
   9         #
  10         proc read_phonebook {} {
  11                 variable phones
  12                 variable phonebookstamp
  13                 if {[info exists phonebookstamp]&&[file mtime ~/.phonebook.vcf]<$phonebookstamp} {
  14                         return 0
  15                 }
  16                 if {[info exists phones]} {unset phones}
  17                 set f [open ~/.phonebook.vcf r]
  18                         fconfigure $f -encoding utf-8
  19                         set state "none"
  20                         while {[gets $f line]>=0} {
  21                                 if {![string length $line]} continue
  22                                 if {$state eq "photo"} {
  23                                         if {![regexp ":" $line]} {
  24                                                 set index [lindex [array names cur_record "PHOTO*"] 0]
  25                                                 append cur_record($index) "$line\n"
  26                                                         continue
  27                                         } else {
  28                                                 set state "record"
  29                                         }
  30                                 }
  31                                 foreach {field value} [split $line :] break
  32                                 set list [split $field ";"]
  33                                 if {[llength $list>1]} {
  34                                         set field [lindex $list 0]
  35                                                 foreach opt [lrange $list 1 end] {
  36                                                         if {[string match CHARSET=* $opt]||
  37                                                                 [string match ENCODING=* $opt]||
  38                                                                         $opt eq "PREF"} continue
  39                                                         lappend field $opt
  40                                                 }
  41                                 }
  42                                 if {$field eq "END"} {
  43                                         assemble_record cur_record
  44                                         set state "none"
  45                                         array unset cur_record
  46                                 } elseif {$field eq "BEGIN"} {
  47                                         if {[info exists currecord]} {
  48                                                 array unset cur_record
  49                                         }
  50                                         set state "record"
  51                                 } else {
  52                                         if {[string match "PHOTO*" $field]}      {
  53                                                 set cur_record($field) "$value\n"
  54                                                 set state "photo"
  55                                         } else {
  56                                                 set cur_record($field) ""
  57                                                 foreach subval [split $value ";"] {
  58                                                         set cur_record($field) "$subval $cur_record($field)"
  59                                                 }
  60                                         }
  61                                 }
  62                         }
  63                 close $f
  64                         set phonebookstamp [clock seconds]
  65                         return 1
  66         }
  67
  68         proc assemble_record  {var} {
  69                 upvar $var record
  70                 variable phones
  71                 set index $record(N)
  72                 if [info exists record(ORG)] { append index ",$record(ORG)"}
  73                 if [info exists record(TITLE)] { append index ",$record(TITLE)"}
  74                 set phones($index) [array get record]
  75         }
  76
  77         proc mkwindow {w} {
  78                 wm title $w "Phone book"
  79                         frame $w.search
  80                         entry $w.search.pattern
  81                         button $w.search.loc -text "Find"\
  82                                         -command [list ::phonebook::position $w]
  83                         button $w.search.filter -text "Filter"\
  84                                         -command [list ::phonebook::filter $w]
  85                         button $w.search.new -text "New"\
  86                                         -command [list ::phonebook::new_rec $w]
  87                         bind $w.search.pattern <Key-Return> [list $w.search.loc invoke]
  88                         bind $w.search.pattern <Control-Return> [list $w.search.filter invoke]
  89                         bind $w.search.pattern <Control-n> [list $w.search.new invoke]
  90                         pack $w.search.pattern -side left -fill x -expand y
  91                         pack $w.search.loc $w.search.filter $w.search.new -side left
  92                         listbox $w.list -yscrollcommand "$w.y set" -width 20
  93                         bind $w.list <<ListboxSelect>> "::phonebook::show_record $w \[%W get \[%W curselection\]\]"
  94                         bind $w.list <Key> [list ::phonebook::keyEvent $w.search.pattern %k %s %A %K]
  95                         scrollbar $w.y -orient vert -command "$w.list yview"
  96                         frame $w.record
  97                         foreach {name title} {name "éÍÑ" org "ïÒÇÁÎÉÚÁÃÉÑ" title "ú×ÁÎÉÅ"
  98                                 telcell "ôÅÌ. íÏÂ" telwork "ôÅÌ.òÁÂ." telhome "ôÅÌ.äÏÍ." telother
  99                                         "ðÒÏÞÅÅ" fax "æÁËÓ" email "E-Mail"} {
 100                                                 label $w.record.l$name -text $title -anchor e
 101                                                         label $w.record.$name -anchor w
 102                                                         grid $w.record.l$name $w.record.$name -sticky news
 103                                         }
 104                 label $w.record.image
 105                 button $w.record.edit -text Edit -command "::phonebook::edit_record"
 106                 button $w.record.mail -text Mail -state disabled -command "::phonebook::mail_to"
 107                         grid $w.record.image - -sticky news
 108                         grid $w.record.mail $w.record.edit -sticky ns
 109                         grid columnconfigure $w.record 1 -weight 1
 110                         grid columnconfigure $w.record 0 -weight 0
 111                         grid $w.search - - -sticky news
 112                         grid $w.list $w.y $w.record -sticky news
 113                         grid columnconfigure $w 0 -weight 1
 114                         grid columnconfigure $w 1 -weight 0
 115                         grid columnconfigure $w 2 -weight 1
 116         }
 117         proc keyEvent {window keycode state char keysym} {
 118                 if {![string length $char]} return;#ignore noncharacter keys
 119                 focus $window
 120                 event generate $window <KeyPress> -keycode $keycode -keysym $keysym\
 121                                 -state $state -when tail
 122         }
 123         proc show_record {w index} {
 124                 variable phones
 125                 variable current
 126                 if {[info exists phones($index)]}  {
 127                         array set record $phones($index)
 128                                 set current $index
 129                 } else {
 130                         array set record {}
 131                         if {[info exists current]} {unset current}
 132                 }
 133                 $w.record.name configure -text $record(N);
 134                 set_if_exists $w.record.org record(ORG)
 135                 set_if_exists $w.record.title record(TITLE)
 136                 set_if_exists $w.record.telcell "record(TEL CELL)"
 137                 set_if_exists $w.record.telhome "record(TEL HOME)"
 138                 set_if_exists $w.record.telwork "record(TEL WORK)"
 139                 set_if_exists $w.record.telother "record(TEL)"
 140                 set_if_exists $w.record.fax "record(TEL FAX)"
 141                 set_if_exists $w.record.email "record(EMAIL INTERNET)"
 142                 if {[info exists "record(EMAIL INTERNET)"]} {
 143                         $w.record.mail configure -state normal
 144                 } else {
 145                         $w.record.mail configure -state disabled
 146                 }
 147                 if {[llength [set img_index [lindex [array names record PHOTO*] 0]]]} {
 148                         if {![regexp {TYPE=([^[:space:]]+)} $img_index msg fmt]} {
 149                                 set fmt JPEG
 150                         }
 151                         $w.record.image configure -image [image create photo -format $fmt -data $record($img_index)]
 152                 } else {
 153                         $w.record.image configure -image ""
 154                 }
 155         }
 156
 157         proc set_if_exists {w var} {
 158                 upvar $var v
 159                 if {[info exists v]} {
 160                         $w configure -text $v
 161                 } else {
 162                         $w configure -text {}
 163                 }
 164         }
 165
 166         proc fill_window {w} {
 167                 variable phones
 168                 variable filter
 169                 variable current
 170                 read_phonebook
 171                 set list [lsort [array names phones]]
 172                 if {[info exists filter]} {
 173                         set list [lsearch -all -inline -regexp $list $filter ]
 174                 }
 175                 $w.list delete 0 end
 176                 eval $w.list insert 0 $list
 177                 if {![info exists current]||[set index [lsearch -exact $list $current]]<0} {
 178                         set index 0
 179                 }
 180                 $w.list selection clear 0 end
 181                 $w.list selection set $index
 182                 event generate $w.list <<ListboxSelect>>
 183                 after idle "$w.list see $index;focus $w.list"
 184                 focus $w.search.pattern
 185         }
 186
 187         proc position {w} {
 188                 set pattern [$w.search.pattern get]
 189                 set list [$w.list get 0 end]
 190                 set index [lsearch -regexp $list $pattern]
 191                 if {$index!= -1} {
 192                         $w.list selection clear 0 end
 193                         $w.list selection set $index
 194                         event generate $w.list <<ListboxSelect>>
 195                         after idle "$w.list see $index;focus $w.list"
 196                 }
 197         }
 198
 199         proc filter {w} {
 200                 variable filter
 201                 set filter [$w.search.pattern get]
 202                 if {![string length $filter]} {
 203                         unset filter
 204                 }
 205                 fill_window $w
 206         }
 207 #
 208 # Create an interface
 209 #
 210 if {$::argv0 ne [info script]} {
 211         set m .find.m
 212         $m add command -label "Phone..." -command\
 213                 "create_or_raise .phonebook ::phonebook::mkwindow; ::phonebook::fill_window .phonebook"
 214 } else {
 215         button .b -text "Phonebook" -command "toplevel .phonebook;
 216         ::phonebook::mkwindow .phonebook
 217         ::phonebook::fill_window .phonebook"
 218         pack .b
 219 }
 220
 221 proc mail_to {} {
 222         variable current
 223         variable phones
 224         global CONFIGDIR
 225         array set r $phones($current)
 226         if {![info exists "r(EMAIL INTERNET)"]} {
 227                 return
 228         }
 229         set address ${r(EMAIL INTERNET)}
 230         exec $CONFIGDIR/mail $address &
 231 }
 232
 233 proc new_rec {} {
 234         variable edited
 235         catch {unset edited}
 236         edit_window
 237 }
 238
 239 proc edit_record {} {
 240         variable current
 241         variable phones
 242         variable edited
 243         set edited $current
 244         edit_window
 245 }
 246
 247 proc edit_window {} {
 248
 249 }
 250 }