namespace eval cache {
  set filechar {:a-zA-Z1-9._+&\\-}
  set cachedfiles {}

  for {set i 1} {$i < 255} {incr i} {
    set c [format %c $i]
    if {![string match \[$filechar\] $c]} {
      set esc [format %.2X $i]
      set formMap($c) %$esc
      set reformMap(%$esc) $c
    }
  }

  set cachedir $options(cachedir)

  if {![file exists $cachedir]} {
    file mkdir $cachedir
  } elseif {![file isdirectory $cachedir]} {
    error "can not access cache dir \"$cachedir\"."
  }

  namespace export cachedname get open url filename cache_dialog export_interp
}

proc cache::cachedname {url} {
  variable filechar
  variable formMap
  variable cachedir

  regsub -all \[^$filechar\] $url {$formMap(&)} string
  regsub -all \n $string {\\n} string
  regsub -all \t $string {\\t} string
  regsub -all {[][{})\\]\)} $string {\\&} string
  return $cachedir/[subst $string]
}

proc cache::get {url} {
  global GRACER_USER
  global GRACER_HOME
  set baseurl {}

  switch -glob $url {
    http:* -
    ftp:* {
      set name [cachedname $url]
#      if [file exists $name] {
#	return $name
#      }
      set pwd [pwd]
      cd $GRACER_USER
      set linkname [file nativename [file tail $url]]
      file delete $linkname
      exec ln -s [file nativename $name] $linkname
      set res [catch {exec wget -N -q $url} out]
      file delete $linkname
      cd $pwd
      if {$res} {
#	file delete $name
	error "couldn't get $url"
      }
      return $name
    }
    default {
      if [file exists $GRACER_USER/data/$url] {
	return $GRACER_USER/data/$url
      } elseif [file exists $GRACER_HOME/$url] {
	return $GRACER_HOME/$url
      } else {
	error "file $url doesn't exists."
      }
    }
  }
}

proc cache::filename {url} {
  global GRACER_USER GRACER_HOME
  variable reformMap
  variable cachedir

  switch -glob $url {
    http:* -
    ftp:* {
      set name [cachedname $url]
      if [file exists $name] {
	return $name
      } else {
	error "specified url is not cached yet."
      }
    }
    default {
      if [file exists $GRACER_USER/data/$url] {
	return $GRACER_USER/data/$url
      } elseif [file exists $GRACER_HOME/$url] {
	return $GRACER_HOME/$url
      } else {
	error "file $url doesn't exists."
      }
    }
  }
}

proc cache::url {cachedname} {
  global GRACER_USER GRACER_HOME

  variable reformMap
  variable cachedir

  if [string match $cachedir/* $cachedname] {
    regsub ^$cachedir/ $cachedname {} res
    regsub -all {%..} $res {$reformMap(&)} res
    return [subst $res]
  } elseif [string match $GRACER_HOME/* $cachedname] {
    regsub ^$GRACER_HOME/ $cachedname {} res
    return $res
  } elseif [string match $GRACER_USER/data/* $cachedname] {
    regsub ^$GRACER_USER/data/ $cachedname {} res
    return $res
  } else {
    error "couldn't determine real name.";
  }
}

proc cache::cache_dialog_remove {} {
  variable cachedir
  variable cachedfiles
  variable namelist
  variable timelist

  set sels [$namelist curselection]
  set len [llength $sels]
  if {$len == 0} return

  set answer [tk_messageBox -title "Remove cached files ..." -icon question \
  		-message "Are you sure you want to delete selected file(s)?" \
  		-type yesno -default no ]
  if [string match $answer no] {
    return
  }

  set sels [lsort -decreasing $sels]
  foreach i $sels {
    $namelist delete $i $i
    $timelist delete $i $i
    file delete $cachedir/[lindex $cachedfiles $i]
    set cachedfiles [lreplace $cachedfiles $i $i]
  }
}

proc cache::cache_dialog_set {args} {
  variable timelist
  variable namelist
  variable scrollbar

  eval $timelist yview $args
  eval $namelist yview $args
}

proc cache::cache_dialog_scroll {first args} {
  variable timelist
  variable namelist
  variable scrollbar

  eval $scrollbar set $first $args
  eval $timelist yview moveto $first
  eval $namelist yview moveto $first
}

proc cache::cache_dialog {} {
  variable cachedir
  variable cachedfiles
  variable timelist
  variable namelist
  variable scrollbar

  set d .cache_dialog

  if { ![winfo exists $d] } {
    toplevel $d
    wm title $d "Cache"
    frame $d.f
    pack $d.f -fill both -expand 1

    frame $d.f.tf
    pack $d.f.tf -fill x

    set udbutton $d.f.tf.ud
    set rmbutton $d.f.tf.rm
    set okbutton $d.f.tf.ok
    button $udbutton -text "Update" -command cache::cache_dialog
    button $rmbutton -text "Delete" -command cache::cache_dialog_remove
    button $okbutton -text "Dismiss" -command [list wm withdraw $d]
    pack $udbutton -side left -fill x -expand 1
    pack $rmbutton -side left -fill x -expand 1
    pack $okbutton -side left -fill x -expand 1

    set timelist $d.f.bf.l.tl
    set scrollbar $d.f.bf.r.f.s
    set namelist $d.f.bf.r.f.nl

    frame $d.f.bf
    pack $d.f.bf -side bottom -fill both -expand 1

    frame $d.f.bf.l
    pack $d.f.bf.l -side left -fill both

    label $d.f.bf.l.label -text "Last"
    pack $d.f.bf.l.label -side top -fill x

    listbox $timelist -yscrollcommand cache::cache_dialog_scroll
    pack $timelist -side top -fill y -expand 1

    frame $d.f.bf.r
    pack $d.f.bf.r -side right -fill both -expand 1

    label $d.f.bf.r.label -text "Name"
    pack $d.f.bf.r.label -side top -fill x

    frame $d.f.bf.r.f
    pack $d.f.bf.r.f -side bottom -fill both -expand 1
    listbox $namelist -setgrid 1\
    		      -yscrollcommand cache::cache_dialog_scroll \
    		      -selectmode extended
    pack $namelist -side left -fill both -expand 1

    scrollbar $scrollbar -orient vertical -command cache::cache_dialog_set
    pack $scrollbar -side right -fill y
  } else {
    wm deiconify $d
  }

  $namelist delete 0 end
  $timelist delete 0 end
  set cachedfiles [glob -nocomplain $cachedir/*]
  if {![llength cachedfiles]} {return}
  for {set i 0} {$i < [llength $cachedfiles]} {incr i} {
    set file [lindex $cachedfiles $i]
    set cachedfiles [lreplace $cachedfiles $i $i \
    					[list [file atime $file] $file]]
  }
  set cachedfiles [lsort $cachedfiles]
  foreach item $cachedfiles {
    set atime [lindex $item 0]
    set file [lindex $item 1]
    $namelist insert end [url $file]
    $timelist insert end [clock format $atime -format %c]
  }
}

proc cache::open {url} {
  set filename [get $url]
  return [open $filename]
}


proc cache::export_procs {interp} {
  interp alias $interp cache::open {} open
}

proc cache::fullurl {link base} {
  switch -glob -- $link {
    http://*
      -
    ftp://* {
      return $link
    }
    file://localhost/* {
      regsub ^file://localhost/ $link {} res
      return $res
    }
    default {
      # remove filename
      regsub {(^|/)[^/]*$} $base {} base
      regsub {^[.]/} $link {} link
      if [string match . $base] {
	return $link
      } else {
	return $base/$link
      }
    }
  }
}
