chiark / gitweb /
fdcd59670050bdd87cbf9e530b2c381eb3ff41b3
[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 {msg} {
10     variable lastarg
11     badusage "unknown option $msg"
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 set w 50
32 set h 50
33 set orientation horizontal
34 set bc darkblue
35 set bw 1
36
37 proc generalarg {} {
38     switch -exact $arg {
39         -width { set w [next_num] }
40         -height { set h [next_num] }
41         -horizontal - -vertical { set orientation $arg }
42         -borderColour - -borderColor { set bc [next] }
43         -borderWidth { set bw [next_num] }
44         default { return 0 }
45     }
46     return 1
47 }
48
49 proc more {} {
50     global argv
51     if {![llength $argv]} { return 0 }
52     if {![regexp {^-} [lindex $argv 0]]} { return 0 }
53     return 1
54 }
55
56 proc next_special {va} {
57     upvar 1 $va arg
58     global argv
59     while {[more]} {
60         set arg [next]
61         if {[generalarg $arg]} continue
62         return 1
63     }
64     return 0
65 }
66
67 }