From ab5ceed8f8c0154f3f7a34ad01bf46ebc5911ac3 Mon Sep 17 00:00:00 2001 From: Jeff Hobbs Date: Wed, 20 Jun 2001 23:40:48 +0000 Subject: [PATCH] * tkcon.tcl (InitUI): moved wm protocol inside check to not run under plugin. (::tkcon::Retrieve): added a new method to allow tkcon to retrieve the latest version of itself. --- tkcon.tcl | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/tkcon.tcl b/tkcon.tcl index d078108..f84b6b4 100755 --- a/tkcon.tcl +++ b/tkcon.tcl @@ -166,8 +166,9 @@ proc ::tkcon::Init {} { } version 2.1+ RCS {RCS: @(#) $Id$} + HEADURL {http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tkcon/tkcon/tkcon.tcl?rev=HEAD} release {May 2001} - docs "http://tkcon.sf.net/" + docs "http://tkcon.sourceforge.net/" email {jeff@hobbs.org} root . } { @@ -1214,6 +1215,8 @@ proc ::tkcon::InitMenus {w title} { foreach m [list [menu $w.help] [menu $w.pop.help]] { $m add command -label "About " -underline 0 -accel Ctrl-A \ -command ::tkcon::About + $m add command -label "Retrieve Latest Version" -underline 0 \ + -command ::tkcon::Retrieve } } @@ -4956,6 +4959,52 @@ proc ::tkcon::SafeWindow {i w option args} { return -code $code $msg } +proc ::tkcon::Retrieve {} { + # A little bit'o'magic to grab the latest tkcon from CVS and + # save it locally. It doesn't support proxies though... + variable PRIV + + set defExt "" + if {[string match "windows" $::tcl_platform(platform)]} { + set defExt ".tcl" + } + set file [tk_getSaveFile -title "Save Latest tkcon to ..." \ + -defaultextension $defExt \ + -initialdir [file dirname $PRIV(SCRIPT)] \ + -initialfile [file tail $PRIV(SCRIPT)] \ + -parent $PRIV(root) \ + -filetypes {{"Tcl Files" {.tcl .tk}} {"All Files" {*.*}}}] + if {[string compare $file ""]} { + package require http 2 + set token [::http::geturl $PRIV(HEADURL) -timeout 30000] + ::http::wait $token + set code [catch { + if {[::http::status $token] == "ok"} { + set fid [open $file w] + # We don't want newline mode to change + fconfigure $fid -translation binary + set data [::http::data $token] + puts -nonewline $fid $data + close $fid + regexp {Id: tkcon.tcl,v (\d+\.\d+)} $data -> rcsVersion + regexp {version\s+(\d+\.\d[^\n]*)} $data -> tkconVersion + } + } err] + ::http::cleanup $token + if {$code} { + return -code error $err + } elseif {[tk_messageBox -type yesno -icon info -parent $PRIV(root) \ + -title "Retrieved tkcon v$tkconVersion, RCS $rcsVersion" \ + -message "Successfully retrieved tkcon v$tkconVersion,\ + RCS $rcsVersion. Shall I resource (not restart) this\ + version now?"] == "yes"} { + set PRIV(SCRIPT) $file + set PRIV(version) $tkconVersion-$rcsVersion + ::tkcon::Resource + } + } +} + ## ::tkcon::Resource - re'source's this script into current console ## Meant primarily for my development of this program. It follows ## links until the ultimate source is found. -- 2.23.0