From: Ian Jackson Date: Tue, 12 Jun 2012 15:33:10 +0000 (+0100) Subject: fix option processing X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?a=commitdiff_plain;h=26a08255c2b85fb059d91c408c01851e87e7fa68;p=chiark-tcl-applet.git fix option processing --- diff --git a/applet.tcl b/applet.tcl index 5d9a65d..c3c4c4e 100644 --- a/applet.tcl +++ b/applet.tcl @@ -56,25 +56,28 @@ package require tktray # # Alternatively of icon, it may provide other arrangements for # using the provided subwindow. Such a caller should call -# applet::setup-subwindow \ -# WIDTH HEIGHT DEFAULT-ORIENTATION BORDER-COLOUR BORDER-WIDTH \ -# ON-DESTROYING ON-READY +# applet::setup-subwindow ON-DESTROYING ON-READY # Then the main code will call ON-DESTROYING just before # destroying the inner window and recreating it, and # [concat ON-READY [list ORIENTATION]] # just after. The inner window to use is called .i.i.b. # +# This uses variables, in the applet namespace, +# w h border_colour border_width deforient +# These should be set before setup-subwindow is called and not +# modified thereafter. +# # The user of the subwindow machinery may call # applet::subwindow-need-recreate # if for any reason the inner window should be destroyed and recreated. # # Alternatively, it may request that a subprocess be spawned # repeatedly with the xid of a suitable window. -# applet::setup-subproc \ -# WIDTH HEIGHT DEFAULT-ORIENTATION BORDER-COLOUR BORDER-WIDTH \ -# GET-CMDLINE +# applet::setup-subproc GET-CMDLINE # Then the main code will call [concat GET_CMDLINE [list XID ORIENTATION]] # to get the command line to run. +# +# This also uses the same variables as setup-subwindow. wm withdraw . @@ -212,6 +215,12 @@ proc setimage {image} { variable subwindow_on_destroying variable subwindow_on_ready +variable w 50 +variable h 50 +variable deforient horizontal +variable border_colour darkblue +variable border_width 1 + proc subwindow-need-recreate {} { variable innerwindow_after debug "IW-EVENT" @@ -223,9 +232,9 @@ proc innerwindow-resetup {} { variable innerwindow_after variable subwindow_on_destroying variable subwindow_on_ready - variable subwindow_border_colour - variable subwindow_border_width - variable subwindow_default_orientation + variable border_colour + variable border_width + variable deforient unset innerwindow_after debug RESETUP @@ -239,22 +248,21 @@ proc innerwindow-resetup {} { set orientation [.i orientation] debug "orientation $orientation" if {![string compare $orientation unknown]} { - set orientation $subwindow_default_orientation + set orientation $deforient } .i configure -image applet::innerwindow-ph-$orientation - frame .i.i.b -background darkblue -bd 1 + frame .i.i.b -background $border_colour -bd $border_width pack .i.i.b -fill both -side left -expand 1 uplevel #0 $subwindow_on_ready [list $orientation] } -proc setup-subwindow { - w h default_orientation border_colour border_width on_destroying on_ready -} { - foreach v { - default_orientation border_width border_colour on_destroying on_ready - } { +proc setup-subwindow {on_destroying on_ready} { + variable w + variable h + + foreach v {on_destroying on_ready} { variable subwindow_$v [set $v] } @@ -274,10 +282,9 @@ proc setup-subwindow { variable subproc none variable ratelimit {} -proc setup-subproc {w h deforient border_colour border_width get_cmdline} { +proc setup-subproc {get_cmdline} { variable subproc_get_cmdline $get_cmdline - setup-subwindow $w $h $deforient $border_colour $border_width \ - applet::subproc-destroying applet::subproc-ready + setup-subwindow applet::subproc-destroying applet::subproc-ready } proc subproc-destroying {} { diff --git a/args.tcl b/args.tcl index fdcd596..248548b 100644 --- a/args.tcl +++ b/args.tcl @@ -6,9 +6,9 @@ proc badusage {msg} { exit 12 } -proc badoption {msg} { +proc badoption {} { variable lastarg - badusage "unknown option $msg" + badusage "unknown option $lastarg" } proc next {} { @@ -28,19 +28,14 @@ proc next_num {} { } } -set w 50 -set h 50 -set orientation horizontal -set bc darkblue -set bw 1 - -proc generalarg {} { - switch -exact $arg { - -width { set w [next_num] } - -height { set h [next_num] } - -horizontal - -vertical { set orientation $arg } - -borderColour - -borderColor { set bc [next] } - -borderWidth { set bw [next_num] } +proc generalarg {arg} { + switch -exact -- $arg { + -width { set applet::w [next_num] } + -height { set applet::h [next_num] } + -horizontal - -vertical { set applet::deforient $arg } + -borderColour - -borderColor { set applet::border_colour [next] } + -borderWidth { set applet::border_width [next_num] } + -debug { applet::setup-debug puts } default { return 0 } } return 1 diff --git a/example b/example index 0321c6b..6d3eb65 100755 --- a/example +++ b/example @@ -1,6 +1,9 @@ #!/usr/bin/wish8.4 -f # -*- Tcl -*- +# usage: +# xbatmon-simple-tray + source applet.tcl source subproc.tcl @@ -25,4 +28,4 @@ proc cmdline {id orientation} { return [list xacpi-simple -into $id] } -applet::setup-subproc 40 40 horizontal darkblue 1 cmdline +applet::setup-subproc cmdline diff --git a/xbatmon-simple-tray b/xbatmon-simple-tray index 876cccb..e53945a 100755 --- a/xbatmon-simple-tray +++ b/xbatmon-simple-tray @@ -1,6 +1,10 @@ -#!/usr/bin/wish +#!/usr/bin/wish -f # -*- Tcl -*- +# usage: +# xbatmon-simple-tray +# [WISH-OPTIONS... [-- TRAY-EMBED-OPTIONS... [-- XBATMON-SIMPLE-OPTIONS...]]] + source applet.tcl source subproc.tcl source args.tcl @@ -11,10 +15,10 @@ proc cmdline {id orientation} { } while {[args::next_special arg]} { - switch -exact $arg { + switch -exact -- $arg { -- { break } default { args::badoption } } } -applet::setup-subproc $args::w $args::h $args::orientation $args::bc $args::bw cmdline +applet::setup-subproc cmdline