Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/smlnj-lib/Util/getopt.sml
ViewVC logotype

Diff of /sml/trunk/src/smlnj-lib/Util/getopt.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 815, Fri May 4 05:09:10 2001 UTC revision 816, Fri May 4 16:37:36 2001 UTC
# Line 46  Line 46 
46    
47      (* formatting of options *)      (* formatting of options *)
48    
49      fun fmtShort (NoArg _) so = concat ["-",Char.toString so]      fun fmtShort (NoArg _) so = concat ["-", str so]
50        | fmtShort (ReqArg (_,ad)) so = concat ["-",Char.toString so," ",ad]        | fmtShort (ReqArg (_,ad)) so = concat ["-", str so," ",ad]
51        | fmtShort (OptArg (_,ad)) so = concat ["-",Char.toString so,"[",ad,"]"]        | fmtShort (OptArg (_,ad)) so = concat ["-", str so,"[",ad,"]"]
52    
53      fun fmtLong (NoArg _) lo = concat ["--",lo]      fun fmtLong (NoArg _) lo = concat ["--",lo]
54        | fmtLong (ReqArg (_,ad)) lo = concat ["--",lo,"=",ad]        | fmtLong (ReqArg (_,ad)) lo = concat ["--",lo,"=",ad]
# Line 63  Line 63 
63      fun usageInfo {header, options} = let      fun usageInfo {header, options} = let
64            fun unlines l = sepBy ("\n", l)            fun unlines l = sepBy ("\n", l)
65            val fmtOptions = map fmtOpt options            val fmtOptions = map fmtOpt options
66            val (ms1,ms2,ms3) = foldl            val (ms1, ms2) = foldl
67                  (fn ((e1,e2,e3), (m1,m2,m3)) => (                  (fn ((e1,e2,_), (m1,m2)) => (
68                      Int.max (size e1,m1),                      Int.max (size e1,m1),
69                      Int.max (size e2,m2),                      Int.max (size e2, m2)
70                      Int.max (size e3,m3)                    )) (0,0) fmtOptions
                   )) (0,0,0) fmtOptions  
71            val pad = StringCvt.padRight #" "            val pad = StringCvt.padRight #" "
72            val table = foldr            val table = foldr
73                  (fn ((e1,e2,e3),l) => concat [                  (fn ((e1,e2,e3),l) => concat [
74                        "  ", pad ms1 e1, "  ", pad ms2 e2, "  ", pad ms3 e3                        "  ", pad ms1 e1, "  ", pad ms2 e2, "  ", e3
75                      ] :: l                      ] :: l
76                    ) [] fmtOptions                    ) [] fmtOptions
77            in            in
# Line 142  Line 141 
141                  in                  in
142                    long (map #desc options, arg, rest)                    long (map #desc options, arg, rest)
143                  end                  end
144          (* handle short option *)          (* handle short option.  x is the option character, subs is the
145             * rest of the option string, rest is the rest of the command-line
146             * options.
147             *)
148            fun shortOpt (x, subs, rest, optDescr : 'a opt_descr list) = let            fun shortOpt (x, subs, rest, optDescr : 'a opt_descr list) = let
149                  val options =                  val options =
150                        List.filter (fn {short,...} => Char.contains short x) optDescr                        List.filter (fn {short,...} => Char.contains short x) optDescr
151                  val ads = map #desc options                  val ads = map #desc options
152                  val optStr = "-"^(Char.toString x)                  val optStr = "-"^(str x)
153                  fun short (_::_::_, _, rest1) = (                  in
154                        errAmbig optStr; (NonOpt optStr, rest1))                    case (ads, rest)
155                    | short ((NoArg a)::_, y, rest') =                     of (_::_::_, rest1) => (errAmbig optStr; (NonOpt optStr, rest1))
156                        if (SS.isEmpty y)                      | ((NoArg a)::_, rest') =>
157                            if (SS.isEmpty subs)
158                          then (Opt(a()), rest')                          then (Opt(a()), rest')
159                          else (Opt(a()), ("-"^(SS.string y))::rest')                            else (Opt(a()), ("-"^(SS.string subs))::rest')
160                    | short ((ReqArg (f,d))::_, y, []) =                      | ((ReqArg(f,d))::_, []) =>
161                        if (SS.isEmpty y)                          if (SS.isEmpty subs)
162                          then (errReq(d, optStr); (NonOpt optStr, []))                          then (errReq(d, optStr); (NonOpt optStr, []))
163                          else (Opt(f (SS.string y)), [])                            else (Opt(f (SS.string subs)), [])
164                    | short ((ReqArg(f,_))::_, y, rest' as (r::rs)) =                      | ((ReqArg(f,_))::_, rest' as (r::rs)) =>
165                        if (SS.isEmpty y)                          if (SS.isEmpty subs)
166                          then (Opt(f r), rs)                          then (Opt(f r), rs)
167                          else (Opt(f (SS.string y)), rest')                            else (Opt(f (SS.string subs)), rest')
168                    | short ((OptArg(f,_))::_, y, rest') =                      | ((OptArg(f,_))::_, rest') =>
169                        if (SS.isEmpty y)                          if (SS.isEmpty subs)
170                          then (Opt(f NONE), rest')                          then (Opt(f NONE), rest')
171                          else (Opt(f (SOME (SS.string y))), rest')                            else (Opt(f (SOME(SS.string subs))), rest')
172                    | short ([], y, rest') =                      | ([], rest') =>
173                        if (SS.isEmpty y)                          if (SS.isEmpty subs)
174                          then (errUnrec optStr; (NonOpt optStr, rest'))                          then (errUnrec optStr; (NonOpt optStr, rest'))
175                          else (                          else (
176                            errUnrec optStr;                            errUnrec optStr;
177                            (NonOpt optStr, ("-" ^ SS.string y)::rest'))                              (NonOpt optStr, ("-" ^ SS.string subs)::rest'))
178                  in                    (* end case *)
                   short (ads, subs, rest)  
179                  end                  end
180          (* take a look at the next command line argument and decide what to          (* take a look at the next command line argument and decide what to
181           * do with it           * do with it

Legend:
Removed from v.815  
changed lines
  Added in v.816

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0