home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv7.zip / vac22os2 / ibmcobol / macros / copyfile.lx < prev    next >
Text File  |  1998-02-27  |  61KB  |  2,052 lines
  1. /* REXX */
  2. trace off;
  3. signal on novalue;
  4. parse source opsys . whoami rest;
  5. if opsys = 'OS/2' then
  6.   do;
  7.   env = 'OS2ENVIRONMENT';
  8.   callit = '@Call';
  9.   call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs';
  10.   call SysLoadFuncs;
  11.   end;
  12. else
  13.   do;
  14.   env = 'ENVIRONMENT';
  15.   callit = '@Rexx';
  16.   end;
  17. exit_rc = 0;
  18. setdoc = 'no';
  19. setpos = 'no';
  20. setposl = 'no';
  21. setpos3 = 'no';
  22. 'extract doctype into doctype';
  23. if translate(doctype) <> 'CBL' then
  24.   call errmsg 'Action valid only for CBL files';
  25. tempdir = value('TMP',,env);
  26. tempout = SysTempFileName(tempdir'\TM?????.OUT');
  27. parse upper arg type type2 type3 type4 type5 rest;
  28. parse upper arg dummy path;
  29. parse arg dummy pathasis;
  30. parse arg dummy saveargs;
  31. blanks = '                         ';
  32. blanks = blanks||blanks||blanks||blanks;
  33. if type <> 'INIT' then
  34.   do;
  35.   'extract classes into classes';
  36.   if wordpos('CPYFILE',classes) = 0 then
  37.     call errmsg 'Copy file facility has not been initialized';
  38.   'extract docnum into docnum';
  39.   'extract global.cpyfile_readproj_'docnum 'into readproj';
  40.   if readproj = 'no' then
  41.     call read_project;
  42.   end;
  43. select;
  44.   when type = 'NOP' then
  45.     nop;
  46.   when type = 'INIT' then
  47.     call init;
  48.   when type = 'EXPAND' then
  49.     call expand;
  50.   when type = 'CONTRACT' then
  51.     call contract;
  52.   when type = 'REFRESH' then
  53.     call refresh;
  54.   when type = 'HIDE' then
  55.     call hide;
  56.   when type = 'IPATH' then
  57.     call ipath;
  58.   when type = 'SET' then
  59.     call set;
  60.   when type = 'EDIT' then
  61.     call edit;
  62.   when type = 'LPEXCMD' then
  63.     call lpexcmd;
  64.   when type = 'DELETE' then
  65.     call delete;
  66.   when type = 'SAVECMD' then
  67.     call savecmd;
  68.   when type = 'MENU' then
  69.     call menu;
  70.   when type = 'POPUP' then
  71.     call popup;
  72.   when type = 'LSHELP' then
  73.     call lshelp;
  74.   when type = 'NAVIG' then
  75.     call navig;
  76.   when type = 'CLEANUP' then
  77.     call cleanup;
  78.   when type = 'HELP' then
  79.     call help;
  80.   otherwise
  81.     call errmsg 'Invalid request type' type;
  82.   end;
  83. exit exit_rc;
  84. /* */
  85. expand:
  86. call check_syntax;
  87. call get_path;
  88. call get_copy;
  89. return;
  90. /* */
  91. check_syntax:
  92. 'extract class into class';
  93. if wordpos('MESSAGE',class) > 0 | wordpos('MVSMSG',class) > 0 |,
  94.   wordpos('CPYHEAD',class) > 0 then
  95.   call errmsg 'Not positioned at a COPY statement';
  96. call get_content;
  97. if substr(content,7,1) <> ' ' then
  98.   call errmsg 'Not positioned at a COPY statement';
  99. data = substr(content,1,72);
  100. data = substr(data,8);
  101. data = strip(data,'T');
  102. if length(data) < 2 then
  103.   data = ' 'data;
  104. if substr(data,length(data),1) = '.' then
  105.   do;
  106.   len = length(data) - 1;
  107.   data = substr(data,1,len);
  108.   end;
  109. parse upper var data arg1 arg2 arg3 arg4 rest;
  110. if arg1 <> 'COPY' then
  111.   call errmsg 'Not positioned at a COPY statement';
  112. if arg2 = '' then
  113.   call errmsg 'Name of COPY file missing';
  114. if length(arg2) > 8 then
  115.   call errmsg 'Copy file names longer than eight characters not supported:',
  116.     arg2;
  117. if substr(arg2,1,1) = '"' | substr(arg2,1,1) = "'" then
  118.   call errmsg 'Literal for copy file name not supported:' arg2;
  119. copyname = arg2;
  120. copylib = '';
  121. if arg3 = 'IN' | arg3 = 'OF' then
  122.   do;
  123.   if arg4 = '' then
  124.     call errmsg 'Name of COPY library missing';
  125.   if length(arg4) > 8 then
  126.     call errmsg 'Library names longer than eight characters not supported:',
  127.       arg4;
  128.   copylib = arg4;
  129.   end;
  130. if copylib = '' then
  131.   copylibs = '';
  132. else
  133.   copylibs = '/'copylib;
  134. copyname2 = copyname||copylibs;
  135. copynames = substr(copyname||copylibs'                 ',1,17);
  136. 'extract element into element';
  137. 'extract elements into elements';
  138. if element < elements then
  139.   do;
  140.   'mark set @@cpyfile2@@';
  141.   'next';
  142.   'extract class into class';
  143.   'extract content into content';
  144.   'mark find @@cpyfile2@@';
  145.   'mark clear @@cpyfile2@@';
  146.   if wordpos('CPYFILE',class) > 0 then
  147.     do;
  148.     eyecatcher = substr(content,81,26);
  149.     if substr(eyecatcher,1,6) <> ' COPY ' then
  150.       call errmsg 'Internal error, unknown copy file line';
  151.     copytest = substr(eyecatcher,7);
  152.     parse var copytest copytest level;
  153.     if copytest = '' | level = '' then
  154.       call errmsg 'Internal error, unknown copy file line';
  155.     if copytest = copyname2 then
  156.       call errmsg 'Copy file is already expanded';
  157.     end;
  158.   end;
  159. 'extract class into class';
  160. if wordpos('CPYFILE',class) > 0 then
  161.   do;
  162.   'extract content into content';
  163.   eyecatcher = substr(content,81,26);
  164.   if substr(eyecatcher,1,6) <> ' COPY ' then
  165.     call errmsg 'Internal error, unknown copy file line';
  166.   copytest = substr(eyecatcher,7);
  167.   parse var copytest copytest level;
  168.   if copytest = '' | level = '' then
  169.     call errmsg 'Internal error, unknown copy file line';
  170.   end;
  171. else
  172.   level = 0;
  173. return;
  174. /* */
  175. get_path:
  176. 'extract docnum into docnum';
  177. 'extract global.cpyfile_workdir_'docnum 'into workdir';
  178. 'extract global.cpyfile_ipath_'docnum 'into ipath';
  179. if ipath = '**null**' then
  180.   ipath = '';
  181. if length(ipath) > 0 then
  182.   do;
  183.   if substr(ipath,length(ipath),1) <> ';' then
  184.     ipath = ipath||';';
  185.   end;
  186. ipaths = ipath;
  187. copylibo = copylib;
  188. if copylib = '' then
  189.   copylib = 'SYSLIB';
  190. libpath = getenv(copylib);
  191. libpath = strip(libpath,'B');
  192. libpath = translate(libpath);
  193. if length(libpath) > 0 then
  194.   do;
  195.   if substr(libpath,length(libpath),1) <> ';' then
  196.     libpath = libpath||';';
  197.   end;
  198. libpaths = libpath;
  199. curpath = translate(workdir);
  200. if substr(curpath,length(curpath),1) <> '\' then
  201.   curpath = curpath||'\';
  202. suffices = '.CPY .CBL .COB *';
  203. do ii = 1 to words(suffices);
  204.   suffix = word(suffices,ii);
  205.   if suffix = '*' then
  206.     suffix = '';
  207.   if copylibo = '' then
  208.     do;
  209.     copypath = curpath||copyname||suffix;
  210.  /* xx = SysFileTree(copypath,'ts.','F'); */ /* use bypass instead */
  211.     call testfile copypath;
  212.     if ts.0 > 0 then
  213.       return;
  214.     ipath = ipaths;
  215.     if ipath <> '' then
  216.       do;
  217.       do forever;
  218.         if ipath = '' then
  219.           leave;
  220.         if pos(';',ipath) = 0 then
  221.           leave;
  222.         parse var ipath path ';' ipath;
  223.         if substr(path,length(path),1) <> '\' then
  224.           path = path||'\';
  225.         copypath = path||copyname||suffix;
  226.      /* xx = SysFileTree(copypath,'ts.','F'); */ /* use bypass instead */
  227.         call testfile copypath;
  228.         if ts.0 > 0 then
  229.           return;
  230.         end;
  231.       end;
  232.     end;
  233.   libpath = libpaths;
  234.   do forever;
  235.     if libpath = '' then
  236.       leave;
  237.     if pos(';',libpath) = 0 then
  238.       leave;
  239.     parse var libpath path ';' libpath;
  240.     if substr(path,length(path),1) <> '\' then
  241.       path = path||'\';
  242.     copypath = path||copyname||suffix;
  243.  /* xx = SysFileTree(copypath,'ts.','F'); */ /* use bypass instead */
  244.     call testfile copypath;
  245.     if ts.0 > 0 then
  246.       return;
  247.     end;
  248.   end;
  249. if copylibo = '' then
  250.   call errmsg 'Cannot find copy file' copyname;
  251. else
  252.   call errmsg 'Cannot find copy file' copyname arg3 copylibo;
  253. /* */
  254. read_project:
  255. 'extract docnum into docnum';
  256. 'extract name into name';
  257. if substr(name,2,2) <> ':\' then
  258.   call errmsg 'Do not understand file name' name;
  259. lastslash = lastpos('\',name);
  260. if lastslash > 3 then
  261.   lastslash = lastslash - 1;
  262. workdir = substr(name,1,lastslash);
  263. workdir = translate(workdir);
  264. 'set global.cpyfile_workdir_'docnum workdir;
  265. 'set global.cpyfile_readproj_'docnum 'yes';
  266. 'extract project into project';
  267. if project = '' then
  268.   return;
  269. workdir = '';
  270. read_stem.0 = 0;
  271. xx = linein(project,1,0);
  272. do forever;
  273.   if lines(project) = 0 then
  274.     leave;
  275.   read_stem.0 = read_stem.0 + 1;
  276.   nn = read_stem.0;
  277.   read_stem.nn = linein(project);
  278.   end;
  279. xx = stream(project,'C','CLOSE');
  280. if read_stem.0 > 0 then
  281.   do;
  282.   do ii = 1 to read_stem.0;
  283.     record = read_stem.ii;
  284.     if substr(record,1,12) = '+defaultDir=' then
  285.       do;
  286.       workdir = substr(record,13);
  287.       workdir = strip(workdir,'T');
  288.       if workdir = '' then
  289.         leave;
  290.       do forever;
  291.         if pos('\\',workdir) = 0 then
  292.           leave;
  293.         parse var workdir workdir1 '\\' workdir2;
  294.         workdir = workdir1'\'workdir2;
  295.         end;
  296.       end;
  297.     end;
  298.   if substr(workdir,2,2) <> ':\' then
  299.     call errmsg 'Invalid or missing working directory for project' project;
  300.   workdir = translate(workdir);
  301.   'set global.cpyfile_workdir_'docnum workdir;
  302.   end;
  303. else
  304.   call errmsg 'Project file' project 'could not be read or was empty';
  305. if read_stem.0 > 0 then
  306.   do;
  307.   do ii = 1 to read_stem.0;
  308.     record = read_stem.ii;
  309.     if substr(record,1,12) = '+defaultDir=' then
  310.       do;
  311.       workdir = substr(record,13);
  312.       workdir = strip(workdir,'T');
  313.       if workdir = '' then
  314.         leave;
  315.       do forever;
  316.         if pos('\\',workdir) = 0 then
  317.           leave;
  318.         parse var workdir workdir1 '\\' workdir2;
  319.         workdir = workdir1'\'workdir2;
  320.         end;
  321.       end;
  322.     if substr(record,1,4) = '+var' then
  323.       do;
  324.       parse var record dummy '=' varname '=' varval;
  325.       varname = translate(varname);
  326.       call setvar;
  327.       end;
  328.     end;
  329.   end;
  330. return;
  331. /* */
  332. setvar:
  333. varname = translate(varname);
  334. varval = translate(varval);
  335. 'extract docnum into docnum';
  336. 'extract global.cpyfile_workdir_'docnum 'into workdir';
  337. found = 'yes';
  338. varval = strip(varval,'B');
  339. do forever;
  340.   if pos('\\',varval) = 0 then
  341.     leave;
  342.   parse var varval varval1 '\\' varval2;
  343.   varval = varval1'\'varval2;
  344.   end;
  345. do forever;
  346.   if pos('%',varval) = 0 then
  347.     leave;
  348.   if lastpos('%',varval) = pos('%',varval) then
  349.     leave;
  350.   parse var varval varval1 '%' envname '%' varval2;
  351.   varval = varval1||getenv(envname)||varval2;
  352.   end;
  353. if length(varval) > 0 then
  354.   do;
  355.   if substr(varval,length(varval),1) <> ';' then
  356.     varval = varval||';';
  357.   end;
  358. varval2 = '';
  359. do forever;
  360.   if varval = '' then
  361.     leave;
  362.   if pos(';',varval) = 0 then
  363.     leave;
  364.   parse var varval val ';' varval;
  365.   select;
  366.     when val = '' then
  367.       nop;
  368.     when substr(val,1,2) = '..' then
  369.       do;
  370.       val = substr(val,3);
  371.       if length(workdir) = 3 then
  372.         do;
  373.         'msg Cannot determine higher directory for' varname;
  374.         'alarm';
  375.         found = 'no';
  376.         leave;
  377.         end;
  378.       lastslash = lastpos('\',workdir);
  379.       workdirh = substr(workdir,1,lastslash);
  380.       if length(workdirh) > 3 then
  381.         workdirh = substr(workdirh,1,length(workdirh) - 1);
  382.       end;
  383.     when substr(val,1,1) = '.' then
  384.       do;
  385.       val = substr(val,2);
  386.       if val = '' then
  387.         val = workdir;
  388.       else
  389.         do;
  390.         if substr(workdir,length(workdir),1) = '\' then
  391.           val = workdir||substr(val,2);
  392.         else
  393.           val = workdir||val;
  394.         end;
  395.       end;
  396.     when substr(val,1,1) = '\' then
  397.       val = substr(workdir,1,2)||val;
  398.     when substr(val,2,2) <> ':\' then
  399.       do;
  400.       if substr(workdir,length(workdir),1) = '\' then
  401.         val = workdir||val;
  402.       else
  403.         val = workdir||'\'||val;
  404.       end;
  405.     otherwise
  406.       nop;
  407.     end;
  408.   varval2 = varval2||val||';';
  409.   end;
  410. if found = 'yes' then
  411.   do;
  412.   if varval2 = '' then
  413.     varval2 = '**null**';
  414.   'set global.cpyfile_envvar_'docnum'_'varname varval2;
  415.   'extract global.cpyfile_envvars_'docnum 'into envvars';
  416.   if wordpos(varname,envvars) = 0 then
  417.     'set global.cpyfile_envvars_'docnum envvars varname;
  418.   end;
  419. return;
  420. /* */
  421. get_copy:
  422. do forever;
  423.   thedate = date('U');
  424.   thetime = time('L');
  425.   marktime = substr(thedate,1,2)||,
  426.     substr(thedate,4,2)||substr(thedate,7,2)||substr(thetime,1,2)||,
  427.     substr(thetime,4,2)||substr(thetime,7,2)||substr(thetime,10,2);
  428.   markname0 = '@@cpyfilee0@@'||marktime;
  429.   markname1 = '@@cpyfilee1@@'||marktime;
  430.   markname2 = '@@cpyfilee2@@'||marktime;
  431.   'extract mark.'markname1 'into marktest';
  432.   if marktest = 0 then
  433.     leave;
  434.   end;
  435. newlevel = level + 1;
  436. newlevel = substr('0'newlevel,length(newlevel),2);
  437. font8 = '888888888888888888888888888888888888888888';
  438. font8 = font8||font8||font8||font8;
  439. fontv = 'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv';
  440. fontv = fontv||fontv||fontv||fontv;
  441. font9 = '99999999999999999999999999'||fontv;
  442. fonty = 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy';
  443. fonty = fonty||fonty||fonty||fonty;
  444. fontus = '________';
  445. equals = '==========================================';
  446. equals = equals||equals||equals||equals;
  447. 'extract cursorrow into cursorrow';
  448. 'mark set @@cpyfile@@'newlevel;
  449. setposl = 'yes';
  450. 'extract docnum into docnum';
  451. 'set global.cpyfile_expanded_'docnum 'yes';
  452. 'extract global.cpyfile_color_'docnum 'into color';
  453. 'extract global.cpyfile_fast_'docnum 'into fast';
  454. 'extract global.cpyfile_navig_'docnum 'into navig';
  455. if navig = 'on' then
  456.   do;
  457.   if color <> 'BASE' then
  458.     do;
  459.     if fast = 'FAST' then
  460.       'msg Navigator will not show expanded copy files';
  461.     else
  462.       'msg Refresh within Navigator will not show expaned copy files';
  463.     'alarm';
  464.     end;
  465.   'set global.cpyfile_navig_'docnum 'msg';
  466.   end;
  467. 'extract actionbarid.LP_VIEW.Hide_copy_files into hide';
  468. 'set menuactive.'hide 'on';
  469. 'extract exclude into exclude';
  470. cpyfilepos = wordpos('CPYFILE',exclude);
  471. if cpyfilepos > 0 then
  472.   do;
  473.   exclude = delword(exclude,cpyfilepos,1);
  474.   'set exclude' exclude;
  475.   end;
  476.   do;
  477.   'mark set' markname0;
  478.   'extract recording into recording';
  479.   'extract limiterror into limiterror';
  480.   'extract readonly into readonly';
  481.   'set recording off';
  482.   'set limiterror ignore';
  483.   'set readonly off';
  484.   numequal = newlevel * 3;
  485.   arrow = substr(equals,1,numequal)||'>';
  486.   newline = arrow 'Start copy' copypath;
  487.   newline = substr(newline,1,80);
  488.   call addlines newline;
  489.   'mark set' markname1;
  490.   'mark set @@cpyfile@@'newlevel'top'
  491.  
  492.   newline = arrow 'End copy' copypath;
  493.   newline = substr(newline,1,80);
  494.   call addlines newline;
  495.   'mark set' markname2;
  496.   'mark find @@cpyfile@@'newlevel;
  497.  
  498. /* maybe a before trigger c program and an after trigger pgm? */
  499.  
  500.  'mark find @@cpyfile@@'newlevel'top'  /* find our insert point */
  501.  'mark clear @@cpyfile@@'newlevel'top' /* be neat */
  502.  'mcpi' copynames newlevel marktime copypath   /* expand the copyfile */
  503.  mcpi_rc = rc;
  504.  'set readonly' readonly;
  505.  'set limiterror' limiterror;
  506.  'set recording' recording;
  507.  if mcpi_rc = 100 then
  508.    call errmsg "mcpi: too few parameters - got:" copynames newlevel marktime copypath
  509.  if mcpi_rc = 150 then call errmsg "mcpi: class CPYFILE not available in this edit session"
  510.  if mcpi_rc = 200 then call errmsg "copyfile:" copypath "cannot be opened"
  511.  if mcpi_rc = 250 then call errmsg "copyfile:" copypath "is empty"
  512.  if mcpi_rc = 300 then call errmsg "copyfile: error reading file" copypath
  513.  if mcpi_rc <> 0 then call errmsg "mcpi non-zero return code:" mcpi_rc
  514.   end;
  515. /*
  516. else
  517.   call errmsg 'Copy file' copypath 'has no lines'; */
  518. if type3 <> 'INNER' then
  519.   do;
  520.   'mark find @@cpyfile@@'newlevel;
  521.   'set focus.next' cursorrow;
  522.   end;
  523. 'mark clear @@cpyfile@@'newlevel;
  524. return;
  525. /* */
  526. addline:
  527. parse arg theline;
  528. theline = substr(theline||blanks,1,80)' COPY' copynames newlevel copypath;
  529. theline = substr(theline||blanks,1,80)' COPY' copynames newlevel marktime copypath;
  530. 'lxn insert' theline;
  531. 'extract class into class';
  532. 'set class' class 'CPYFILE';
  533. return;
  534. /* */
  535. addlines:
  536. parse arg thelines;
  537. call addline thelines;
  538. 'extract class into class';
  539. 'set class' class 'CPYHEAD';
  540. 'set show on';
  541. data = substr(thelines,1,72);              /* from tweeking noted above */
  542. data = strip(data,'T');                                            /*   */
  543. 'extract fonts into fonts';                                        /*   */
  544. newfonts = substr(font8,1,length(data))||fonty;                    /*   */
  545. newfonts = substr(newfonts,1,80)||font9;                           /*   */
  546. newfonts = substr(newfonts,1,length(fonts));                       /*   */
  547. 'set fonts' newfonts;                      /* --------------------------*/
  548. return;
  549. /* */
  550. color:
  551. parse upper arg thecolor '!' thecolor2 '!' thecolor3;
  552. if thecolor = 'DEFAULT' | thecolor = '' then
  553.   thecolor = 'BASE';
  554. 'extract docnum into docnum';
  555. 'set global.cpyfile_color_'docnum thecolor;
  556. if thecolor = 'BASE' then
  557.   usecolor = 'light grey';
  558. else
  559.   usecolor = thecolor;
  560. if thecolor2 = '' then
  561.   usecolor2 = usecolor;
  562. else
  563.   usecolor2 = thecolor2;
  564. if thecolor3 = '' then
  565.   usecolor3 = 'LIGHT GREY';
  566. else
  567.    usecolor3 = thecolor3;
  568. 'set font.8 red/'usecolor2;
  569. 'set font.9' usecolor3'/white';
  570. if usecolor3 <> 'WHITE' then
  571.   do;
  572.   'set font.z' usecolor3'/grey';
  573.   'set font.w' usecolor3'/light grey';
  574.   end;
  575. else
  576.   do;
  577.   'set font.z grey/grey';
  578.   'set font.w light grey/light grey';
  579.   end;
  580. 'set font.y red/'usecolor;
  581. 'set font.@  black/'usecolor;
  582. 'set font.#  black/'usecolor;
  583. 'set font.$  bright red/'usecolor;
  584. 'set font.a  black/'usecolor;
  585. 'set font.m  cyan/'usecolor;
  586. 'set font.g  underline bright blue/'usecolor;
  587. 'set font.o  cyan/'usecolor;
  588. 'set font.j  black/'usecolor;
  589. 'set font.k  black/'usecolor;
  590. 'set font.1  cyan/'usecolor;
  591. 'set font.2  pink/'usecolor;
  592. 'set font.3  pink/'usecolor;
  593. 'set font.4  pink/'usecolor;
  594. 'set font.5  green/'usecolor;
  595. 'set font.6  bright blue/'usecolor;
  596. 'set font.7  bright blue/'usecolor;
  597. return;
  598. /* */
  599. expandfile:
  600. return;
  601. /* */
  602. contract:
  603. 'extract class into class';
  604. if wordpos('CPYFILE',class) = 0 then
  605.   call errmsg 'Not positioned at a line from a copy file';
  606. 'extract content into content';
  607. eyecatcher = substr(content,81,26);
  608. if substr(eyecatcher,1,6) <> ' COPY ' then
  609.   call errmsg 'Internal error, unknown copy file line';
  610. copyname = substr(eyecatcher,7);
  611. parse var copyname copyname level;
  612. if copyname = '' | level = '' then
  613.   call errmsg 'Internal error, unknown copy file line';
  614. if type2 <> 'ALL' & type2 <> 'CLEANUP' then
  615.   do;
  616.   'extract blocktype into blocktype';
  617.   if blocktype = 'UNSET' then
  618.     do;
  619.     marktime = substr(content,108,14);
  620.     markname0 = '@@cpyfilee0@@'||marktime;
  621.     markname1 = '@@cpyfilee1@@'||marktime;
  622.     markname2 = '@@cpyfilee2@@'||marktime;
  623.     'extract mark.'markname1 'into marktest';
  624.     if marktest = 0 then
  625.       call errmsg 'Internal error, starting mark not found';
  626.     'extract mark.'markname2 'into marktest';
  627.     if marktest = 0 then
  628.       call errmsg 'Internal error, ending mark not found';
  629.     'extract autoparse into autoparse';
  630.     'set autoparse off';
  631.     'extract parser into parser';
  632.     'extract deleting into deleting';
  633.     'set parser';
  634.     'extract readonly into readonly';
  635.     'extract recording into recording';
  636.     'set recording off';
  637.     'set readonly off';
  638.     'set deleting';
  639.     'mark find' markname1;
  640.     'block mark element';
  641.     'mark find' markname2;
  642.     'block mark element';
  643.     'lxn block delete';
  644.     'set parser' parser;
  645.     'set autoparse' autoparse;
  646.     'trigger';
  647.     'set deleting' deleting;
  648.     'set readonly' readonly;
  649.     'set recording' recording;
  650.     'mark find' markname0;
  651.     'primitive beginelement';
  652.     'mark clear' markname0;
  653.     'mark clear' markname1;
  654.     'mark clear' markname2;
  655.     return;
  656.     end;
  657.   end;
  658. 'extract element into element';
  659. if element > 1 then
  660.   do;
  661.   do forever;
  662.     'prev';
  663.     'extract class into class';
  664.     if wordpos('MESSAGE',class) = 0 & wordpos('MVSMSG',class) = 0 then
  665.       do;
  666.       if wordpos('CPYFILE',class) = 0 then
  667.         do;
  668.         'extract cursorrow into cursorrow';
  669.         'mark set @@cpyfile@@';
  670.         setpos = 'yes';
  671.         'next';
  672.         leave;
  673.         end;
  674.       'extract content into content';
  675.       eyecatcher = substr(content,81,26);
  676.       if substr(eyecatcher,1,6) <> ' COPY ' then
  677.         call errmsg 'Internal error, unknown copy file line';
  678.       copytest = substr(eyecatcher,7);
  679.       parse var copytest copytest leveltest;
  680.       if copytest = '' | leveltest = '' then
  681.         call errmsg 'Internal error, unknown copy file line';
  682.       if wordpos('CPYHEAD',class) > 0 then
  683.         do;
  684.         if pos('End copy',content) > 0 & leveltest = 01 then
  685.           do;
  686.           'extract cursorrow into cursorrow';
  687.           'mark set @@cpyfile@@';
  688.           setpos = 'yes';
  689.           'next';
  690.           leave;
  691.           end;
  692.         end;
  693.       if type2 <> 'ALL' & type2 <> 'CLEANUP' then
  694.         do;
  695.         if copytest <> copyname & leveltest <= level then
  696.           do;
  697.           'extract cursorrow into cursorrow';
  698.           'mark set @@cpyfile@@';
  699.           setpos = 'yes';
  700.           'next';
  701.           leave;
  702.           end;
  703.         end;
  704.       end;
  705.     'extract element into element';
  706.     if element = 1 then /* prevent infinite loop */
  707.       leave;
  708.     end;
  709.   end;
  710. 'extract autoparse into autoparse';
  711. 'set autoparse off';
  712. 'extract parser into parser';
  713. 'extract deleting into deleting';
  714. 'set parser';
  715. 'extract readonly into readonly';
  716. 'extract recording into recording';
  717. 'set recording off';
  718. 'set readonly off';
  719. 'set deleting';
  720. atlast = 'no';
  721. numstart = 0;
  722. do forever;
  723.   'extract class into class';
  724.   if wordpos('MESSAGE',class) > 0 | wordpos('MVSMSG',class) > 0 then
  725.     nop;
  726.   else
  727.     do;
  728.     if wordpos('CPYFILE',class) = 0 then
  729.       leave;
  730.     'extract content into content';
  731.     eyecatcher = substr(content,81,26);
  732.     if substr(eyecatcher,1,6) <> ' COPY ' then
  733.       call errmsg 'Internal error, unknown copy file line';
  734.     copytest = substr(eyecatcher,7);
  735.     parse var copytest copytest leveltest;
  736.     if copytest = '' | leveltest = '' then
  737.       call errmsg 'Internal error, unknown copy file line';
  738.     if type2 <> 'CLEANUP' then
  739.       do;
  740.       if wordpos('CPYHEAD',class) > 0 then
  741.         do;
  742.         if pos('Start copy',content) > 0 & leveltest = 01 then
  743.           do;
  744.           numstart = numstart + 1;
  745.           if numstart > 1 then
  746.             leave;
  747.           end;
  748.         end;
  749.       end;
  750.     if type2 <> 'ALL' & type2 <> 'CLEANUP' then
  751.       do;
  752.       if copytest <> copyname & leveltest <= level then
  753.         leave;
  754.       end;
  755.     end;
  756.   'lxn delete';
  757.   if atlast = 'yes' then
  758.     leave;
  759.   'extract elements into elements';
  760.   'extract element into element';
  761.   if element >= elements then /* prevent infinite loop */
  762.     atlast = 'yes';
  763.   end;
  764. 'set parser' parser;
  765. 'set autoparse' autoparse;
  766. 'trigger';
  767. 'set deleting' deleting;
  768. 'set readonly' readonly;
  769. 'set recording' recording;
  770. if setpos = 'yes' then
  771.   do;
  772.   'mark find @@cpyfile@@';
  773.   'mark clear @@cpyfile@@';
  774.   'set focus.next' cursorrow;
  775.   end;
  776. return;
  777. /* */
  778. contractfile:
  779. return;
  780. /* */
  781. refresh:
  782. 'extract class into class';
  783. if wordpos('CPYFILE',class) = 0 then
  784.   call errmsg 'Not positioned at a line from a copy file';
  785. 'macro copyfile.lx contract' type2;
  786. 'macro copyfile.lx expand' type2;
  787. return;
  788. /* */
  789. hide:
  790. 'extract exclude into exclude';
  791. if wordpos('CPYFILE',exclude) = 0 then
  792.   'set exclude' exclude 'CPYFILE';
  793. return;
  794. /* */
  795. ipath:
  796. if path = '' then
  797.   path = '**null**';
  798. 'extract docnum into docnum';
  799. 'set global.cpyfile_ipath_'docnum path;
  800. return;
  801. /* */
  802. set:
  803. if pos('=',path) = 0 then
  804.   do;
  805.   'extract docnum into docnum';
  806.   parse upper var path varname;
  807.   if varname = '' then
  808.     do;
  809.     'extract global.cpyfile_envvars_'docnum 'into envvars';
  810.     numvars = words(envvars);
  811.     if numvars > 0 then
  812.       do;
  813.       do ii = 1 to numvars;
  814.         envvar = word(envvars,ii);
  815.         'extract global.cpyfile_envvar_'docnum'_'envvar 'into envval';
  816.         if envval = '**null**';
  817.           then envval = '(null)';
  818.         'msg' envvar'='envval;
  819.         end;
  820.       end;
  821.     else
  822.       'msg No copy file environment variables set';
  823.     return;
  824.     end;
  825.   'extract global.cpyfile_envvar_'docnum'_'varname 'into envval';
  826.   if envval = '' then
  827.     do;
  828.     envval = getenv(varname);
  829.     if envval = '' then
  830.       envval = '(null)';
  831.     end;
  832.   else
  833.     do;
  834.     if envval = '**null**';
  835.       then envval = '(null)';
  836.     end;
  837.   'msg' varname'='envval;
  838.   return;
  839.   end;
  840. parse upper var path varname '=' varval;
  841. if varname = '' then
  842.   call errmsg 'Variable name missing';
  843. call setvar;
  844. return;
  845. /* */
  846. edit:
  847. copyname = '';
  848. copypath = '';
  849. 'extract class into class';
  850. if wordpos('MESSAGE',class) = 0 & wordpos('MVSMSG',class) = 0 &,
  851.   wordpos('CPYHEAD',class) = 0 then
  852.   do;
  853.   call get_content;
  854.   if substr(content,7,1) = ' ' then
  855.     do;
  856.     data = substr(content,1,72);
  857.     data = substr(data,8);
  858.     data = strip(data,'T');
  859.     if length(data) < 2 then
  860.       data = ' 'data;
  861.     if substr(data,length(data),1) = '.' then
  862.       do;
  863.       len = length(data) - 1;
  864.       data = substr(data,1,len);
  865.       end;
  866.     parse upper var data arg1 arg2 arg3 arg4 rest;
  867.     if arg1 = 'COPY' & arg2 <> '' then
  868.       do;
  869.       if length(arg2) > 8 then
  870.         call errmsg,
  871.         'Copy file names longer than eight characters not supported:',
  872.           arg2;
  873.       if substr(arg2,1,1) = '"' | substr(arg2,1,1) = "'" then
  874.         call errmsg,
  875.         'Literal for copy file name not supported:' arg2;
  876.       copyname = arg2;
  877.       copylib = '';
  878.       if arg3 = 'IN' | arg3 = 'OF' then
  879.         do;
  880.         if arg4 = '' then
  881.           call errmsg 'Name of COPY library missing';
  882.         if length(arg4) > 8 then
  883.           call errmsg,
  884.           'Library names longer than eight characters not supported:',
  885.             arg4;
  886.         copylib = arg4;
  887.         end;
  888.       end;
  889.     end;
  890.   end;
  891. if copyname = '' then
  892.   do;
  893.   'extract class into class';
  894.   if wordpos('CPYFILE',class) = 0 then
  895.     call errmsg 'Not positioned at a line from a copy file';
  896.   'extract content into content';
  897.   eyecatcher = substr(content,81,26);
  898.   if substr(eyecatcher,1,6) <> ' COPY ' then
  899.     call errmsg 'Internal error, unknown copy file line';
  900.   copyname = substr(eyecatcher,7);
  901.   parse var copyname copyname level;
  902.   if copyname = '' | level = '' then
  903.     call errmsg 'Internal error, unknown copy file line';
  904.   copypath = substr(content,123);
  905.   if copypath = '' then
  906.     call errmsg 'Internal error, unknown copy file line';
  907. /*xx = SysFileTree(copypath,'ts.','F'); */ /* use bypass instead */
  908.   call testfile copypath;
  909.   if ts.0 = 0 then
  910.     call errmsg 'Copy file' copypath 'no longer exists';
  911.   end;
  912. if copypath = '' then
  913.   call get_path;
  914. copydrive = substr(copypath,1,2);
  915. copydrive = translate(copydrive);
  916. filetype = 'local';
  917. mvsinfoQ = translate('IWZM_MVSINFO.DAT_YALE');
  918. oldq = rxqueue('Set',mvsinfoQ);
  919. numqueue = queued();
  920. qname = rxqueue('Set',oldq);
  921. if numqueue > 0 then
  922.   do;
  923.   xx = Get_MVSINFO();
  924.   if xx <> 0 then
  925.     call errmsg 'Error getting MVS information';
  926.   call Set_MVSINFO_Vars;
  927.   if numdrive > 0 then
  928.     do;
  929.     do ii = 1 to numdrive;
  930.       if drive.ii = copydrive then
  931.         do;
  932.         filetype = 'mvs';
  933.         leave;
  934.         end;
  935.       end;
  936.     end;
  937.   end;
  938. if filetype = 'local' then
  939.   do;
  940.   mvsinfoQ = translate('IBMM_MVSINFO.DAT_YALE');
  941.   oldq = rxqueue('Set',mvsinfoQ);
  942.   numqueue = queued();
  943.   qname = rxqueue('Set',oldq);
  944.   if numqueue > 0 then
  945.     do;
  946.     xx = Get_MVSINFO();
  947.     if xx <> 0 then
  948.       call errmsg 'Error getting MVS information';
  949.     call Set_MVSINFO_Vars;
  950.     if numdrive > 0 then
  951.       do;
  952.       do ii = 1 to numdrive;
  953.         if drive.ii = copydrive then
  954.           do;
  955.           filetype = 'mvs';
  956.           leave;
  957.           end;
  958.         end;
  959.       end;
  960.     end;
  961.   end;
  962. if filetype = 'local' then
  963.   'lx' copypath '/doctype cpy';
  964. else
  965.   do;
  966.   product = '';
  967.   'extract messages into messages';
  968.   'extract beeplength into beeplength';
  969.   'set messages off';
  970.   'set beeplength 0';
  971.   'macroload iwzmtdc.lx';
  972.   macroload_rc = rc;
  973.   if macroload_rc = 0 then
  974.     do;
  975.     'macrodrop iwzmtdc.lx';
  976.     product = 'cobol';
  977.     end;
  978.   else
  979.     do;
  980.     'macroload ibmmtdc.lx';
  981.     macroload_rc = rc;
  982.     if macroload_rc = 0 then
  983.       do;
  984.       'macrodrop ibmmtdc.lx';
  985.       product = 'pli';
  986.       end;
  987.     end;
  988.   'set messages' messages;
  989.   'set beeplength' beeplength;
  990.   if product = '' then
  991.     call errmsg 'Editor version does not support Remote Edit';
  992.   qname = RxQueue('Create');
  993.   if product = 'cobol' then
  994.     'macro iwzmtdc.lx' qname copypath;
  995.   else
  996.     'macro ibmmtdc.lx' qname copypath;
  997.   oldq = RxQueue('Set',qname);
  998.   rcode = linein('QUEUE:');
  999.   xx = RxQueue('Set',oldq);
  1000.   xx = RxQueue('Delete',qname);
  1001.   if rcode = 4 then
  1002.     do;
  1003.     if product = 'cobol' then
  1004.       address cmd callit 'iwzmscm.cmd' callit 'iwzmedi.cmd' copypath;
  1005.     else
  1006.       address cmd callit 'ibmmscm.cmd' callit 'ibmmedi.cmd' copypath;
  1007.     end;
  1008.   end;
  1009. return;
  1010. /* */
  1011. stale_mark:
  1012. return;
  1013. /* */
  1014. lpexcmd:
  1015. rwcmds1 = 'DELETE';
  1016. rwcmds2 = 'GET OPENLINC';
  1017. rwcmds3 = 'SPLITLINC';
  1018. noparsecmds = 'CLIP BLOCK DELETE SPLITJOIN';
  1019. lxicmds = 'OPENLINC SPLITLINC';
  1020. parse upper var path thecmd restsave;
  1021. parse upper var restsave cmdarg cmdarg2 rest;
  1022. if thecmd = 'FIND' then
  1023.   do;
  1024.   parse var pathasis dummy rest;
  1025.   restu = translate(rest);
  1026.   testpos1 = wordpos('ANY',restu);
  1027.   testpos2 = wordpos('ASIS',restu);
  1028.   select;
  1029.     when testpos1 = 0 & testpos2 = 0 then
  1030.       testpos = 0;
  1031.     when testpos1 = 0 & testpos2 > 0 then
  1032.       testpos = pos(' ASIS',' 'restu) - 1;
  1033.     when testpos1 > 0 & testpos2 = 0 then
  1034.       testpos = pos('ANY',restu);
  1035.     when testpos1 > 0 & testpos2 > 0 then
  1036.       do;
  1037.       if testpos1 < testpos2 then
  1038.         testpos = pos('ANY',restu);
  1039.       else
  1040.         testpos = pos(' ASIS',' 'restu) - 1;
  1041.       end;
  1042.     otherwise
  1043.       testpos = 0;
  1044.     end;
  1045.   if testpos > 0 then
  1046.     do;
  1047.     if pos('COLUMNS',restu) = 0 | pos('COLUMNS',restu) > testpos then
  1048.       do;
  1049.       cols = '1 80'
  1050.       if testpos = 1 then
  1051.         findcmd = 'COLUMNS' cols rest;
  1052.       else
  1053.         do;
  1054.         part3 = substr(rest,testpos);
  1055.         len = testpos - 1;
  1056.         part1 = substr(rest,1,len);
  1057.         findcmd = part1 'COLUMNS' cols part3;
  1058.         end;
  1059.       'lxn find' findcmd;
  1060.       find_rc = rc;
  1061.       exit find_rc;
  1062.       end;
  1063.     end;
  1064.   'lxn find' rest;
  1065.   find_rc = rc;
  1066.   exit find_rc;
  1067.   end;
  1068. thecmd2 = '';
  1069. if thecmd = 'SPLITJOIN' then
  1070.   do;
  1071.   if cmdarg = 'SPLIT' | cmdarg = 'JOIN' then
  1072.     thecmd2 = cmdarg;
  1073.   else
  1074.     do;
  1075.     'extract content into content';
  1076.     'extract cursorpos into cursorpos';
  1077.     restcontent = substr(content,cursorpos);
  1078.     if restcontent = ' ' then
  1079.       thecmd2 = 'JOIN'
  1080.     else
  1081.       thecmd2 = 'SPLIT';
  1082.     end;
  1083.   end;
  1084. if thecmd = 'BLOCK' then
  1085.   do;
  1086.   if cmdarg = 'MOVE' | cmdarg = 'COPY' then
  1087.     do;
  1088.     if cmdarg2 = 'BEFORE' then
  1089.       thecmd2 = 'BEFORE';
  1090.     else
  1091.       thecmd2 = 'AFTER';
  1092.     end;
  1093.   end;
  1094. 'extract class into class';
  1095. if thecmd = 'CLIP' & cmdarg = 'PASTE' then
  1096.   do;
  1097.   if wordpos('CPYFILE',class) > 0 then
  1098.     call errmsg 'Expanded copy file is read/only';
  1099.   end;
  1100. if wordpos(thecmd,rwcmds1) > 0 | thecmd2 = 'JOIN' |,
  1101.   thecmd2 = 'BEFORE' then
  1102.   do;
  1103.   if wordpos('CPYFILE',class) > 0 then
  1104.     call errmsg 'Expanded copy file is read/only';
  1105.   end;
  1106. if wordpos(thecmd,rwcmds2) > 0 | wordpos(thecmd,rwcmds3) |,
  1107.   thecmd2 = 'SPLIT' | thecmd2 = 'AFTER' then
  1108.   do;
  1109.   if wordpos('CPYFILE',class) > 0 then
  1110.     do;
  1111.     if thecmd2 = 'AFTER' then
  1112.       do;
  1113.       'extract blocktype into blocktype';
  1114.       if blocktype <> 'ELEMENT' then
  1115.          call errmsg 'Expanded copy file is read/only';
  1116.       end;
  1117.     if wordpos('CPYHEAD',class) = 0 then
  1118.       call errmsg 'Expanded copy file is read/only';
  1119.     'extract content into content';
  1120.     eyecatcher = substr(content,81,26);
  1121.     if substr(eyecatcher,1,6) <> ' COPY ' then
  1122.       call errmsg 'Internal error, unknown copy file line';
  1123.     copytest = substr(eyecatcher,7);
  1124.     parse var copytest copytest leveltest;
  1125.     if copytest = '' | leveltest = '' then
  1126.       call errmsg 'Internal error, unknown copy file line';
  1127.     if pos('End copy',content) = 0 | leveltest <> 01 then
  1128.       call errmsg 'Expanded copy file is read/only';
  1129.     if wordpos(thecmd,rwcmds3) > 0 | thecmd2 = 'SPLIT' then
  1130.       do;
  1131.       'extract cursorpos into cursorpos';
  1132.       if cursorpos <> (length(content) + 1) then
  1133.         call errmsg 'Expanded copy file is read/only';
  1134.       end;
  1135.     end;
  1136.   end;
  1137. if thecmd = 'BLOCK' & (cmdarg = 'MOVE' | cmdarg = 'DELETE') then
  1138.   do;
  1139.   'extract docnum into docnum';
  1140.   'extract blockdoc into blockdoc';
  1141.   if blockdoc <> docnum then
  1142.     'godoc docnum' blockdoc;
  1143.   setdoc = 'yes';
  1144.   'extract cursorrow into cursorrow';
  1145.   'mark set @@cpyfile@@';
  1146.   setpos = 'yes';
  1147.   'block find';
  1148.   'extract class into class';
  1149.   if wordpos('CPYFILE',class) > 0 then
  1150.     call errmsg 'Expanded copy file is read/only';
  1151.   'block find end';
  1152.   'extract class into class';
  1153.   if wordpos('CPYFILE',class) > 0 then
  1154.     do;
  1155.     if wordpos('CPYHEAD',class) = 0 then
  1156.       call errmsg 'Expanded copy file is read/only';
  1157.     'extract content into content';
  1158.     eyecatcher = substr(content,81,26);
  1159.     if substr(eyecatcher,1,6) <> ' COPY ' then
  1160.       call errmsg 'Internal error, unknown copy file line';
  1161.     copytest = substr(eyecatcher,7);
  1162.     parse var copytest copytest leveltest;
  1163.     if copytest = '' | leveltest = '' then
  1164.       call errmsg 'Internal error, unknown copy file line';
  1165.     if pos('End copy',content) = 0 | leveltest <> 01 then
  1166.       call errmsg 'Expanded copy file is read/only';
  1167.     end;
  1168.   'mark find @@cpyfile@@';
  1169.   'mark clear @@cpyfile@@';
  1170.   'godoc docnum' docnum;
  1171.   end;
  1172. if thecmd = 'CLIP' | thecmd = 'BLOCK' then
  1173.   do;
  1174.   if (thecmd = 'CLIP' & cmdarg = 'CUT') |,
  1175.     (thecmd = 'BLOCK' &,
  1176.     wordpos(cmdarg,'SHIFT LOWER UPPER FILL') > 0) then
  1177.     do;
  1178.     'extract docnum into docnum';
  1179.     'extract blockdoc into blockdoc';
  1180.     if blockdoc <> docnum then
  1181.       'godoc docnum' blockdoc;
  1182.     setdoc = 'yes';
  1183.     'extract cursorrow into cursorrow';
  1184.     'mark set @@cpyfile@@';
  1185.     setpos = 'yes';
  1186.     'block find';
  1187.     'extract element into element1';
  1188.     'block find end';
  1189.     'extract element into element2';
  1190.     'find element' element1;
  1191.     do forever;
  1192.       'extract class into class';
  1193.       if wordpos('CPYFILE',class) > 0 then
  1194.         call errmsg 'Expanded copy file is read/only';
  1195.       'extract element into element';
  1196.       if element >= element2 then
  1197.         leave;
  1198.       'next';
  1199.       end;
  1200.     'mark find @@cpyfile@@';
  1201.     'mark clear @@cpyfile@@';
  1202.    'godoc docnum' docnum;
  1203.     end;
  1204.   if thecmd = 'BLOCK' then
  1205.     do;
  1206.     'extract blocktype into blocktype';
  1207.     if cmdarg = 'OVERLAY' | (blocktype = 'RECTANGLE' &,
  1208.       (cmdarg = 'MOVE' | cmdarg = 'COPY')) then
  1209.       do;
  1210.       'extract docnum into docnum';
  1211.       'extract blockdoc into blockdoc';
  1212.       if blockdoc <> docnum then
  1213.         'godoc docnum' blockdoc;
  1214.       'extract cursorrow into cursorrow';
  1215.       'mark set @@cpyfile@@';
  1216.       setpos = 'yes';
  1217.       'block find';
  1218.       'extract element into element1';
  1219.       'block find end';
  1220.       'extract element into element2';
  1221.       numelems = element2 - element1 + 1;
  1222.      'godoc docnum' docnum;
  1223.       'mark find @@cpyfile@@';
  1224.       do ii = 1 to numelems;
  1225.         'extract class into class';
  1226.         if wordpos('CPYFILE',class) > 0 then
  1227.           call errmsg 'Expanded copy file is read/only';
  1228.         'extract element into element';
  1229.         'extract elements into elements';
  1230.         if element >= elements then
  1231.           leave;
  1232.         'next';
  1233.         end;
  1234.       'mark find @@cpyfile@@';
  1235.       'mark clear @@cpyfile@@';
  1236.       end;
  1237.     end;
  1238.   end;
  1239. if thecmd = 'BLOCK' then
  1240.   do;
  1241.   if cmdarg = 'MOVE' then
  1242.     do;
  1243.     'extract docnum into docnum_before_move';
  1244.     'set global.cpyfile_move_'docnum 'on';
  1245.     end;
  1246.   end;
  1247. if wordpos(thecmd,lxicmds) > 0 then
  1248.   'lxi' path;
  1249. else
  1250.   'lxn' path;
  1251. lpexcmd_rc = rc;
  1252. if lpexcmd_rc <> 0 then
  1253.   exit_rc = lpexcmd_rc;
  1254. if thecmd = 'BLOCK' then
  1255.   do;
  1256.   if cmdarg = 'MOVE' then
  1257.     do;
  1258.     'godoc docnum' docnum_before_move;
  1259.     end;
  1260.   end;
  1261. if thecmd = 'BLOCK' & lpexcmd_rc >= 0 then
  1262.   do;
  1263.   'extract docnum into docnum';
  1264.   'extract blockdoc into blockdoc';
  1265.   if cmdarg = 'COPY' then
  1266.     do;
  1267.     'extract blocktype into blocktype';
  1268.     if blockdoc = docnum & blocktype = 'ELEMENT' then
  1269.       do;
  1270.       'mark set @@cpyfileb@@';
  1271.       'block find';
  1272.       'extract element into element1';
  1273.       'block find end';
  1274.       'extract element into element2';
  1275.       numelems = element2 - element1 + 1;
  1276.       delmsg = 'no';
  1277.       'find element' element1;
  1278.       do ii = 1 to numelems;
  1279.         'extract class into class';
  1280.         if wordpos('CPYFILE',class) > 0 then
  1281.           do;
  1282.           'extract content into content';
  1283.           eyecatcher = substr(content,81,26);
  1284.           if substr(eyecatcher,1,6) <> ' COPY ' then
  1285.             call errmsg 'Internal error, unknown copy file line';
  1286.           copytest = substr(eyecatcher,7);
  1287.           parse var copytest copytest level;
  1288.           if copytest = '' | level = '' then
  1289.             call errmsg 'Internal error, unknown copy file line';
  1290.           end;
  1291.         if wordpos('CPYFILE',class) > 0 & wordpos('CPYHEAD',class) > 0 then
  1292.           do;
  1293.           delmsg = 'yes';
  1294.           'extract deleting into deleting';
  1295.           'set deleting';
  1296.           'lxn delete';
  1297.           'set deleting' deleting;
  1298.           end;
  1299.         else
  1300.           do;
  1301.           if wordpos('CPYFILE',class) > 0 then
  1302.             do;
  1303.             'set show off';
  1304.             cpyfilepos = wordpos('CPYFILE',class);
  1305.             newclass = delword(class,cpyfilepos,1);
  1306.             'set class' newclass;
  1307.             'extract content into content';
  1308.             content = substr(content,1,80);
  1309.             content = strip(content,'T');
  1310.             'set content' content;
  1311.             end;
  1312.           'next';
  1313.           end;
  1314.         end;
  1315.       'trigger';
  1316.       if delmsg = 'yes' then
  1317.         'msg Expanded copy file header lines deleted on copy';
  1318.       'mark find @@cpyfileb@@';
  1319.       'mark clear @@cpyfileb@@';
  1320.       end;
  1321.     end;
  1322.   if cmdarg = 'MOVE' then
  1323.     do;
  1324.     'extract global.cpyfile_move_'docnum 'into movestat';
  1325.     if movestat = 'contract' then
  1326.       do;
  1327.       if blockdoc = docnum then
  1328.         do;
  1329.         'mark set @@cpyfileb@@';
  1330.         'block find end';
  1331.         call get_content;
  1332.         if substr(content,7,1) = ' ' then
  1333.           do;
  1334.           data = substr(content,1,72);
  1335.           data = substr(data,8);
  1336.           data = strip(data,'T');
  1337.           if length(data) < 2 then
  1338.             data = ' 'data;
  1339.           if substr(data,length(data),1) = '.' then
  1340.             do;
  1341.             len = length(data) - 1;
  1342.             data = substr(data,1,len);
  1343.             end;
  1344.           parse upper var data arg1 arg2 arg3 arg4 rest;
  1345.           if arg1 = 'COPY' & arg2 <> '' then
  1346.             do;
  1347.             iscopy = 'yes';
  1348.             if length(arg2) > 8 | substr(arg2,1,1) = '"' |,
  1349.               substr(arg2,1,1) = "'" then
  1350.               iscopy = 'no';
  1351.             else
  1352.               do;
  1353.               copylib = '';
  1354.               if arg3 = 'IN' | arg3 = 'OF' then
  1355.                 do;
  1356.                 if arg4 = '' | length(arg4) > 8 then
  1357.                   iscopy = 'no';
  1358.                 else
  1359.                   copylib = arg4;
  1360.                 end;
  1361.               end;
  1362.             if iscopy = 'yes' then
  1363.               do;
  1364.               'macro copyfile.lx expand';
  1365.               'msg Associated expanded copy file re-expanded';
  1366.               end;
  1367.             end;
  1368.           end;
  1369.         'mark find @@cpyfileb@@';
  1370.         'mark clear @@cpyfileb@@';
  1371.         end;
  1372.       end;
  1373.     'set global.cpyfile_move_'docnum 'off';
  1374.     end;
  1375.   end;
  1376. return;
  1377. /* */
  1378. delete:
  1379. return;
  1380. /* */
  1381. savecmd:
  1382. 'extract classes into classes';
  1383. if pos('MVSMSG',classes) = 0 then
  1384.   'lxn save' saveargs;
  1385. else
  1386.   do;
  1387.   mvsinfoQ = translate('IWZM_MVSINFO.DAT_YALE');
  1388.   oldq = rxqueue('Set',mvsinfoQ);
  1389.   numqueue = queued();
  1390.   qname = rxqueue('Set',oldq);
  1391.   if numqueue > 0 then
  1392.     'macro iwzmsav.lx' saveargs;
  1393.   else
  1394.     'macro ibmmsav.lx' saveargs;
  1395.   end;
  1396. save_rc = rc;
  1397. if save_rc = 0 then
  1398.   do;
  1399.   newargs = '';
  1400.   inquote = 'no';
  1401.   sepchar = '01'x;
  1402.   if length(saveargs) > 0 then
  1403.     do;
  1404.     do ii = 1 to length(saveargs);
  1405.       thechar = substr(saveargs,ii,1);
  1406.       select;
  1407.         when thechar = '"' then
  1408.           do;
  1409.           if inquote = 'yes' then
  1410.             inquote = 'no';
  1411.           else
  1412.             inquote = 'yes';
  1413.           newargs = newargs||thechar;
  1414.           end;
  1415.         when thechar == ' ' then
  1416.           do;
  1417.           if inquote = 'yes' then
  1418.             newargs = newargs||sepchar;
  1419.           else
  1420.             newargs = newargs||thechar;
  1421.           end;
  1422.         otherwise
  1423.           newargs = newargs||thechar;
  1424.         end;
  1425.       end;
  1426.     end;
  1427.   do ii = 1 to 12;
  1428.     thearg.ii = word(newargs,ii);
  1429.     thearg.ii = translate(thearg.ii,' ',sepchar);
  1430.     end;
  1431.   a1 = thearg.1;
  1432.   'extract name into savename';
  1433.   if a1 <> '' then
  1434.     do;
  1435.     if substr(a1,1,1) <> '/' then
  1436.       savename = a1;
  1437.     end;
  1438.   savename = strip(savename,'B','"');
  1439.   call stale_mark savename;
  1440.   end;
  1441. return;
  1442. /* */
  1443. menu:
  1444. if type2 <> 'FULL' & type2 <> 'SHORT' then
  1445.   call errmsg 'Invalid MENU request type' type2;
  1446. if type2 = 'FULL' then
  1447.   do;
  1448.   end;
  1449. else
  1450.   do;
  1451.   'extract popupmenu.Expand_copy_file_all into menutest';
  1452.   if menutest <> '' then
  1453.     do;
  1454.     'set popupmenu.Expand_copy_file_all';
  1455.     'set popupmenu.Expand_all_copy_files';
  1456.     'set popupmenu.Contract_copy_file_all';
  1457.     'set popupmenu.Contract_all_copy_files';
  1458.     'set popupmenu.Refresh_copy_file_all';
  1459.     'set popupmenu.Refresh_all_copy_files';
  1460.     'set popupmenu.Cleanup';
  1461.     end;
  1462.  
  1463.   end;
  1464. return;
  1465. /* */
  1466. popup:
  1467. doexpand = 'no';
  1468. docontract = 'no';
  1469. docontractall = 'no';
  1470. dorefresh = 'no';
  1471. doedit = 'no';
  1472. doclean = 'no';
  1473. 'extract class into class';
  1474. if wordpos('CPYFILE',class) > 0 then
  1475.   do;
  1476.   docontract = 'yes';
  1477.   dorefresh = 'yes';
  1478.   doedit = 'yes';
  1479.   end;
  1480. 'extract docnum into docnum';
  1481. 'extract global.cpyfile_expanded_'docnum 'into expanded';
  1482. if expanded = 'yes' then
  1483.   do;
  1484.   docontractall = 'yes';
  1485.   doclean = 'yes';
  1486.   end;
  1487. 'extract class into class';
  1488. if wordpos('MESSAGE',class) = 0 & wordpos('MVSMSG',class) = 0 &,
  1489.   wordpos('CPYHEAD',class) = 0 then
  1490.   do;
  1491.   call get_content;
  1492.   if substr(content,7,1) = ' ' then
  1493.     do;
  1494.     data = substr(content,1,72);
  1495.     data = substr(data,8);
  1496.     data = strip(data,'T');
  1497.     if length(data) < 2 then
  1498.       data = ' 'data;
  1499.     if substr(data,length(data),1) = '.' then
  1500.       do;
  1501.       len = length(data) - 1;
  1502.       data = substr(data,1,len);
  1503.       end;
  1504.     iscopy = 'no';
  1505.     parse upper var data arg1 arg2 arg3 arg4 rest;
  1506.     if arg1 = 'COPY' & arg2 <> '' then
  1507.       do;
  1508.       if length(arg2) <= 8 & substr(arg2,1,1) <> '"' &,
  1509.         substr(arg2,2,1) <> "'" then
  1510.         do;
  1511.         iscopy = 'yes';
  1512.         copyname = arg2;
  1513.         copylib = '';
  1514.         if arg3 = 'IN' | arg3 = 'OF' then
  1515.           do;
  1516.           if arg4 = '' | length(arg4) > 8 then
  1517.             iscopy = 'no';
  1518.           else
  1519.             copylib = arg4;
  1520.           end;
  1521.         end;
  1522.       end;
  1523.     if iscopy = 'yes' then
  1524.       do;
  1525.       doedit = 'yes';
  1526.       doexpand = 'yes';
  1527.       if copylib = '' then
  1528.         copylibs = '';
  1529.       else
  1530.         copylibs = '/'copylib;
  1531.       copyname2 = copyname||copylibs;
  1532.       'extract element into element';
  1533.       'extract elements into elements';
  1534.       if element < elements then
  1535.         do;
  1536.         'mark set @@cpyfile2@@';
  1537.         'next';
  1538.         'extract class into class';
  1539.         'extract content into content';
  1540.         'mark find @@cpyfile2@@';
  1541.         'mark clear @@cpyfile2@@';
  1542.         if wordpos('CPYFILE',class) > 0 then
  1543.           do;
  1544.           eyecatcher = substr(content,81,26);
  1545.           if substr(eyecatcher,1,6) <> ' COPY ' then
  1546.             call errmsg 'Internal error, unknown copy file line';
  1547.           copytest = substr(eyecatcher,7);
  1548.           parse var copytest copytest level;
  1549.           if copytest = '' | level = '' then
  1550.             call errmsg 'Internal error, unknown copy file line';
  1551.           if copytest = copyname2 then
  1552.             doexpand = 'no';
  1553.           end;
  1554.         end;
  1555.       end;
  1556.     end;
  1557.   end;
  1558. 'extract popupmenuid.Expand_copy_file into expand';
  1559. 'extract popupmenuid.Contract_copy_file into contract';
  1560. 'extract popupmenuid.Refresh_copy_file into refresh';
  1561. 'extract popupmenuid.Edit_copy_file into edit';
  1562. 'extract popupmenu.Expand_copy_file_all into menutest';
  1563. if menutest <> '' then
  1564.   do;
  1565.   'extract popupmenuid.Expand_copy_file_all into expandall';
  1566.   'extract popupmenuid.Expand_all_copy_files into expandallfile';
  1567.   'extract popupmenuid.Contract_copy_file_all into contractall';
  1568.   'extract popupmenuid.Contract_all_copy_files into contractallfile';
  1569.   'extract popupmenuid.Refresh_copy_file_all into refreshall';
  1570.   'extract popupmenuid.Refresh_all_copy_files into refreshallfile';
  1571.   'extract popupmenuid.Cleanup into cleanup';
  1572.   end;
  1573. if doexpand = 'yes' then
  1574.   do;
  1575.   'set menuactive.'expand 'on';
  1576.   if menutest <> '' then
  1577.     'set menuactive.'expandall 'on';
  1578.   end;
  1579. else
  1580.   do;
  1581.   'set menuactive.'expand 'off';
  1582.   if menutest <> '' then
  1583.     'set menuactive.'expandall 'off';
  1584.   end;
  1585. if docontract = 'yes' then
  1586.   do;
  1587.   'set menuactive.'contract 'on';
  1588.   if menutest <> '' then
  1589.     'set menuactive.'contractall 'on';
  1590.   end;
  1591. else
  1592.   do;
  1593.   'set menuactive.'contract 'off';
  1594.   if menutest <> '' then
  1595.     'set menuactive.'contractall 'off';
  1596.   end;
  1597. if menutest <> '' then
  1598.   do;
  1599.   if docontractall = 'yes' then
  1600.     'set menuactive.'contractallfile 'on';
  1601.   else
  1602.     'set menuactive.'contractallfile 'off';
  1603.   if doclean = 'yes' then
  1604.     'set menuactive.'cleanup 'on';
  1605.   else
  1606.     'set menuactive.'cleanup 'off';
  1607.   end;
  1608. if dorefresh = 'yes' then
  1609.   do;
  1610.   'set menuactive.'refresh 'on';
  1611.   if menutest <> '' then
  1612.     'set menuactive.'refreshall 'on';
  1613.   end;
  1614. else
  1615.   do;
  1616.   'set menuactive.'refresh 'off';
  1617.   if menutest <> '' then
  1618.     'set menuactive.'refreshall 'off';
  1619.   end;
  1620. if doedit = 'yes' then
  1621.   'set menuactive.'edit 'on';
  1622. else
  1623.   'set menuactive.'edit 'off';
  1624. return;
  1625. /* */
  1626. lshelp:
  1627. return;
  1628. /* */
  1629. navig:
  1630. return;
  1631. /* */
  1632. cleanup:
  1633. return;
  1634. /* */
  1635. get_content:
  1636. 'extract content into content';
  1637. content = substr(content||blanks,1,80);
  1638. 'extract class into tstclass';
  1639. if wordpos('MESSAGE',tstclass) > 0 | wordpos('MVSMSG',tstclass) > 0 |,
  1640.   wordpos('CPYHEAD',tstclass) > 0 then
  1641.   return;
  1642. if substr(content,7,1) <> ' ' then
  1643.   return;
  1644. tstdata = substr(content,1,72);
  1645. tstdata = substr(tstdata,8);
  1646. tstdata = strip(tstdata,'T');
  1647. tstdata = ' 'tstdata;
  1648. poscopy =  pos(' COPY ',translate(tstdata));
  1649. if poscopy = 0 then
  1650.   return;
  1651. tstdata = substr(tstdata,(poscopy + 1));
  1652. posperiod = pos('.',tstdata);
  1653. if posperiod > 0 then
  1654.   tstdata = substr(tstdata,1,posperiod);
  1655. extra = poscopy - 1;
  1656. if extra > 0 then
  1657.   tstdata = substr(blanks,1,extra)||tstdata;
  1658. tstdata = substr(tstdata||blanks,1,65);
  1659. content = substr(content,1,7)||tstdata||substr(content,73,8);
  1660. return;
  1661. /* */
  1662. testfile:
  1663. /* This code is used to bypass the SdU problem where doing either a  */
  1664. /* DIR command or a SysFileTree on a non-existent member will return */
  1665. /* data as if the member exists.                                     */
  1666. parse upper arg copypatht;
  1667. copypatht = strip(copypatht,'T');
  1668. if substr(copypatht,2,2) <> ':\' then
  1669.   call errmsg 'Do not understand file name' copypatht;
  1670. xx = SysFileTree(copypatht,'ts.','F');
  1671. if ts.0 = 0 then /* if file not found then file really does not exist */
  1672.   return;
  1673. parse var ts.1 v0 v1 v2 .;
  1674. if v2 > 0 then /* if non-zero length file then file really exists */
  1675.   return;
  1676. /* If file length is zero then need to do a generic search to see if */
  1677. /* the file really exists.  For this to work on SdU the leading part */
  1678. /* of the search must be less than eight characters.                 */
  1679. lastslash = lastpos('\',copypatht);
  1680. copypatht2 = substr(copypatht,1,lastslash);
  1681. copypatht2r = substr(copypatht,(lastslash + 1));
  1682. if copypatht2r = '' then
  1683.   call errmsg 'Do not understand file name' copypatht;
  1684. if length(copypatht2r) < 8 then
  1685.   copypatht2r = copypatht2r||'*';
  1686. else
  1687.   copypatht2r = substr(copypatht2r,1,7)||'*';
  1688. copypatht2 = copypatht2||copypatht2r;
  1689. xx = SysFileTree(copypatht2,'ts.','F');
  1690. if ts.0 = 0 then /* if no files found then file really does not exist */
  1691.   return;
  1692. do ii = 1 to ts.0; /* search through found files for desired file */
  1693.   parse upper var ts.ii v0 v1 v2 v3 v4;
  1694.   if copypatht = v4 then
  1695.     return;
  1696.   end;
  1697. ts.0 = 0; /* no match so set to show file not found */
  1698. return;
  1699. /* */
  1700. init:
  1701. 'set actionbar.LP_VIEW.Hide_copy_files 8 macro copyfile.lx hide';
  1702. 'set actionbar.LP_HELP.Expand_copy_file_help 7 copyfile.lx help';
  1703. 'set popupmenu.separator 98';
  1704. 'set popupmenu.Expand_copy_file macro copyfile.lx expand';
  1705. 'set popupmenu.Contract_copy_file macro copyfile.lx contract';
  1706. 'set popupmenu.Refresh_copy_file macro copyfile.lx refresh';
  1707. 'set popupmenu.Edit_copy_file macro copyfile.lx edit';
  1708. 'extract actionbarid.LP_VIEW.Hide_copy_files into hide';
  1709. 'extract popupmenuid.Expand_copy_file into expand';
  1710. 'extract popupmenuid.Contract_copy_file into contract';
  1711. 'extract popupmenuid.Refresh_copy_file into refresh';
  1712. 'extract popupmenuid.Edit_copy_file into edit';
  1713. 'set menuactive.'hide 'off';
  1714. 'set menuactive.'expand 'off';
  1715. 'set menuactive.'contract 'off';
  1716. 'set menuactive.'refresh 'off';
  1717. 'set menuactive.'edit 'off';
  1718. 'set popupinit macro copyfile.lx popup';
  1719. 'set synonym.block cpyblk';
  1720. 'set synonym.clip macro copyfile.lx lpexcmd clip';
  1721. 'set synonym.delete macro copyfile.lx lpexcmd delete';
  1722. 'set synonym.get macro copyfile.lx lpexcmd get';
  1723. 'set synonym.splitjoin macro copyfile.lx lpexcmd splitjoin';
  1724. 'extract synonym.openline into openline';
  1725. if openline <> '' then
  1726.   do;
  1727.   'set synonym.openlinc' openline;
  1728.   'set synonym.openline macro copyfile.lx lpexcmd openlinc';
  1729.   end;
  1730. 'extract synonym.splitline into splitline';
  1731. if splitline <> '' then
  1732.   do;
  1733.   'set synonym.splitlinc' splitline;
  1734.   'set synonym.splitline macro copyfile.lx lpexcmd splitlinc';
  1735.   end;
  1736. /* 'set deleting macro copyfile.lx delete'; */
  1737. /* 'set protect' protect 'CPYFILE CPYHEAD'; */
  1738. 'set font.v light grey/white';
  1739. /* 'set find.columnnums 1 80';
  1740. 'set find.columns on'; */
  1741. /* 'set synonym.find macro copyfile.lx lpexcmd find'; */
  1742. 'extract docnum into docnum';
  1743. if type3 = 'STALE' then
  1744.   do;
  1745.   'set global.cpyfile_stale_'docnum 'ON';
  1746.   'set synonym.save macro copyfile.lx savecmd';
  1747.   end;
  1748. else
  1749.   'set global.cpyfile_stale_'docnum 'OFF';
  1750. if type4 = '' then
  1751.   type4 = 'DEFAULT';
  1752. type4 = translate(type4,' ','_');
  1753. call color type4;
  1754. if type5 = '' then
  1755.   type5 = 'FAST';
  1756. 'set global.cpyfile_fast_'docnum type5;
  1757. 'set global.cpyfile_navig_'docnum 'off';
  1758. /*'SET ACTION.F1 macro copyfile.lx lshelp'; */
  1759. /* 'SET ACTIONBAR.LP_VIEW.Na~vigator.~Open macro copyfile.lx navig open';
  1760. 'SET HELP. 16806';
  1761. 'SET ACTIONBAR.LP_VIEW.Na~vigator.Refresh macro copyfile.lx navig refresh';
  1762. 'SET HELP. 16806'; */
  1763. 'set global.cpyfile_readproj_'docnum 'no';
  1764. return;
  1765. /* */
  1766. getenv:
  1767. parse upper arg envvar;
  1768. 'extract docnum into docnume';
  1769. 'extract global.cpyfile_envvar_'docnume'_'envvar 'into envval';
  1770. if envval <> '' then
  1771.   do;
  1772.   if envval = '**null**' then
  1773.     envval = '';
  1774.   envval = strip(envval,'T');
  1775.   return envval;
  1776.   end;
  1777. if opsys = 'Windows95' then
  1778.   envval = value(envvar,,env);
  1779. else
  1780.   do;
  1781.   qname = RxQueue('Create');
  1782.   if opsys = 'OS/2' then
  1783.     address cmd '@start /c /i /min copyfile.cmd' qname envvar;
  1784.   else
  1785.     address cmd '@start /i /min rexx copyfile.cmd' qname envvar;
  1786.   oldq = RxQueue('Set',qname);
  1787.   envval = linein('QUEUE:');
  1788.   envval = substr(envval,2);
  1789.   xx = RxQueue('Set',oldq);
  1790.   xx = RxQueue('Delete',qname);
  1791.   end;
  1792. envval = strip(envval,'T');
  1793. envval2 = envval;
  1794. if envval2 = '' then
  1795.   envval2 = '**null**';
  1796. 'set global.cpyfile_envvar_'docnume'_'envvar envval2;
  1797. return envval;
  1798. /* */
  1799. errmsg:
  1800. parse arg themsg;
  1801. if setpos = 'yes' then
  1802.   do;
  1803.   'mark find @@cpyfile@@';
  1804.   'mark clear @@cpyfile@@';
  1805.   'set focus.next' cursorrow;
  1806.   end;
  1807. if setposl = 'yes' then
  1808.   do;
  1809.   if type3 <> 'INNER' then
  1810.     do;
  1811.     'mark find @@cpyfile@@'newlevel;
  1812.     'set focus.next' cursorrow;
  1813.     end;
  1814.   'mark clear @@cpyfile@@'newlevel;
  1815.   end;
  1816. if setpos3 = 'yes' then
  1817.   do;
  1818.   'mark find @@cpyfile3@@';
  1819.   'mark clear @@cpyfile3@@';
  1820.   'set focus.next' cursorrow;
  1821.   end;
  1822. if setdoc = 'yes' then
  1823.   'godoc docnum' docnum;
  1824. 'msg' themsg;
  1825. 'alarm';
  1826. exit 16;
  1827. /* */
  1828. Get_MVSINFO:
  1829. rtn = 0
  1830. null = '0000'x
  1831. crlf = '0D0A'x
  1832. mvsinfo. = ''
  1833.  
  1834. oldq = rxqueue('Set',mvsinfoQ)   /* switch to mvsinfo queue */
  1835. if queued() = 0 then do
  1836.   qname = rxqueue('Set',oldq)      /* restore normal queue */
  1837.   return 4;
  1838.   end;
  1839. parse pull mvsstuff; push mvsstuff        /* get/replace Q contents */
  1840. parse value mvsstuff with ts (null) . cobolroot (null) mvsstuff /* get */
  1841.                                         /* timestamp and cobolroot */
  1842. if ts <> 'Sven' then do;
  1843.   mvsinfo = cobolroot'\MACROS\MVSINFO.DAT'
  1844.   bad_mvsinfo = '    **' whoami '****'crlf'    **error*' mvsinfo,
  1845.                 'is unavailable, missing or empty **'
  1846.  
  1847.   /* Following use of SysFileTree does not need bypass since it is */
  1848.   /* for a file on a real workstation drive, i.e it cannot be an   */
  1849.   /* SdU drive on MVS.                                             */
  1850.   x=SysFileTree(mvsinfo,'ts','F')       /* get MVSINFO.DAT's timestamp */
  1851.   if ts.0 <> 1 then do
  1852.     say bad_mvsinfo
  1853.     return 12;
  1854.     end
  1855.   parse var ts.1 v0 v1 v2 .
  1856.   timestamp ='mvsinfo.dat.timestamp' v0 v1 v2
  1857.   end;
  1858. else
  1859.   timestamp = 'Yale'
  1860. if timestamp <> ts then do              /* timestamps match? */
  1861.   pull mvsstuff                         /* no, remove bad contents */
  1862.   if product = 'cobol' then
  1863.     rtn = "IWZMIR.CMD"()                 /* ask for new stuff */
  1864.   else
  1865.     rtn = "IBMMIR.CMD"()                 /* ask for new stuff */
  1866.   if rtn = 0 then do
  1867.     parse pull mvsstuff; push mvsstuff    /* get/replace Q contents */
  1868.                                         /* remove timestamp and     */
  1869.                                         /* cobolroot                */
  1870.     parse value mvsstuff with . (null) . cobolroot ( null) mvsstuff
  1871.     end
  1872.   end
  1873. qname = rxqueue('Set',oldq)      /* restore normal queue */
  1874.  
  1875. do while (mvsstuff<>'') & (rtn=0)   /* mvsinfo. structure */
  1876.   parse value mvsstuff with key val (null) mvsstuff
  1877.   if mvsinfo.key = '' then do       /* e.g. mvsinfo.TYPE='' */
  1878.     mvsinfo.KEYS = mvsinfo.KEYS key /* no substitution for KEYS */
  1879.     mvsinfo.key.1 = val             /* e.g. mvsinfo.TYPE.1=val  */
  1880.     mvsinfo.key = 1                 /* e.g. mvsinfo.TYPE=1      */
  1881.     end
  1882.   else do
  1883.     x = mvsinfo.key + 1             /* e.g. mvsinfo.TYPE+1     */
  1884.     mvsinfo.key.x = val             /* e.g. mvsinfo.TYPE.2=val */
  1885.     mvsinfo.key = x                 /* e.g. mvsinfo.TYPE=2     */
  1886.     end
  1887.   end
  1888.  
  1889. return rtn
  1890.  
  1891. Set_MVSINFO_Vars:
  1892.  
  1893.  parse var mvsinfo.DRIVE numdrive;
  1894.  if numdrive = '' then
  1895.    numdrive = 0;
  1896.  do ii = 1 to numdrive;
  1897.    parse var mvsinfo.DRIVE.ii,
  1898.              drive.ii highqual.ii trans.ii mapping.ii sidefile.ii;
  1899.    end;
  1900.  
  1901. return
  1902. /* */
  1903. help:
  1904. helpname = '"COBOL Expand Copy Files Help Information"';
  1905. 'godoc find' helpname;
  1906. 'extract doclist into doclist';
  1907. if words(doclist) > 0 then
  1908.   do;
  1909.   'extract name into name';
  1910.   name = translate(name);
  1911.   if name = helpname then
  1912.     return; /* help already loaded */
  1913.   end;
  1914. 'lx' helpname '/asis';
  1915. 'extract recording into recording';
  1916. 'set recording off';
  1917. numhelp = 0;
  1918. call showhelp;
  1919. 'msg  ';
  1920. 'set readonly on';
  1921. 'set recording' recording;
  1922. 'top';
  1923. return;
  1924. /* */
  1925. showhelp:
  1926. call ah 'The COBOL Expand Copy Files facility allows you to expand';
  1927. call ah 'the contents of copy files inline.';
  1928. call ah;
  1929. call ah 'The following forms of the COPY statement are supported:';
  1930. call ah;
  1931. call ah 'COPY copyname.';
  1932. call ah;
  1933. call ah 'COPY copyname IN libname.';
  1934. call ah;
  1935. call ah 'COPY copyname OF libname.';
  1936. call ah;
  1937. call ah 'The copyname must be a one to eight character simple file';
  1938. call ah 'name, such as MYCOPY, with no file extension or path';
  1939. call ah 'information specified.  The copyname is assumed to not be';
  1940. call ah 'a reference to an environment variable.  The libname must be';
  1941. call ah 'a one to eight character environment variable name, such as';
  1942. call ah 'MYLIB or SYSLIB.  The replacing phrase may be specified, but';
  1943. call ah 'is ignored, meaning the expanded copy file is shown asis.';
  1944. call ah 'Except for an optional replacing phrase, the COPY statement';
  1945. call ah 'must appear on one line that contains no other statements,';
  1946. call ah 'however, a construct such as the following is also supported:';
  1947. call ah;
  1948. call ah '       01 WORK-FIELDS. COPY WORKVARS.';
  1949. call ah;
  1950. call ah;
  1951. call ah;
  1952. call ah 'The expanded copy file lines have the following properties:';
  1953. call ah;
  1954. call ah '- they are preceded and followed by a line indicating the';
  1955. call ah '  full path of the copy file.  The same search algorithm';
  1956. call ah '  as the COBOL compiler is used to find the copy file.';
  1957. call ah;
  1958. call ah '- they are read only, which means you cannot type over them,';
  1959. call ah '  nor are they saved when the file is saved';
  1960. call ah;
  1961. call ah '- they appear with the same language sesitivity (such as';
  1962. call ah '  color) as the rest of the file';
  1963. call ah;
  1964. call ah 'Expanded copy files may be hidden from view by selecting the';
  1965. call ah '"View" menu-bar choice and then selecting "Hide copy files".';
  1966. call ah 'Expanding a copy file will cause hidden copy files to be';
  1967. call ah 'shown.';
  1968. call ah;
  1969. call ah;
  1970. call ah;
  1971. call ah 'The following functions are supported:';
  1972. call ah;
  1973. call ah 'Expand a copy file:';
  1974. call ah;
  1975. call ah '  Position the cursor to the desired COPY statement to be';
  1976. call ah '  expanded, click on mouse button 2 (usually the right mouse';
  1977. call ah '  button) and choose "Expand copy file".  A single level of';
  1978. call ah '  copy file is expanded following the COPY statement.';
  1979. call ah;
  1980. call ah 'Contract an expanded copy file:';
  1981. call ah;
  1982. call ah '  Position the cursor to any line from the expanded copy file,';
  1983. call ah '  click on mouse button 2 (usually the right mouse button) and';
  1984. call ah '  choose "Contract copy file".  The expanded copy file and any';
  1985. call ah '  expanded inner copy files will be contracted.';
  1986. call ah;
  1987. call ah 'Refresh an expanded copy file:';
  1988. call ah;
  1989. call ah '  Position the cursor to any line from the expanded copy file,';
  1990. call ah '  click on mouse button 2 (usually the right mouse button) and';
  1991. call ah '  choose "Refreshcopy file".  The expanded copy file will be';
  1992. call ah '  refreshed.  Any previously expanded inner copy file must be';
  1993. call ah '  manually re-expanded if desired.';
  1994. call ah;
  1995. call ah '  An expanded copy file is not automatically updated when the';
  1996. call ah '  underlying file is updated.  The refresh function may be';
  1997. call ah '  used to refresh the expansion after the underlying file has';
  1998. call ah '  been updated.';
  1999. call ah;
  2000. call ah 'Edit a copy file:';
  2001. call ah;
  2002. call ah '  Position the cursor to the desired COPY statement to be';
  2003. call ah '  edit, click on mouse button 2 (usually the right mouse';
  2004. call ah '  button) and choose "Edit copy file".  An edit session will';
  2005. call ah '  be started for the copy file.  The same search algorithm';
  2006. call ah '  as the COBOL compiler is used to find the copy file.  If';
  2007. call ah '  the copy file is on MVS, the "Connect MVS drives" action';
  2008. call ah '  must have previously been issued to establish a connection';
  2009. call ah '  to MVS.';
  2010. call ah;
  2011. call ah 'Edit an expanded copy file:';
  2012. call ah;
  2013. call ah '  Position the cursor to any line from the expanded copy file,';
  2014. call ah '  click on mouse button 2 (usually the right mouse button) and';
  2015. call ah '  choose "Edit copy file".  An edit session will be started';
  2016. call ah '  for the copy file.  Note, if you position to a COPY';
  2017. call ah '  statement within the expanded copy file, the request will be';
  2018. call ah '  interpreted as applying to the copy file associated with the';
  2019. call ah '  COPY statement as opposed to the expanded copy file itself.';
  2020. call ah '  You can always position to the header or trailer line';
  2021. call ah '  associated with the expanded copy file if you want to';
  2022. call ah '  insure that the request will apply to the expanded copy file';
  2023. call ah '  itself.';
  2024. call ah ;
  2025. call ah 'Set an environment variable for copy file search:';
  2026. call ah;
  2027. call ah '  Position the cursor to the Editor command line and enter';
  2028. call ah '  the following command:';
  2029. call ah;
  2030. call ah '  copyfile set varname=path';
  2031. call ah;
  2032. call ah '  For example, to set MYLIB to point to D:\MYCOPY followed by';
  2033. call ah '  D:\YOURCOPY enter the command:';
  2034. call ah;
  2035. call ah '  copyfile set mylib=d:\mycopy;d:\yourcopy';
  2036. call ah;
  2037. call ah '  As another example, to add E:\THECOPY to the beginning of';
  2038. call ah '  of SYSLIB enter the command:';
  2039. call ah;
  2040. call ah '  copyfile set syslib=e:\thecopy;%syslib%';
  2041. return;
  2042. /* */
  2043. ah:
  2044. parse arg thehelp;
  2045. numhelp = numhelp + 1;
  2046. if numhelp = 1 then
  2047.   'set content' thehelp;
  2048. else
  2049.   'lxn insert' thehelp;
  2050. 'set show on';
  2051. return;
  2052.