Newsgroups: bit.listserv.vm-util
Date:         Mon, 13 Apr 1992 08:23:47 EST
From:         "Scott Mattes" <COTRSSM@SEA04VM.NAVSEA.NAVY.MIL>
Subject:      Re: VmShare
Comments: To: VM Utilities Discussion List <VM-UTIL@OHSTVMA.ACS.OHIO-STATE.EDU>
              12 Apr 1992 00:00:20 EDT from
              <057504%ACADVM1.UOTTAWA.CA@OHSTVMA.ACS.OHIO-STATE.EDU>

On Sun, 12 Apr 1992 00:00:20 EDT Costa Karamalis said:
>2) is it possible to have multiple screens (windows)? I am writting a
>rexx program and want to have several windows in my screen as an output
>when the program executes.

:READ CUTPASTE XEDIT
/*  CUTPASTE XEDIT MACRO to support cut/paste and text formatting operations
----------------------------------------------------------------------------
Main routine  Extracts requested subfunction from argument list and
              calls the appropriate subroutine.
----------------------------------------------------------------------------
 */
trace 'O'
address xedit
'COMMAND EXTRACT /FNAME /FTYPE /EFNAME /EFTYPE /UNIQUEID'
fn = strip(fname.1)
ft = strip(ftype.1)
selgrp = 'C'strip(uniqueid.1)
address command 'GLOBALV SELECT' selgrp 'GET MODE STATUS EFN EFT'
if efn^= '' & (efname.1^=efn | eftype.1^=eft) then do
   address command 'GLOBALV SELECT' selgrp 'PURGE'
   mode = 'BLOCK'
   status = 'RESET'
   efn = ''
   eft = ''
   end
if mode='' then do
   mode = 'BLOCK'
   address command 'GLOBALV SELECT' selgrp 'PUT MODE'
   end
if status = '' then do
   status = 'RESET'
   address command 'GLOBALV SELECT' selgrp 'PUT STATUS'
   end
arg action how .
if action = '' then action = 'KEYPAD'
select
  when abbrev('KEYPAD',action,1) then call keypad
  when abbrev('MODE',action,2) then do
     if status='MARK1' then call reseting
     if status='MARK2' & mode^='BLOCK' then call reseting
     select
        when mode='STREAM' then mode = 'BLOCK'
        when mode='BLOCK' & status='RESET' then mode = 'STREAM'
        when mode='BLOCK' & status='MARK2' then do
           mode = 'BLK/STR'
           status = 'RESET'
           end
        when mode='BLK/STR' then do
           mode = 'BLOCK'
           status = 'MARK2'
           end
        otherwise nop
        end
     address command 'GLOBALV SELECT' selgrp 'PUT MODE'
     call set_status
     end
  when abbrev('RESET',action,2) then do
     call reseting
     call set_status
     end
  when abbrev('MARK',action,2) then call marking
  when abbrev('LINES',action,2) then call mark_lines
  when abbrev('CUT',action,2) then do
     select
        when abbrev('BLANK',how,1)  then how = 'BLANK'
        when abbrev('COPY',how,1)   then how = 'COPY'
        when abbrev('DELETE',how,1) then how = 'DELETE'
        otherwise do
           'COMMAND EMSG Argument' how 'is invalid for CUTPASTE CUT'
           exit 5
           end
        end
     call cutting how
     end
  when abbrev('PASTE',action,2) then do
     select
        when abbrev('REPLACE',how,1) then how = 'REPLACE'
        when abbrev('OPEN',how,1)    then how = 'OPEN'
        when abbrev('INSERT',how,1)  then how = 'INSERT'
        when abbrev('SMART',how,1)   then how = 'SMART'
        otherwise do
           'COMMAND EMSG Argument' how ' is invalid for CUTPASTE PASTE'
           exit 5
           end
        end
     call pasting how
     end
  when abbrev('FORMAT',action,2)
     then if mode='STREAM' then call paraform 'BOTH'
          else call reformat 'BOTH'
  when abbrev('LFORMAT',action,2)
     then if mode='STREAM' then call paraform 'LEFT'
          else call reformat 'LEFT'
  when abbrev('SENTENCE',action,2) then call sentence
  when abbrev('CREATE',action,2) then do
     call create_clip
     if result ^=0 then exit result
     end
  when abbrev('QBLOCK',action,2) then call qblock
  when abbrev('POP',action,3) then call pop_window
  when abbrev('BWDBUFF',action,3) then call backward_buffer
  when abbrev('DISCARD',action,4) then call discard_buffer how
  when abbrev('QUIT',action,2) then do
     call quitting
     exit 0
     end
  when abbrev('QCURSOR',action,2) then do
     'COMMAND EXTRACT /CURSOR'
     if cursor.3 = -1 | cursor.4 = -1
        then 'COMMAND MSG Cursor not positioned in the file.'
        else 'COMMAND MSG Cursor positioned at: Line' cursor.3 'Column' cursor.4
     exit 0
     end
  when abbrev('LMARGIN',action,2) then do
     'COMMAND EXTRACT /CURSOR'
     if cursor.3 = -1 | cursor.4 = -1 then do
        'COMMAND EMSG Cursor not positioned in the file.'
        exit 5
        end
     address command 'GLOBALV SELECT' selgrp 'GET RIGHT_MARGIN'
     if right_margin ^= '' & cursor.4 >= right_margin then do
        'COMMAND EMSG Left margin must be less than right margin.'
        exit 5
        end
     left_margin = cursor.4
     address command 'GLOBALV SELECT' selgrp 'PUT LEFT_MARGIN'
     'COMMAND MSG Left margin now set to column' cursor.4
     exit 0
     end
  when abbrev('RMARGIN',action,2) then do
     'COMMAND EXTRACT /CURSOR'
     if cursor.3 = -1 | cursor.4 = -1 then do
        'COMMAND EMSG Cursor not positioned in the file.'
        exit 5
        end
     address command 'GLOBALV SELECT' selgrp 'GET LEFT_MARGIN'
     if left_margin ^= '' & cursor.4 <= left_margin then do
        'COMMAND EMSG Right margin must be greater than right margin.'
        exit 5
        end
     right_margin = cursor.4
     address command 'GLOBALV SELECT' selgrp 'PUT RIGHT_MARGIN'
     'COMMAND MSG Right margin now set to column' cursor.4
     exit 0
     end
  when abbrev('CMARGIN',action,2) then do
     left_margin = ''
     right_margin = ''
     address command 'GLOBALV SELECT' selgrp 'PUT LEFT_MARGIN RIGHT_MARGIN'
     'COMMAND MSG Margins settings cleared'
     exit 0
     end
  when abbrev('QMARGIN',action,2) then do
     address command 'GLOBALV SELECT' selgrp 'GET LEFT_MARGIN RIGHT_MARGIN'
     if left_margin  = '' then ml = 'Left margin not set'
                          else ml = 'Left margin set at' left_margin
     if right_margin = '' then mr = 'Right margin not set'
                          else mr = 'Right margin set at' right_margin
     'COMMAND MSG' ml',' mr
     'COMMAND EXTRACT /CURSOR'
     if cursor.3 ^= -1 & cursor.4 ^= -1
        then 'COMMAND CURSOR FILE' cursor.3 left_margin
     exit 0
     end
  otherwise do
     'COMMAND EMSG Argument' action 'is invalid'
     exit 5
     end
  end    /* end of large select */
if efname.1=efn & eftype.1=eft then call statusl 'ON'
exit 0
/*
-------------------------------------------------------------------------
Mark   Chart points on the screen to establish reference points
       identifying the beginning and end of a region to be later
       stored in a buffer by the Cut or Copy functions.
-------------------------------------------------------------------------
 */
marking: procedure expose mode status fn ft selgrp
  /* Determine the cursor position marking a corner of a block */
  'COMMAND EXTRACT /CURSOR'
  xline = cursor.3
  xcol = cursor.4
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS STREAM_MARKS'
  parse var block_marks b_cnt . . b_line1 b_col1 b_line2 b_col2 .
  parse var stream_marks s_cnt . . s_line1 s_col1 s_line2 s_col2 .
  if b_cnt='' then b_cnt = 0
  if s_cnt='' then s_cnt = 0
  if status='MARK2' then do    /* automatic reset */
     call reseting
     if mode='BLOCK' then do
        b_cnt = 0
        b_line1 = '' ; b_col1 = '' ;
        b_line2 = '' ; b_col2 = '' ;
        end
     else do
        s_cnt = 0
        s_line1 = '' ; s_col1 = '' ;
        s_line2 = '' ; s_col2 = '' ;
        end
     end
  if xline = -1 | xcol = -1 then do
     'COMMAND EMSG Cursor must be positioned in the file'
     error = 'yes'
     end
  else if mode='BLK/STR' then do
     topline = min(b_line1,b_line2)
     botline = max(b_line1,b_line2)
     topcol  = min(b_col1,b_col2)
     botcol  = max(b_col1,b_col2)
     if xline<topline | xline>botline | xcol<topcol | xcol>botcol then do
        'COMMAND EMSG Cursor must be positioned within the block'
        error = 'yes'
        end
     end
  if error = 'yes' then do
     if mode='BLOCK' then do
        cnt = b_cnt ; line1 = b_line1 ; col1 = b_col1 ;
        end
     else do
        cnt = s_cnt ; line1 = s_line1 ; col1 = s_col1 ;
        end
     if cnt = 1 then do
        'COMMAND EXTRACT /LSCREEN /CURLINE /LINE'
         min = line.1 - curline.2 + 3
         max = min + lscreen.1 - 3
         if line1 >= min & line1 <= max
            then 'COMMAND CURSOR FILE' line1 col1
            else  do
               'COMMAND LOCATE :'line1
               'COMMAND CURSOR FILE' line1 col1
               end
        'COMMAND MSG Place marker presently set at:  Line' line1 ', Column' col1
        end
     exit 2
     end
  if mode='BLOCK' then do
     b_cnt = b_cnt+1
     if b_cnt = 1 then do
        status = 'MARK1'
        block_marks = b_cnt fn ft xline xcol
        'COMMAND MSG Place marker presently set at:  Line' xline ', Column' xcol
        end
     else do
        status = 'MARK2'
        block_marks = b_cnt fn ft b_line1 b_col1 xline xcol
        call outline block_marks
        'COMMAND MSG Place markers presently set at:' b_line1','b_col1 '&' xline
               '('abs(xline-b_line1)+1 'X' abs(xcol-b_col1)+1')'
        end
     address command 'GLOBALV SELECT' selgrp 'PUT BLOCK_MARKS'
     end
  else do  /* STREAM or BLKSTR */
     s_cnt = s_cnt+1
     if s_cnt = 1 then do
        status = 'MARK1'
        stream_marks = s_cnt fn ft xline xcol
        'COMMAND MSG Place marker presently set at:  Line' xline ', Column' xcol
        end
     else do
        status = 'MARK2'
        stream_marks = s_cnt fn ft s_line1 s_col1 xline xcol
        'COMMAND MSG Place markers presently set at:' s_line1','s_col1 '&' xline
        end
     address command 'GLOBALV SELECT' selgrp 'PUT STREAM_MARKS'
     end
  call set_status status
  return
mark_lines: procedure expose selgrp status mode fn ft
  if mode^='BLOCK' then do
     'COMMAND EMSG Line marking is only valid in BLOCK mode'
     exit 4
     end
  /* Get marked position in file */
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS'
  parse var block_marks b_cnt . . b_line1 b_col1 b_line2 b_col2 .
  'COMMAND EXTRACT /LRECL'
  select
     when status='MARK2' then do
        bl1 = min(b_line1,b_line2)
        bl2 = max(b_line1,b_line2)
        bc1 = 1
        bc2 = lrecl.1
        end
     when status='MARK1' then do
        bl1 = b_line1
        bl2 = bl1
        bc1 = 1
        bc2 = lrecl.1
        end
     otherwise do
        'COMMAND EMSG No reference points have been MARKed within this file'
        exit 4
        end
     end
  block_marks = 2 fn ft bl1 bc1 bl2 bc2
  address command 'GLOBALV SELECT' selgrp 'PUT BLOCK_MARKS'
  call outline block_marks
  'COMMAND MSG Place markers presently set at:' bl1','bc1 '&' bl2','bc2 ,
          '('bl2-bl1+1 'X' bc2-bc1+1')'
  if status='MARK1' then do
     status = 'MARK2'
     call set_status status
     end
  return
/*
-------------------------------------------------------------------------
CUt Copy|Blank|Delete   Place contents of the rectangle (block mode) or
                        the character stream (stream mode) defined by the
two reference marks previously set, into a GLOBALV buffer.  The Delete
function will delete the selected text in the file, Blank will replace it
with blanks, while Copy will leave it unscathed.
-------------------------------------------------------------------------
 */
cutting: procedure expose selgrp status mode fn ft
  parse arg how .
  if mode='BLK/STR' & status='RESET'
     then 'COMMAND MSG Using block marks for cut...'
  else if status^='MARK2' then do
     'COMMAND EMSG Two reference points have not yet been MARKed within this fil
     exit 4
     end
  /* Get marked position in file */
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS STREAM_MARKS'
  parse var block_marks b_cnt . . b_line1 b_col1 b_line2 b_col2 .
  parse var stream_marks s_cnt . . s_line1 s_col1 s_line2 s_col2 .
  if b_cnt ='' then b_cnt = 0
  if s_cnt ='' then s_cnt = 0
  if mode='BLOCK' | mode='BLK/STR' & s_cnt=0 then do
     cnt = b_cnt ; line1 = b_line1 ; col1 = b_col1 ;
                   line2 = b_line2 ; col2 = b_col2 ;
     end
  else do
     cnt = s_cnt ; line1 = s_line1 ; col1 = s_col1 ;
                   line2 = s_line2 ; col2 = s_col2 ;
     end
  /* Determine the location of the top left corner, the number of lines
     and the number of columns */
  fline = min(line1,line2)               /* first line       */
  fcol  = min(col1,col2)                 /* first column     */
  lline = max(line1,line2)               /* last line        */
  lcol  = max(col1,col2)                 /* last column      */
  nline = lline-fline+1                  /* num of lines     */
  ncol  = lcol-fcol+1                    /* num of columns   */
  select                                 /* for stream mode: */
     when line2 > line1 then do
        tcol = col1
        bcol = col2
        end
     when line2 < line1 then do
        tcol = col2
        bcol = col1
        end
     otherwise do
        tcol = min(col1,col2)
        bcol = max(col1,col2)
        end
     end  /* select  */
  if mode='BLK/STR' then do
     min_line = min(b_line1,b_line2)
     max_line = max(b_line1,b_line2)
     min_col  = min(b_col1, b_col2 )
     max_col  = max(b_col1, b_col2 )
     num_col  = max_col-min_col+1
     end
  'COMMAND EXTRACT /LINE /COLUMN /LRECL /TRUNC'
  old_current_line = line.1
  old_current_col  = column.1
  select  /* decide where to place cursor when done */
     when mode = 'STREAM' & how = 'DELETE' then do
        old_cursor_line = fline
        old_cursor_col  = tcol
        end
     when mode = 'STREAM' then do
        old_cursor_line = lline
        old_cursor_col  = bcol
        end
     when mode = 'BLOCK' then do
        old_cursor_line = lline
        old_cursor_col  = lcol
        end
     otherwise do
        old_cursor_line = fline
        old_cursor_col  = tcol
        end
     end
  'COMMAND PRESERVE'
  'COMMAND SET LINEND OFF'
  'COMMAND SET ZONE 1 *'
  'COMMAND LOCATE :'fline           /* Position to cut: Line */
  if mode = 'BLOCK' then do
     'COMMAND CLOCATE :'fcol
     if ncol=lrecl.1 then 'COMMAND SET TRUNC' lrecl.1
     end
  /* Cut all lines into clip.i */
  clip. = ''
  delete_lines = 0
  delete_start = 0
  do i = 1 to nline
     'COMMAND EXTRACT /CURLINE /LINE'
     select;
       when mode = 'BLOCK' then do
          clip.i = substr(curline.3,fcol,ncol)
          select
             when how='BLANK'  then 'COMMAND CREPLACE' left('',ncol)
             when how='DELETE' then ,
                if ncol<lrecl.1 then 'COMMAND CDELETE' ncol
                                else 'COMMAND DELETE 1'
             otherwise /* COPY */ nop
             end
          end   /* end of mode = block  */
       when mode = 'BLK/STR' then do
          select
             when i=1 then do  /* first line */
                'COMMAND CLOCATE :'tcol         /* Position to cut: Column */
                if nline=1 then ecol = bcol
                else ecol = max_col
                addline = substr(curline.3,tcol,ecol-tcol+1)
                addlen = length(addline)
                clip.i = space(addline)
                if how^='COPY' then 'COMMAND CREPLACE' left('',addlen)
                end
             when i=nline then do  /* last line */
               'COMMAND CLOCATE :'min_col       /* Position to cut: Column */
                addline = substr(curline.3,min_col,bcol-min_col+1)
                addlen = length(addline)
                clip.i = space(addline)
                if how^='COPY' then 'COMMAND CREPLACE' left('',addlen)
                end
             otherwise do
               'COMMAND CLOCATE :'min_col       /* Position to cut: Column */
                addline = substr(curline.3,min_col,num_col)
                clip.i = space(addline)
                if how^='COPY' then 'COMMAND CREPLACE' left('',num_col)
                end
             end
          end   /* end of mode = blk/str */
       otherwise /* mode = 'STREAM' */ do
          select
            when i = 1 then do   /* cut first line in stream mode  */
               'COMMAND CLOCATE :'tcol  /* Position to cut: Column */
               if nline = 1 then do     /* only one line in cut ?  */
                  addline = substr(curline.3,tcol,bcol-tcol+1)
                  xlen = verify(curline.3,' ','N',bcol+1)
                  if xlen>0 then xlen = xlen-(bcol+1)
                  end
               else do
                  addline = substr(curline.3,tcol)
                  xlen = 0
                  end
               addlen = length(addline)
               clip.i = space(addline)
               select
                  when how='BLANK'  then 'COMMAND CREPLACE' left('',addlen)
                  when how='DELETE' then do
                     delcol = addlen+xlen
                     if delcol>0 then 'COMMAND CDELETE' delcol
                     end
                  otherwise /* COPY */ nop
                  end
               'COMMAND EXTRACT /LENGTH'
               if how='DELETE' & length.1=0 then do
                  delete_lines = delete_lines + 1
                  delete_start = line.1
                  end
               end
            when i = nline then do      /* cut last line  */
               'COMMAND CLOCATE :1'             /* Position to cut: Column */
               firstcol = verify(curline.3,' ')
               addline = substr(curline.3,1,bcol)
               addlen = length(addline)
               clip.i = space(addline)
               select
                  when how='BLANK' then 'COMMAND CREPLACE' left('',bcol)
                  when how='DELETE' then do
                     delcol = max(bcol,verify(curline.3,' ','N',bcol+1)-1)
                     'COMMAND CDELETE' delcol
                     if firstcol>1 then 'COMMAND CINSERT' left('',firstcol-1)
                     end
                  otherwise /* COPY */ nop
                  end
               if how='DELETE' & addlen>=length(curline.3) then do
                  delete_lines = delete_lines + 1
                  if delete_lines=1 then delete_start = line.1
                  end
               end
            otherwise do
               'COMMAND CLOCATE :1'    /* Position to cut: Column      */
               addline = curline.3     /* get entire intermediate line */
               addlen = length(addline)
               clip.i = space(addline)
               select
                  when how='BLANK'  then 'COMMAND CREPLACE' left('',addlen)
                  when how='DELETE' then do
                     delete_lines = delete_lines + 1
                     if delete_lines=1 then delete_start = line.1
                     end
                  otherwise /* COPY */ nop
                  end
               end
            end   /* end of inner select group */
          end   /* end of mode = stream       */
       end    /* end of outer select group   */
     if ^(mode='BLOCK' & how='DELETE' & ncol=lrecl.1) then 'COMMAND LOCATE +1'
     end    /* end of iterations through lines to be cut  */
  if delete_lines > 0 then do
     'COMMAND LOCATE :'delete_start
     'COMMAND DELETE' delete_lines
     end
  /* If this is the first block to be cut, then initialize CLIPLIST
     and HIGHBLK.  CLIPLIST is a string of numeric identifiers being
     used to identify clippings.  HIGHBLK is the last used identifier.*/
  address command 'GLOBALV SELECT CUTPASGL GET CLIPLIST HIGHBLK'
  if highblk = '' then do
     highblk = 1
     cliplist = highblk
     end
  else do
     highblk = highblk+1
     cliplist = space(highblk cliplist)
     end
  address command 'GLOBALV SELECT CUTPASGL PUT CLIPLIST HIGHBLK'
  /* Put all variables and text data into storage */
  clip.0 = nline
  address command 'GLOBALV SELECT CLIP.'highblk 'PUT CLIP.0'
  if mode='STREAM' then ncol = 0
  do i=1 to nline
     if mode='STREAM' then ncol = max(ncol,length(clip.i))
     address command 'GLOBALV SELECT CLIP.'highblk 'PUT CLIP.'i
     end
  if mode='BLOCK' then cut_mode='BLOCK'
  else cut_mode = 'STREAM'
  address command 'GLOBALV SELECT CLIP.'highblk 'PUT CUT_MODE NLINE NCOL'
  if mode='BLK/STR' & how='DELETE' then do  /* reformat */
     'COMMAND LOCATE :'fline
     'COMMAND EXTRACT /CURLINE'
     clip_str = substr(curline.3,tcol,max_col-tcol+1)
     do i = 1 to max_line-fline
        'COMMAND LOCATE +1'
        'COMMAND EXTRACT /CURLINE'
        clip_str = clip_str substr(curline.3,min_col,num_col)
        end
     clip_str = space(clip_str)
     'COMMAND LOCATE :'fline
     'COMMAND CLOCATE :'tcol
     'COMMAND CREPLACE' left('',max_col-tcol+1)
     i = lastpos(' ',clip_str,max_col-tcol)
     if i>0 then do
        str = substr(clip_str,1,i-1)
        clip_str = delstr(clip_str,1,i)
        'COMMAND CREPLACE' str
        end
     clip. = ''
     call block_format num_col 'LEFT'
     'COMMAND LOCATE  :'fline
     'COMMAND CLOCATE :'min_col
     do i = 1 to max_line-fline
        'COMMAND LOCATE +1'
        if i<=clip.0 then 'COMMAND CREPLACE' left(clip.i,num_col)
                     else 'COMMAND CREPLACE' left('',num_col)
        end
     end
  if (mode='BLOCK' & ncol=lrecl.1) then do ;
     'COMMAND SET TRUNC' trunc.1
     old_cursor_line = fline
     old_cursor_col = fcol
     end
  'COMMAND SET MSGMODE OFF'
  'COMMAND LOCATE :'old_current_line    /* Return to current position */
  'COMMAND CLOCATE :'old_cursor_col
  'COMMAND CURSOR FILE' old_cursor_line old_cursor_col
  'COMMAND RESTORE'
  call reseting
  call set_status
  'COMMAND MSG Placed on ClipBoard as Item' highblk
  return
/*
-------------------------------------------------------------------------
PAste Replace|Insert|Open   Insert the contents of the current buffer
      Smart                 into the file, starting at the cursor
position, which identifies the top left corner of the insertion area.
The buffer contents will thus be inserted below and to the right of
the cursor's position when the Paste function is invoked.
   The PASTE REPLACE function will paste the contents of the buffer
over any existing text.              (BLOCK mode or BLK/STR only)
   The PASTE INSERT function will push any text to the right of the
cursor by enough columns to acomodate block being inserted.
   The PASTE OPEN function will insert the buffer between two lines of
the file, inserting enough blank lines to paste the contents of the
current buffer without affecting existing text.   (BLOCK mode only)
   The PASTE SMART will only replace a blank area, otherwise it opens
only as many lines as necessary.  (BLOCK mode only)
-------------------------------------------------------------------------
 */
pasting: procedure expose selgrp status mode
  arg how open .
  address command 'GLOBALV SELECT CUTPASGL GET CLIPLIST'
  if cliplist = '' then do
     'COMMAND EMSG No block(s) in storage to paste'
     exit 3
     end
  clipid = word(cliplist,1)
  'COMMAND EXTRACT /CURSOR /LINE /COLUMN /ALT /SIZE /LRECL /TRUNC'
  if cursor.3 = -1 | cursor.4 = -1 then do
     'COMMAND EMSG Cursor is not on a valid data field'
     exit 2
     end
  if mode='BLK/STR' then do
     address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS'
     parse var block_marks b_cnt fn ft b_line1 b_col1 b_line2 b_col2 .
     topline = min(b_line1,b_line2)
     botline = max(b_line1,b_line2)
     topcol  = min(b_col1,b_col2)
     botcol  = max(b_col1,b_col2)
     if cursor.3<topline | cursor.3>botline | ,
        cursor.4<topcol  | cursor.4>botcol then do
        'COMMAND EMSG Cursor must be positioned within the block'
        exit 5
        end
     end
  address command 'GLOBALV SELECT CLIP.'clipid 'GET CUT_MODE NLINE NCOL'
  if cut_mode='STREAM' & mode='BLOCK' then do
     'COMMAND EMSG A stream clipping cannot be pasted in block mode.'
     exit 5
     end
  if mode='STREAM' & how='REPLACE' then do
     'COMMAND EMSG Paste replace is illegal in stream mode.'
     exit 5
     end
  if mode='STREAM' & how='OPEN' then do
     'COMMAND EMSG Paste open is illegal in stream mode.'
     exit 5
     end
  /* Recover our clipping from GLOBALV */
  clip_str = ''
  do i = 1 to nline
     address command 'GLOBALV SELECT CLIP.'clipid 'GET CLIP.'i
     clip_str = clip_str clip.i
     end
  clip.0 = nline
  clip_str = space(clip_str)
  old_current_line = line.1    /* Save current position in file */
  old_current_col  = column.1
  old_cursor_line  = cursor.3  /* Save current position on screen  */
  old_cursor_col   = cursor.4
  insert_line = cursor.3
  insert_col = cursor.4
  expand_num = 0
  'COMMAND PRESERVE'                 /* Save currrent Xedit settings */
  'COMMAND SET LINEND OFF'
  'COMMAND SET ZONE 1 *'
  'COMMAND SET AUTOSAVE OFF'         /* Disable AUTOSAVE for efficiency */
  'COMMAND LOCATE  :'insert_line     /* Set left pasting corner */
  'COMMAND CLOCATE :'insert_col
  if insert_line=0 | insert_line>size.1 then do
     if ^(mode='BLOCK' & how='OPEN') then do
        'COMMAND ADD 1'
        'COMMAND LOCATE +1'
        end
     if insert_line=0 then do
        insert_line = insert_line+1
        old_cursor_line = old_cursor_line+1
        if old_current_line=0 then old_current_line=1
        end
     end
  if mode='STREAM' then do
     /* first, let's figure out margins, which may be set */
     address command 'GLOBALV SELECT' selgrp 'GET LEFT_MARGIN RIGHT_MARGIN'
     'COMMAND EXTRACT /CURLINE /LENGTH /LRECL /TRUNC /LSCREEN /VERIFY /VERSHIFT'
     parse var verify.2 ver1 .
     ver1 = max(1,ver1+vershift.1)
     ver2 = min(ver1+lscreen.2-8,lrecl.1,trunc.1)
     first_text = verify(curline.3,' ')
     if left_margin=''
        then if first_text=0 then left_margin = insert_col
             else left_margin = first_text
     if right_margin='' then right_margin = ver2
     width = right_margin-left_margin+1
     if first_text > 0 then do
        clip_str = clip_str space(substr(curline.3,insert_col))
        delcol = length.1-insert_col+1
        if delcol^=0 then 'COMMAND CDELETE' delcol
        end
     if insert_col<=right_margin then do
        i = lastpos(' ',clip_str||' ',right_margin-insert_col+1)
        if i>0 then do
           str = substr(clip_str,1,i-1)
           clip_str = delstr(clip_str,1,i)
           'COMMAND CREPLACE' str
           end
        end
     /* format the rest of the data stream */
     call block_format width 'LEFT'
     'COMMAND LOCATE  :'insert_line
     'COMMAND CLOCATE :'left_margin
     if how='INSERT' then how='OPEN'
     if how='SMART'  then 'COMMAND LOCATE +1'
     nline = clip.0
     ncol = width
     end   /* End of stream mode reformat */
  if mode='BLK/STR' then do
     /* margins are topcol and botcol*/
     width = botcol-topcol+1
     first_width = botcol-insert_col+1
     'COMMAND EXTRACT /CURLINE'
     str = substr(curline.3,insert_col,first_width)
     clip_str = clip_str str
     do botline-insert_line
        'COMMAND LOCATE +1'
        'COMMAND EXTRACT /CURLINE'
        clip_str = clip_str substr(curline.3,topcol,width)
        end
     clip_str = space(clip_str) || ' '
     i = lastpos(' ',clip_str,botcol-insert_col+1)
     if i>0 then do
        str = substr(clip_str,1,i-1)
        clip_str = delstr(clip_str,1,i)
        end
     else str=''
     /* format the rest of the data stream */
     call block_format width 'LEFT'
     expand_num = insert_line + clip.0 - botline
     if expand_num>0 & how = 'REPLACE' then do
        'COMMAND EMSG Data will not fit within block.'
        'COMMAND LOCATE :'old_current_line
        'COMMAND CLOCATE :'old_current_col
        'COMMAND CURSOR FILE' old_cursor_line old_cursor_col
        'COMMAND RESTORE'
        exit 4
        end
     else do
        'COMMAND LOCATE  :'insert_line
        'COMMAND CLOCATE :'insert_col
        'COMMAND CREPLACE' left('',first_width)
        if str^='' then 'COMMAND CREPLACE' str
        'COMMAND CLOCATE :'topcol
        i=0
        do botline-insert_line
           i = i+1
           'COMMAND LOCATE +1'
           'COMMAND CREPLACE' left(clip.i,width)
           end
        if expand_num <= 0 then do
           nline = 0
           ncol = width
           end
        else do
           j = 0
           do expand_num
              i = i+1 ; j = j+1 ;
              clip.j = clip.i
              end
           clip.0 = j
           nline = j
           ncol = width
           new_botline = botline+expand_num
           block_marks = b_cnt fn ft topline topcol new_botline botcol
           address command 'GLOBALV SELECT' selgrp 'PUT BLOCK_MARKS'
           end
        if how='INSERT' then how='OPEN'
        'COMMAND LOCATE :'botline
        if how='SMART'  then 'COMMAND LOCATE +1'
        'COMMAND CLOCATE :'topcol
        end
     end   /* End of block/stream mode reformat */
  if mode='BLOCK' then 'COMMAND EXTRACT /LRECL /TRUNC'
  'COMMAND SET MSGMODE OFF'
  'COMMAND SET SPILL OFF'
  trunc_cnt = 0
  do i = 1 to nline
     select
        when how='REPLACE' then do
           'COMMAND CREPLACE' clip.i
           if rc=3 then trunc_cnt = trunc_cnt+1
           if rc=4 then do   /* eof ? */
              'COMMAND ADD 1'
              'COMMAND LOCATE +1'
              'COMMAND CREPLACE' clip.i
              if rc=3 then trunc_cnt = trunc_cnt+1
              end
           'COMMAND LOCATE +1'
           end
        when how='INSERT'  then do
           'COMMAND CINSERT' clip.i
           if rc=3 then trunc_cnt = trunc_cnt+1
           if rc=4 then do   /* eof ? */
              'COMMAND ADD 1'
              'COMMAND LOCATE +1'
              'COMMAND CREPLACE' clip.i
              if rc=3 then trunc_cnt = trunc_cnt+1
              end
           'COMMAND LOCATE +1'
           end
        when how='OPEN'    then do
           'COMMAND ADD 1'
           'COMMAND LOCATE +1'
           if mode='BLOCK' & insert_col=1 & ncol=lrecl.1
              then 'COMMAND SET TRUNC' lrecl.1
           'COMMAND CREPLACE' clip.i
           if rc=3 then trunc_cnt = trunc_cnt+1
           if mode='BLOCK' & insert_col=1 & ncol=lrecl.1
              then 'COMMAND SET TRUNC' trunc.1
           end
        otherwise /* SMART */ do
           'COMMAND EXTRACT /CURLINE'
           select
              when mode='BLOCK' then teststr = substr(curline.3,insert_col,ncol)
              when mode='BLK/STR' then teststr = substr(curline.3,topcol,width)
              otherwise /* STREAM */ teststr = curline.3
              end
           if teststr^=' ' then do
              'COMMAND LOCATE -1'
              'COMMAND ADD 1'
              'COMMAND LOCATE +1'
              end
           'COMMAND CREPLACE' clip.i
           if rc=3 then trunc_cnt = trunc_cnt+1
           if rc=4 then do   /* eof ? */
              'COMMAND ADD 1'
              'COMMAND LOCATE +1'
              'COMMAND CREPLACE' clip.i
              if rc=3 then trunc_cnt = trunc_cnt+1
              end
           'COMMAND LOCATE +1'
           end
        end            /* end of select     */
     end               /* end of do loop    */
  'COMMAND LOCATE :'old_current_line     /* Return to current position */
  'COMMAND CLOCATE :'old_current_col
  'COMMAND CURSOR FILE' old_cursor_line old_cursor_col
  if mode='BLK/STR' & expand_num>0 then call outline block_marks
  'COMMAND RESTORE'                      /* Restore Xedit settings */
  'COMMAND SET ALT' alt.1+1 alt.2+1      /* Restore no. of alterations */
  if trunc_count > 0 then do     /* Issue TRUNCATED message... */
     over = 'TRUNCATED'
     if trunc_count = 1 then lines = 'line'
     'COMMAND EMSG' trunc_cnt lines over
     end
  return
/*
-------------------------------------------------------------------------
This routine will format a block of text into 'width' wide records.
-------------------------------------------------------------------------
 */
block_format: procedure expose clip_str clip. mode
  arg width just .
  if just='BOTH' then just = 1
                 else just = 0
  clip_str = space(clip_str) || ' '
  clip. = ''
  column = width + 1
  x = x2c('11')    /* use any unprintable character */
  if mode='STREAM' then do
     n = pos('. ',clip_str,1)
     if n>0 then do until n=0
        clip_str = insert(x,clip_str,n,1)
        n = n+2
        n = pos('. ',clip_str,n)
        end
     end
  n = 0
  do while clip_str ^= '' & clip_str ^= ' '
     clip_str = space(clip_str) || ' '
     i = lastpos(' ',clip_str,column)
     if i = 0 then i = pos(' ',clip_str,column)
     str = substr(clip_str,1,i-1)
     clip_str = delstr(clip_str,1,i)
     if substr(str,length(str),1)=x then str = delstr(str,length(str),1)
     if just & clip_str ^= '' then str = justify(str,width)
     str = translate(str,' ',x)
     n = n+1
     clip.n = str
     end
  clip.0 = n
  return
/*
-------------------------------------------------------------------------
FORMAT  Take the contents of a rectangle, whose corners were previously
        defined.  Re-format the contents and justify within the margins.
-------------------------------------------------------------------------
 */
reformat: procedure expose selgrp status mode
  arg type .
  if status^='MARK2' & mode^='BLK/STR' then do
     'COMMAND EMSG Two reference points have not yet been MARKed within this fil
     exit 4
     end
  if mode='BLK/STR' then call reseting
  /* Get marked position in file */
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS'
  parse var block_marks cnt . . line1 col1 line2 col2 .
  /* Determine the location of the top left corner, the number of lines
     and the number of columns */
  fline = min(line1,line2)               /* first line       */
  fcol  = min(col1,col2)                 /* first column     */
  lline = max(line1,line2)               /* last line        */
  lcol  = max(col1,col2)                 /* last column      */
  nline = lline-fline+1                  /* num of lines     */
  ncol  = lcol-fcol+1                    /* num of columns   */
  'COMMAND EXTRACT /LINE /COLUMN /CURLINE /ALT'
  old_current_line = line.1
  old_current_col  = column.1
  old_cursor_line = lline
  old_cursor_col  = lcol
  'COMMAND PRESERVE'
  'COMMAND SET LINEND OFF'
  'COMMAND SET ZONE 1 *'
  'COMMAND LOCATE :'fline
  'COMMAND CLOCATE :'fcol
  /* Cut lines into stream clip_str */
  clip_str = ''
  do i = 1 to nline
     'COMMAND EXTRACT /CURLINE'
     clip_str = clip_str substr(curline.3,fcol,ncol)
     'COMMAND LOCATE +1'
     end
  /* format the data stream */
  clip. = ''
  call block_format ncol type
  'COMMAND LOCATE  :'fline
  'COMMAND CLOCATE :'fcol
  do i = 1 to nline
     'COMMAND CREPLACE' left(clip.i,ncol)
     'COMMAND LOCATE +1'
     end
  expand_num = clip.0 - nline
  if expand_num>0 then do
     'COMMAND SET MSGMODE OFF'
     do i=nline+1 to clip.0     /* insert smart */
        'COMMAND EXTRACT /CURLINE'
        if substr(curline.3,fcol,ncol) ^= ' ' then do
           'COMMAND LOCATE -1'
           'COMMAND ADD 1'
           'COMMAND LOCATE +1'
           end
        'COMMAND CREPLACE' clip.i
        if rc=4 then do   /* eof ? */
           'COMMAND ADD 1'
           'COMMAND LOCATE +1'
           'COMMAND CREPLACE' clip.i
           end
        end
     lline = lline + expand_num
     block_marks = clip.0 fn ft fline fcol lline lcol
     address command 'GLOBALV SELECT' selgrp 'PUT BLOCK_MARKS'
     'COMMAND LOCATE :'old_current_line     /* Return to current position */
     call outline block_marks
     end
  'COMMAND LOCATE :'old_current_line     /* Return to current position */
  'COMMAND CLOCATE :'old_current_col
  'COMMAND CURSOR FILE' old_cursor_line  old_cursor_col
  'COMMAND RESTORE '                     /* Restore Xedit settings */
  'COMMAND SET ALT' alt.1+1 alt.2+1      /* Restore no. of alterations */
  return
/*
-------------------------------------------------------------------------
FORMAT  Format a paragraph (stream mode), boundaries determined by blank
        lines above and below.  The cursor should be within paragraph.
-------------------------------------------------------------------------
 */
paraform: procedure expose selgrp status mode
  arg type .
  'COMMAND EXTRACT /CURSOR/SIZE/'
  if cursor.3 = -1 | cursor.4 = -1 then do
     'COMMAND EMSG Cursor not positioned in the file'
     exit 4
     end
  'COMMAND EXTRACT /LINE /COLUMN /ALT'
  old_current_line = line.1
  old_current_col  = column.1
  old_cursor_line = cursor.3
  old_cursor_col  = cursor.4
  curspos = cursor.3              /* cursor pos when PFK was hit */
  first_text = verify(curline.3,' ')
  do i=curspos to 0 by -1         /* scan back for a blank line  */
     ':'i
     'COMMAND EXTRACT /LENGTH/'
     if length.1 = 0 then leave
     end
  'COMMAND EXTRACT /LINE/'
  pline = line.1
  if pline = curspos then do
     'COMMAND EMSG The cursor is not positioned within a paragraph.'
     'COMMAND LOCATE :'old_current_line
     exit 5
     end
  'COMMAND PRESERVE'
  'COMMAND SET LINEND OFF'
  'COMMAND SET ZONE 1 *'
  'COMMAND LOCATE +1'
  clip_str = ''
  do i=pline to size.1+1
     'COMMAND EXTRACT /LENGTH/CURLINE'
     if length.1 = 0 then leave
     str = curline.3
     clip_str = clip_str str
     'COMMAND DELETE 1'
     end
  'COMMAND LOCATE -1'
  /* Now let's figure out margins, which may have been set */
  address command 'GLOBALV SELECT' selgrp 'GET LEFT_MARGIN RIGHT_MARGIN'
  'COMMAND EXTRACT /LRECL /TRUNC /LSCREEN /VERIFY /VERSHIFT'
  parse var verify.2 ver1 .
  ver1 = max(1,ver1+vershift.1)
  ver2 = min(ver1+lscreen.2-8,lrecl.1,trunc.1)
  if left_margin='' then left_margin = first_text
  if right_margin='' then right_margin = ver2
  width = right_margin-left_margin+1
  /* format the data stream */
  clip. = ''
  call block_format width type
  'COMMAND CLOCATE :'left_margin
  do i=1 to clip.0
     'COMMAND ADD 1'
     'COMMAND LOCATE +1'
     'COMMAND CREPLACE' clip.i
     end
  'COMMAND LOCATE :'old_current_line     /* Return to current position */
  'COMMAND CLOCATE :'old_current_col
  'COMMAND CURSOR FILE' old_cursor_line  old_cursor_col
  'COMMAND RESTORE'                      /* Restore Xedit settings */
  'COMMAND SET ALT' alt.1+1 alt.2+1      /* Restore no. of alterations */
  return
/*
-------------------------------------------------------------------------
SENTENCE Marks the cursor position and the period at the end of sentence.
-------------------------------------------------------------------------
 */
sentence: procedure expose mode status fn ft selgrp
  if mode='BLOCK' then do
     'COMMAND EMSG Sentence marking is not possible in BLOCK mode.'
     exit 5
     end
  if status ='MARK2' then do
     'COMMAND EMSG Marks already exist.'
     exit 5
     end
  'COMMAND EXTRACT /CURSOR /LRECL /LINE'
  if xline = -1 | xcol = -1 then do
     'COMMAND EMSG Cursor must be positioned in the file'
     exit 2
     end
  xline = cursor.3
  xcol = cursor.4
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS'
  parse var block_marks b_cnt . . b_line1 b_col1 b_line2 b_col2 .
  if b_cnt='' then b_cnt = 0
  scol = 1
  ecol = lrecl.1
  if mode='BLK/STR' then do
     topline = min(b_line1,b_line2)
     botline = max(b_line1,b_line2)
     topcol  = min(b_col1,b_col2)
     botcol  = max(b_col1,b_col2)
     if xline<topline | xline>botline | xcol<topcol | xcol>botcol then do
        'COMMAND EMSG Cursor must be positioned within the block'
        exit 2
        end
     scol = topcol
     ecol = botcol
     end
  if status='MARK1' then xcol=xcol+1
  old_current_line = line.1
  notfound=0
  zcol=xcol
  'COMMAND LOCATE :'xline
  do until n>0 | notfound=1
     'COMMAND EXTRACT /CURLINE /LINE'
     n = pos('. ',curline.3||' ',zcol)
     zcol=scol
     if n>ecol then n=0
     yline = line.1
     ycol = n
     if n=0 then do
        'COMMAND LOCATE +1'
        if rc^=0 then notfound=1
        if mode='BLK/STR' & (line.1+1)>botline then notfound=1
        end
     end
  if notfound then do
     'COMMAND EMSG End of sentence not found.  No marks have been set.'
     'COMMAND LOCATE :'old_current_line
     exit 2
     end
  if status='MARK1' then do
     'COMMAND LOCATE :'old_current_line
     'COMMAND CURSOR FILE' yline ycol
     return
     end
  stream_marks = 2 fn ft xline xcol yline ycol
  'COMMAND MSG Place markers presently set at:' xline','xcol '-' yline','ycol
  address command 'GLOBALV SELECT' selgrp 'PUT STREAM_MARKS'
  status = 'MARK2'
  call set_status status
  'COMMAND LOCATE :'old_current_line
  return
/*
-------------------------------------------------------------------------
QBLOCK      Query markers, position cursor at mark 1,
            Redraw the BOX (CMS window) around the marked block
-------------------------------------------------------------------------
 */
qblock: procedure expose selgrp status mode
  if (mode='STREAM' | mode='BLOCK') & status='RESET' then do
     'COMMAND EMSG No blocks have been marked.'
     return
     end
  address command 'GLOBALV SELECT' selgrp 'GET BLOCK_MARKS STREAM_MARKS'
  parse var block_marks b_cnt . . b_line1 b_col1 b_line2 b_col2 .
  parse var stream_marks s_cnt . . s_line1 s_col1 s_line2 s_col2 .
  if b_cnt ='' then b_cnt = 0
  if s_cnt ='' then s_cnt = 0
  if s_cnt = 1
     then 'COMMAND MSG Stream marker presently set at:  Line' s_line1 ', Column'
  else if s_cnt = 2
     then 'COMMAND MSG Stream markers presently set at:' s_line1','s_col1 '&' s_
  if b_cnt = 1
     then 'COMMAND MSG Block marker presently set at:  Line' b_line1 ', Column'
  else if b_cnt = 2
      then 'COMMAND MSG Block markers presently set at:' b_line1','b_col1 '&' b_
               '('abs(b_line2-b_line1)+1 'X' abs(b_col2-b_col1)+1')'
  if s_cnt>0 then do
     if s_cnt=1 then do
        tline = s_line1
        tcol = s_col1
        end
     else select  /* for stream mode: */
        when s_line2 > s_line1 then do
           tline = s_line1
           tcol = s_col1
           end
        when s_line2 < s_line1 then do
           tline = s_line2
           tcol = s_col2
           end
        otherwise do
           tline = s_line1
           tcol = min(s_col1,s_col2)
           end
           end  /* select  */
        'COMMAND CURSOR FILE' tline tcol
        end
  if b_cnt<2 then return
  call outline block_marks
  if result>0 then 'COMMAND EMSG The block extends beyond screen boundaries.'
  if result<4 then 'COMMAND CURSOR FILE' min(b_line1,b_line2) min(b_col1,b_col2)
  return
/*
-------------------------------------------------------------------------
BWDbuffer   The buffer preceeding the current buffer in the ring is
            made the current buffer.
-------------------------------------------------------------------------
 */
backward_buffer: procedure
  address command 'GLOBALV SELECT CUTPASGL GET CLIPLIST'
  if cliplist = '' then do
     'COMMAND EMSG No block(s) in storage'
     exit 3
     end
  save = word(cliplist,1)
  cliplist = delword(cliplist,1,1)
  cliplist = space(cliplist save)
  'GLOBALV SELECT CUTPASGL PUT CLIPLIST'
  'COMMAND MSG Current clip is now' word(cliplist,1)
  return
/*
-------------------------------------------------------------------------
DISCard   Purges the current buffer.
-------------------------------------------------------------------------
 */
discard_buffer: procedure
  arg how .
  address command 'GLOBALV SELECT CUTPASGL GET CLIPLIST'
  if cliplist = '' then do
     'COMMAND EMSG No block(s) in storage'
     exit 3
     end
  select
     when how='ALL' then do
        n = words(cliplist)
        do i=1 to n
           clipx = word(cliplist,i)
           'GLOBALV SELECT CLIP.'clipx 'PURGE'
            end
        cliplist = ''
        highblk = 0
        'GLOBALV SELECT CUTPASGL PUT CLIPLIST HIGHBLK'
        'COMMAND MSG All clippings have been discarded.'
        end
     when how='' then do
        clipid = word(cliplist,1)
        cliplist = space(delword(cliplist,1,1))
        'GLOBALV SELECT CUTPASGL PUT CLIPLIST'
        'GLOBALV SELECT CLIP.'clipid 'PURGE'
        'COMMAND MSG Item' clipid 'has been discarded.'
        end
     otherwise do
        'COMMAND EMSG Argument' how 'not valid for DISCARD COMMAND.'
        exit 3
        end
     end
  return
/*
-------------------------------------------------------------------------
Keypad   Initialize PF keys to various CutPaste functions. and initialize
         the Cutpaste environment. Save the original PF key settings in
         the GLOBALV group for that file. CUTPASTE QUIT will restore
         all those settings.
-------------------------------------------------------------------------
 */
keypad: procedure expose selgrp status mode efname. eftype. efn eft
  if efname.1^=efn | eftype.1^=eft then call save_pf_keys
  call initialize
  call set_status
  return
/* Save setting of PF keys and other stuff in memory using GLOBALV */
save_pf_keys: procedure expose selgrp efname. eftype. efn eft
  'COMMAND PRESERVE'
  'COMMAND EXTRACT /PF * /MSGLINE /RESERVED *'
  do pfk = 1 to 24
     pfkstring.pfk = value('PF'pfk'.1') value('PF'pfk'.2')
     interpret 'PF'pfk '= pfkstring.pfk'
     address command 'GLOBALV SELECT' selgrp 'PUT PF'pfk
     end
  msgl = ''
  do i = 1 to msgline.0
     msgl = msgl msgline.i
     end
  address command 'GLOBALV SELECT' selgrp 'PUT RESERVED.0'
  do i = 1 to reserved.0
     address command 'GLOBALV SELECT' selgrp 'PUT RESERVED.'i
     parse var reserved.i num .
     'COMMAND SET RESERVED' num 'OFF'
     end
  efn=strip(efname.1)
  eft=strip(eftype.1)
  address command 'GLOBALV SELECT' selgrp 'PUT MSGL EFN EFT'
  return
initialize:  procedure expose mode
  address command 'QUERY DISPLAY (LIFO'
  parse pull . . pcol .
  'COMMAND EXTRACT /LSCREEN /VERIFY /VERSHIFT /LRECL /TRUNC /SCALE /TABLINE'
  parse var verify.2 ver1 .
  ver1 = max(1,ver1+vershift.1)
  ver2 = min(ver1+lscreen.2-8,lrecl.1,trunc.1)
  'COMMAND SET VERIFY' ver1 ver2
  if scale.1='ON' then 'COMMAND SET SCALE ON 3'
  if tabline.1='ON' then
     if scale.1='ON' then 'COMMAND SET TABLINE ON 4'
        else 'COMMAND SET TABLINE ON 3'
  'COMMAND SET CMDLINE TOP'
/*'COMMAND SET PREFIX ON LEFT'                                      */
  if prefix.1='ON' then 'COMMAND SET PREFIX ON LEFT'
  if pcol=132 then 'COMMAND SET MSGLINE ON -2 5 OVERLAY'
              else 'COMMAND SET MSGLINE ON -3 5 OVERLAY'
  'COMMAND SET SCOPE DISPLAY'
  'COMMAND SET DISPLAY 0 *'
  address command 'GLOBALV SELECT CUTPASGL GET CLIPLIST'
  curr_blkid = word(cliplist,1)
  blocks = words(cliplist)
  'COMMAND MSG ITEMS ON CLIPBOARD='blocks
  return
set_status: procedure expose selgrp status mode
  address command 'GLOBALV SELECT' selgrp 'PUT STATUS'
  address command 'GLOBALV SELECT' selgrp 'GET EFN EFT'
  'COMMAND EXTRACT /EFNAME /EFTYPE'
  if efname.1^=efn | eftype.1^=eft then return
  'COMMAND SET PF1 HELP CUTPASTE'
  select
     when status='RESET' then do
        'COMMAND SET PF2  MACRO CUTPASTE MOde'
        'COMMAND SET PF3  MACRO CUTPASTE QUit'
        'COMMAND SET PF4  MACRO CUTPASTE RE'
        'COMMAND SET PF5  MACRO CUTPASTE MArk'
        'COMMAND SET PF6  MACRO CUTPASTE POP'
        if mode='BLOCK' then do
           'COMMAND SET PF9  MACRO CUTPASTE PA RE'
           'COMMAND SET PF10 MACRO CUTPASTE PA OP'
           call restore_pfkey '17'
           'COMMAND SET PF21 MACRO CUTPASTE PA IN'
           call restore_pfkey '22'
           call restore_pfkey '23'
           end
        if mode='STREAM' then do
           call restore_pfkey '9'
           'COMMAND SET PF10 MACRO CUTPASTE PA IN'
           'COMMAND SET PF17 MACRO CUTPASTE SE'
           call restore_pfkey '21'
           'COMMAND SET PF22 MACRO CUTPASTE LFO'
           'COMMAND SET PF23 MACRO CUTPASTE FOrmat'
           end
        if mode='BLK/STR' then do
           'COMMAND SET PF9  MACRO CUTPASTE PA RE'
           'COMMAND SET PF10 MACRO CUTPASTE PA IN'
           'COMMAND SET PF17 MACRO CUTPASTE SE'
           'COMMAND SET PF21 MACRO CUTPASTE CU BL'
           'COMMAND SET PF22 MACRO CUTPASTE LFO'
           'COMMAND SET PF23 MACRO CUTPASTE FOrmat'
           end
        'COMMAND SET PF11 MACRO CUTPASTE PA SM'
        'COMMAND SET PF12 MACRO CUTPASTE QC'
        'COMMAND SET PF13 MACRO CUTPASTE QM'
        'COMMAND SET PF14 MACRO CUTPASTE LM'
        'COMMAND SET PF15 MACRO CUTPASTE RM'
        'COMMAND SET PF16 MACRO CUTPASTE CM'
        'COMMAND SET PF18 MACRO CUTPASTE CR'
        'COMMAND SET PF24 MACRO CUTPASTE QB'
        end
     when status='MARK2' then do
        'COMMAND SET PF2  MACRO CUTPASTE MOde'
        'COMMAND SET PF3  MACRO CUTPASTE QUit'
        'COMMAND SET PF4  MACRO CUTPASTE RE'
        'COMMAND SET PF5  MACRO CUTPASTE CU CO'
        'COMMAND SET PF6  MACRO CUTPASTE CU BL'
        if mode='BLOCK' then do
           'COMMAND SET PF17 MACRO CUTPASTE LI'
           'COMMAND SET PF22 MACRO CUTPASTE LFO'
           'COMMAND SET PF23 MACRO CUTPASTE FOrmat'
           end
        else do
           call restore_pfkey '17'
           call restore_pfkey '22'
           call restore_pfkey '23'
           end
        'COMMAND SET PF9  MACRO CUTPASTE CU DE'
        call restore_pfkey '10'
        call restore_pfkey '11'
        'COMMAND SET PF12 MACRO CUTPASTE QC'
        call restore_pfkey '18'
        call restore_pfkey '21'
        end
     when status='MARK1' then do
        call restore_pfkey '2'
        'COMMAND SET PF3  MACRO CUTPASTE QUit'
        'COMMAND SET PF4  MACRO CUTPASTE RE'
        'COMMAND SET PF5  MACRO CUTPASTE MArk'
        call restore_pfkey '6'
        call restore_pfkey '9'
        call restore_pfkey '10'
        call restore_pfkey '11'
        'COMMAND SET PF12 MACRO CUTPASTE QC'
        if mode='BLOCK' then 'COMMAND SET PF17 MACRO CUTPASTE LI'
        call restore_pfkey '18'
        call restore_pfkey '21'
        call restore_pfkey '22'
        call restore_pfkey '23'
        end
     otherwise nop
     end
  return
statusl: procedure expose status mode selgrp
  parse arg opt .
  address command 'QUERY DISPLAY (LIFO'
  parse pull . . pcol .
  if opt='OFF' then do
     'COMMAND SET RESERVE -1 OFF'
     if pcol=80 then 'COMMAND SET RESERVE -2 OFF'
     return
     end
  'COMMAND EXTRACT /PF*'
  pfl1 = ''
  do i = 1 to 12
     interpret 'pfk = pf'i'.2'
     pfk = space(pfk)
     if subword(pfk,1,2) = 'MACRO CUTPASTE' then do
        func = subword(pfk,3)
        pfl1 = pfl1 i'='func
        end
     end
  pfl1 = strip(pfl1)
  pfl2 = ''
  do i = 13 to 24
     interpret 'pfk = pf'i'.2'
     pfk = space(pfk)
     if subword(pfk,1,2) = 'MACRO CUTPASTE' then do
        func = subword(pfk,3)
        pfl2 = pfl2 i'='func
        end
     end
  pfl2 = strip(pfl2)
  if pcol=132 then 'COMMAND SET RESERVE -1 HI' mode':' pfl1 pfl2
  else do
     'COMMAND SET RESERVE -1 HI' mode':' pfl1
     'COMMAND SET RESERVE -2 HI' pfl2
     end
  return
/*
-------------------------------------------------------------------------
QUIT   Restores the values the PF keys had before entering CUTPASTE.
-------------------------------------------------------------------------
 */
quitting: procedure expose selgrp efn eft efname. eftype. fname. ftype.
  address command 'DELETE WINDOW CUTPASTE'
  if efname.1=efn & eftype.1=eft then do
     call statusl 'OFF'
     call restore_pf_keys
     end
  else do
     'COMMAND EMSG Cutpaste keypad was not initialized.'
     exit 6
     end
  address command 'GLOBALV SELECT' selgrp 'PURGE'
  'COMMAND EXTRACT /FMODE'
  'COMMAND RESTORE'
  'COMMAND SET FNAME' fname.1
  'COMMAND SET FTYPE' ftype.1
  'COMMAND SET FMODE' fmode.1
  'COMMAND MSG CUTPASTE KEYPAD Cleared - All PF Key Values Restored.'
  return
/* Restore settings of PF keys from memory using GLOBALV */
restore_pf_keys: procedure expose selgrp
'set linend off'
  do pfk = 1 to 24
     address command 'GLOBALV SELECT' selgrp 'GET PF'pfk
     'COMMAND SET PF'pfk value('PF'pfk)
     end
'set linend on'
  address command 'GLOBALV SELECT' selgrp 'GET MSGL'
  'COMMAND SET MSGLINE' msgl
  address command 'GLOBALV SELECT' selgrp 'GET RESERVED.0'
  do i = 1 to reserved.0
     address command 'GLOBALV SELECT' selgrp 'GET RESERVED.'i
     'COMMAND SET RESERVED' reserved.i
     end
  return
/* Restore settings of PF keys from memory using GLOBALV */
restore_pfkey: procedure expose selgrp
  arg pfk .
  address command 'GLOBALV SELECT' selgrp 'GET PF'pfk
  'COMMAND SET PF'pfk value('PF'pfk)
  return
/*
-------------------------------------------------------------------------
Reseting   Resets marks, removes window, as necessary.
-------------------------------------------------------------------------
 */
reseting: procedure expose selgrp status mode
  if mode='BLOCK' then do
     block_marks = ''
     address command 'GLOBALV SELECT' selgrp 'PUT BLOCK_MARKS'
     address command 'DELETE WINDOW CUTPASTE'
     status = 'RESET'
     end
  else do
     stream_marks = ''
     address command 'GLOBALV SELECT' selgrp 'PUT STREAM_MARKS'
     status = 'RESET'
     end
  return
/*
-------------------------------------------------------------------------
Outline  will place a CMS window around the block to be cut if the
         entire block fits on the viewable screen.
-------------------------------------------------------------------------
 */
outline: procedure
  address command 'DELETE WINDOW CUTPASTE'
  parse arg cnt fn ft line1 col1 line2 col2 .
  'COMMAND EXTRACT /WINDOW /FLSCREEN /LSCREEN /LINE /CURLINE /VERIFY /VERSHIFT /
  parse var verify.2 ver1 .
  topline = min(line1,line2)
  leftcol = min(col1,col2)
  botline = max(line1,line2)
  righcol = max(col1,col2)
  if topline < flscreen.1 | botline > flscreen.2 then return 4
  nlines = botline-topline+1
  ncols = righcol-leftcol+2  /* extra space for sf */
  /* we know the physical line of current line and we can use
     that to calculate the window position we want */
  pline = curline.2 - (line.1-topline) + (lscreen.3-1)
  pcol  = leftcol + 5 - vershift.1     + (lscreen.4-1)
  vline = curline.2 - (line.1-topline) + (lscreen.3-1)
  vcol  = leftcol + 6 - vershift.1     + (lscreen.4-1) - (ver1-1)
  if vcol<7 then return 4
  if vcol+ncols-1>lscreen.6+7*(prefix.1='OFF') then return 2
  if prefix.1='OFF' | prefix.2='RIGHT' then do
/*if prefix.1='ON' | prefix.2='RIGHT' then do */
/*if prefix.1='ON' & prefix.2='RIGHT' then do */
     pcol=pcol-6
     vcol=vcol-6
     end
  address command 'QUERY WINDOW' window.1 '(LIFO'
  parse pull . wname . . wline wcol .
  pline = pline+wline-1
  pcol = pcol+wcol-(wcol=1)
  address command 'DEFINE WINDOW CUTPASTE' nlines ncols pline pcol
  address command 'SET LOCATION CUTPASTE OFF'
  address command 'SHOW WINDOW CUTPASTE ON' wname vline vcol
  return 0
/*
-------------------------------------------------------------------------
Pop-window will display the current clipping in a CMS vscreen/window and
           then allow clip-board management functions.
-------------------------------------------------------------------------
 */
pop_window: procedure
  /* find out about physical screen */
  address command
  'QUERY DISPLAY (LIFO'
  parse pull . pline pcol .
  pfkeys = '3=Return 4=Discard 5=Next 6=Prev 10=Create 12=Discard All'
  'DEFINE VSCREEN CLIPMGR 3' pcol '0 0 (PROT'
  'WRITE VSCREEN CLIPMGR 3 1' pcol '(HIGH FIELD' pfkeys
  'DEFINE WINDOW CLIPMGR 3' pcol '-1 1'
  'SET LOCATION CLIPMGR OFF'
  'SET BORDER CLIPMGR ON (TOP ='
  'SHOW WINDOW CLIPMGR ON CLIPMGR 1 1'
  quit=0
  msg = ' '
  bigloop: do until quit
     'GLOBALV SELECT CUTPASGL GET CLIPLIST'
     if cliplist = '' then do
        if msg^=' ' then msg = msg','
        msg = space(msg 'No block(s) in storage')
        clipid=''
        cut_mode=''
        siz=''
        end
     else do
        clipid = word(cliplist,1)
        'GLOBALV SELECT CLIP.'clipid 'GET CUT_MODE NLINE NCOL'
        /* Recover our clipping from GLOBALV */
        clip_str = ''
        do i = 1 to nline
           'GLOBALV SELECT CLIP.'clipid 'GET CLIP.'i
           clip_str = clip_str clip.i
           end
        clip.0 = nline
        clip_str = space(clip_str)
        nwords = words(clip_str)
        nbytes = length(clip_str)
        if cut_mode='STREAM' then do
           call block_format 65 'LEFT'
           nline = clip.0
           ncol = 65
           end
        wline = min(nline+1,pline-6)
        wcol =  min(ncol,pcol-8) + 3
        sline = 3
        scol =  pcol-wcol-2
        clipmsg = 'CLIP' clipid
        if length(clipmsg)>ncol then clipmsg = clipid
        if length(clipmsg)>ncol then clipmsg = '*'
        'DEFINE VSCREEN CLIP'clipid nline+1 ncol+1 '1 0 (PROT HIGH UND'
        'WRITE VSCREEN CLIP'clipid 1 1 ncol '(RESERVED BLANK DATA' clipmsg
        do i = 1 to nline
           'WRITE VSCREEN CLIP'clipid i 0 ncol+1 '(NOHIGH NONE FIELD' clip.i
           end
        'DEFINE WINDOW CLIP'clipid wline wcol sline scol
        'SET BORDER CLIP'clipid 'ON (TOP = BOTTOM = LEFT * RIGHT *'
        'SHOW WINDOW CLIP'clipid 'ON CLIP'clipid '1 1'
        'WAITT VSCREEN CLIP'clipid
        if cut_mode = 'BLOCK' then siz = '('nline 'lines X' ncol 'cols)'
           else siz = '('nwords 'words,' nbytes 'chars)'
        end
     title = 'Cut-Paste Clipboard:' words(cliplist) 'clips.  Curr=' clipid',' ,
             cut_mode siz
     if msg^=' ' then msg = msg','
     msg = space(msg 'List=' cliplist)
     'WRITE VSCREEN CLIPMGR 1 1' pcol '(HIGH FIELD' title
     'WRITE VSCREEN CLIPMGR 2 1' pcol '(FIELD' msg
     msg = ' '
     'WAITREAD VSCREEN CLIPMGR'
     parse var waitread.1 key num .
     if key='PFKEY'
        then select
           when num='3' then quit=1
           when num='4' & cliplist^='' then do
              cliplist = space(delword(cliplist,1,1))
              'GLOBALV SELECT CUTPASGL PUT CLIPLIST'
              'GLOBALV SELECT CLIP.'clipid 'PURGE'
              msg = 'Item' clipid 'discarded'
              end
           when num='5' & cliplist^='' then do
              n = words(cliplist)
              save = word(cliplist,n)
              cliplist = delword(cliplist,n,1)
              cliplist = space(save cliplist)
              'GLOBALV SELECT CUTPASGL PUT CLIPLIST'
              end
           when num='6' & cliplist^='' then do
              save = word(cliplist,1)
              cliplist = delword(cliplist,1,1)
              cliplist = space(cliplist save)
              'GLOBALV SELECT CUTPASGL PUT CLIPLIST'
              end
           when num='10' then call create_clip
           when num='12' & cliplist^='' then do
              n = words(cliplist)
              do i=1 to n
                 clipx = word(cliplist,i)
                 'GLOBALV SELECT CLIP.'clipx 'PURGE'
                 end
              cliplist = ''
              highblk = 0
              'GLOBALV SELECT CUTPASGL PUT CLIPLIST HIGHBLK'
              end
           otherwise 'ALARM VSCREEN CLIPMGR'
           end
     'DELETE VSCREEN CLIP'clipid
     'DELETE WINDOW CLIP'clipid
     end  /* big loop */
  'DELETE WINDOW CLIPMGR'
  'DELETE VSCREEN CLIPMGR'
  return
/*
-------------------------------------------------------------------------
Create_clip will display a window where a stream-mode clipping may be
            entered interactively.
-------------------------------------------------------------------------
 */
create_clip: procedure
  /* find out about physical screen */
  address command
  'QUERY DISPLAY (LIFO'
  parse pull . pline pcol .
  title = 'Create Clipping:  Type in your data'
  pfkeys = 'Enter=Save 3=Quit'
  'DEFINE VSCREEN NEWCLIP 12 66 1 1'
  'WRITE VSCREEN NEWCLIP  1 1 65 (RESERVED BLANK PROT HIGH UND FIELD' title
  'WRITE VSCREEN NEWCLIP -1 1 65 (RESERVED BLANK PROT HIGH FIELD' pfkeys
  'DEFINE WINDOW NEWCLIP 12 67 5 5'
  'SET BORDER NEWCLIP ON (TOP = BOTTOM = LEFT * RIGHT *'
  'SHOW WINDOW NEWCLIP ON NEWCLIP 1 1'
  do i=1 to 10
     inp.i = ' '
     end
  ok = 0
  do until ok
     do i=1 to 10
        'WRITE VSCREEN NEWCLIP' i '0 65 (NOPROT NOHIGH NONE FIELD' inp.i
        end
     'CURSOR VSCREEN NEWCLIP 1 2 (DATA'
     'WAITREAD VSCREEN NEWCLIP'
     parse var waitread.1 keytype keynum .
     select
        when keytype='ENTER' then ok=1
        when keytype='PFKEY' & keynum='3' then ok=1
        otherwise 'ALARM VSCREEN NEWCLIP'
        end
     do i=3 to waitread.0
        parse var waitread.i itype iline icol idata
        inp.iline = idata
        end
     end
  'DELETE WINDOW NEWCLIP'
  'DELETE VSCREEN NEWCLIP'
  if keytype='PFKEY' then return 2
  j = 0
  do i=1 to 10
     if inp.i=' ' then iterate i
     j = j+1
     clip.j = inp.i
     end
  clip.0 = j
  if j=0 then return 2
  /* If this is the first block to be saved, then initialize CLIPLIST
     and HIGHBLK.  CLIPLIST is a string of numeric identifiers being
     used to identify clippings.  HIGHBLK is the last used identifier.*/
  'GLOBALV SELECT CUTPASGL GET CLIPLIST HIGHBLK'
  if highblk = '' then do
     highblk = 1
     cliplist = highblk
     end
  else do
     highblk = highblk+1
     cliplist = space(highblk cliplist)
     end
  'GLOBALV SELECT CUTPASGL PUT CLIPLIST HIGHBLK'
  /* Put all variables and text data into storage */
  'GLOBALV SELECT CLIP.'highblk 'PUT CLIP.0'
  nline = clip.0
  ncol = 0
  do i=1 to nline
     ncol = max(ncol,length(clip.i))
     'GLOBALV SELECT CLIP.'highblk 'PUT CLIP.'i
     end
  cut_mode = 'STREAM'
  'GLOBALV SELECT CLIP.'highblk 'PUT CUT_MODE NLINE NCOL'
  return 0

Scott       | No success can compensate for failure in the home. David O. McKay
Mattes      | President 1951-70, Church of Jesus Christ of Latter-day Saints
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU