home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume29 / parseargs / part02 / parseargs.tcl < prev    next >
Encoding:
Text File  |  1992-05-19  |  4.7 KB  |  123 lines
  1. #########################################################################
  2. # ^FILE: parseargs.tcl - parseargs for tcl scripts
  3. #
  4. # ^DESCRIPTION:
  5. #    This file defines a tcl procedure named parseargs to parse
  6. #    command-line arguments for tcl scripts.
  7. #
  8. # ^HISTORY:
  9. #    05/07/92  Brad Appleton   <brad@ssd.csd.harris.com>   Created
  10. ##^^#####################################################################
  11.  
  12. ########
  13. # ^PROCEDURE: parseargs - parse command-line argument lists
  14. #
  15. # ^SYNOPSIS:
  16. #    parseargs <options> -- $scriptName arg [arg ...]
  17. #
  18. #        where <options> is any valid option combination for parseargs(1)
  19. #
  20. # ^DESCRIPTION:
  21. #    Parseargs will invoke parseargs(1) with the options and arguments
  22. #    specified by the caller.
  23. #
  24. # ^RETURN-VALUE:
  25. #    A string of variable settings for the caller to evaluate
  26. #
  27. # ^EXAMPLE:
  28. #     #!/usr/bin/tcl -q
  29. #     
  30. #     source parseargs.tcl
  31. #     
  32. #     set arguments {
  33. #       { '?', ARGHIDDEN, argUsage, NULL,    "Help : print usage and exit" },
  34. #       { 'S', ARGVALOPT, argStr,   string,  "STRing : optional string arg" },
  35. #       { 'g', ARGLIST,   argStr,   groups,  "newsGROUPS : groups to test" },
  36. #       { 'r', ARGOPT,    argInt,   count,   "REPcount : group repeat count" },
  37. #       { 'd', ARGOPT,    argStr,   dirname, "DIRectory : working directory" },
  38. #       { 'x', ARGOPT,    argBool,  xflag,   "Xflag : turn on X-mode" },
  39. #       { 'y', ARGOPT,    argUBool, yflag,   "Yflag : turn off Y-mode" },
  40. #       { 's', ARGOPT,    argChar,  sepch,   "SEPchar : field separator" },
  41. #       { 'f', ARGLIST,   argStr,   files,   "files : files to process" },
  42. #       { 'n', ARGREQ|ARGPOS, argStr, name,  "name : name to use" },
  43. #       { ' ', ARGLIST,   argStr,   argv,    "argv : remaining arguments" },
  44. #       ENDOFARGS
  45. #     }
  46. #     
  47. #     set count 1 ;    set dirname "." ;   set sepch "," ;
  48. #     set xflag "" ;   set yflag "TRUE" ;
  49. #     set files {} ;   set groups {} ;  set name "" ;
  50. #     set string "" ;  set string_flag "" ;
  51. #     
  52. #     eval [ parseargs -u -a $arguments $scriptName $argv ]
  53. #
  54. #
  55. # ^ALGORITHM:
  56. #    We need to do an "eval exec parseargs $args" in order have exec
  57. #    treat $args as many arguments instead of just one argument. Before
  58. #    we can do that however, we must quote each argument in $args and
  59. #    escape any special characters that it contains.  Hence we have the
  60. #    following algorithm:
  61. #
  62. #       - quote and escape special character for each arg in $args
  63. #       - do an "eval exec $args" and save the results
  64. #       - if parseargs(1) exit-status is non-zero than exit (and make
  65. #            sure the parseargs message(s) is/are printed).
  66. #         else
  67. #            return the standard-output of parseargs(1)
  68. #         endif
  69. #
  70. #
  71. # ^BUGS:
  72. #    Actually - this procedure doesnt work. It has some problems,
  73. #    some of which I know about and can describe below:
  74. #
  75. # 1) TCL refuses to let ME do the error-checking after exec'ing parseargs(1).
  76. #    What I need to do is look at the exit-status and exit if it is non-zero.
  77. #    If parseargs happens to write anything to stderr (which it always does
  78. #    if it prints usage or a syntax error) then TCL automatically terminates
  79. #    my procedure (not the process) and doesnt let me check the exit-status.
  80. #
  81. # 2) Error messages printed by parseargs(1) are prefixed with "Error: "
  82. #    and suffixed by some other error-message info added by TCL. I dont
  83. #    want ANY of this, just let parseargs(1) print the error text and dont
  84. #    embellish it. As a fix, I tried to have parseargs(1) write error messages
  85. #    to stdout (for TCL only) and exit with a non-zero status. This didnt
  86. #    work at all (and Im not completely sure as to why).
  87. #
  88. # 3) I ought to be able to use far fewer "regsub" statements below but I
  89. #    couldnt seem to get "&" or "\0" to work as documented as substitution
  90. #    strings.
  91. #
  92. # If you happen to get this procedure (along with test.tcl) working, then
  93. # please, PLEASE let me know and tell me how you did it!!
  94. #
  95. ###^^####
  96. proc parseargs args {
  97.    set escaped_args {}
  98.    foreach arg $args {
  99.       regsub -all "\\\\" "$arg" "\\\\" arg
  100.       regsub -all "\\\$" "$arg" "\\\$" arg
  101.       regsub -all "\\\[" "$arg" "\\\[" arg
  102.       regsub -all "\]" "$arg" "\\\]" arg
  103.       regsub -all "\{" "$arg" "\\\{" arg
  104.       regsub -all "\]" "$arg" "\\\]" arg
  105.       regsub -all "\"" "$arg" "\\\"" arg
  106.       regsub -all "\t" "$arg" "\\t" arg
  107.       regsub -all "\n" "$arg" "\\n" arg
  108.       regsub -all "\r" "$arg" "\\r" arg
  109.       regsub -all "\v" "$arg" "\\v" arg
  110.       regsub -all "\f" "$arg" "\\f" arg
  111.       regsub -all "\b" "$arg" "\\b" arg
  112.       append escaped_args " \"$arg\""
  113.    }
  114.    set  errorCode {}
  115.    set  opt_settings [ eval exec parseargs -s tcl $escaped_args ]
  116.    if {( $errorCode != {} )} { 
  117.       ## echo $opt_settings
  118.       exit [lindex $errorCode 2]
  119.    }
  120.    return  $opt_settings ;
  121. }
  122.  
  123.