home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / mep1 / Samples / Programs / getopt.icn < prev    next >
Encoding:
Text File  |  1989-05-09  |  2.5 KB  |  72 lines  |  [TEXT/PICN]
  1. ############################################################################
  2. #
  3. #  getopt.icn
  4. #  
  5. #     getopt(arg,optstring) -- Get options from parameter string.
  6. #  
  7. #     This procedure analyzes the parameter string. Its inputs are:
  8. #  
  9. #       arg         the argument list as passed to the main pro-
  10. #                   cedure.
  11. #  
  12. #       optstring   a string of allowable option letters. If a
  13. #                   letter is followed by ":" the corresponding
  14. #                   option is assumed to be followed by a string of
  15. #                   data, optionally separated from the letter by
  16. #                   space. If instead of ":" the letter is followed
  17. #                   by a "+", the parameter will converted to an
  18. #                   integer; if a ".", converted to a real.  If opt-
  19. #                   string is omitted any letter is assumed to be
  20. #                   valid and require no data.
  21. #  
  22. #     It returns a list consisting of two items:
  23. #  
  24. #       [1]  a table of options specified. The entry values are the
  25. #            specified option letters. The assigned values are the
  26. #            data words following the options, if any, or 1 if the
  27. #            option has no data. The table's default value is &null.
  28. #  
  29. #       [2]  a list of remaining parameters in the parameter string
  30. #            (usually file names). A "-" which is not followed by a
  31. #            letter is taken as a file name rather than an option.
  32. #  
  33. #     If an error is detected, stop() is called with an appropriate
  34. #  error message. After calling getopt() the original argument list,
  35. #  arg, is empty.
  36. #  
  37. ############################################################################
  38. #
  39. #  Many thanks to Bob Alexander, who wrote this procedure and placed it in
  40. #  the public domain.
  41. #
  42. ############################################################################
  43.  
  44. procedure getopt(arg,optstring)
  45.     local x,i,c,otab,flist,o,p
  46.     /optstring := string(&lcase ++ &ucase)
  47.     otab := table()
  48.     flist := []
  49.     while x := get(arg) do
  50.         x ? {
  51.             if ="-"  & not pos(0) then
  52.                 while c := move(1) do
  53.                     if i := find(c,optstring) + 1 then
  54.                         otab[c] :=
  55.                             if any(':+.',o := optstring[i]) then {
  56.                                 p := "" ~== tab(0) | get(arg) |
  57.                                     stop("No parameter following ",x)
  58.                                 case o of {
  59.                                     ":": p
  60.                                     "+": integer(p) |
  61.                                          stop("-",c," needs numeric parameter")
  62.                                     ".": real(p) |
  63.                                          stop("-",c," needs numeric parameter")
  64.                                     }
  65.                                 }
  66.                             else 1
  67.                        else stop("Unrecognized option: ",x)
  68.             else put(flist,x)
  69.             }
  70.     return [otab,flist]
  71. end
  72.