chiark / gitweb /
raise tooltip
[chiark-tcl-applet.git] / args.tcl
1
2 namespace eval args {
3
4 proc badusage {msg} {
5     puts stderr "bad usage: $msg"
6     exit 12
7 }
8
9 proc badoption {} {
10     variable lastarg
11     badusage "unknown option $lastarg"
12 }
13
14 proc next {} {
15     global argv
16     variable lastarg
17     if {![llength $argv]} { badusage "$lastarg needs a value" }
18     set arg [lindex $argv 0]
19     set argv [lrange $argv 1 end]
20     set lastarg $arg
21 }
22
23 proc next_num {} {
24     set arg [next]
25     variable lastarg
26     if {[catch { eval {$arg + 0} } emsg]} { 
27         badusage "$lastargv value must be a number ($emsg)"
28     }
29 }
30
31 proc generalarg {arg} {
32     switch -exact -- $arg {
33         -width { set applet::w [next_num] }
34         -height { set applet::h [next_num] }
35         -horizontal - -vertical { set applet::deforient $arg }
36         -borderColour - -borderColor { set applet::border_colour [next] }
37         -borderWidth { set applet::border_width [next_num] }
38         -debug { debug::setup puts }
39         default { return 0 }
40     }
41     return 1
42 }
43
44 proc more {} {
45     global argv
46     if {![llength $argv]} { return 0 }
47     if {![regexp {^-} [lindex $argv 0]]} { return 0 }
48     return 1
49 }
50
51 proc next_special {va} {
52     upvar 1 $va arg
53     global argv
54     while {[more]} {
55         set arg [next]
56         if {[generalarg $arg]} continue
57         return 1
58     }
59     return 0
60 }
61
62 }