From: Pat Thoyts Date: Thu, 26 Nov 2009 23:46:01 +0000 (+0000) Subject: Added support for tile or ttk to get themed widgets. X-Git-Tag: v2.6~14 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=de07584f5c5961a2fe996079f839584109a6ba9e;p=sockspy Added support for tile or ttk to get themed widgets. This improves the look of the application on Windows XP. Signed-off-by: Pat Thoyts --- diff --git a/bin/sockspy.tcl b/bin/sockspy.tcl index 6e2f870..c0a9cff 100644 --- a/bin/sockspy.tcl +++ b/bin/sockspy.tcl @@ -11,6 +11,7 @@ exec wish $0 ${1+"$@"} # KPV Dec 21, 2002 - added extract window # version 2.5 - February, 2003 by Don Libes # DL Jan/Feb, 2003 - added date support, state save/restore, cmdline display +# Pat Thoyts - 2007 - added theming / ttk support. # # spy on conversation between a tcp client and server # @@ -28,8 +29,50 @@ exec wish $0 ${1+"$@"} catch {package require uri} ;# Error handled below +# Handle the various versions of tile/ttk +variable useTile +if {[package provide Tk] ne ""} { + if {![info exists useTile]} { + variable useTile 1 + variable NS "::ttk" + if {[llength [info commands ::ttk::*]] == 0} { + if {![catch {package require tile 0.8}]} { + # we're all good + } elseif {![catch {package require tile 0.7}]} { + # tile to ttk compatability + interp alias {} ::ttk::style {} ::style + interp alias {} ::ttk::setTheme {} ::tile::setTheme + interp alias {} ::ttk::themes {} ::tile::availableThemes + interp alias {} ::ttk::LoadImages {} ::tile::LoadImages + } else { + set useTile 0 + set NS "::tk" + } + } else { + # we have ttk in tk85 + } + if {$useTile && [tk windowingsystem] eq "aqua"} { + # use native scrollbars on the mac + if {[llength [info commands ::ttk::_scrollbar]] == 0} { + rename ::ttk::scrollbar ::ttk::_scrollbar + interp alias {} ::ttk::scrollbar {} ::tk::scrollbar + } + } + # Ensure that Tk widgets are available in the tk namespace. This is useful + # if we are using Ttk widgets as sometimes we need the originals. + # + if {[llength [info commands ::tk::label]] < 1} { + foreach cmd { label entry text canvas menubutton button frame labelframe \ + radiobutton checkbutton scale scrollbar} { + rename ::$cmd ::tk::$cmd + interp alias {} ::$cmd {} ::tk::$cmd + } + } + } +} + array set state { - version 2.5 + version 2.6 extract 0 bbar 1 ascii 1 @@ -86,12 +129,34 @@ set extract(meta2) {.} # proc createMain {} { global state colors tcl_platform + variable NS wm withdraw . - set state(fixed) [font create -family courier -size $state(fontSize)] - set state(fixedbold) [font create -family courier -size $state(fontSize) \ - -weight bold] + # See if we can find a better font than the TkFixedFont or courier + if {[lsearch -exact [font names] TkFixedFont] != -1} { + eval [linsert [font configure TkFixedFont] 0 font create SockspyFont] + } else { + font create SockspyFont -family courier + } + set families [font families] + switch -exact -- [tk windowingsystem] { + aqua { set preferred {Monaco 9} } + win32 { set preferred {ProFontWindows 8 Consolas 8} } + default { set preferred {} } + } + foreach {family size} $preferred { + if {[lsearch -exact $families $family] != -1} { + font configure SockspyFont -family $family -size $size + break + } + } + + font configure SockspyFont -size $state(fontSize) + set state(fixed) SockspyFont + set state(fixedbold) [eval [list font create SockspyBold] \ + [font configure SockspyFont] -weight bold] + wm title . "SockSpy -- $state(title)" wm resizable . 1 1 @@ -106,13 +171,13 @@ proc createMain {} { .m add cascade -menu .m.view -label "View" -underline 0 .m add cascade -menu .m.help -label "Help" -underline 0 - menu .m.file + menu .m.file -tearoff 0 .m.file add command -label "Save ..." -underline 0 -command saveOutput .m.file add command -label "Reconnect ..." -underline 0 -command GetSetup .m.file add separator .m.file add command -label "Exit" -underline 1 -command Shutdown - menu .m.view + menu .m.view -tearoff 0 .m.view add command -label " Clear" -underline 1 -command clearOutput .m.view add separator .m.view add checkbutton -label " ButtonBar" -variable state(bbar) \ @@ -146,43 +211,42 @@ proc createMain {} { # # Title and status window # - frame .bbar - frame .cmd -relief sunken -bd 2 - radiobutton .cmd.hex -text Hex -variable state(ascii) \ + ${NS}::frame .bbar + ${NS}::frame .cmd ;#-relief sunken -borderwidth 2 + ${NS}::radiobutton .cmd.hex -text Hex -variable state(ascii) \ -value 0 -command redraw - radiobutton .cmd.ascii -text ASCII -variable state(ascii) \ + ${NS}::radiobutton .cmd.ascii -text ASCII -variable state(ascii) \ -value 1 -command redraw - checkbutton .cmd.autos -text Autoscroll -variable state(autoscroll) - checkbutton .cmd.autow -text Autowrap -variable state(autowrap) \ + ${NS}::checkbutton .cmd.autos -text Autoscroll -variable state(autoscroll) + ${NS}::checkbutton .cmd.autow -text Autowrap -variable state(autowrap) \ -command ToggleWrap - checkbutton .cmd.capture -text Capture -variable state(capture) \ + ${NS}::checkbutton .cmd.capture -text Capture -variable state(capture) \ -command ToggleCapture - checkbutton .cmd.time -text Time -variable state(time) \ - -command redraw - button .cmd.clear -text Clear -command clearOutput + ${NS}::checkbutton .cmd.time -text Time -variable state(time) \ + -command redraw + ${NS}::button .cmd.clear -text Clear -command clearOutput -width -6 #button .cmd.incr -text "+ Font" -command [list doFont 1] #button .cmd.decr -text "- Font" -command [list doFont -1] - button .cmd.save -text Save -command saveOutput - button .cmd.kill -text Exit -command Shutdown - pack .cmd -side top -fill x -pady 5 -in .bbar + ${NS}::button .cmd.save -text Save -command saveOutput -width -6 + ${NS}::button .cmd.kill -text Exit -command Shutdown -width -6 + pack .cmd -side top -fill x -pady 2 -in .bbar pack .cmd.kill .cmd.save .cmd.clear .cmd.autow .cmd.autos .cmd.capture \ - .cmd.time \ - -side right -padx 3 -pady 3 + .cmd.time -side right -padx 1 -pady 1 #label .title -relief ridge -textvariable state(title) #.title config -font "[.title cget -font] bold" - label .stat -textvariable state(msg) -relief ridge -anchor w + ${NS}::label .stat -textvariable state(msg) -anchor w # # Now for the output area of the display # - scrollbar .yscroll -orient vertical -command {.out yview} - scrollbar .xscroll -orient horizontal -command {.out xview} - text .out -width 80 -height 50 -font $state(fixed) -bg white -setgrid 1 \ - -yscrollcommand ".yscroll set" -xscrollcommand ".xscroll set" + ${NS}::scrollbar .yscroll -orient vertical -command {.out yview} + ${NS}::scrollbar .xscroll -orient horizontal -command {.out xview} + text .out -width 80 -height 43 -font $state(fixed) -background white -setgrid 1 \ + -yscrollcommand ".yscroll set" -xscrollcommand ".xscroll set" -borderwidth 1 foreach t [array names colors] { - .out tag configure $t -background $colors($t) -borderwidth 2 \ + .out tag configure $t -background $colors($t) -borderwidth 1 \ -relief raised -lmargin1 5 -lmargin2 5 - .out tag configure time_$t -background $colors($t) -borderwidth 2 \ + .out tag configure time_$t -background $colors($t) -borderwidth 1 \ -relief raised -lmargin1 5 -lmargin2 5 -font $state(fixedbold) } .out tag configure client2 -font $state(fixedbold) @@ -197,8 +261,10 @@ proc createMain {} { bind .out clearOutput bind all {console show} + bind all {console show} focus .out wm geometry . +10+10 + wm deiconify . } ##+########################################################################## # @@ -206,28 +272,32 @@ proc createMain {} { # proc createExtract {} { global state colors - - if {[winfo exists .extract]} { - wm deiconify .extract + variable NS + + set top .extract + if {[winfo exists $top]} { + wm deiconify $top return } - set top ".extract" + toplevel $top + wm withdraw $top wm title $top "SockSpy Extract" + wm transient $top . wm protocol $top WM_DELETE_WINDOW [list ToggleExtract -1] if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} { wm geom $top "+[expr {$wx+35+[winfo width .]}]+[expr {$wy+15}]" } - frame $top.top -bd 2 -relief ridge - label $top.top.c -text "Client Filter" -anchor e + ${NS}::frame $top.top + ${NS}::label $top.top.c -text "Client Filter" -anchor e entry $top.top.ce -textvariable extract(client) -bg $colors(client) - label $top.top.s -text "Server Filter" -anchor e + ${NS}::label $top.top.s -text "Server Filter" -anchor e entry $top.top.se -textvariable extract(server) -bg $colors(server) - label $top.top.m -text "Metadata Filter" -anchor e + ${NS}::label $top.top.m -text "Metadata Filter" -anchor e entry $top.top.me -textvariable extract(meta2) -bg $colors(meta2) - text $top.out -width 80 -height 20 -font $state(fixed) -bg beige \ + text $top.out -width 80 -height 20 -font $state(fixed) \ -setgrid 1 -wrap none -yscrollcommand [list $top.yscroll set] \ -xscrollcommand [list $top.xscroll set] foreach t [array names colors] { @@ -238,8 +308,8 @@ proc createExtract {} { } $top.out tag raise sel ;# Selection is most prominent - scrollbar $top.yscroll -orient vertical -command [list $top.out yview] - scrollbar $top.xscroll -orient horizontal -command [list $top.out xview] + ${NS}::scrollbar $top.yscroll -orient vertical -command [list $top.out yview] + ${NS}::scrollbar $top.xscroll -orient horizontal -command [list $top.out xview] grid $top.top - -row 0 -sticky ew -ipady 10 grid $top.out $top.yscroll -sticky news grid $top.xscroll -sticky ew @@ -252,6 +322,7 @@ proc createExtract {} { grid $top.top.m $top.top.me -sticky ew grid columnconfigure $top.top 1 -weight 1 grid columnconfigure $top.top 2 -minsize 10 + wm deiconify $top } ##+########################################################################## # @@ -603,14 +674,14 @@ proc DoListen {} { global state SP set rval 1 - catch {close $state(sockClnt)} ;# Only the last open connection + catch {close $state(sockClnt)} ;# Only the last open connection - ;# Close old listener if it exists + # Close old listener if it exists if {$state(listen) != ""} { set n [catch {close $state(listen)} emsg] if {$n} { INFO "socket close error: $emsg"} set state(listen) "" - update ;# Need else socket below fails + update ;# Need else socket below fails } # Listen on clntPort or proxyPort for incoming connections @@ -632,7 +703,9 @@ proc DoListen {} { INFO $state(title) INFO "waiting for new connection..." } - wm title . "SockSpy -- $state(title)" + if {$state(gui)} { + wm title . "SockSpy -- $state(title)" + } return $rval } ##+########################################################################## @@ -641,6 +714,7 @@ proc DoListen {} { # proc GetSetup {} { global state SP ok + variable NS array set save [array get SP] set ok 0 ;# Assume cancelling @@ -669,53 +743,55 @@ proc GetSetup {} { destroy .dlg toplevel .dlg + wm withdraw .dlg wm title .dlg "SockSpy Setup" + wm transient .dlg . wm geom .dlg +176+176 - #wm transient .dlg . - label .dlg.top -bd 2 -relief raised + ${NS}::label .dlg.top set msg "You can configure SockSpy to either forward data\n" append msg "a fixed server and port or to use the HTTP Proxy\n" append msg "protocol to dynamically determine the server and\n" append msg "port to forward data to." - frame .dlg.fforward - frame .dlg.fproxy - frame .dlg.fcmdline - - label .dlg.msg -text $msg -justify left - radiobutton .dlg.forward -text "Use fixed server forwarding" \ - -variable state(proxy) -value 0 -anchor w -command GetSetup2 - label .dlg.fl1 -text "Client Port:" -anchor e - entry .dlg.fe1 -textvariable SP(clntPort) - - label .dlg.fl2 -text "Server Host:" -anchor e - entry .dlg.fe2 -textvariable SP(servHost) - label .dlg.fl3 -text "Server Port:" -anchor e - entry .dlg.fe3 -textvariable SP(servPort) + ${NS}::frame .dlg.fforward + ${NS}::frame .dlg.fproxy + ${NS}::frame .dlg.fcmdline + + ${NS}::label .dlg.msg -text $msg -justify left + ${NS}::radiobutton .dlg.forward -text "Use fixed server forwarding" \ + -variable state(proxy) -value 0 -command GetSetup2 + if {$NS ne "::ttk"} { .dlg.forward configure -anchor w } + ${NS}::label .dlg.fl1 -text "Client Port:" -anchor e + ${NS}::entry .dlg.fe1 -textvariable SP(clntPort) + + ${NS}::label .dlg.fl2 -text "Server Host:" -anchor e + ${NS}::entry .dlg.fe2 -textvariable SP(servHost) + ${NS}::label .dlg.fl3 -text "Server Port:" -anchor e + ${NS}::entry .dlg.fe3 -textvariable SP(servPort) - radiobutton .dlg.proxy -text "Use HTTP Proxying" \ - -variable state(proxy) -value 1 -anchor w -command GetSetup2 - label .dlg.pl1 -text "Proxy Port:" -anchor e - entry .dlg.pe1 -textvariable SP(proxyPort) - - label .dlg.cllabel -text "Command Line Equivalent" - entry .dlg.clvar -textvariable SP(cmdLine) \ - -borderwidth 2 -relief sunken + ${NS}::radiobutton .dlg.proxy -text "Use HTTP Proxying" \ + -variable state(proxy) -value 1 -command GetSetup2 + if {$NS ne "::ttk"} {.dlg.proxy configure -anchor w} + ${NS}::label .dlg.pl1 -text "Proxy Port:" -anchor e + ${NS}::entry .dlg.pe1 -textvariable SP(proxyPort) + + ${NS}::label .dlg.cllabel -text "Command Line Equivalent" + ${NS}::entry .dlg.clvar -textvariable SP(cmdLine) # -state readonly doesn't seem to work, sigh - button .dlg.ok -text OK -width 10 -command ValidForm - button .dlg.cancel -text Cancel -width 10 -command [list destroy .dlg] + ${NS}::button .dlg.ok -text OK -width 10 -command ValidForm + ${NS}::button .dlg.cancel -text Cancel -width 10 -command [list destroy .dlg] - grid .dlg.top -row 0 -column 0 -columnspan 3 -sticky ew -padx 10 -pady 10 + grid .dlg.top -row 0 -column 0 -columnspan 3 -sticky ew -padx 2 -pady 2 grid columnconfigure .dlg 0 -weight 1 - grid x .dlg.ok .dlg.cancel -padx 10 + grid x .dlg.ok .dlg.cancel -padx 2 grid configure .dlg.ok -padx 0 grid rowconfigure .dlg 2 -minsize 8 - pack .dlg.msg -in .dlg.top -side top -fill x -padx 10 -pady 5 + pack .dlg.msg -in .dlg.top -side top -fill x -padx 2 -pady 1 pack .dlg.fforward .dlg.fproxy .dlg.fcmdline -in .dlg.top \ - -side top -fill x -padx 10 -pady 10 + -side top -fill x -padx 2 -pady 2 grid .dlg.cllabel -in .dlg.fcmdline -row 0 -column 0 -sticky w grid .dlg.clvar -in .dlg.fcmdline -row 1 -column 0 -sticky ew @@ -758,8 +834,9 @@ proc GetSetup {} { if {$state(proxy)} { focus -force .dlg.pe1 } { focus -force .dlg.fe2 } raise .dlg + wm deiconify .dlg tkwait window .dlg - wm deiconify . + wm deiconify . if {$ok} { DoListen @@ -918,29 +995,33 @@ proc ToggleCapture {} { # Help -- a simple help system # proc Help {} { - destroy .help - toplevel .help - wm title .help "SockSpy Help" - wm geom .help "+[expr {[winfo x .] + 50}]+[expr {[winfo y .] + 50}]" - - text .help.t -relief raised -wrap word -width 70 -height 25 \ - -padx 10 -pady 10 -cursor {} -yscrollcommand {.help.sb set} - scrollbar .help.sb -orient vertical -command {.help.t yview} - button .help.dismiss -text Dismiss -command {destroy .help} - pack .help.dismiss -side bottom -pady 10 - pack .help.sb -side right -fill y - pack .help.t -side top -expand 1 -fill both - - set bold "[font actual [.help.t cget -font]] -weight bold" - set fixed "[font actual [.help.t cget -font]] -family courier" - .help.t tag config title -justify center -foregr red -font "Times 20 bold" - .help.t tag configure title2 -justify center -font "Times 12 bold" - .help.t tag configure header -font $bold - .help.t tag configure n -lmargin1 15 -lmargin2 15 - .help.t tag configure fixed -font $fixed -lmargin1 25 -lmargin2 55 - - .help.t insert end "SockSpy\n" title - .help.t insert end "Authors: Tom Poindexter and Keith Vetter\n\n" title2 + variable NS + set dlg .help + destroy $dlg + toplevel $dlg -class Dialog + wm withdraw $dlg + wm title $dlg "SockSpy Help" + wm transient $dlg . + wm geom $dlg "+[expr {[winfo x .] + 50}]+[expr {[winfo y .] + 50}]" + + set txt [text $dlg.t -relief raised -wrap word -width 70 -height 25 \ + -padx 10 -pady 10 -cursor {} -yscrollcommand [list $dlg.sb set]] + ${NS}::scrollbar $dlg.sb -orient vertical -command [list $dlg.t yview] + ${NS}::button $dlg.dismiss -text Dismiss -command [list destroy $dlg] + pack $dlg.dismiss -side bottom -pady 10 + pack $dlg.sb -side right -fill y + pack $dlg.t -side top -expand 1 -fill both + + set bold "[font actual [$txt cget -font]] -weight bold" + set fixed "[font actual [$txt cget -font]] -family courier" + $txt tag config title -justify center -foregr red -font "Times 20 bold" + $txt tag configure title2 -justify center -font "Times 12 bold" + $txt tag configure header -font $bold + $txt tag configure n -lmargin1 15 -lmargin2 15 + $txt tag configure fixed -font $fixed -lmargin1 25 -lmargin2 55 + + $txt insert end "SockSpy\n" title + $txt insert end "Authors: Tom Poindexter and Keith Vetter\n\n" title2 set m "SockSpy lets you watch the conversation of a tcp client and server. " append m "SockSpy acts much like a gateway: it waits for a tcp connection, " @@ -953,7 +1034,7 @@ proc Help {} { append m "from the server in blue and connection metadata in red. The data " append m "can be displayed as printable ASCII or both hex and " append m "printables.\n\n" - .help.t insert end "What is SockSpy?\n" header $m n + $txt insert end "What is SockSpy?\n" header $m n set m "Why might you want to use SockSpy? Debugging tcp client/server " append m "programs, examining protocols and diagnosing network problems " @@ -965,7 +1046,7 @@ proc Help {} { append m "other hand, SockSpy doesn't require any special privileges to " append m "run (unless of course, you try to listen on a Unix reserved tcp " append m "port less than 1024.)\n\n" - .help.t insert end "Why Use SockSpy?\n" header $m n + $txt insert end "Why Use SockSpy?\n" header $m n set m "Just double click on SockSpy to start it. You will be prompted for " append m "various connection parameters described below.\n\n" @@ -973,24 +1054,24 @@ proc Help {} { append m "command line. This is also how you can run SockSpy in text mode " append m "without a GUI.\n\n" append m "To start SockSpy from the command line:\n" - .help.t insert end "How to Use SockSpy\n" header $m n + $txt insert end "How to Use SockSpy\n" header $m n set m "$ sockspy \n or\n" append m "$ sockspy -proxy \n\n" - .help.t insert end $m fixed + $txt insert end $m fixed set m "To start SockSpy in text mode without a GUI:\n" - .help.t insert end $m n + $txt insert end $m n set m "$ tclsh sockspy \n or\n" append m "$ tclsh sockspy -proxy \n\n" - .help.t insert end $m fixed + $txt insert end $m fixed set m ": the tcp port on which to listen. Clients should " append m "connect to this port.\n" append m ": the host where the real server runs.\n" append m ": the tcp port on which the real server listens.\n" append m ": the tcp port on which to listen in proxy-mode.\n\n" - .help.t insert end $m n + $txt insert end $m n set m "In proxy mode SockSpy works like a simple HTTP proxy server. " append m "Instead of forwarding to a fixed server and port, it follows the " @@ -998,7 +1079,7 @@ proc Help {} { append m "first line of HTTP request.\n\n" append m "You can turn on proxy mode by selecting it in the SockSpy Setup " append m "dialog, or by specifying -proxy on the command line.\n\n" - .help.t insert end "Proxy Mode\n" header $m n + $txt insert end "Proxy Mode\n" header $m n set m "The extract window lets you extract specific parts of the " append m "data stream. As data arrives from the client, server, or as " @@ -1006,20 +1087,20 @@ proc Help {} { append m "expression filter. If it matches, the data gets displayed " append m "in the extract window. (Malformed regular expression are " append m "silently ignored.)\n\n" - .help.t insert end "Extract Window\n" header $m n + $txt insert end "Extract Window\n" header $m n set m "To spy on HTTP connections to a server, type:\n" - .help.t insert end "Example\n" header $m n - .help.t insert end " sockspy 8080 www.some.com 80\n" fixed - .help.t insert end "and point your browser to\n" n - .help.t insert end " http://localhost:8080/index.html\n\n" fixed - .help.t insert end "Alternatively, you could configure your browser to " n - .help.t insert end "use localhost and port 8000 as its proxy, and then " n - .help.t insert end "type:\n" n - .help.t insert end " sockspy -proxy 8000\n" fixed - .help.t insert end "and user your browser normally.\n" n - - .help.t config -state disabled + $txt insert end "Example\n" header $m n + $txt insert end " sockspy 8080 www.some.com 80\n" fixed + $txt insert end "and point your browser to\n" n + $txt insert end " http://localhost:8080/index.html\n\n" fixed + $txt insert end "Alternatively, you could configure your browser to " n + $txt insert end "use localhost and port 8000 as its proxy, and then " n + $txt insert end "type:\n" n + $txt insert end " sockspy -proxy 8000\n" fixed + $txt insert end "and user your browser normally.\n" n + $txt config -state disabled + wm deiconify $dlg } ##+########################################################################## # @@ -1139,7 +1220,7 @@ if {[catch {package present uri}]} { timestampInit stateRestore -if {$state(gui)} createMain +if {$state(gui)} { createMain } if {[lindex $argv 0] == "-local"} { set argv [list 8080 localhost 80]