/usr/share/obextool/plugins/vcs

###
### VCal plugin for ObexTool
###
### (c) Gerhard Reithofer, Techn. EDV Reithofer - 2003-05
### gerhard.reithofer@tech-edv.co.at http://www.tech-edv.co.at
###
### See COPYING for further details
###

namespace eval ::VCS {

  variable version 1.0

  variable show_alarmtime 0
  variable siemens_warning 1
  variable init_all_entries 1
  variable export_header_line 1
  variable exportfile "obexvcal.txt"

  variable label_font   {Helvetica 12 bold}
  variable dialog_font  {Helvetica 12}
  variable listbox_font {Helvetica 12}

  variable date_lbformat "%4d-%02d-%02d %02d:%02d:%02d"
  variable tmp_prefix "/tmp/vcal_data"
  variable date_separator "."
  variable time_separator ":"

  variable label_width 16
	variable supported_vcal_ver "1.0"

  variable obext_date "%4d%02d%02dT%02d%02d%02d" 
  variable vcal_entr
  variable vcentry_idx
  variable vcal_numbers
  variable top_level .vcal
  variable top_list .vlist
  variable pathname
	variable dataframe
  variable lb_widget
  variable prev_widget
  variable array repeat_day
  variable array vcal_array

  variable array years 
  array set years {start 1970 last 2100}

  load_Messages vcs_plug [getObexCfg config language] $version

  variable cat_name
  set cat_name(CATEGORIES)  [get_text "Category"     vcs_plug] 
  set cat_name(DTSTART)     [get_text "Start"        vcs_plug] 
  set cat_name(DALARM)      [get_text "Alarm"        vcs_plug] 
  set cat_name(DESCRIPTION) [get_text "Description"  vcs_plug] 
  set cat_name(RRULE)       [get_text "Repeat every" vcs_plug] 

  variable cat_type
  set {cat_type(ANNIVERSARY)}   [get_text "Birthday"      vcs_plug] 
  set {cat_type(TCELEBRATE)}    [get_text "Anniversary"   vcs_plug] 
  set {cat_type(VALENTINE)}     [get_text "Special event" vcs_plug] 
  set {cat_type(MISCELLANEOUS)} [get_text "Memo"          vcs_plug] 
  set {cat_type(PHONE CALL)}    [get_text "Phone call"    vcs_plug] 
  set {cat_type(MEETING)}       [get_text "Meeting"       vcs_plug] 

  variable cat_rule
  set cat_rule(D1)  [get_text "day"   vcs_plug]
  set cat_rule(YD1) [get_text "year"  vcs_plug]  
  set cat_rule(MD1) [get_text "month" vcs_plug] 
  set cat_rule(W1)  [get_text "week"  vcs_plug] 
  set cat_rule(D7)  [get_text "week"  vcs_plug]

  variable wdaylist [list MO TU WE TH FR SA SU]

  variable weekdays 
  set weekdays([lindex $wdaylist 0]) [get_text "Mo" vcs_plug] 
  set weekdays([lindex $wdaylist 1]) [get_text "Tu" vcs_plug] 
  set weekdays([lindex $wdaylist 2]) [get_text "We" vcs_plug] 
  set weekdays([lindex $wdaylist 3]) [get_text "Th" vcs_plug] 
  set weekdays([lindex $wdaylist 4]) [get_text "Fr" vcs_plug] 
  set weekdays([lindex $wdaylist 5]) [get_text "Sa" vcs_plug] 
  set weekdays([lindex $wdaylist 6]) [get_text "Su" vcs_plug] 
##################################################################
### Simple utility functions
###
### Just for debugging....
###
  proc debug_vcal { vl lv } { foreach entr $vl { debug_var entr $lv } }
###
### ... to avoid octal interpretation on leading zeroes
###
  proc ztrim { value } {
    regsub ^0+(.+) $value \\1 retval
    return $retval
  }
###
### Extract entry of listbox labels
###
  proc cat_label { key } {
    variable cat_name
debug_out "cat_label $key" 5

    if [info exists cat_name($key)] {
      set rv $cat_name($key)
    } else {
      set rv [string toupper [string index $key 0]]
      append rv [string tolower [string range $key 1 end]]
    }
debug_var rv 5
    return $rv
  }
###
### Extract a value for a category
###
  proc cat_value { key } {
    variable cat_type
debug_out "cat_type $key" 5

    if [info exists cat_type($key)] {
      set rv $cat_type($key)
    } else {
      set rv [string toupper [string index $key 0]]
      append rv [string tolower [string range $key 1 end]]
    }
debug_var rv 5
    return $rv
  }
###
### Extract value for a repetition rule
###
  proc rul_value { rlist } {
    variable wdaylist
    variable weekdays
    variable cat_rule
    variable cat_name
debug_out "rul_value $rlist" 5
    set rlist [split $rlist " "]
    set rule [lindex $rlist 0]
    set rpar [lrange $rlist 1 end]
    if {[lsearch [array names cat_rule] $rule]<0} {
      set msg [get_text "Unexpected Repeat-Rule '%s' found!" vcs_plug]
      warning [format $msg $rule]
      return [list "" "" ""]
    }
    set rv $cat_rule($rule)
debug_var rv 5
debug_var rule 5
    switch $rule {
      MD1 { 
        append rv [format [get_text " at the %s." vcs_plug] [ztrim $rpar]]
      }
      D7 -
      W1 { 
        set days ""
debug_var rpar
        foreach d $wdaylist {
          if {[lsearch $rpar $d]>=0} { append days " $weekdays($d)" }
        }
        append rv [format [get_text " on%s" vcs_plug]  $days]
      }
    }
    return $rv
  }

##################################################################
### Low level widgets
###
### Combo entry (for appointment category and repetition rules)
###
  proc combo_entry { w id ckey } {
    variable cat_type
    variable label_font
    variable dialog_font
    variable label_width
    debug_out "combo_entry $w $id $ckey" 5

    set value ""
    set name $w.[string tolower $id] 
    set dname [cat_label $id]
    set lf [LabelFrame $name -text $dname -justify left \
                       -width $label_width -font $label_font]
    foreach cate [array names cat_type] { lappend cl $cat_type($cate) }
    if [info exists cat_type($ckey)] { 
      set value $cat_type($ckey) 
    } else {
      set value 
    }
#   set txt $ckey
    ComboBox $lf.c -values $cl -text $value -font $dialog_font \
                   -entrybg white -justify left -disabledbackground white
    pack $lf.c $lf
###
### Currently we do not allow to change the catagory
###
    if {[string_equal $id "CATEGORIES"]&&![string_equal $ckey ""]} {
      $lf.c configure -state disabled 
    } else {
		  $lf.c setvalue first
		}
  }
###
### Date/time entry (for apointment and alarm)
###
  proc dtime_entry { w id val }  {
    variable years
    variable label_font
    variable dialog_font
    variable date_separator
    variable time_separator
    variable label_width
    variable obext_date
    debug_out "dtime_entry $w $id $val" 5
    
    set res [scan $val $obext_date Y M D h m s]
    set name $w.[string tolower $id] 
    set dname [cat_label $id]
    set lbl [format [get_text "%s date" vcs_plug] $dname]
    set l1 [LabelFrame ${name}d -text $lbl -justify left \
                       -width $label_width -font $label_font]
    SpinBox $l1.dy -text $Y -width 4 -font $dialog_font \
            -range [list $years(start) $years(last) 1] \
            -textvariable ::VCS::SB_year
    label $l1.d1 -text $date_separator
    SpinBox $l1.dm -text $M -width 2 -font $dialog_font -range [list 1 12 1] \
                   -textvariable ::VCS::SB_month
    label $l1.d2 -text $date_separator
    SpinBox $l1.dd -text $D -width 2 -font $dialog_font -range [list 1 31 1] \
                   -textvariable ::VCS::SB_day
    set lbl [format [get_text "%s time" vcs_plug] $dname]
    set l2 [LabelFrame ${name}t -text $lbl -justify left \
                        -width $label_width -font $label_font]
    SpinBox $l2.th -text $h -width 2 -font $dialog_font -range [list 0 23 1]\
                   -textvariable ::VCS::SB_hour
    label $l2.t1 -text $time_separator
    SpinBox $l2.tm -text $m -width 2 -font $dialog_font -range [list 0 59 1]\
                   -textvariable ::VCS::SB_minute
    label $l2.t2 -text $time_separator
    SpinBox $l2.ts -text $s -width 2 -font $dialog_font -range [list 0 59 1]\
                   -textvariable ::VCS::SB_second
    eval "pack [winfo children $l1] -side left"
    eval "pack [winfo children $l2] -side left"
    pack $l1 $l2 -fill x
  }
###
### Dynamic dialog part for apointment repetition rules
### Consisting of: combobox (day, week, month, year)
###                spinbox (day on monthly repetition only)
###                checkboxes (weekdays on weekly repetition only)
###
  proc rrule_entry { w id val } {
    variable cat_rule
    variable cat_name
    variable weekdays
    variable repeat_day
    variable label_font
    variable dialog_font
    variable label_width
    variable date_separator 
    debug_out "rrule_entry $w $id $val" 5

    set rlist [split $val " "]
    set rule [lindex $rlist 0]
    set rpar [lrange $rlist 1 end]
    if {[lsearch [array names cat_rule] $rule]<0} {
      set msg [get_text "Unexpected Repeat-Rule '%s' found!" vcs_plug]
      warning [format $msg $rule]
      return
    }

    set name $w.[string tolower $id] 
    set l1 [LabelFrame ${name}r -text $cat_name(RRULE) -justify left \
                       -width $label_width -font $label_font]
    foreach r [array names cat_rule] { lappend cl $cat_rule($r) }
    ComboBox $l1.c -values $cl -text $cat_rule($rule) -font $dialog_font \
                   -entrybg white -justify left -disabledbackground white
    eval "pack [winfo children $l1] -side left"
		if {[string_equal $rule "W1"]&&[string_equal $rpar ""]} { 
      $l1.c setvalue first
    } else {
      $l1.c configure -state disabled
		}
    pack $l1 -fill x
    switch $rule {
      MD1 {
        set l2 [LabelFrame ${name}d -text [get_text " on every " vcs_plug] \
                           -justify left -width $label_width -font $label_font]
        SpinBox $l2.s -text $rpar -width 2 -range [list 1 31 1] \
                      -font $dialog_font -textvariable ::VCS::SB_day
        label $l2.p -text $date_separator  
        eval "pack [winfo children $l2] -side left"
        pack $l2 -anchor w
      }
      D7 -
      W1 {
        set l3 [LabelFrame ${name}d -text [get_text " on every " vcs_plug]\
                           -justify left -width $label_width -font $label_font]
        foreach d [list MO TU WE] {
          set vn "wday_${d}"
          set rb $l3.[string tolower $d]
          checkbutton $rb -variable VCS::repeat_day($d) -text $weekdays($d)
        }
        eval "pack [winfo children $l3] -side left"
        pack $l3 -fill x
        set l4 [frame ${name}x]
        foreach d [list SU SA FR TH] {
          set vn "wday_${d}"
          set rb $l4.[string tolower $d]
          checkbutton $rb -variable VCS::repeat_day($d) -text $weekdays($d)
        }
        eval "pack [winfo children $l4] -side right"
        pack $l4 -fill x
        foreach d [array names weekdays] {
          if {[lsearch $rpar $d]<0} {
            set VCS::repeat_day($d) 0
          } else {
            set VCS::repeat_day($d) 1
          }
        }
      }
    }
  }
###
### Simple label entry - surprised ? ;-)
###
  proc label_entry { w id dval } {
    variable label_font
    variable dialog_font
    variable label_width
    debug_out "label_entry $w $id $dval" 5

    set name $w.[string tolower $id] 
    set dname [cat_label $id]
    LabelFrame $name -text $dname -justify left \
                      -width $label_width -font $label_font
    Entry $name.e -text $dval -bg white -justify left -font $dialog_font
    pack $name.e $name -expand 1 -fill x
  }
######################################################################
###  High level "master" widgets definitions and methods
### 
###  Listbox with all VCal entries
###
  proc create_listbox { path } {
    variable listbox_font
    variable label_font
    variable lb_widget
    variable cat_name
		variable top_list
    variable version

    set buttons [list \
		  [get_text "&Edit" vcs_plug]\
	  	  [get_text "Edit selected data record" vcs_plug]\
			  "[namespace current]::show_single"\
      [get_text "&Copy" vcs_plug] \
			  [get_text "Create new record using current selection" vcs_plug]\
        "[namespace current]::new_vcentry 1"\
      [get_text "C&reate" vcs_plug]\
			  [get_text "Create new data record" vcs_plug]\
        "[namespace current]::new_vcentry 0"\
      [get_text "&Delete" vcs_plug]\
			  [get_text "Delete selected data record" vcs_plug]\
        "[namespace current]::delete_rec"\
      [get_text "E&xport..." vcs_plug]\
			  [get_text "Export all records to text file" vcs_plug]\
				"[namespace current]::export_data"\
      [get_text "&Close" vcs_plug]\
			  [get_text "Close list window" vcs_plug]\
				"after idle {destroy $top_list}"\
    ]
    set wintitle [get_text "Obextool VCal-Plugin %s" vcs_plug] 
    set ftitle [format [get_text "VCal Folder: %s" vcs_plug] $path]
		set wtitle [format $wintitle $version]
    set sw [new_swindow $top_list $wtitle $ftitle $buttons 5 .]
    set lb_widget [tablelist::tablelist $sw.lbx \
                     -background white\
                     -font $listbox_font\
                     -labelrelief flat \
                     -showseparators 1 \
                     -columns [list 0 "#" right \
                                    0 $cat_name(CATEGORIES) \
                                    0 $cat_name(DTSTART) \
                                    0 $cat_name(DALARM) \
                                    0 $cat_name(DESCRIPTION) \
                                    0 $cat_name(RRULE)] \
                     -labelcommand tablelist::sortByColumn \
                     -height 15 -width 100 -stretch all]
    $lb_widget columnconfigure 0 -sortmode integer
    pack $lb_widget -expand yes -fill both
    $sw setwidget $lb_widget
    bind [$lb_widget bodypath] <Double-Button-1> \
		      "[namespace current]::show_single"
		BWidget::place $top_list 0 0 center .
		wm deiconify $top_list
  }
###
### insert an entry and values into appointment detail view
###
  proc insert_vcentry { w id val } {
    debug_out "insert_vcentry $w $id $val" 5
    switch $id {
      DTSTART -
      AALARM  -
      DALARM     { dtime_entry $w $id $val }
      CATEGORIES { combo_entry $w $id $val }
      RRULE      { rrule_entry $w $id $val }
      default    { label_entry $w $id $val }
    } 
  }
### 
###  insert one entry/line into listbox overwiew
###
  proc update_listbox { num mode } {
    variable obext_date 
    variable vcal_numbers
    variable date_lbformat 
    variable vcentry_idx
    variable vcal_array
    variable vcal_entr
    variable lb_widget
    variable top_list
debug_out "update_listbox $num $mode" 4

    set lentry(CATEGORIES)  {}
    set lentry(DTSTART)     {}
    set lentry(DALARM)      {}
    set lentry(DESCRIPTION) {}
    set lentry(RRULE)       {}

    if [set_vcal_entr $vcal_array($num)] return

    foreach entr $vcentry_idx {
      set idx [string first "," $entr]
      set typ [string range $entr 0 [expr $idx-1]]
      set vid [string range $entr [expr $idx+1] end]
      if {$typ eq "VEVENT"} {
        switch $vid {
          DTSTART - 
          AALARM  -
          DALARM      { 
            set res [scan $vcal_entr($entr) $obext_date Y M D h m s]
            if {$res == 6} {
              set lentry($vid) [format $date_lbformat $Y $M $D $h $m $s]
            } else {
              set lentry($vid) $vcal_entr($entr)
            }
          }
          CATEGORIES  {
            set lentry($vid) [cat_value $vcal_entr($entr)]
          }
          RRULE       {
            set lentry($vid) [rul_value $vcal_entr($entr)]
          }
          DESCRIPTION {
            set lentry($vid) $vcal_entr($entr)
          }
        } 
      }
    }
###
### Handle listbox entries, if "insert" mode 
### vcal_numbers handling is done by caller
###
		if [string_equal $mode "insert"] {
			$lb_widget insert end [list $num\
																	$lentry(CATEGORIES)\
																	$lentry(DTSTART)\
																	$lentry(DALARM)\
																	$lentry(DESCRIPTION)\
																	$lentry(RRULE)]
		} else {
			set vcal_numbers {}
      set imax [$lb_widget index end]
			for {set i 0} {$i<$imax} {incr i} {
				set id [lindex [$lb_widget get $i] 0]
        lappend vcal_numbers $id
				if {$id == $num} {
					$lb_widget delete $i
					if [string_equal $mode "replace"] {
						$lb_widget insert $i [list $num\
																			 $lentry(CATEGORIES)\
																			 $lentry(DTSTART)\
																			 $lentry(DALARM)\
																			 $lentry(DESCRIPTION)\
																			 $lentry(RRULE)]
						$lb_widget see $i
						$lb_widget selection clear 0 end
						$lb_widget selection set $i
					}
				}
			}
    }
  }
### 
### check if window $which already exists
###
  proc win_check { which name } {
  debug_out "win_check $which $name" 4
    if [winfo exists $which] {
      set msg [get_text "%s window already open!\nPlease" vcs_plug] 
      append msg [get_text " close it before opening a new one." vcs_plug] 
      warning [format $msg $name]
      return 1
    }
    return 0
  }
#################################################################
### Data management and file i/o functions
###
### Read one single VCal file and return list of VCal lines
###
  proc read_entry { path } {
    debug_out "read_entry $path" 4
    set local [ObexFile::read_file_tmp $path]
    if [string_empty $local] {
      warning [format [get_text "Unable to download file '%s'!" vcs_plug] $path]
      return {}
    }
    set fd [open $local "r"]
    fconfigure $fd -translation crlf 
    set vc_lines [split [read $fd] "\n"]
    close $fd
    file delete $local
    return $vc_lines
  }
###
### Download all VCal entries from the mobile
### $vcal_numbers is the list of VCal file names (in reading order)
### $vcal_array($name) internal storage of VCal file number as index
###
  proc download_entries { path } {
    variable vcal_numbers
    variable vcal_array
    global prg_msg bail vinc 
debug_out "download_entries $path" 4

    set flist [ObexFile::list_dir $path]
    set vmax [expr [llength $flist]-1]
    ProgressDlg .prg -command {set bail 1} \
      -variable vinc -textvariable prg_msg -maximum $vmax\
      -type normal -stop [get_text "Stop" vcs_plug] -width 50\
      -title [get_text "Reading all VCal entries..." vcs_plug]  
    set vinc 0
    set bail 0
    set vcal_numbers {}
    foreach entr $flist {
      if [string_equal [lindex $entr 1] "vcs"] {
        set fname [lindex $entr 0]
        set dentr "$path/$fname"
        set prg_msg [format [get_text "Reading %s..." vcs_plug] $dentr]
        set vcard [read_entry $dentr]
        if [string_empty $vcard] {return 0}

				set id [file rootname $fname]
        set vcal_array($id) $vcard
        lappend vcal_numbers $id
        incr vinc
        if $bail break
        status_msg [format [get_text "%d entries read." vcs_plug]  $vinc]
      }
    }
    if [winfo exists .prg] {destroy .prg}
    return $vinc
  }

###
### Analyse VCal lines and store VEVENT records in an array indexed  
### by "GROUP,INDEX", where GROUP is the value of last BEGIN: key and
### INDEX the active field name (line DTSTART, RRULE...)
###
  proc set_vcal_entr { vcard } {
	  variable supported_vcal_ver
    variable vcentry_idx
    variable vcal_entr
    debug_out "set_vcal_entr $vcard" 4
### We use unset var, because of TCL 8.2 compatibility
    if [info exists vcal_entr] {unset vcal_entr} 
    if {![string equal [lindex $vcard 0] "BEGIN:VCALENDAR"]} {
      warning [get_text "File does not seem to be a VCal file!" vcs_plug] 
      return 1
    }

    set level {}
    set vcentry_idx {}
    foreach vc $vcard {
      if [string_empty $vc] continue
      set si [string first ":" $vc]
      set key [string range $vc 0 [expr $si-1]]
      set val [string range $vc [expr $si+1] end]
      switch $key {
        BEGIN { set level [concat $val $level] }
        END   { set level [lrange $level 1 end] }
        default {
          set lvl [lindex $level 0]
          set idx "$lvl,$key"
          set vcal_entr($idx) $val
          lappend vcentry_idx $idx
### debug_out "vcal_entr($idx)=$vcal_entr($idx)" 5
        }
      }
    }
    if ![info exists vcal_entr(VCALENDAR,VERSION)] {
      warning [get_text "No version info in VCal File!" vcs_plug] 
      debug_vcal $vcentry_idx 1
      return 1
    } 
    if ![string_equal $vcal_entr(VCALENDAR,VERSION) $supported_vcal_ver] {
      set msg \
    [get_text "This plugin does not support version %s of VCal file!" vcs_plug] 
      warning [format $msg $vcal_entr(VCALENDAR,VERSION)]
      debug_vcal $vcentry_idx 1
      return 1
    }
    debug_vcal $vcentry_idx 8
    return 0
  }
###
### Create format to write data back to phone (VCal http://www.imc.org/pdi/)
###
  proc format_output { w id val } {
    variable repeat_day
    variable cat_type
    variable cat_rule
    variable obext_date
    debug_out "format_output $w $id $val" 5

    set name $w.[string tolower $id] 
    switch $id {
		DTSTART -
      AALARM  -
      DALARM { ; ### dtime_entry $w $id $val 
        set l1 ${name}d 
        set l2 ${name}t 
        set Y [ztrim [$l1.dy cget -text]]
        set M [ztrim [$l1.dm cget -text]]
        set D [ztrim [$l1.dd cget -text]]
        set h [ztrim [$l2.th cget -text]]
        set m [ztrim [$l2.tm cget -text]]
        set s [ztrim [$l2.ts cget -text]]
        return [format "$obext_date" $Y $M $D $h $m $s]
      }
      CATEGORIES { ; ### combo_entry $w $id $val 
        set lf $name
        set val [$lf.c cget -text]
        foreach cat [array names cat_type] {
          if [string_equal $val $cat_type($cat)] {
            return $cat
          }
        }
      }
      RRULE { ; ### rrule_entry $w $id $val 
        set rule ""
        set l1 ${name}r
        set rval [$l1.c cget -text]
        foreach cat [array names cat_rule] {
          if [string_equal $rval $cat_rule($cat)] {
            set rule $cat
            break;
          }
        }
        if [string_empty $rule] {return ""} 
### debug_var rule
        switch $rule {
          MD1 {
###         set l2 ${name}d
###         set v2 [ztrim [$l2.s cget -text]]
###         return [format "%s %02d" $rule $v2]
### Repeating day is sync'd with day of start date - ger
            set day [$w.dtstartd.dd cget -text]
            return [format "%s %02d" $rule $day]
          }
          D7 -
          W1 {
            set wdays ""
            foreach d [list MO TU WE TH FR SA SU] {
### debug_var ::VCS::repeat_day($d)
              if $VCS::repeat_day($d) { append wdays " $d" }
            }
            return "$rule$wdays"
          }
          default {
            return $rule
          }
        }
      }
      default {
        set val [$name.e cget -text]
        return $val
      }
    } 
  }
###
### Listbox callback on selection (Edit) of an entry
###
  proc export_data { } {
    variable export_header_line
    variable exportfile
    variable lb_widget
		variable top_list

    set def_ext [file extension $exportfile]
    set types [list [list [get_text "ASCII Text Files <TAB>" vcs_plug]      \
                    [list .txt]]\
                    [list [get_text "ASCII Files <Semicolon>" vcs_plug]     \
                    [list .dat]]\
                    [list [get_text "CSV Files <Comma separated>" vcs_plug] \
                    [list .csv]]\
                    [list [get_text "All files" vcs_plug]  [list "*"]]]
    set outn [tk_getSaveFile -parent $top_list\
                             -title [get_text "Export file" vcs_plug] \
                             -defaultextension $def_ext\
                             -filetypes $types\
                             -initialfile $exportfile]
    if [string_empty $outn] return

debug_var outn 4
    set new_ext [file extension $outn]
    if [string_empty $new_ext] { set outn $outn$def_ext }

    switch $new_ext {
      .txt    { set separator "\t" }
      .dat    { set separator ";"  }
      .csv    { set separator ","  }
      default { set separator "\t" }
    }
    set numrecs 0
    set fd [open $outn "w"] 
    set imax [$lb_widget columncount]
    if $export_header_line {
      set row {}
      for {set i 0} {$i<$imax} {incr i} {
        lappend row [$lb_widget columncget $i -title]
      }
      set line [join $row $separator]
      puts $fd $line
    }
    foreach row [$lb_widget get 0 end] {
      set line [join $row $separator]
      puts $fd $line
      incr numrecs
    }
    close $fd
    set msg [get_text "%d records written to file '%s'" vcs_plug]
    status_msg [format $msg $numrecs $outn]
  }
###
### Listbox callback on selection (Delete) of an entry
###
  proc delete_rec { } {
    variable pathname
    variable lb_widget
    variable vcal_entr
debug_out "delete_rec" 4
### Parameter $w currently not used here - ger

    set selidx [$lb_widget curselection]
		if [string_empty $selidx] {
		  warning [get_text "No record selected for deleting!" vcs_plug]
			return
		}
    set selected [$lb_widget get $selidx]
    set id [lindex $selected 0]
### if [set_vcal_entr $vcal_array($id)] return

    set delname $id.vcs
    set vcaldir [file dirname $pathname]
    set delpath "$vcaldir/$delname"

	  set qry [get_text\
	 	"Do you really want to delete the appointment entry %s?" vcs_plug]
		set title [get_text "Deleting appointment entry" vcs_plug]
    if [ask_yes_no $title [format $qry $id]] {
		  set_cursor on
	    ObexFile::obexftp rm $delpath
	    ObexTree::refresh_list ""
			set err 0
		  foreach entr $ObexTree::dir_list {
			  if [string_equal $entr $delpath] { set err 1 }
      }
			if $err {
			  set msg [get_text "Schedule entry %s could not be deleted!"]
				no_permission [format $msg $id]
			} else {
				update_listbox $id delete
			}
		  set_cursor 
    }
  }

###
### Listbox callback on selection (Edit) of an entry
###
  proc show_single { } {
    variable vcal_array
    variable top_level
    variable top_list
    variable version
    variable pathname
    variable lb_widget
debug_out "show_single" 4

    if [win_check $top_level [get_text "VCal detail data" vcs_plug] ] return

    set selidx [$lb_widget curselection]
		if [string_empty $selidx] {
		  warning [get_text "No record selected for editing!" vcs_plug]
			return
		}
    set selected [$lb_widget get $selidx]
    set id [lindex $selected 0]

    set newname $id.vcs
    set old_dir [file dirname $pathname]
    set pathname "$old_dir/$newname"

    set vcard [read_entry $pathname]
    if [string_empty $vcard] return
    if [set_vcal_entr $vcard] return

    vc_dialog $top_list $pathname 0 0
    set vcal_array($id) $vcard
### update_listbox $id replace
  }
###
### Save data (write back) callback on "Save" inVCal detail view
###
  proc save_data { path is_new } {
	  variable top_list
		variable top_level
    variable vcal_entr
		variable vcal_array
    variable vcentry_idx
    variable prev_widget 
    variable tmp_prefix
		variable dataframe
    debug_out "save_data $path $is_new" 4

    set vcs_dir [file dirname $path]
    set id [file rootname [file tail $path]]
    set backup(VCALENDAR,VERSION) "$vcal_entr(VCALENDAR,VERSION)"
    set result [list "BEGIN:VCALENDAR" \
                     $backup(VCALENDAR,VERSION) \
                     "BEGIN:VEVENT" ]
    foreach rule [array names cat_rule] { set rcheck($rule) {} }
		set dcheck ""
    foreach entr $vcentry_idx {
      set idx [string first "," $entr]
      set typ [string range $entr 0 [expr $idx-1]]
      set vid [string range $entr [expr $idx+1] end]
      if {$typ eq "VEVENT"} {

        set vc_entr [format_output $dataframe $vid $vcal_entr($entr)]
        if [string_equal $vid "RRULE"] {
### Rules with "W1" and "D7" are ignored -> no weekdays!
					if [string_equal $vc_entr "W1"] continue 
					if [string_equal $vc_entr "D7"] continue 
        } 

        set backup($entr) $vc_entr
debug_var backup($entr) 6
        if [string_empty $vc_entr] {
          set msg [get_text "No valid VCal entry for\n%s: %s" vcs_plug] 
          warning [format $msg $vid $vc_entr] 
          return
        }
        lappend result "$vid:$vc_entr"
      }
      debug_var entr 5
    }
    lappend result "END:VEVENT" "END:VCALENDAR"
    if ![ask_yes_no [get_text "Confirm" vcs_plug] \
          [get_text "Do you really want to store this record?" vcs_plug]] {
      return 1
    }
debug_var result 3
    set cnt 0
    while 1 { 
      set fn $tmp_prefix[incr cnt].tmp 
      if ![file exists $fn] break
    }

    set fd [open $fn "w"]
    fconfigure $fd -translation crlf 
    foreach line $result {
		  puts $fd $line
			debug_var line 6
	}
debug_var fn 3
    close $fd
    set msg [get_text "Uploading file '%s' to '%s'..." vcs_plug]
    status_msg [format $msg $fn $path]
### We don't check if file exists - even on new entry...
    ObexFile::write_file_tmp $fn $path
###
### Consistency checks
### 
    set vcard [read_entry $path]
    if [string_empty $vcard] return
    if [set_vcal_entr $vcard] return

    set bk_list [array names backup]
    set vc_list [array names vcal_entr]
    set msg {}
    if {[llength $bk_list] != [llength $vc_list]} {
     set msg [get_text "Missing records in stored entry:" vcs_plug]
     foreach idx $bk_list {
       if ![info exists vcal_entr($idx)] {
			   set code [lindex [split $idx ","] 1]
         append msg [format "\n$code:$backup($idx)"]
       }
     }
     foreach idx $vc_list {
       if ![info exists backup($idx)] {
         append msg [format "\n$idx:$vcal_entr($idx)"]
       }
     }
    } else {
      foreach idx $vc_list {
        if ![string_equal $backup($idx) $vcal_entr($idx)] {
          append msg [format "\n%s\n%s" $vcal_entr($idx) $backup($idx)]
        }
      }
      if ![string_empty $msg] {
        set msg [format \
				  [get_text "Saved entries not identical to input entry:%s" vcs_plug]\
					$msg]
      }
    }
    if ![string_empty $msg] {warning [format $msg]}
    destroy $top_level

    set msg [get_text "File '%s' stored" vcs_plug]
    ObexTree::refresh_list [format $msg $path]
	  if [winfo exists $prev_widget] { wm deiconify $prev_widget }
### is it the lis subwindow?
		if [string_equal $prev_widget $top_list] {
      set vcal_array($id) $vcard
      if $is_new {
        lappend vcal_numbers $id
        update_listbox $id insert
			} else {
        update_listbox $id replace
			}
    }
    return 0
  }

  proc new_vcentry { copy } {
    debug_out "new_vcentry $copy" 4
		variable supported_vcal_ver
		variable show_alarmtime
	  variable vcal_numbers
	  variable vcal_entr
		variable lb_widget 
		variable top_level
		variable top_list
		variable pathname

    if [win_check $top_level [get_text "VCal detail data" vcs_plug] ] return

		set id 0
    set vcs_dir [file dirname $pathname]
debug_var vcal_numbers 3
		while 1 {
			if {[lsearch $vcal_numbers [incr id]]<0} break
		}

		set newpath "$vcs_dir/$id.vcs"
		set tomorrow [expr [clock seconds]+(60*60*24)]
		set date [clock format $tomorrow -format "%Y%m%dT%H%M00"]

    if $copy {
      set selidx [$lb_widget curselection]
      if [string_empty $selidx] {
        warning [get_text "No record selected for copying!" vcs_plug]
        return
      }
      set selidx [$lb_widget curselection]
		  debug_var selidx 4
      set selected [$lb_widget get $selidx]
			debug_var selected 3
      set id [lindex $selected 0]
      set vcard [read_entry "$vcs_dir/$id.vcs"]
      set_vcal_entr $vcard
		} else {
  		if [info exists vcal_entr] {unset vcal_entr}
		}

### debug_var newpath
### debug_arr vcal_entr
    set vc_new [list "BEGIN:VCALENDAR" \
		                 "VERSION:$supported_vcal_ver" \
										 "BEGIN:VEVENT"]
### debug_var vcal_entr(VEVENT,CATEGORIES)
		if [info exists vcal_entr(VEVENT,CATEGORIES)] {
		  lappend vc_new "CATEGORIES:$vcal_entr(VEVENT,CATEGORIES)"
		} else {
#		  lappend vc_new "CATEGORIES:MISCELLANEOUS"
		  lappend vc_new "CATEGORIES:"
		}
### debug_var vcal_entr(VEVENT,DTSTART)
		if [info exists vcal_entr(VEVENT,DTSTART)] {
		  lappend vc_new "DTSTART:$vcal_entr(VEVENT,DTSTART)"
		} else {
		  lappend vc_new "DTSTART:$date"
		}
		if ($show_alarmtime) {
### debug_var vcal_entr(VEVENT,DALARM)
			if [info exists vcal_entr(VEVENT,DALARM)] {
				lappend vc_new "DALARM:$vcal_entr(VEVENT,DALARM)"
			} else {
				lappend vc_new "DALARM:$date"
			}
		}
### debug_var vcal_entr(VEVENT,RRULE)
		if [info exists vcal_entr(VEVENT,RRULE)] {
		  lappend vc_new "RRULE:$vcal_entr(VEVENT,RRULE)"
		} else {
    	lappend vc_new "RRULE:W1"
		}
### debug_var vcal_entr(VEVENT,DESCRIPTION)
		if [info exists vcal_entr(VEVENT,DESCRIPTION)] {
		  lappend vc_new "DESCRIPTION:$vcal_entr(VEVENT,DESCRIPTION)"
		} else {
		  lappend vc_new "DESCRIPTION:"
		}
    lappend vc_new "END:VEVENT" "END:VCALENDAR"

### debug_var vc_new 4
    if [set_vcal_entr $vc_new] return
	  vc_dialog $top_list $newpath 1 0
	}

###################################################################
### Top level dialogues and fillup functions
### 
###  Single appointment detail view
###
  proc vc_dialog { parent path is_new is_top } {
    variable version
    variable top_list
    variable top_level
    variable vcal_entr
    variable vcentry_idx
		variable dataframe
    variable label_font
    variable prev_widget $parent

    debug_out "vc_dialog $parent $path $is_new $is_top" 4

	  set buttons [list \
		   [get_text "&Save" vcs_plug]\
			   [get_text "Write entry to device" vcs_plug]\
			   "[namespace current]::save_data $path $is_new"]
    if $is_top {
		 lappend buttons \
		   [get_text "&Read all" vcs_plug]\
				 [get_text "Read all entries and open list" vcs_plug]\
				 "[namespace current]::vc_listbox $path"
      set active 2
			set parent .
		} else {
      set active 1
			set parent $top_list
    }
		lappend buttons \
       [get_text "&Close" vcs_plug]\
			   [get_text "Close detail view window"]\
         "after idle {[namespace current]::close_dialog $prev_widget}"

    set tstr [get_text "Obextool VCal-Plugin %s" vcs_plug] 
		set wtitle [format $tstr $version]
		if $is_new {
		  set frame_str [get_text "New VCal Entry: %s" vcs_plug]
		} else {
		  set frame_str [get_text "Edit VCal Entry: %s" vcs_plug]
		}

    set ftitle [format $frame_str [file tail $path]]
    set dataframe [new_window $top_level $wtitle $ftitle $buttons $active $parent]

    foreach entr $vcentry_idx {
      set idx [string first "," $entr]
      set typ [string range $entr 0 [expr $idx-1]]
      set vid [string range $entr [expr $idx+1] end]
      if {$typ eq "VEVENT"} {
        insert_vcentry $dataframe $vid $vcal_entr($entr)
      }
      debug_var entr 5
    }

		BWidget::place $top_level 0 0 center .
		wm deiconify $top_level
  }
	###
	### Close dialog
	###
	proc close_dialog {  prev } {
	  variable top_level
	  destroy $top_level
		wm deiconify $prev
  }
###
### Create listbox of all VCal entries
###
  proc vc_listbox { path } {
    variable version
		variable top_list
    variable top_level
    variable lb_widget
    variable vcal_numbers
    debug_out "vc_listbox $path" 4

    if [win_check $top_list [get_text "VCal overview" vcs_plug]] return

    set vcs_dir [file dirname $path]
    set vcs_id [file tail [file rootname $path]]
    if ![download_entries $vcs_dir] return

    catch {destroy $top_level}
    create_listbox $vcs_dir

    set cnt 0
    set sel -1
    foreach num $vcal_numbers { 
      update_listbox $num insert
      if {$num eq $vcs_id} {set sel $cnt}
      incr cnt
    }
    if {$sel != -1} {
      $lb_widget selection set $sel
      $lb_widget see $sel
    }
  }
###
### ObexTool main entry point
###
  proc default_handler { args } {
    variable top_level
    variable init_all_entries
    variable pathname [lindex $args 0]
    debug_out "[namespace current]::default_handler $args" 5

    if [win_check $top_level [get_text "VCal detail data" vcs_plug] ] return

    if $init_all_entries {
      vc_listbox $pathname
    } else {
      set vcard [read_entry $pathname]
      if [string_empty $vcard] return
      if [set_vcal_entr $vcard] return
      vc_dialog . $pathname 0 1
		}
  }

  ###
  ### Warning on load of plugin - there is a strange behaviour on 
  ### Siemens phones - ger
  ###
  if $siemens_warning {
    set msg [get_text "On Siemens mobiles, all uploaded" vcs_plug] 
    append msg [get_text " entries are deactivated by default." vcs_plug]
    append msg [get_text " Don't forget to activate any modified" vcs_plug]
    append msg [get_text " entry in the options of your phone directly." vcs_plug] 
    warning $msg
  }
}

return $::VCS::version
obextool 0.35-0ubuntu2 / usr / share / obextool / plugins / vcs_plugin.tcl
