
/* Poor man's getopt. This is a quick-and-dirty replacement for the GNU
   getopt_long function. Copyright (c) 2006 by Albert Graef. */

/* $Id: getopt.q,v 1.5 2008/01/23 05:57:22 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* The getopt function takes two arguments: OPTS, a list of option
   descriptions in the format described below, and ARGS, a list of strings
   containing the command line parameters to be parsed for options. The result
   is a pair (OPTS,ARGS) where OPTS is a list of pairs of options and their
   arguments (if any; missing arguments are returned as ()), and ARGS is the
   list of remaining (non-option) arguments. Options are parsed using the
   rules of GNU getopt(1). If an invalid option is encountered (unrecognized
   option, missing or extra argument, etc.), getopt throws the offending
   option string as an exception.

   The OPTS argument of getopt is a list of triples (LONG,SHORT,FLAG), where
   LONG denotes the long option, SHORT the equivalent short option, and FLAG
   is one of the symbolic integer values NOARG, OPTARG and REQARG which
   specifies whether the option has no argument, an optional argument or a
   required argument, respectively. In the returned option-value list, all
   options will be represented using their long option equivalents.

   Also note that both the long and short option values in the OPTS argument
   may actually be any values, so unneeded options may be replaced with
   corresponding dummy values. Moreover, non-option parameters, as well as
   option arguments which are specified as separate parameters can be
   arbitrary values, too. Note, however, that an option will only be
   recognized if it is a string starting with the "-" character for which a
   corresponding entry can be found in getopt's OPTS argument. */

public const var NOARG = 0, REQARG = 1, OPTARG = 2;

public getopt OPTS ARGS;

private opt, longopt, shortopt, scanopt, checkopt,
  find_longopt, find_shortopt, prefix;

getopt OPTS ARGS
		= opt OPTS ([],[]) ARGS;

opt OPTS (O,A) []
		= (O,A);
opt OPTS (O,A) ["--"|ARGS]
		= (O,A++ARGS);
opt OPTS (O,A) [ARG|ARGS]
		= opt OPTS (O,A++[ARG]) ARGS
		    if not isstr ARG or else (ARG="-") or else
		      (sub ARG 0 0<>"-");
		= opt OPTS (O++VALS,A) ARGS
		    where (VALS,ARGS) = longopt OPTS ARG ARGS;
		= opt OPTS (O++VALS,A) ARGS
		    where (VALS,ARGS) = shortopt OPTS ARG ARGS;
		= throw ARG otherwise;

longopt OPTS ARG ARGS
		= ([(OPT,VAL)],ARGS)
		    where [(OPT,VAL)] = regex "" "^--([^=]+)=(.*)$" ARG
		      (reg 1,reg 2),
		      (LONG,SHORT,FLAG) = find_longopt OPTS OPT,
		      (OPT,VAL,ARGS) = checkopt FLAG LONG VAL ARGS;
		= ([(OPT,VAL)],ARGS)
		    where [OPT] = regex "" "^--([^=]+)$" ARG
		      (reg 1),
		      (LONG,SHORT,FLAG) = find_longopt OPTS OPT,
		      (OPT,VAL,ARGS) = checkopt FLAG LONG () ARGS;

shortopt OPTS ARG ARGS
		= (zip (map fst OPT1) (map (cst ()) OPT1)++[(OPT,VAL)],
		   ARGS)
		    where (LONG,SHORT,FLAG) = OPT2,
		      (OPT,VAL,ARGS) = checkopt FLAG LONG VAL ARGS
		    if all ((=NOARG).(!2)) OPT1
		    where ["-"|CHARS] = chars ARG,
		      OPT = scanopt $ map (find_shortopt OPTS) CHARS,
		      OPT1:List = init OPT, OPT2 = last OPT,
		      VAL = sub ARG (#OPT+1) (#ARG-1),
		      VAL = ifelse (null VAL) () VAL;

scanopt [(LONG,SHORT,FLAG)|OPT]
		= [(LONG,SHORT,FLAG)] if FLAG<>NOARG;
		= [(LONG,SHORT,FLAG)|scanopt OPT] otherwise;
scanopt _	= [] otherwise;

checkopt FLAG LONG VAL ARGS
		= (LONG,(),ARGS) if (FLAG=NOARG) and then null VAL;
		= (LONG,VAL,ARGS) if (FLAG<>NOARG) and then neq () VAL;
		= (LONG,(),ARGS) if FLAG=OPTARG;
checkopt FLAG LONG VAL [ARG|ARGS]
		= (LONG,ARG,ARGS) if FLAG=REQARG;

prefix X:String Y:String
		= (N<=M) and then (X=sub Y 0 (N-1))
		    where N=#X, M=#Y;
prefix _ _	= false otherwise;

find_longopt OPTS OPT
		= (LONG,SHORT,FLAG)
		    where [(LONG,SHORT,FLAG)] =
		      filter ((prefix $ "--"++OPT).fst) OPTS;

find_shortopt OPTS OPT
		= (LONG,SHORT,FLAG)
		    where [(LONG,SHORT,FLAG)|_] =
		      dropwhile ((neq $ "-"++OPT).snd) OPTS;
