plugins/phone_vcf

   1 #!/usr/bin/wish
   2 # Fubar plug-in to handle phonebook
   3 if [catch {package require Img} msg] {
   4         puts stderr "Failed to load IMG package: $msg"
   5         set noImg 1
   6 } else {
   7         set noImg 0
   8 }
   9 if {![file exists ~/.phonebook.vcf]} {
  10         error "Phonebook file $env(HOME)/.phonebook.vcf not found"
  11 }
  12 namespace eval phonebook {
  13         # Returns true if phonebook was reread, false if it is not changed
  14         #
  15         proc read_phonebook {} {
  16                 variable phones
  17                 variable phonebookstamp
  18                 if {[info exists phonebookstamp]&&[file mtime ~/.phonebook.vcf]<$phonebookstamp} {
  19                         return 0
  20                 }
  21                 if {[info exists phones]} {unset phones}
  22                 set f [open ~/.phonebook.vcf r]
  23                         fconfigure $f -encoding utf-8
  24                         set state "none"
  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"
  31                                                         continue
  32                                         } else {
  33                                                 set state "record"
  34                                         }
  35                                 }
  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
  45                                                         lappend field $opt
  46                                                 }
  47                                         }
  48                                 }
  49                                 if {$field eq "END"} {
  50                                         assemble_record cur_record
  51                                         set state "none"
  52                                         array unset cur_record
  53                                 } elseif {$field eq "BEGIN"} {
  54                                         if {[info exists currecord]} {
  55                                                 array unset cur_record
  56                                         }
  57                                         set state "record"
  58                                 } else {
  59                                         if {[string match "PHOTO*" $field]}      {
  60                                                 set cur_record($field) "$value\n"
  61                                                 set state "photo"
  62                                         } else {
  63                                                 set cur_record($field) ""
  64                                                 foreach subval [split $value ";"] {
  65                                                         set cur_record($field) "$subval $cur_record($field)"
  66                                                 }
  67                                         }
  68                                 }
  69                         }
  70                 close $f
  71                         set phonebookstamp [clock seconds]
  72                         return 1
  73         }
  74
  75         proc assemble_record  {var} {
  76                 upvar $var record
  77                 variable phones
  78                 if {[info exists record(FN)]} {
  79                         set index $record(FN)
  80                 } elseif {[info exists record(N)]} {
  81                         set index $record(N)
  82                 } elseif {[info exists record(NICKNAME)]} {
  83                         set index $record(NICKNAME)
  84                 }
  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\""
  89                 }
  90                 set phones($index) [array get record]
  91         }
  92
  93         proc mkwindow {w} {
  94                 wm title $w "Phone book"
  95                         frame $w.search
  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"
 112                         frame $w.record
 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
 119                                         }
 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
 132         }
 133         proc keyEvent {window keycode state char keysym} {
 134                 if {![string length $char]} return;#ignore noncharacter keys
 135                 focus $window
 136                 event generate $window <KeyPress> -keycode $keycode -keysym $keysym\
 137                                 -state $state -when tail
 138         }
 139         proc show_record {w index} {
 140                 variable phones
 141                 variable current
 142                 if {[info exists phones($index)]}  {
 143                         array set record $phones($index)
 144                                 set current $index
 145                 } else {
 146                         array set record {}
 147                         if {[info exists current]} {unset current}
 148                 }
 149
 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
 161                 } else {
 162                         $w.record.mail configure -state disabled
 163                 }
 164                 set hasImage 0
 165                 if {[llength [set img_index [lindex [array names record PHOTO*] 0]]]} {
 166                         if {![regexp {TYPE=([^[:space:]]+)} $img_index msg fmt]} {
 167                                 set fmt JPEG
 168                         }
 169                         if {!$::noImg || $fmt eq "GIF" || $fmt eq "PPM"} {
 170                         $w.record.image configure -image [image create photo -format $fmt -data $record($img_index)]
 171                         set hasImage 1
 172                         }
 173
 174                 }
 175                 if {!$hasImage} {
 176                         $w.record.image configure -image ""
 177                 }
 178         }
 179
 180         proc set_if_exists {w var} {
 181                 upvar $var v
 182                 if {[info exists v]} {
 183                         $w configure -text $v
 184                 } else {
 185                         $w configure -text {}
 186                 }
 187         }
 188
 189         proc fill_window {w} {
 190                 variable phones
 191                 variable filter
 192                 variable current
 193                 read_phonebook
 194                 set list [lsort [array names phones]]
 195                 if {[info exists filter]} {
 196                         set list [lsearch -all -inline -regexp $list $filter ]
 197                 }
 198                 $w.list delete 0 end
 199                 eval $w.list insert 0 $list
 200                 if {![info exists current]||[set index [lsearch -exact $list $current]]<0} {
 201                         set index 0
 202                 }
 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
 208         }
 209
 210         proc position {w} {
 211                 set pattern [$w.search.pattern get]
 212                 set list [$w.list get 0 end]
 213                 set index [lsearch -regexp $list $pattern]
 214                 if {$index!= -1} {
 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"
 219                 }
 220         }
 221
 222         proc filter {w} {
 223                 variable filter
 224                 set filter [$w.search.pattern get]
 225                 if {![string length $filter]} {
 226                         unset filter
 227                 }
 228                 fill_window $w
 229         }
 230 #
 231 # Create an interface
 232 #
 233 if {$::argv0 ne [info script]} {
 234         set m .find.m
 235         $m add command -label "Phone..." -command\
 236                 "create_or_raise .phonebook ::phonebook::mkwindow; ::phonebook::fill_window .phonebook"
 237 } else {
 238         button .b -text "Phonebook" -command "toplevel .phonebook;
 239         ::phonebook::mkwindow .phonebook
 240         ::phonebook::fill_window .phonebook"
 241         pack .b
 242 }
 243
 244 proc mail_to {} {
 245         variable current
 246         variable phones
 247         global CONFIGDIR
 248         array set r $phones($current)
 249         if {![info exists "r(EMAIL INTERNET)"]} {
 250                 return
 251         }
 252         set address ${r(EMAIL INTERNET)}
 253         exec $CONFIGDIR/mail $address &
 254 }
 255
 256 proc new_rec {} {
 257         variable edited
 258         catch {unset edited}
 259         edit_window
 260 }
 261
 262 proc edit_record {} {
 263         variable current
 264         variable phones
 265         variable edited
 266         set edited $current
 267         edit_window
 268 }
 269
 270 proc edit_window {} {
 271
 272 }
 273 }