home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxlb.zip / SAMPLES / ENVED.CMD < prev    next >
OS/2 REXX Batch file  |  1993-01-05  |  6KB  |  174 lines
  1. /*****************************************************************************/
  2. /*                                                                           */
  3. /* (c) Copyright 1988-1993, Quercus Systems                                  */
  4. /* All rights reserved                                                       */
  5. /*                                                                           */
  6. /* REXXLIB sample program: environment string editor                         */
  7. /*                                                                           */
  8. /* This sample is an environment string editor that allows interactive       */
  9. /* examination and modification of system environment variables. It          */
  10. /* provides a simple illustration of the use of RXWINDOW functions.          */
  11. /* Other REXXLIB functions used include:                                     */
  12. /*                                                                           */
  13. /*     dosenv        pcvideomode                                             */
  14. /*     dosenvlist    scrsize                                                 */
  15. /*     lower         scrwrite                                                */
  16. /*                                                                           */
  17. /*****************************************************************************/
  18. /* Help data:
  19. ? ENVED.REX is an environment string editor. It displays a window with a
  20. ? copy of the system environment. Standard RXWINDOW editing keys can be
  21. ? used to modify environment variables. Modified values are updated in the
  22. ? system environment.
  23. ?
  24. ? - To delete environment variables, change the value to blanks.
  25. ? - Variables with blank values are removed from the environment.
  26. */
  27.  
  28. signal on halt
  29. signal on novalue
  30. signal on syntax
  31.  
  32. /* misc initialization and validation */
  33. call initialize arg(1)
  34.  
  35. /* put output from "set" command into array "env.N" */
  36. call dosenvlist 'env'
  37. if env.0 > scr_height - 2 then
  38.     call emsg 'Too many environment variables'
  39.  
  40. /* open window and set border */
  41. start_line = format((scr_height - env.0) / 2, 2, 0)
  42. w = w_open(start_line, 1, env.0 + 2, scr_width)
  43. if w = '' then
  44.     call emsg 'Error opening a window'
  45. call w_border w, , , , ,color_border
  46. call w_put w, 1, format((scr_width - length(top_header)) / 2, 2, 0), ,
  47.  top_header, , color_prefix
  48. call w_put w, env.0 + 2, ,
  49.  format((scr_width - length(bot_header)) / 2, 2, 0), bot_header, , color_prefix
  50.  
  51. /* setup window with environment variables */
  52. do i = 1 to env.0
  53.    name.i = env.i
  54.    value.i = dosenv(env.i)
  55.    call w_put w, i + 1, 2, name.i'=', ,color_prefix
  56.    field_width = scr_width - 3 - length(name.i)
  57.    if length(value.i) > field_width then
  58.       call w_put w, i + 1, 2 + length(name.i) + 1, ,
  59.        ' ... Variable too long for ENVED ...', , color_prefix
  60.    else do
  61.       call w_field w, 'value.'i, i + 1, 2 + length(name.i) + 1, ,
  62.        field_width, color_data
  63.       if result \= 1 then
  64.          say 'error defining field'
  65.       end
  66. end
  67.  
  68. /* make a copy of the original values */
  69. do i = 1 to env.0
  70.    original.i = value.i
  71. end
  72.  
  73. /* display variables and wait for user to finish editing */
  74. call w_read w
  75. call w_close w
  76. w = ''
  77.  
  78. /* update the environment with any changed variables */
  79. changes = 0
  80. do i = 1 to env.0
  81.    if original.i \= value.i then do
  82.       call value name.i, value.i, 'os2environment'
  83.       if dosenv(name.i) \= value.i then
  84.          say 'Unable to set environment variable' name.i
  85.       else
  86.          changes = changes + 1
  87.       end
  88. end
  89. if \quiet then
  90.     if changes = 0 then
  91.         say 'Environment unchanged'
  92.     else
  93.         say changes 'environment variable(s) changed'
  94.  
  95. exit 0
  96.  
  97. /* initialize - misc initialization and validation */
  98. initialize:
  99. /* inititalize w (window number) */
  100. w = ''
  101. quiet = 0
  102.  
  103. /* display help info if any arguments were specified */
  104. do i = 1 to words(arg(1))
  105.    parm = lower(word(arg(1),i))
  106.    select
  107.      when parm = '/q' then
  108.          quiet = 1
  109.      otherwise
  110.          signal explain
  111.      end
  112.    end
  113.  
  114. /* load rxwindow if necessary */
  115. call load_rxwindow
  116.  
  117. /* set misc values for window handling */
  118. parse value scrsize() with scr_height scr_width .
  119. top_header = 'OS/2 Environment Editor'
  120. bot_header = 'Press Enter to make all changes, Esc to abort all changes'
  121. parse value pcvideomode() with . colors .
  122. if colors <= 2 then do
  123.     color_prefix = 15
  124.     color_data = 7
  125.     color_border = 7
  126.     end
  127. else do
  128.     color_prefix = 14
  129.     color_data = 10
  130.     color_border = 6
  131.     end
  132. return
  133.  
  134. /* ctrl-break handler */
  135. halt:
  136. call emsg 'Ctrl-Break detected - aborting'
  137.  
  138. /* emsg - general purpose fatal error message routine */
  139. emsg:
  140. if w \= '' then
  141.     call w_close w
  142. say arg(1)
  143. exit 99
  144.  
  145. /* explain - when user asks for help */
  146. explain:
  147. do i = 1 to sourceline()
  148.    parse value sourceline(i) with firstcol +1 rest
  149.    if firstcol = '?' then
  150.        say rest
  151.     end
  152. exit
  153.  
  154. /* syntax error handler */
  155. syntax:
  156. do stax = max(1, sigl - 7) to min(sigl + 3, sourceline())
  157.     call scrwrite , 1, '', 80
  158.     say right(word(stax '===>', 1 + (stax = sigl)), 4) sourceline(stax)
  159. end
  160. say '===> REXX error' rc 'in line' sigl':' errortext(rc)
  161. exit
  162.  
  163. /* novalue - error handler */
  164. novalue:
  165. call emsg 'novalue error detected on line' sigl
  166. exit
  167.  
  168. /* load rxwindow package if required to */
  169. load_rxwindow: procedure
  170. call rxfuncdrop 'w_register'
  171. call rxfuncadd  'w_register', 'rxwin30', 'rxwindow'
  172. call w_register
  173. return
  174.