home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / cvs110.zip / cvs / bin / cvs2log.cmd < prev    next >
OS/2 REXX Batch file  |  1998-08-21  |  20KB  |  701 lines

  1. /*
  2. ** $Id: cvs2log.cmd,v 1.1.2.1 1998/06/23 12:32:36 ahuber Exp $
  3. **
  4. ** CVS to ChangeLog generator.
  5. **
  6. ** Generate a change log prefix from a CVS repository and the
  7. ** ChangeLog (if any). The new prefix is prepended to the ChangeLog.
  8. ** The editor specified by the CVSEDITOR environment variable (or a
  9. ** default editor, if CVSEDITOR is not set) is invoked with the new
  10. ** ChangeLog as an argument.
  11. **
  12. ** The files %HOME%\.cvsauthors and/or %ETC%\.cvsauthors contain a
  13. ** list of all known login names and their corresponding full names
  14. ** and email addresses.
  15. **
  16. ** Usage: cvs2log [-?Rgv] [-c changelog] [-d date] [-i indent]
  17. **   [-l length] [-t tabwidth] [-A authors] [files...]
  18. **
  19. ** Options:
  20. **  -?            Display usage information.
  21. **  -R            Process directories recursively.
  22. **  -c changelog  Specify a different name for the ChangeLog
  23. **                (default 'ChangeLog').
  24. **  -g            Use a 'global' changelog, as opposed to a ChangeLog
  25. **                local to each directory.
  26. **  -d date       Specify a date argument to 'cvs log'.
  27. **  -i indent     Indent ChangeLog lines by 'indent' spaces (default 8).
  28. **  -l length     Try to limit log lines to 'length' characters
  29. **                (default 79).
  30. **  -t tabwidth   Tab stops are every 'tabwidth' characters (default 8).
  31. **  -v            Append RCS revision to file names in log lines.
  32. **  -a authors    Specify a different path for '.cvsauthors'.
  33. **
  34. ** 'files...' can be any combination of files (including wildcards) and
  35. ** (CVS controlled) directories.
  36. **
  37. ** Log entries that start with '#' are ignored.
  38. ** Log entries that start with '{topic}', where 'topic' contains
  39. ** neither white space nor '}', are clumped together.
  40. **
  41. ** Based on rcs2log.sh by Paul Eggert <eggert@twinsun.com>.
  42. **
  43. ** Copyright (C) 1998  Andreas Huber <ahuber@ping.at>
  44. **
  45. ** This program is free software; you can redistribute it and/or
  46. ** modify it under the terms of the GNU General Public License
  47. ** as published by the Free Software Foundation; either version 2
  48. ** of the License, or (at your option) any later version.
  49. **
  50. ** This program is distributed in the hope that it will be useful,
  51. ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  52. ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  53. ** GNU General Public License for more details.
  54. **
  55. ** You should have received a copy of the GNU General Public License
  56. ** along with this program; see the file COPYING. If not, write to
  57. ** the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  58. ** Boston, MA 02111-1307, USA.
  59. */
  60. call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  61. call SysLoadFuncs
  62.  
  63. /*
  64. ** Constants.
  65. **/
  66. EXIT_SUCCESS        = 0
  67. EXIT_FAILURE        = 1
  68. EXIT_USAGE            = 2
  69. EXIT_SIGNAL            = 3
  70.  
  71. FALSE                = 0
  72. TRUE                = \FALSE
  73.  
  74. MONTHS                = 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec'
  75.  
  76. SOH                    = d2c(1)
  77. TAB                    = d2c(9)
  78.  
  79. CVSEDITOR_DEFAULT    = 'tedit'
  80.  
  81. /*
  82. ** Configurable options.
  83. */
  84. recursive            = FALSE
  85. datearg                = ''
  86. global_changelog    = FALSE
  87. changelog_name        = 'ChangeLog'
  88. changelog_prefix    = 'ChangeLog.new'
  89. line_length            = 79
  90. line_indent            = 8
  91. tabwidth            = 8
  92. cvsauthors            = ''
  93. revision            = FALSE
  94. cvseditor            = ''
  95.  
  96. /*
  97. ** Global names known to all procedures.
  98. */
  99. globals = 'EXIT_SUCCESS EXIT_USAGE EXIT_FAILURE EXIT_SIGNAL',
  100.     ' FALSE TRUE argc argv. MONTHS SOH TAB',
  101.     'recursive datearg global_changelog changelog_name changelog_prefix',
  102.     'line_length line_indent tabwidth cvsauthors revision cvseditor',
  103.     'fullname. mailaddr.'
  104.  
  105. /*
  106. ** Main body.
  107. */
  108. main:
  109.     argc = 1; argv. = ''; argv.0 = 'cvs2log'
  110.     signal on halt name signal_handler
  111.     do i = 1 to arg(); call setargv arg(i); end
  112.     optind = 0
  113.     options = '?Rc::d::gi::l::t::va::'
  114.     do forever
  115.         c = getopt(options)
  116.         if c <= 0 then leave
  117.         select
  118.             when c = '?' | c = ':' then call usage
  119.             when c = 'R' then recursive = TRUE
  120.             when c = 'c' then changelog_name = optarg
  121.             when c = 'g' then global_changelog = TRUE
  122.             when c = 'd' then datearg = ' "-d'||optarg||'"'
  123.             when c = 'i' then line_indent = numeric_argument(1, 100)
  124.             when c = 'l' then line_length = numeric_argument(40, 200)
  125.             when c = 't' then tabwidth = numeric_argument(0, 100)
  126.             when c = 'v' then revision = TRUE
  127.             when c = 'a' then cvsauthors = optarg
  128.             otherwise exit EXIT_FAILURE
  129.         end
  130.     end
  131.     files = ''
  132.     do while optind < argc
  133.         path = translate(argv.optind, '/', '\')
  134.         i = lastpos('/', path)
  135.         if i < length(path) then if is_directory(path) then do
  136.             path = path||'/'
  137.             i = length(path)
  138.         end
  139.         dir = substr(path, 1, i)
  140.         if dir = '' then
  141.             dir = './'
  142.         filename = substr(argv.optind, i+1)
  143.         if filename = '' then
  144.             filename = '*'
  145.         if wordpos(dir, files) = 0 then do
  146.             files = files dir
  147.             files.dir = ''
  148.         end
  149.         if filename = '*' then
  150.             files.dir = filename
  151.         else if files.dir \= '*' then
  152.             files.dir = files.dir filename
  153.         optind = optind+1
  154.     end
  155.     cvseditor = value('CVSEDITOR',, 'OS2ENVIRONMENT')
  156.     if cvseditor = '' then cvseditor = CVSEDITOR_DEFAULT
  157.     call read_authors
  158.     repository = ''
  159.     if global_changelog then do
  160.         call parse_changelog './'
  161.         repository = get_repository('./')
  162.         text. = ''; text.0 = 0
  163.     end
  164.     if files = '' then
  165.         call do_directory './', '*', repository
  166.     else do
  167.         do i = 1 to words(files)
  168.             dir = word(files, i)
  169.             call do_directory dir, files.dir, repository
  170.         end
  171.     end
  172.     if global_changelog then do
  173.         call sort_log
  174.         call format_log './'
  175.         call edit_changelog './'
  176.     end
  177.     exit EXIT_SUCCESS
  178.  
  179. edit_changelog: procedure expose (globals)
  180.     parse arg dir
  181.     dir = translate(dir, '\', '/')
  182.     if exists(dir||changelog_prefix) then do
  183.         tempname = SysTempFileName(dir||changelog_name||'.?????')
  184.         '@copy' dir||changelog_prefix '+' dir||changelog_name,
  185.             tempname '>nul 2>&1'
  186.         '@erase' dir||changelog_name dir||changelog_prefix '>nul 2>&1'
  187.         '@rename' tempname dir||changelog_name  '>nul 2>&1'
  188.         '@'||cvseditor dir||changelog_name
  189.     end
  190.     return
  191.  
  192. parse_timestamp: procedure expose (globals)
  193.     parse arg line
  194.     if verify(line, ' '||TAB) > 1 then return ''
  195.     parse var line year '-' month '-' day .
  196.     if year \= '' & month \= '' & day \= '' then
  197.         return ' "-d>'||year||'-'||month||'-'||day||'"'
  198.     parse var line . ' ' month ' ' day ' ' . ':' . ':' . ' ' year .
  199.     if year \= '' & month \= '' & day \= '' then do
  200.         month = wordpos(month, MONTHS)
  201.         return ' "-d>'||year||'-'||month||'-'||day||'"'
  202.     end
  203.     parse var line day ' ' month ' ' year .
  204.     if year \= '' & month \= '' & day \= '' then do
  205.         month = wordpos(month, MONTHS)
  206.         return ' "-d>'||year||'-'||month||'-'||day||'"'
  207.     end
  208.     parse var line . ', ' day ' ' month ' ' year .
  209.     if year \= '' & month \= '' & day \= '' then do
  210.         month = wordpos(month, MONTHS)
  211.         return ' "-d>'||year||'-'||month||'-'||day||'"'
  212.     end
  213.     return ''
  214.  
  215. parse_changelog: procedure expose (globals) tz dateval
  216.     parse arg dir
  217.     dateval = datearg
  218.     filename = dir||changelog_name
  219.     if stream(filename, 'c', 'query size') = 0 then
  220.         return FALSE
  221.     call stream filename, 'c', 'open read'
  222.     do while lines(filename) > 0
  223.         line = translate(linein(filename), ' ', TAB)
  224.         if dateval = '' then dateval = parse_timestamp(line)
  225.         line = space(line, 0)
  226.         parse var line '#change-log-time-zone-rule:' tz
  227.         if tz \= '' then leave
  228.     end
  229.     call stream filename, 'c', 'close'
  230.     if tz = '' then
  231.         tz = value('TZ',, 'OS2ENVIRONMENT')
  232.     return TRUE
  233.  
  234. exists: procedure expose (globals)
  235.     parse arg filename
  236.     return stream(filename, 'c', 'query size') \= ''
  237.  
  238. is_directory: procedure expose (globals)
  239.     parse arg path
  240.     if pos('?', path) > 0 | pos('*', path) > 0 then
  241.         return false
  242.     filespec = translate(path, '\', '/')
  243.     if SysFileTree(filespec, filelist, 'do', '*+-*-') \= 0 then
  244.         call die '"'||path||'": Not enough memory'
  245.     return filelist.0 > 0
  246.  
  247. do_directory: procedure expose (globals) dateval tz text.
  248.     parse arg dir, filelist, repository
  249.     call do_files dir, filelist, repository
  250.     if filelist = '*' & recursive then do
  251.         call read_entries dir
  252.         do i = 1 to entries.0
  253.             dir = dir||entries.i||'/'
  254.             call do_directory dir, '*', repository
  255.         end
  256.     end
  257.     return
  258.  
  259. do_files: procedure expose (globals) dateval tz text.
  260.     parse arg dir, filelist, repository
  261.     if \global_changelog then do
  262.         call parse_changelog dir
  263.         repository = get_repository(dir)
  264.         text. = ''; text.0 = 0
  265.     end
  266.     call parse_log dir, filelist, repository
  267.     if \global_changelog then do
  268.         call sort_log
  269.         call format_log dir
  270.         call edit_changelog dir
  271.     end
  272.     return
  273.  
  274. format_log: procedure expose (globals) tz text.
  275.     parse arg dir
  276.     changelog = dir||changelog_prefix
  277.     if stream(changelog, 'c', 'open write') \= 'READY:' then
  278.         call die 'Cannot write to' changelog '.'
  279.     indent_string = ''
  280.     i = line_indent
  281.     if tabwidth > 0 then do while i >= tabwidth
  282.         indent_string = indent_string||TAB
  283.         i = i-tabwidth
  284.     end
  285.     do i; indent_string = indent_string||' '; end
  286.     hostname = get_hostname()
  287.     date = ''; time = ''; author = ''; log = ''
  288.     clumpname = ''; files = ''; filesknown. = FALSE
  289.     do i = 1 to text.0
  290.         parse var text.i nfilename nrev ndate ntime nauthor (SOH) nlog
  291.         nclumpname = ''
  292.         if left(nlog, 1) = '{' then do
  293.             p = verify(nlog, ' }'||TAB||SOH, 'm')
  294.             if substr(nlog, p, 1) = '}' then do
  295.                 nclumpname = substr(nlog, 2, p-2)
  296.                 nlog = substr(nlog,,
  297.                     p+verify(substr(nlog, p+1), ' '||TAB))
  298.             end
  299.         end
  300.         if log \= nlog | date \= ndate | author \= nauthor then do
  301.             if date \= '' then do
  302.                 call print_log changelog, files, log
  303.                 if nclumpname = '' | nclumpname \= clumpname then
  304.                     call lineout changelog, ''
  305.             end
  306.             clumpname = nclumpname
  307.             log = nlog
  308.             files = ''; filesknown. = FALSE
  309.         end
  310.         if date \= ndate | author \= nauthor then do
  311.             date = ndate; time = ntime; author = nauthor
  312.             zone = ''
  313.             if tz \= '' then do
  314.                 p = pos('-', time)
  315.                 if p = 0 then p = pos('+', time)
  316.                 if p > 0 then zone = substr(time, p)
  317.             end
  318.             if fullname.author \= '' then
  319.                 fullname = fullname.author
  320.             else
  321.                 fullname = author
  322.             call charout changelog, date||zone||'  '||fullname
  323.             if mailaddr.author \= '' then
  324.                 mailaddr = mailaddr.author
  325.             else
  326.                 mailaddr = author||'@'||hostname
  327.             call lineout changelog, '  <'||mailaddr||'>'
  328.             call lineout changelog, ''
  329.         end
  330.         if \filesknown.nfilename then do
  331.             filesknown.nfilename = TRUE
  332.             if files = '' then
  333.                 files = ' '||nfilename
  334.             else
  335.                 files = files||', '||nfilename
  336.             if revision & nrev \= '?' then
  337.                 files = files||' '||nrev
  338.         end
  339.     end
  340.     if date \= '' then do
  341.         call print_log changelog, files, log
  342.         call lineout changelog, ''
  343.     end
  344.     call stream changelog, 'c', 'close'
  345.     if stream(changelog, 'c', 'query size') = 0 then
  346.         call SysFileDelete translate(changelog, '\', '/')
  347.     return
  348.  
  349. print_log: procedure expose (globals) indent_string
  350.     parse arg changelog, files, log
  351.     do forever
  352.         c = left(log, 1)
  353.         if c \= '(' & c \= '[' then leave
  354.         c = translate(c, ')]', '([')
  355.         i = verify(log, SOH||c, 'm')
  356.         if substr(log, i, 1) \= c then leave
  357.         files = files substr(log, 1, i)
  358.         log = substr(log, i+verify(substr(log, i+1), ' '||TAB))
  359.     end
  360.     call charout changelog, indent_string||'*'||files||':'
  361.     indent = ' '
  362.     if line_indent+1+length(files)+2+pos(SOH, log) >= line_length then do
  363.         call lineout changelog, ''
  364.         indent = indent_string
  365.     end
  366.     do forever
  367.         i = pos(SOH, log)
  368.         if i = 0 then leave
  369.         logline = substr(log, 1, i-1)
  370.         if space(translate(logline, ' ', TAB), 0) = '' then
  371.             call lineout changelog, ''
  372.         else
  373.             call lineout changelog, indent||logline
  374.         log = substr(log, i+1)
  375.         indent = indent_string
  376.     end
  377.     return
  378.  
  379. read_entries: procedure expose (globals) entries.
  380.     parse arg dir
  381.     filename = dir||'CVS/Entries'
  382.     if stream(filename, 'c', 'open read') \= 'READY:' then
  383.         call die '"'||dir||'" is not a CVS controlled directory.'
  384.     entries. = ''; entries.0 = 0
  385.     do while lines(filename) > 0
  386.         line = linein(filename)
  387.         parse var line 'D/' dir '/'
  388.         if dir \= '' then do
  389.             i = entries.0+1
  390.             entries.i = dir
  391.             entries.0 = i
  392.         end
  393.     end
  394.     call stream filename, 'c', 'close'
  395.     return
  396.  
  397. parse_log: procedure expose (globals) dateval text.
  398.     parse arg dir, filelist, repository
  399.     files = ''; author. = FALSE
  400.     do i = 1 to words(filelist)
  401.         file = word(filelist, i)
  402.         if file = '*' then
  403.             file = left(dir, length(dir)-1)
  404.         else
  405.             file = dir||file
  406.         if length(files)+length(file) > 1000 then do
  407.             call parse_log_partial files, repository
  408.             files = ''
  409.         end
  410.         files = files file
  411.     end
  412.     if files \= '' then
  413.         call parse_log_partial files, repository
  414.     return
  415.  
  416. parse_log_partial: procedure expose (globals) dateval text.
  417.     parse arg files, repository
  418.     queue = rxqueue('create')
  419.     call rxqueue 'set', queue
  420.     '@cvs -Qn log -l'||dateval||files||' | rxqueue '||queue
  421.     state = 0
  422.     do while queued() > 0
  423.         line = linein('queue:')
  424.         if state = 0 then do
  425.             if pos('RCS file:', line) = 1 then do
  426.                 parse var line . ': ' filename
  427.                 if abbrev(filename, repository||'/') then
  428.                     filename = substr(filename, length(repository)+2)
  429.                 if right(filename, 2) = ',v' then
  430.                     filename = left(filename, length(filename)-2)
  431.                 i = lastpos('Attic/', filename)
  432.                 if i > 0 then
  433.                     filename = delstr(filename, i, 6)
  434.                 if right(filename, length(changelog_name)) \=,
  435.                         changelog_name then do
  436.                     rev = '?'
  437.                     state = 1
  438.                 end
  439.             end
  440.         end
  441.         else if pos('==========', line) = 1 then do
  442.             if state = 2 then call push_text text
  443.             state = 0
  444.         end
  445.         else if state = 1 then do
  446.             if pos('revision ', line) = 1 then do
  447.                 parse var line . ' ' rev ' ' .
  448.                 state = 2
  449.             end
  450.         end
  451.         else if state = 2 then do
  452.             if pos('----------', line) = 1 then do
  453.                 call push_text text
  454.                 state = 1
  455.                 iterate
  456.             end
  457.             if pos('date: ', line) = 1 then do
  458.                 parse var line . ': ' date ' ' time,
  459.                     ';' . 'author: ' author ';'
  460.                 date = translate(date, '-', '/')
  461.                 text = filename rev date time author||SOH
  462.                 rev = '?'
  463.                 iterate
  464.             end
  465.             if pos('branches: ', line) = 1 then iterate
  466.             if line = 'Initial revision' then
  467.                 line = 'New file.'
  468.             else do
  469.                 parse var line 'file ' .,
  470.                     ' was initially added on branch ' branch '.'
  471.                 if branch \= '' then
  472.                     line = 'New file.'
  473.             end
  474.             text = text||line||SOH
  475.         end
  476.     end
  477.     call rxqueue 'delete', queue
  478.     return
  479.  
  480. push_text: procedure expose text.
  481.     parse arg text
  482.     i = text.0+1
  483.     text.i = text
  484.     text.0 = i
  485.     return
  486.     
  487. sort_log: procedure expose text.
  488.     if text.0 > 1 then
  489.         call quicksort 1, text.0
  490.     return
  491.  
  492. quicksort: procedure expose text.
  493.     parse arg l, r
  494.     i = l; j = r; x = (l+r)%2; x = text.x
  495.     do forever
  496.         do while compare_log(text.i, x) < 0; i = i+1; end
  497.         do while compare_log(x, text.j) < 0; j = j-1; end
  498.         if i <= j then do
  499.             w = text.i; text.i = text.j; text.j = w
  500.             i = i+1; j = j-1
  501.         end
  502.         if i > j then leave
  503.     end
  504.     if l < j then call quicksort l, j
  505.     if i < r then call quicksort i, r
  506.     return
  507.  
  508. compare_log: procedure
  509.     parse arg a, b
  510.     parse var a filename1 rev1 date1 time1 author1 log1
  511.     parse var b filename2 rev2 date2 time2 author2 log2
  512.     select
  513.         when date1 time1 << date2 time2 then return +1
  514.         when date1 time1 >> date2 time2 then return -1
  515.         otherwise nop
  516.     end
  517.     select
  518.         when author1 << author2 then return -1
  519.         when author1 >> author2 then return +1
  520.         otherwise nop
  521.     end
  522.     select
  523.         when log1 << log2 then return -1
  524.         when log1 >> log2 then return +1
  525.         otherwise nop
  526.     end
  527.     select
  528.         when filename1 rev1 << filename2 rev2 then return -1
  529.         when filename1 rev1 >> filename2 rev2 then return +1
  530.         otherwise nop
  531.     end
  532.     return 0
  533.  
  534. is_absolute: procedure expose (globals)
  535.     parse arg path
  536.     return pos(':/', path) = 2 | pos('/', path) = 1
  537.  
  538. get_repository: procedure expose (globals)
  539.     parse arg dir
  540.     repository = linein(dir||'CVS/Repository')
  541.     call stream dir||'CVS/Repository', 'c', 'close'
  542.     cvsroot = linein(dir||'CVS/Root')
  543.     call stream dir||'CVS/Root', 'c', 'close'
  544.     if repository = '' || cvsroot = '' then
  545.         call die 'This is not a CVS controlled directory.'
  546.     if left(cvsroot, 1) = ':' then
  547.         parse var cvsroot ':' method ':' cvsroot
  548.     else if pos(cvsroot, ':') = 0 then
  549.         method = 'local'
  550.     else
  551.         method = 'server'
  552.     if method = 'local' then do
  553.         if \is_absolute(repository) then
  554.             repository = cvsroot||'/'||repository
  555.         if \is_directory(repository) then
  556.             call die repository||': Bad repository (see CVS/Repository).'
  557.     end
  558.     else
  559.         parse var cvsroot . ':' cvsroot
  560.     return repository
  561.  
  562. get_hostname: procedure expose (globals)
  563.     hostname = value('HOSTNAME',, 'OS2ENVIRONMENT')
  564.     if hostname \= '' then return hostname
  565.     queue = rxqueue('create')
  566.     call rxqueue 'set', queue
  567.     'hostname | rxqueue '||queue
  568.     if rc = 0 then if lines('queue:') > 0 then
  569.         hostname = linein('queue:')
  570.     call rxqueue 'delete', queue
  571.     if hostname = '' then
  572.         hostname = 'localhost'
  573.     return hostname
  574.  
  575. find_authors: procedure expose (globals)
  576.     parse arg env
  577.     dir = value(env,, 'OS2ENVIRONMENT')
  578.     if dir \= '' then if exists(dir||'/.cvsauthors') then
  579.         return dir||'/.cvsauthors'
  580.     return ''
  581.  
  582. read_authors: procedure expose (globals)
  583.     fullname. = ''; mailaddr. = ''
  584.     filename = cvsauthors
  585.     if filename = '' then do
  586.         filename = find_authors('HOME')
  587.         if filename = '' then
  588.             filename = find_authors('ETC')
  589.         if filename = '' then
  590.             return
  591.     end
  592.     if stream(filename, 'c', 'open read') \= 'READY:' then
  593.         call die 'Cannot open' filename 'for reading.'
  594.     do while lines(filename) > 0
  595.         line = linein(filename)
  596.         parse var line login '|' fullname '|' mailaddr
  597.         if login \= '#' then do
  598.             fullname.login = fullname
  599.             mailaddr.login = mailaddr
  600.         end
  601.     end
  602.     call stream filename, 'c', 'close'
  603.     return
  604.  
  605. die: procedure expose (globals)
  606.     parse arg text
  607.     call lineout 'stderr:', argv.0||': '||text
  608.     exit EXIT_FAILURE
  609.  
  610. usage: procedure expose (globals)
  611.     say 'Usage: '||argv.0||' [-?Rgv] [-c changelog] [-d date] [-i indent]'
  612.     say '  [-l length] [-t tabwidth] [-a authors] [files...]'
  613.     exit EXIT_USAGE
  614.  
  615. numeric_argument: procedure expose (globals) optopt optarg
  616.     parse arg minval, maxval
  617.     if \datatype(optarg, 'w') then
  618.         call die '-'||optopt optarg||': invalid argument.'
  619.     if optarg < minval | optarg > maxval then
  620.         call die '-'||optopt optarg||': argument out of range',
  621.             '['||minval||', '||maxval||'].'
  622.     return optarg
  623.  
  624. getopt: procedure expose (globals) optind optarg optopt optptr
  625.     parse arg options
  626.     if optind = 0 then optptr = 0
  627.     if optptr = 0 | optptr > length(argv.optind) then do
  628.         if optind >= argc then return -1
  629.         optind = optind+1
  630.         optptr = 1
  631.         if substr(argv.optind, optptr, 1) \= '-' then return 0
  632.         optptr = optptr+1
  633.     end
  634.     optopt = substr(argv.optind, optptr, 1)
  635.     optptr = optptr+1
  636.     if optopt = '-' then do
  637.         optind = optind+1
  638.         optptr = 0
  639.         return -1
  640.     end
  641.     i = pos(optopt, options)
  642.     if optopt = ':' | i = 0 then do
  643.         say argv.0||': -'||optopt||' is not a valid option.'
  644.         return '?'
  645.     end
  646.     if substr(options, i+1, 1) = ':' then do
  647.         if optptr <= length(argv.optind) then do
  648.             optarg = substr(argv.optind, optptr)
  649.             optptr = 0
  650.             return optopt;
  651.         end
  652.         if substr(options, i+2, 1) = ':' then do
  653.             i = optind+1
  654.             optptr = 1
  655.             if i < argc & substr(argv.i, optptr, 1) \= '-' then do
  656.                 optind = i
  657.                 optarg = argv.optind
  658.                 optptr = 0
  659.                 return optopt
  660.             end
  661.             say argv.0||': -'||optopt||' is missing an argument.'
  662.             return ':'
  663.         end
  664.         optptr = 0
  665.     end
  666.     optarg = ''
  667.     return optopt
  668.  
  669. setargv: procedure expose (globals)
  670.     parse arg args
  671.     inquote = FALSE
  672.     do forever
  673.         parse var args arg args
  674.         if arg = '' then leave
  675.         quotes = FALSE
  676.         i = 1
  677.         do forever
  678.             i = pos('"', arg, i)
  679.             if i = 0 then leave
  680.             if i > 1 then if substr(arg, i-1, 1) = '\' then do
  681.                 arg = delstr(arg, i-1, 1)
  682.                 iterate
  683.             end
  684.             arg = delstr(arg, i, 1)
  685.             quotes = \quotes
  686.         end
  687.         if inquote then
  688.             argv.argc = argv.argc arg
  689.         else do
  690.             argv.argc = arg
  691.             argc = argc+1
  692.         end
  693.         if quotes then inquote = \inquote
  694.     end
  695.     return
  696.  
  697. signal_handler:
  698.     call lineout 'stderr:', argv.0||': terminated by SIGINT.'
  699.     exit EXIT_SIGNAL
  700.  
  701.