Attachment "tkchat.patch" to
ticket [467835ffff]
added by
patthoyts
2001-10-04 18:37:43.
*** tkchat.tcl.orig Thu Oct 04 12:35:46 2001
--- tkchat.tcl Thu Oct 04 12:34:36 2001
***************
*** 30,35 ****
--- 30,38 ----
# Everything will eventually be namespaced
variable MessageHooks
array set MessageHooks {}
+
+ variable HEADUrl {http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tcllib/tclapps/apps/tkchat/tkchat.tcl?rev=HEAD}
+ variable rcsid {$Id$}
}
set ::DEBUG 1
***************
*** 68,73 ****
--- 71,125 ----
return $auth
}
+ # Retrieve the lastest version of tkchat from the SourceForge CVS.
+ # This code is (almost) entirely ripped from TkCon. - PT.
+ proc tkchat::Retrieve {} {
+ variable HEADUrl
+ set rcsVersion {}
+
+ set defExt ""
+ if {[string match "windows" $::tcl_platform(platform)]} {
+ set defExt ".tcl"
+ }
+
+ set file [tk_getSaveFile -title "Save Latest TkChat to ..." \
+ -defaultextension $defExt \
+ -initialdir [file dirname $::argv0] \
+ -initialfile [file tail $::argv0] \
+ -parent . \
+ -filetypes {{"Tcl Files" {.tcl .tk}} {"All Files" {*.*}}}]
+ if {[string compare $file ""]} {
+ set token [::http::geturl $HEADUrl -headers [buildProxyHeaders] -timeout 30000]
+ ::http::wait $token
+ set code [catch {
+ if {[::http::status $token] == "ok"} {
+ set fid [open $file w]
+ fconfigure $fid -translation binary
+ set data [::http::data $token]
+ puts -nonewline $fid $data
+ close $fid
+ regexp {Id: tkchat.tcl,v (\d+\.\d+)} $data -> rcsVersion
+ }
+ } err]
+ ::http::cleanup $token
+
+ if {$code} {
+ tk_messageBox -type ok -icon error \
+ -title "Error retrieving tkchat from CVS" \
+ -message $err
+ } else {
+ set resource? [tk_messageBox -type yesno -icon info \
+ -title "Retrieved tkchat $rcsVersion" \
+ -message "Successfully retrieved v$rcsVersion.\
+ Do you want to reload from the new version?"]
+ if {${resource?} == "yes"} {
+ uplevel \#0 [list source $file]
+ tk_messageBox -message "Script has been reloaded!"
+ }
+ }
+ }
+ }
+
proc msgSend {str {user ""}} {
global Options
set qry [::http::formatQuery \
***************
*** 800,805 ****
--- 852,859 ----
-command [list ::tkchat::debug reload]
$m add comman -label "Restart Script" \
-command [list ::tkchat::debug restart]
+ $m add comman -label "Retrieve Script" \
+ -command [list ::tkchat::debug retrieve]
$m add comman -label "Evaluate Selection" \
-command [list ::tkchat::debug evalSel]
$m add comman -label "Purge Chat Window" \
***************
*** 1214,1219 ****
--- 1268,1276 ----
eval font delete [font names]
unset ::Options
Init
+ }
+ retrieve {
+ Retrieve
}
purge {
pause on 0
