head	1.1;
access;
symbols;
locks
	root:1.1; strict;
comment	@# @;


1.1
date	94.12.15.11.52.20;	author root;	state Exp;
branches;
next	;


desc
@a getopt for tcl
@


1.1
log
@Initial revision
@
text
@#!/usr/local/bin/tclsh
#
# A short getopt for tcl. This is so that we can use arguments to tclsh
# scripts.
#
# Written by: Alistair G. Crooks
# (agc@@uts.amdahl.com)
# 15th December 1994
#

set optind 0
set optarg ""

proc getopt { argv optstr } {
	global optind optarg

	set optarg ""
	set arg [lindex $argv $optind]
	incr optind
	if { [string index $arg 0] != "-" } {
		return EOF
	}
	if { [string length $arg] <= 1 } {
		puts stderr "Bad option `$ret'"
		return EOF
	}
	set ret [string index $arg 1]
	set ind [string first $ret $optstr]
	if { $ind < 0 } {
		puts stderr "Not an option `$ret'"
		return EOF
	}
	if { [string index $optstr [expr $ind+1]] != ":" } {
		# a simple argument - return it
		return $ret
	}
	if { [string length $arg] > 2 } {
		# -carg form
		set optarg [string range $arg 2 end]
		return $ret
	}
	if { $optind >= [llength $argv] } {
		puts stderr "No arg to $ret"
		return EOF
	}
	set optarg [lindex $argv $optind]
	if { [string index $optarg 0] == "-" } {
		puts stderr "`$ret' takes an argument"
		return EOF
	}
	incr optind
	return $ret
}

while 1 {
	set opt [getopt $argv "a:b:c:d:e:f:ghijkl"]
	if { $opt == "EOF" } {
		break
	}
	puts stdout "arg is `$opt', optarg is `$optarg'"
}
@
