/* TXT_DATA:  view   data in   text files; with column highlighting 
   1 Feb 2003. Daniel Hellerstein (danielh@crosslink.net)
   This is freeware. Use at your own risk.
   Requires REXXLIB.DLL
   
   For more OS/2 utilities, visit srehttp2.srehttp.org

   Sample  /F=file.ext option file

 ---------- start below here ------
; 1 option per line. Line starting with ; are comments
; N = 1/0           1=line numbers on, 0=line number off
; G = nnn           show lines starting at nnn'
; # = n1 n2 .. nn   Space delimited list of column numbers to strongly highlight
; M = mm            Parse mode: mm=1, 2 or 3 (spaces&comma, space only, CSV with "s)  
; W = nn            Set display column width to nn, use 0 for variable widths  
; W = TOP           Set display column widths to widths of words in top line 
; WABS = nn         Use absolute column widths of nn characters 
; WABS = TOP        Use absolute column widths, using Top line as guide 
; WABS = c1 c2 .. cn  Define n columns, starting at columns #c1,..,#cn 
; LABEL= TOP          Extract column labels from top line 
; LABEL = RULER               Display a ruler instead of labels (only works if WABS= is specified)
; LABELnth = a label  Use  "a label" as label for nth column.

N = 1
G = 12
# =  3
W = 10
;wabs = 5 10 15 30 50 125
label1 =  dog
label2= cats 
label3 = women and kids
 ---------- end above here ------


*/

/*** User changeable variable */

/*Default input file (ENTER means -- show directory) */
default_infile='?DIR'   

/* column delimiters:
    1 : tabs, commas and space(s)
    2 : spaces only
    3 : CSV (" x,y" is one column)

  Note: to specify absolute columns, you must use the W option when
         running the program (absolute columns can not be used at the default)
*/
mode=1

/* Display line number: 1=YES, 0=No */
donums=1


/* Space delimited list of column numbers to special-highlight,
   Leave blank and no special highlighting will be done */
whichcol=' '

/* use this column width. If 0, each column in each row is not
   adjusted (all characters are displayed) */
col_width=0


/* how many lines to store in a local cache. More lines speeds up
   movements within larger files. Too many lines eats up memory */
cache_lines=10000



/***  End user changeable variables */

signal on error name foo1
signal on syntax name foo1

call inits

parse arg ifile
ifile0=ifile
if pos('"',ifile)=0 then do
   parse var ifile ifile aswitch
end 
else do
  parse var ifile '"' ifile '"' aswitch
end


dobig=1 

if abbrev(strip(translate(aswitch)),'/S')  then do
   dobig=0
   parse upper var aswitch . '/S' aswitch
end
if aswitch<>'' then do
   if abbrev(strip(translate(aswitch)),'/F')=1 then do
      call read_fileopts aswitch
   end 
end 

call get_infile ifile

if infilelen/cache_lines>80 & dobig<>0  then do
   cls
   Say bold||infile1||normal||" "||addcomma(infilelen)||' bytes'
   say
   if dobig=1  & ifile0<>'' then do
      call preload_index
   end 
   else do
      say "This file may have many lines. To avoid long waits when jumping to "
      say "widely seperated lines, you can preload an index. "
      call charout,bold"Would you like to preload an index (1=YES)? "normal
      iyes=inkey()
      if iyes=1 then call preload_index
   end
end 

funckey=''


step1: nop
cc=scrwrite(1,1,left('1, '||leftedge,12)||infile1,i80,' ',32)
if col_width>4 | colwidths.0>0 then call label_cols

cc=scrwrite(2,1,copies('-',i80),i80,' ',6)

do forever

   if funckey='D' then do
      foo=scrollup(1,,,3,1,3+i20-1,i80)
      do im0=2 to i20
        im00=im0-1
        lines.im00=lines.im0
      end 
      topline.=''
      topline.!line=lines.1
      ff=scrwrite(2+i20,1,' ',i80)
      if lins_info.!EOF< nlines & lins_info.!EOF<>'' then do 
         lines.i20='' 
         cc=scrwrite(2+i20,1,copies('.',i80),i80,' ',2)
      end 
      else do
        nlines=nlines+1
        aline=get_linein(infile1,nlines)
        
        if aline='' then
           nuline=''
        else
          foo=parse_line(nlines,0)          /* creates stuff. and nuline */

        ff=cursor(2+i20,1)
        call charout,nuline
        lines.i20=aline
      end                       /* not eof */
   end 
   else do                      /* NOT DOWN ARROW */
     lines.=''
     do jj=1 to i20
       ff=scrwrite(2+jj,1,' ',i80)
       if lins_info.!EOF< nlines & lins_info.!EOF<>'' then do 
         cc=scrwrite(2+jj,1,copies('.',i80),i80,' ',2)
         iterate
       end
       nlines=nlines+1
       aline=get_linein(infile1,nlines)

       if aline='' then
          nuline=''
       else
          foo=parse_line(nlines,jj)          /* creates stuff. and nuline */

       ff=cursor(2+jj,1)
       call charout,nuline
       lines.jj=aline
     end
     if lins_info.!EOF< nlines & lins_info.!EOF<>'' then nlines=lins_info.!EOF
    end

    cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
     
    if start_top<>0 then do
        if start_top='T0' then do
          call set_relcolwidths 
          col_width='T'
        end
        else do
           call set_colwidths start_top
        end
        starT_top=0
        nlines=nlines-i20
        iterate
    end

    if start_top2<>0 then do
        call do_labels starT_top2
        start_top2=0
        iterate
    end  
 
    call label_cols

    do forever
      ff=scrwrite(i20+3,1,'ESC,crlf,arrow,G,?, ... : ',i80,' ',2)
      ff=cursor(i20+3,26)
      akey=inkey() 
      if akey=''  then akey=' '
      funckey=''
      if length(akey)=1 then do
          isfunc=0
          ikey=c2d(akey)
      end
      else do
        ikey=c2x(right(akey,1))
        isfunc=1
        akey=''
      end

      if ikey=27 then signal alldone

/* arrows*/
      if isfunc=1 then do
        if ikey='3C' then  funckey='FIND'
        if ikey='3B' then  do
           akey='?'
           isfunc=0
         end
        if ikey='55' then  funckey='FINDAGAIN'
        if ikey='4B' then  funckey='L'
        if ikey='4D' then  funckey='R'
        if ikey='48' then  funckey='U'
        if ikey='50' then  funckey='D'
        if ikey='49' then  funckey='PGUP'
        if ikey='47' then  funckey='HOME'
        if ikey='4F' then  funckey='END'

      end

      if translate(akey)='?' then do
         do kk=1 to i20
           cc=scrwrite(kk+2,1,,i80,' ',3)
         end
         foo=cursor(3,1)
         call show_help 
         iterate
      end

      if translate(akey)='M' then do
          ff=cursor(i20+3,1)
          if colwidths.0>0 & col_width<>'T' then do
             say 'Modes not used:  'bold"column specific"normal" widths are being used!"
             call syssleep(2)
             iterate
          end 
          say 'Modes:  1= tab comma space,  2= tab space,  3= CSV (" x,y" is one column)'
          call charout,'   Choose "column delimiters" mode (1,2, or 3):'
          modex=inkey()
          if pos(modex,'123')>0 then mode=modex
          ug=nlines-i20
          do jj=1 to i20
            aline=lines.jj
            ff=scrwrite(2+jj,1,' ',i80)
            ug2=ug+jj
            foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
            ff=cursor(2+jj,1)
            call charout,nuline
          end
          cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
          call label_cols
          cc=scrwrite(i20+3,1,copies(' ',i80),i80,' ')
          cc=scrwrite(i20+4,1,copies(' ',i80),i80,' ')
          iterate
      end

      if translate(akey)='L' then do
          call do_labels
          ug=nlines-i20
          do jj=1 to i20
            aline=lines.jj
            ff=scrwrite(2+jj,1,' ',i80)
            ug2=ug+jj
            foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
            ff=cursor(2+jj,1)
            call charout,nuline
          end
          cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
          call label_cols
          iterate
      end

      if funckey='FIND' | funckey="FINDAGAIN" then do
            if funckey='FIND' then do
               ff=cursor(i20+3,1)
               call charout,bold'   Which column to search'normal' (Enter='leftedge'): '
               pull searchcol ; if searchcol='' then searchcol=leftedge
               call charout,bold'   String to search for: 'normal
               pull tofind ; tofind=strip(tofind)
            end
            if tofind<>'' then do
              cc=scrwrite(i20+3,1,copies(' ',i80),i80,' ')
              cc=scrwrite(i20+4,1,copies(' ',i80),i80,' ')
              call find_it(1)
            end
      end
   
      if translate(akey)='W' then do
          ff=cursor(i20+3,1)
          oldc=col_width
          call charout,'   'bold'Column width'normal' (0=variable, T=TopLine, Enter=absolute-columns):'
          col_width=stringin(i20+3,65,"",55)
       
          if strip(translate(col_width))='T' then do 
             call set_relcolwidths
             col_width='T'
          end
          else do
            if col_width='' then do
               call set_colwidths
               if result=0 then col_width=oldc
            end
            else do
             if datatype(col_width)<>'NUM' then col_width=0
             col_width=max(0,col_width)
             colwidths.=''
             colwidths.0=0
            end
          end
          ug=nlines-i20
          do jj=1 to i20
            aline=lines.jj
            ff=scrwrite(2+jj,1,' ',i80)
            ug2=ug+jj
            foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
            ff=cursor(2+jj,1)
            call charout,nuline
          end
          cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
          call label_cols
          iterate
      end

      if translate(akey)='N' then do
         donums=1-donums
         ug=nlines-i20
         do jj=1 to i20
           aline=lines.jj
           ff=scrwrite(2+jj,1,' ',i80)
           ug2=ug+jj
           foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
           ff=cursor(2+jj,1)
           call charout,nuline
         end
         cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
         call label_cols
         iterate
      end

      if funckey='U' then do      /* a hack */
         nlines=max(nlines-i20,1)-1
      end

      if funckey='PGUP' then do      
         nlines=max(nlines-((2*i20)),1)-1
      end

      if funckey='HOME' & leftedge=1 then do 
         nlines=0
      end

      if funckey='END' then do     
         if lins_info.!PRE=1 then do
            nlines=lins_INFO.!EOF-trunc(i20/2)
         end
         else do
           foo=get_linein(infile1,999999999)
           nlines=lins_info.!NEXTREAD-trunc(i20/2)
         end
      end


      if funckey='L' | funckey='R' | (leftedge<>1 & funckey="HOME")  then do
         if funckey='L'  then leftedge=max(1,leftedge-1)
         if funckey='R' then  leftedge=leftedge+1
         if funckey='HOME' then leftedge=1
         ug=nlines-i20
         do jj=1 to i20
           aline=lines.jj
           ff=scrwrite(2+jj,1,' ',i80)
           ug2=ug+jj
           foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
           ff=cursor(2+jj,1)
           call charout,nuline
         end
         cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
         call label_cols
         iterate
     end 

     if translate(akey)='S' then do
          do forever
            ff=cursor(i20+3,1)
            call charout,'      # of screen rows (0< n <50, enter=25) : '
            pull s_rows ; if s_rows='' then s_rows=25
            call charout,'      # of screen columns: (0 < n < 201, enter=80) '
            pull s_cols ; if s_cols='' then s_cols=80
            if s_rows<0 | s_rows>50 then iterate
            if s_cols<0 | s_cols>201 then iterate
            leave
         end
         cc=scrwrite(i20+3,1,copies(' ',i80),i80,' ')
         cc=scrwrite(i20+4,1,copies(' ',i80),i80,' ')

         address cmd 'mode co'||strip(s_cols)||','||strip(s_rows)
         parse value scrsize() with scrrows scrcols
         i20=scrrows-5
         i80=scrcols
         ug=nlines-i20
         do jj=1 to i20
           aline=lines.jj
           ff=scrwrite(2+jj,1,' ',i80)
           ug2=ug+jj
           foo=parse_line(ug2,jj)          /* creates stuff. and nuline */
           ff=cursor(2+jj,1)
           call charout,nuline
         end
         cc=scrwrite(1,1,left(1+nlines-i20||', '||leftedge,12)||infile1,i80,' ',32)
         iterate
     end

     if translate(akey)='#' then do
          ff=cursor(i20+3,1)
          call charout,'     Highlight column #(s): '
          pull whichcol
          cff=scrwrite(i20+3,1,' ',i80,' ')
    end

    if translate(akey)='G' then do
        if funckey=' ' then do
          ff=cursor(i20+3,1)
          call charout,'     Skip to line #: '
          pull linenum
        end
        cff=scrwrite(i20+3,1,' ',i80,' ')
        if datatype(linenum)<>'NUM' then iterate
       if lins_info.!PRE=1 then linenum=min(linenum,lins_info.!EOF)
        nlines=max(0,linenum-1)   /* next get will be linenum */
     end                /* G */
     leave                      /* out of user input loop */
   end                  /* user loop */

end

alldone:
exit


/*******/
find_it:
fline0=nlines
tofind=strip(translate(tofind))
fline=fline0

do forever
  fline=fline+1
  if lins_info.!EOF<fline & lins_info.!EOF<>'' then do 
        cff=scrwrite(i20+3,1,'Unable to find: 'tofind,i80,' ')
        nlines=fline0-i20
        return 1
  end
  aline=get_linein(infile1,fline)
  if aline=''  then iterate
  foo=parse_line(fline,0)
  if pos(tofind,translate(stuff.searchcol))>0 then do
     nlines=fline-1
     return 1
  end
end



/*******/
read_fileopts:
parse arg daswitch
parse var daswitch '=' optfile ; optfile=strip(optfile)
if optfile='' then optfile='txt_data.opt'
iff=stream(optfile,'c','query size')
if iff='' | iff=0 then do
   say "No such option file: "optfile
   exit
end 
do until lines(optfile)=0
   aline=linein(optfile)
   aline=strip(aline)
   if abbrev(aline,';')=1 | aline='' then iterate
   PARSE VAR ALINE AOPT '=' AVALS
   AOPT=STRIP(TRANSLATE(AOPT)) ; avals=strip(avals)

   select
      when aopt='N' then do
         IF abbrev(strip(avals),0)=1 then 
            donums=0
         else
            donums=1
      end
      when aopt='G' then do
          avals=strip(avals)
          if datatype(avals)='NUM' then do
               avals=max(0,avals-1)
               nlines=avals
          end 
      end
      when aopt='#' then do
          whichcol=avals
      end
      when aopt='M' then do
         bb=wordpos(strip(avals),'1 2 3')
         if bb>0 then mode=bb
      end
      when aopt='W' then do
         avals=strip(avals)
         if datatype(avals)='NUM' then do
            col_width=avals
            iterate
         end 
         if avals='TOP' then do
           starT_top='T0'
         end
      end
      when aopt='WABS' then do
         if datatype(avals)='NUM' then do
            start_top='E '||avals
            iterate
         end 
         if translate(avals)='TOP' then do
             starT_top='T'
         end
         if words(avals)>1 then do
            start_top='K '||avals
         end 
      end
      when abbrev(aopt,'LABEL')=1 then do
         if translate(avals)='TOP' then do
            starT_top2='T'
            iterate
         end
         if translate(avals)='RULER' then do
            start_top2='R'
            iterate
         end
         parse var aopt . 'LABEL' nth; nth=strip(nth)
         if datatype(nth)='NUM' then do
            if nth>0 then do
               clabels.nth=avals
               clabels.0=max(clabels.0,nth)
            end 
         end
      end
      otherwise do
      end 
  end

end 
return 1

/*******/
/* set column widths (not-absolute columns) */
set_relcolwidths:

 do kk=1 to i20+3
      cc=scrwrite(kk+3,1,' ',i80,' ',3)
  end
foo=cursor(4,1)

uline=topline.!line   /* nth columns start at start of nth  word */
iat=1
colat.1=1 ; ict=1
jwords=words(uline)   
colwidths.=10
do ict=1 to jwords
    colwidths.ict=max(2,length(word(uline,ict))+2)
end
colwidths.0=jwords
call label_cols
return 1


/*******/
/* set varying sized, fixed width, columns */
set_colwidths:
parse arg ltype0

ltype00=''

 do kk=1 to i20+3
      cc=scrwrite(kk+3,1,' ',i80,' ',3)
  end
if ltype0='' then do
  foo=cursor(4,1)
  say
  say cyanon||"Absolute columns"normal
  say "Absolute-columns means that data lines will be divided into columns based on"
  say "the character location within the line (rather then using spaces or commas)."
  say 'In contrast, the 'bold'column width'normal' is used to specify how many characters should be'
  say "used to display a column; with the contents of each column determined"
  say "by delimiters (spaces or commas)".

  say
  call charout,'Specify absolute-columns using: ('bold'T'normal')op line, ('bold'E'normal')qual-width, or ('bold'K'normal')eyboard: '

  ltypea=translate(inkey()) ; say 

  if c2d(ltypea)=27 then return 0

  ltype=ltypea
end
else do
  parse var ltype0 ltype ltype00 ; ltype=strip(ltype) ; ltype00=strip(ltype00)
end

if ltype='T' then do    /* 1st columns at character 1 */
     uline=topline.!line   /* nth columns start at start of nth  word */
     iat=1
     colat.1=1 ; ict=1
     jwords=words(uline)   
     do ict=2 to jwords
        IKOO=wordindex(uline,ict)
        colat.ict=ikoo
     end

     if jwords<2 then do
        colwidths.1=10000    /* 10000 means "unlimited" */
        colwidths.0=1
        colwidths.!Pos=1
     end 
     else do
       colwidths.1=colat.2-1
       colwidths.1.!pos=1
       do ict=2 to jwords-1
          ict2=ict+1
          colwidths.ict=(colat.ict2-colat.ict)
          colwidths.ict.!POS=colat.ict
       end
       colwidths.jwords=10000
       colwidths.ict.!POS=colat.ict
       colwidths.0=jwords
     end
     call label_cols

     return 1
end

if ltype='E' then do    /* equal width columns */
  say
  say
  if ltype00<>'' then do
    col_width2=ltype00
  end
  else do
    call charout, bold"Enter the equal-sized absolute-column width (ENTER=10): "normal
    pull col_width2 ; if col_width2='' then col_Width2=10
    if datatype(col_width2)<>'NUM' then return 0  /* ignore */
  end
  ijj=0
  kk1=(10000/col_width2)
  do mm=1 to kk1
     colwidths.mm=col_width2
     colwidths.mm.!POS=1+((mm-1)*col_width2)
  end
  colwidths.0=kk1
  call label_cols
  return 1
end  
 
ith=1
inow=1
colwidths.=''
colwidths.1=10000
colwidths.0=1
call label_cols
if ltype00='' then do
  say
  say bold"Enter absolute position (in line) of column start, ESC when done: "normal
end

wasat=0
do forever 
    if ltype00<>'' then do
       ith=ith+1
       if (ith-1)>words(ltype00) then return 1
       alabel=strip(word(ltype00,ith-1))
    end 
    else do
      ith=ith+1
      foo=cursor(15,1)
      say "Position "ith||bold||" :  "||normal
      alabel=stringin(15,12," ",50)
    end
    if length(alabel)=0 then leave
    if alabel<=wasat then do
       ith=ith-1
       iterate
    end 
    wasat=alabel
    if datatype(alabel)<>'NUM' then do  /* bad, ignore */
       ith=ith-1
       iterate
    end 

    colwidths.0=ith
    ith0=ith-1
    colwidths.ith0=alabel-inow
    inow=alabel
    colwidths.ith=10000
    colwidth.ith.!pos=alabel
    call label_cols
end
return 1



/*******/
/* get column labels */
do_labels:
parse arg todo1

at1a:

 do kk=1 to i20-1
      cc=scrwrite(kk+3,1,,i80,' ',3)
  end
  foo=cursor(4,1)

  if todo1='' then do
     say cyanon||"Column labels"normal
     call charout,"Specify labels using: (R)uler, (F)ile, (T)op line, or (K)eyboard: "
     ltype=translate(inkey()) ; say 
     if c2d(ltype)=27 then return 1
  end
  else do
     ltype=todo1
  end

  if ltype='R' then do      
    if colwidths.0=0  then do
       say "To use a ruler, you must specify Absolute-Columns "
       if todo1<>'' then return 1
       call syssleep 1
       signal at1a
    end 
    isruler=1
    call label_cols
    return 0
  end

 
  if ltype='F' then do 
      isruler=0     
      call get_labelfile 
      if result=1 then return 0
      signal at1a
  end

  if ltype='T' then do 
     isruler=0     
     clabels.0=topline.0
     do tt=1 to topline.0
        clabels.tt=topline.tt
     end 
     call label_cols
     return 1
  end

  isruler=0     
  say bold"Enter column labels. "normal||'  ESC to exit'
 
  ith=0
  do forever 
    ith=ith+1
    foo=cursor(8,1)
    say "Column "ith||bold||" :  "||normal
    alabel=stringin(8,12," ",50)
    if length(alabel)=0 then leave
    clabels.0=ith
    clabels.ith=alabel
    if col_widths>3 then call label_cols
  end    
  return 1

/***************************/
/* parse line into stuff. 
   This is mode 1 (comma and spaces) */

parse_line:
parse arg thisline,is_top ; thisline=strip(thisline)
if colwidths.0>0 & col_width<>'T' then do                /* use absolute positions */
     call parse_line_col thisline
     return 1
end
if mode=2 then do
     call parse_line_2 thisline
     return 1
end 
  
if mode=3 then do
     call parse_line_3 thisline
     return 1
end

iat=1  
lline=length(aline) 
nthword=0
nuline=''
itot=0

if donums=1 then do
  if lins_info.!PRE=1 then do
    thisline=left(thisline,length(lins_info.!EOF)+1,' ')
  end
  else do
    if thisline<10000 then
      thisline=left(thisline,5,' ')
    else
      thisline=left(thisline,length(thisline)+1,' ')
  end
  nuline=redd||thisline||normal
  itot=length(thisline)
end

aline=translate(aline,' ','09'x)
do  forever
  if substr(aline,iat)='' then leave
  icomma=pos(',',aline,iat)
  if icomma=iat then do                 /* a ,, */
     nthword=nthword+1; stuff.nthword=','
     stuff.nthword.1=1
     iat=icomma+1
     iterate
  end
  if icomma>0 then do           /* comma found, with something preceding it*/
     ccw=substr(aline,iat,icomma-iat)
     if WORDS(ccw)<2 then do
        nthword=nthword+1; stuff.nthword=substr(aline,iat,1+icomma-iat)
        stuff.nthword.1=length(stuff.nthword)
        iat=icomma+1
        iterate
     end
   end                  /* no comma, or 2 words before a comma */
   IKOO=wordindex(substr(aline,iat),2)
   nthword=nthword+1; 
   if ikoo=0 then do
      stuff.nthword=substr(aline,iat)
      stuff.nthword.1=length(stuff.nthword)
      leave
   end
   stuff.nthword=substr(aline,iat,ikoo-1)
   stuff.nthword.1=length(stuff.nthword)
   iat=iat+ikoo-1
end

/* from leftedge column, up to i80 characters */


do oncol=leftedge to nthword
   klen=stuff.oncol.1
   cword=stuff.oncol
   if col_width<>0 then do
       if col_width<>'T' then do
          cwidth=col_width
          cword=left(cword,cwidth,' ')
       end
       else do
         cwidth=colwidths.oncol
         usecw=cwidth-1
         if cwidth<2 then usecw=1
         cword=left(strip(cword),usecw,' ')||' '
       end
       klen=cwidth
   end 
   if (itot+klen)>i80 then do
      klen=i80-itot
      cword=left(cword,klen)
   end
   
   iww=wordpos(oncol,whichcol)
   if iww<>0 then do
       if iww=1 then
         nuline=nuline||bold||cword||normal
       else
         nuline=nuline||reverse||cword||normal
   end
   else do
     if (oncol//2)=1 then
        nuline=nuline||cword
     else
        nuline=nuline||cyanon||cword||normal
   end
   itot=itot+klen
   if itot>=i80 then leave
end

if is_top=1 then do
  do kk=1 to nthword
     topline.kk=stuff.kk
  end
  topline.0=nthword 
  topline.!line=aline
end 

return 1


/***************/
/* parse using fixed width columns  */
parse_line_col:
parse arg thisline ; thisline=strip(thisline)


linelen=length(aline)
stuff.1.1=colwidths.1
stuff.1=left(aline,colwidths.1,' ')
kkols=colwidths.0
istart=colwidths.1+1
do ikk=2 to kkols-1
   iww=colwidths.ikk
   stuff.ikk.1=iww
   stuff.ikk=substr(aline,istart,iww)
   istart=istart+iww
end 
if kkols>1 then do
   stuff.kkols.1=colwidths.kkols
   stuff.kkols=substr(aline,istart)
end
nthword=kkols

nuline=''
itot=0
if donums=1 then do
  if lins_info.!PRE=1 then do
    thisline=left(thisline,length(lins_info.!EOF)+1,' ')
  end
  else do
    if thisline<10000 then
       thisline=left(thisline,5,' ')
   else
      thisline=left(thisline,length(thisline)+1,' ')
  end
  nuline=redd||thisline||normal
  itot=length(thisline)
end
do oncol=leftedge to nthword
   klen=stuff.oncol.1
   cword=stuff.oncol
   if (itot+klen)>i80 then do
      klen=i80-itot
      cword=left(cword,klen)
   end
 
   iww=wordpos(oncol,whichcol)
   if iww<>0 then do
       if iww=1 then
         nuline=nuline||bold||cword||normal
       else
         nuline=nuline||reverse||cword||normal
   end
   else do
     if (oncol//2)=1 then
        nuline=nuline||cword
     else
        nuline=nuline||cyanon||cword||normal
   end
   itot=itot+klen
   if itot>=i80 then leave
end

if is_top=1 then do
  do kk=1 to nthword
     topline.kk=stuff.kk
  end
  topline.0=nthword 
  topline.!line=aline
end 

return 1

/***************************/
/* parse line into stuff. 
   This is mode 2 (spaces only) */

parse_line_2:
parse arg thisline ; thisline=strip(thisline)

iat=1  
lline=length(aline) 
nthword=0
nuline=''
itot=0
if donums=1 then do
  if lins_info.!PRE=1 then do
    thisline=left(thisline,length(lins_info.!EOF)+1,' ')
  end
  else do
    if thisline<10000 then
       thisline=left(thisline,5,' ')
    else
       thisline=left(thisline,length(thisline)+1,' ')
  end
  nuline=redd||thisline||normal
  itot=length(thisline)
end

nthword=0
iat=1

aline=translate(aline,' ','09'x)
do  forever
  IKOO=wordindex(substr(aline,iat),2)
  nthword=nthword+1; 
  if ikoo=0 then do
      stuff.nthword=substr(aline,iat)
      stuff.nthword.1=length(stuff.nthword)
      leave
  end
  stuff.nthword=substr(aline,iat,ikoo-1)
  stuff.nthword.1=length(stuff.nthword)
  iat=iat+ikoo-1
end

/* from leftedge column, up to i80 characters */
do oncol=leftedge to nthword

   klen=stuff.oncol.1
   cword=stuff.oncol

   if col_width<>0  then do
       if col_width<>'T' then do
          cwidth=col_width
          cword=left(cword,cwidth,' ')
       end
       else do
         cwidth=colwidths.oncol
         usecw=cwidth-1
         if cwidth<2 then usecw=1
         cword=left(strip(cword),usecw,' ')||' '
       end
       klen=cwidth
   end 

   if (itot+klen)>i80 then do
      klen=i80-itot
      cword=left(cword,klen)
   end
   
   iww=wordpos(oncol,whichcol)
   if iww<>0 then do
       if iww=1 then
         nuline=nuline||bold||cword||normal
       else
         nuline=nuline||reverse||cword||normal
   end
   else do
     if (oncol//2)=1 then
        nuline=nuline||cword
     else
        nuline=nuline||cyanon||cword||normal
   end
   itot=itot+klen
   if itot>=i80 then leave
end

if is_top=1 then do
  do kk=1 to nthword
     topline.kk=stuff.kk
  end 
  topline.0=nthword
  topline.!line=aline
end 

return 1


/***************************/
/* parse line into stuff. 
   This is mode 3 (csv) */

parse_line_3:
parse arg thisline ; thisline=strip(thisline)

iat=1  
lline=length(aline) 
nthword=0
nuline=''
itot=0
if donums=1 then do
  if lins_info.!PRE=1 then do
    thisline=left(thisline,length(lins_info.!EOF)+1,' ')
  end
  else do
    if thisline<10000 then
       thisline=left(thisline,5,' ')
    else
       thisline=left(thisline,length(thisline)+1,' ')
  end
  nuline=redd||thisline||normal
  itot=length(thisline)
end

nthword=0
iat=1

/* step 1, replace commas inside of quotes with 01x */
tt=''
do until aline=''
   if pos('"',aline)=0 then do
     tt=tt||aline
     leave
   end 
   parse var aline a1 '"' a2 '"' aline
   tt=tt||a1||'"'||translate(a2,'01'x,',')||'"'
end
aline=tt
/* everything between quotes is a column. Might have to convert
  01x to , */

do  forever
  IKOO=pos(',',aline,iat)
  nthword=nthword+1 
  if ikoo=0 then do
      stuff.nthword=translate(substr(aline,iat),',','01'x)
      stuff.nthword.1=length(stuff.nthword)
      leave
  end
  stuff.nthword=translate(substr(aline,iat,1+ikoo-iat),',','01'x)
  stuff.nthword.1=length(stuff.nthword)
  iat=ikoo+1
end

/* from leftedge column, up to i80 characters */
do oncol=leftedge to nthword

   klen=stuff.oncol.1
   cword=stuff.oncol

   if col_width<>0 then do
       if col_width<>'T' then do
          cwidth=col_width
          cword=left(cword,cwidth,' ')
       end
       else do
         cwidth=colwidths.oncol
         usecw=cwidth-1
         if cwidth<2 then usecw=1
         cword=left(strip(cword),usecw,' ')||' '
       end
       klen=cwidth
   end 

   if (itot+klen)>i80 then do
      klen=i80-itot
      cword=left(cword,klen)
   end
   
   iww=wordpos(oncol,whichcol)
   if iww<>0 then do
       if iww=1 then
         nuline=nuline||bold||cword||normal
       else
         nuline=nuline||reverse||cword||normal
   end
   else do
     if (oncol//2)=1 then
        nuline=nuline||cword
     else
        nuline=nuline||cyanon||cword||normal
   end
   itot=itot+klen
   if itot>=i80 then leave
end


if is_top=1 then do
  do kk=1 to nthword
     topline.kk=stuff.kk
  end 
  topline.0=nthword
  topline.!line=aline
end 

return 1


/***************************/
get_infile:
parse arg ifile

do forever

if ifile<>'' then do
   infile=strip(ifile)
   ifile=''
end 
else do
  call lineout,bold "Data (text) file to view: (ENTER=show directory, . to quit) "normal
  call charout,"  "reverse " :" normal
  parse pull infile ; infile=strip(infile)
end
if strip(translate(infile))='.' then do
   say "bye "
   exit
end

if strip(infile)='?' then do
  call show_help 1
  exit
end

if abbrev(translate(infile),'?DIR')=1 | infile='' then do
    parse upper var infile . '?DIR 'thisdir
    if thisdir="" then do
        thisdir=strip(directory())
    end
    infile=chose_file(thisdir)
    if infile='' then exit
end

if infile='' then infile=default_infile

/* maybe it's actually a file name */

infile0=infile
if pos('.',infile0)=0 then infile0=infile0||'.TXT'
infile1=stream(infile0,'c','query exists')              

if infile1='' then do
    Say "Sorry. could not find: "infile
    exit
end

infilelen=stream(infile1,'c','query size')
if infilelen=0 then do
   say " Sorry -- " infile1 " is empty "
   exit
end

foo=stream(infile1,'c','close')
say 
return 1
end


/***************************/
get_labelfile:

do forever

call lineout,bold "Label file, 1 label per row: (?DIR for a directory, ENTER if none) "normal
call charout,"  "reverse " :" normal
parse pull lfile ; lfile=strip(lfile)

if lfile='' then return 0

if abbrev(translate(lfile),'?DIR')=1 | lfile=''  then do
    parse upper var lfile . '?DIR 'thisdir
    if thisdir="" then do
        thisdir=strip(directory(),'t','\')||'\*.*'
    end
    lfile=chose_file(thisdir)
    if lfile='' then return 0
end

/* maybe it's actually a file name */

if pos('.',lfile)=0 then lfile=lfile||'.TXT'
lfile1=stream(lfile,'c','query exists')              

if lfile1='' then do
    Say "Sorry. could not find: " lfile
    iterate
end

lfilelen=stream(lfile1,'c','query size')
if lfilelen=0 then do
   say " Sorry -- " lfile1 " is empty "
   iterate
end

Say "Length: "lfilelen
foo=stream(lfile1,'c','close')
say

il=0
do until lines(lfile1)=0
   aaline=linein(lfile1)
   il=il+1
   clabels.il=strip(aaline)
   clabels.0=il
end 
callf=scrclear()
return 1

end

/*********/
/* the "indexed" linein */
Bget_linein:procedure expose lins. lins_Info. i20 i80
parse arg afile,jline

if jline>lins_INFO.!EOF then do
      lins.!EOF=1               /* yes */
      return ''
end

/* see if this block is currently in cache */
if jline<=lins_info.!end & jline>=lins_info.!begin then
   return lins.jline


/* otherwise, need to load it into block */
i0=max(1,1+(trunc((jline+200)/1000)*1000)-1000)
cstart=lins_info.!i.i0
i1=i0+2000
if i1>lins_info.!EOF then i1=lins_info.!EOF+1
cend=lins_info.!i.i1-2
cget=cend-cstart
goop=charin(afile,cstart,cget)
lins.=''
lins_info.!BEGIN=i0
ff=scrwrite(i20+4,1,'Loading lines 'i0' - 'i1', please wait ...',i80,' ',2)

kkl=i0-1
kat=1
lengoop=length(goop)
do forever  
   kkl=kkl+1
   lins_Info.!END=kkl
   kat2=pos('0d0a'x,goop,kat)
   if kat2=0 then do
      lins.kkl=substr(goop,kat)
      leave
   end
   kat3=kat2-kat
   lins.kkl=substr(goop,kat,kat3)
   kat=kat2+2
   if kat>lengoop then leave
end 
drop goop

/*
do until goop=''
  parse var goop dally '0d0a'x goop
  lins.kkl=dally
  lins_Info.!END=kkl
  kkl=kkl+1
end 
*/

ff=scrwrite(i20+4,1,' ',i80,' ',2)

if jline>=lins_info.!EOF then lins.!EOF=1
return lins.jline


/*********/
get_linein:procedure expose lins. lins_Info. i20 i80
parse arg afile,jline

if lins_Info.!PRE=1 then do
   arf=bget_linein(afile,jline)
   return arf
end 

if lins_info.!EOF<>'' then do     /* an EOF is known */
  if jline>lins_info.!EOF then do  /* are we beyond it? */
      lins.!EOF=1               /* yes */
      return ''
  end
end

if lins.jline<>'01'x then do       /* it's in the cache */
  if lins_info.!EOF<>'' then do
    if jline>=lins_info.!EOF then do
       lins.!EOF=1  /* and its the last line of the file */
    end
  end
  return lins.jline
end

/*
lins_info.!TOTAL=0
lins_info.!NEXTREAD=1
lins_info.!cache_lines=cache_lines
lins_info.!EOF=''  
lins_info.!START=0 */

clines=lins_info.!cache_lines
nextread=lins_info.!NEXTREAD
if jline<nextread then do        /* not in cache, before nextline -- rewind */
    foo=stream(afile,'c','close')
    drop lins.                  /* backing up is tough, so store prior */
    lins.='01'x    
    doadd=max(0,jline-clines)
    do jj=1 to jline
        aline=linein(afile)
        if  jj>doadd then lins.jj=aline /* store in cache */
    end 
    lins_info.!START=doadd+1
    lins.!TOTAL=min(jline,clines)
    lins_info.!NEXTREAD=jline+1
    lins_Info.!EOF=''
    return lins.jline
end 

/* if here, not in cache, not behind us, not after known eof */

do ikk=nextread to jline
   if lines(afile)=0 then do       /* at eof? */
      lins_info.!eof=ikk-1
      lins_info.!NEXTREAD=ikk
      lins.!EOF=1
      return ' '
  end
  aline=linein(afile)
  if lins_info.!TOTAL>=clines then call cleanup_cache ikk       /* get rid of old entries */
  lins.ikk=aline
  lins_info.!TOTAL=lins_info.!TOTAL+1
end
lins_info.!NEXTREAD=jline+1

return lins.jline

/****/
/* cleanup cache */
cleanup_cache:procedure expose lins_info. lins. i20 i80
parse arg jjlines               /* this will be the last line in the cache */
i1=max(1,jjlines-trunc(0.5*lins_info.!CACHE_LINES))
i2=jjlines-1

todo=1+i2-i1
ff=scrwrite(i20+4,1,'Cleaning items 'i1' - 'i2' from internal cache, please wait ...',i80,' ',2)

do ii=i1 to i2
   tmp.ii=lins.ii
end
drop lins.
lins.='01'x
do ii=i1 to i2
       lins.ii=tmp.ii
end
drop tmp.
lins_info.!TOTAL=1+i2-i1
lins_info.!START=i1
ff=scrwrite(i20+4,1,'',i80,' ',2)

return 1
    

/*********/
/* show stuff in queue as a list 
 NO LONGER USER */
show_dir_queue:procedure expose qlist.
parse arg lookfor
    ibs=0 ;mxlen=0
    if lookfor<>1 then
       nq=queued()
     else
        nq=qlist.0
    do ii=1 to nq
       if lookfor=1 then do
          aa=qlist.ii
          ii2=lastpos('\',aa) ; anam=substr(aa,ii2+1)
       end /* do */
       else do
          parse pull aa
          if pos(lookfor,aa)=0 & lookfor<>'*' then iterate
          parse var aa anam (lookfor) .
          if strip(anam)='.' | strip(anam)='..' then iterate
       end
       ibs=ibs+1
       blist.ibs=anam
       mxlen=max(length(anam),mxlen)
    end /* do */
arf=""
do il=1 to ibs
   anam=blist.il
   arf=arf||left(anam,mxlen+2)
   if length(arf)+mxlen+2>75  then do
        say arf
        arf=""
   end
end 
if length(arf)>1 then say arf
say
return 1


/*********/
/* label columns, if fixed width */
label_cols:

ll=copies('-',i80)

i1=1
ioff=1
if donums=1 then do
  if lins_info.!PRE=1 then do
     ll=overlay('|',ll,length(lins_info.!EOF)+2)
     ioff=length(lins_info.!EOF)+2
  end
  else do
    if nlines<10000 then do
       ll=overlay('|',ll,6)
       ioff=6
    end
    else do
       ll=overlay('|',ll,length(nlines)+2)
       ioff=length(nlines)+2
    end
  end
end

if  col_width<4 & colwidths.0=0 & clabels.0>0 then do
  ll=overlay('label',ll,1)

  ll=overlay('| '||clabels.leftedge||'  ',ll,ioff)
  cc=scrwrite(2,1,ll,i80,' ',6)
  return 1
end

/* show a ruler */
if isruler=1 & colwidths.0>0 then do
   pos1=colwidths.leftedge.!pos
   if pos1='' then do
        cc=scrwrite(2,1,ll,i80,' ',6)
        return 1
   end 
   cpos1=pos1||' '
   nextcol=pos1+length(cpos1)+1
   ll=overlay('ruler',ll,1)

   irem=nextcol//10
   select
      when irem=0 then do
          rline=cpos1||' :'
          pos1=nextcol+1
      end 
      when irem=5 then do
          rline=cpos1||'.     :'
          pos1=nextcol+6
      end 
      when irem<5 then do
          rline=cpos1||copies(' ',5-irem)||'.     :'
          pos1=nextcol+11-irem
      end 
      otherwise do
          rline=cpos1||copies(' ',10-irem)||':'
          pos1=nextcol+11-irem
     end
   end  
   do until length(rline)>i80
      cpos1=pos1
      if length(cpos1)<3 then cpos1=left(cpos1,3,' ')||'.'
      cpos1=left(cpos1,9,' ')||':'
      rline=rline||cpos1
      pos1=pos1+10
   end 

   ll=overlay(rline,ll,ioff+1)
   cc=scrwrite(2,1,ll,i80,' ',6)
   return 1
end 

ikk=leftedge
i1=ioff+1
if colwidths.0=0 then mxwidth=col_width-2
do until i1> i80
   if ikk>clabels.0 then do
      akk=ikk
   end
   else do
      akk=clabels.ikk
   end
   if colwidths.0>0 then do 
      if ikk>colwidths.0 then leave
      mxwidth=colwidths.ikk-2
   end 
   if mxwidth>0 then do
      /* if length(akk)>mxwidth then  */
       akk=left(akk,mxwidth+1,' ')
   end
   if i1>1 then
         ll=overlay('|'||akk,ll,i1-1)
   else
         ll=overlay('|'||akk,ll,1)

   if mxwidth<0 then leave              /* got last column */
        
   i1=i1+mxwidth+2
   ikk=ikk+1
end 
cc=scrwrite(2,1,ll,i80,' ',6)


return 1

/*********/
show_help:
parse arg ahh
say "                "||cyanon||"Txt_Data: Display a textual data file"||normal
say bold||"Txt_Data"||normal||" is data-display utility."
say "It displays text (ascii) files, highlighting each column of data.  Columns"
say "are defined either by tabs, spaces , or commas; or by position in a line."
say
say "Run-time switches: "
say bold'  /S'normal' - small file (don''t make index)   'bold'/F=file.ext'normal' - read options from file'
say
say "Navigation options: "
say    "  "||bold||"ESC   "||normal||" Exit.     " || bold||"Enter "||normal||" Next screen "
say "  "||bold||"N     "||normal||" Toggle line numbers " ||"        "||bold||"S     "||normal||" Set the screen rows & cols"

say "  "||bold||"HOME  "||normal||" First column, or top-left "||bold||"  END   "||normal||" Last row "

say "  "||bold||"Arrows"||normal||" Up, Down: move 1 line "||bold||"   "||normal||" Left, Right: move 1 column "
say "  "||bold||"G     "||normal||" Goto a line number"
say "  "||bold||"#     "||normal||" Space delimited list of column numbers to strongly highlight."

say "  "||bold||"M     "||normal||" Select parsing mode ; currently="||modename.mode
say "  "||bold||"W     "||normal||" Specify display width of columns, or define absolute columns"
say "  "||bold||"L     "||normal||" Label columns, or display a ruler (works best when W>0)"
say "  "||bold||"F2    "||normal||" Find                  "||bold||"Shift-F2    "||normal||" Find again"


/* say "  "||bold||"Hint: "||normal||'To display more lines & columns in your OS/2 window,'
say "   you can use MODE coCC,RR (rr=# of rows, cc=# of columns)"
say "   For example:"bold||"C:>MODE co120,40 "||normal||"yields 120 columns by 40 rows"
*/
if ahh<>1 then return 0
say reverse||' ... hit any key to continue ... '||normal
oo=inkey()
say cyanon'/F=file.ext options'normal' (1 option per line, lines starting with ; are ignored) '
say bold||' N=0/1 '||normal||' 1=line numbers on, 0=line number off '
say bold||' G = nnn '||normal||' show lines starting at nnn'
say bold||' # = n1 n2 .. nn  '||normal||'Space delimited list of column numbers to strongly highlight' 
say bold||' M = mm  '||normal||'Parse mode: mm=1, 2 or 3 (spaces&comma, space only, CSV with "s)  '
say bold||' W = nn '||normal||' Set display column width to nn (use 'bold'0'normal' for variable widths)'
say bold||' W = TOP'||normal||' Set display column widths to widths of words in top line '
say bold||' WABS = nn  '||normal||' Use absolute column widths of nn characters '
say bold||' WABS = TOP  '||normal||' Use absolute column widths, using Top line as guide '
say bold||' WABS = c1 c2 .. cn '||normal||' Define n columns, starting at columns #c1,..,#cn '
say bold||' LABEL= TOP   '||normal||'Extract column labels from top line '
say bold||' LABEL = RULER '||normal||' Display a ruler instead of labels (requires WABS= is specified)'
say bold||' LABELnth = a label '||normal||' Use 'bold' a label 'normal' as label for 'bold'nth'normal' column.'

say 
return 1




/******/
/* initialize some stuff */
inits:
modename.1='Comma & space delimited'
modename.2='Space delimited (commas ignore)'
modename.3='CSV with "quotes" '
topline.=''
topline.0=0

tofind=''
start_top=0
start_top2=0

lins.='01'x

lins_info.!START=0
lins_info.!TOTAL=0
lins_info.!NEXTREAD=1
lins_info.!cache_lines=cache_lines
lins_info.!EOF=''

isruler=0

clabels.=''
clabels.0=0

colwidths.=''
colwidths.0=0


  aesc='1B'x
  cy_ye=aesc||'[37;46;m'
  cyanon=cy_ye
  normal=aesc||'[0;m'
  bold=aesc||'[1;m'
  re_wh=aesc||'[31;47;m'
  redd=aesc||'[31;42;m'

  reverse=aesc||'[7;m'


/* Load up advanced REXX functions */
foo=rxfuncquery('sysloadfuncs')
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end



foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
 call rexxlibregister
end
foo=rxfuncquery('rexxlibregister')
if foo=1 then do
    say " Could not find REXXLIB "
    exit
end 


nlines=0
parse value scrsize() with scrrows scrcols
i20=scrrows-5
i80=scrcols

leftedge=1

cls

return 1

/************/
/* preload an index of infile (pointers to the start of each line
  actually index to each 1000th line
*/
preload_index:
say 

ff=cursor(8,1)
say bold" .. creating index to "normal||addcomma(infilelen)||bold" bytes ... "normal||'(ESC to abort)'
ido=0
iat=1
indmode=1
/* if infilelen>10000000 then indmode=2 */

do until lines(infile1)=0
   a1=linein(infile1)
   ido=ido+1

/*   if indmode=1 | ido<=10000 then lins_info.!i.ido=iat  */
   if (ido//1000)=1 then do
      lins_info.!i.ido=iat
      arf=inkey('N')
      if c2d(arf)=27 then do
            say
            say "Bye. "
            exit
      end 
   end 
   iat=iat+length(a1)+2
   if (ido//5000)=1 then do
      cc=scrwrite(9,1,'Reading line # '||addcomma(ido)||' ('||addcomma(iat)||' bytes)',i80,' ',32)
   end 

end 
lins_info.!BEGIN=0
lins_info.!END=0
lins_info.!EOF=ido
ido1=ido+1
lins_info.!i.ido1=iat
lins_info.!PRE=1
return 1


/************/
/* ADD COMMAS TO A NUMBER */
addcomma:
parse arg aval,ndec
parse var aval p1 '.' p2

if ndec='' then do
   p2=''
end
else do
   p2='.'||left(p2,ndec,'0')
end /* do */

plen=length(p1)
p1new=''
do i=1 to 10000 while plen>3
   p1new=','right(p1,3)||p1new
   p1=delstr(p1,plen-2)
   plen=plen-3
end /* do */

return p1||p1new||p2


/**********/
/* Chose_File: chose file from a list ***/
chose_file:procedure

parse arg aa,aa0,dirok

/* first, is rexxlib available */
foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
 call rexxlibregister
end
foo=rxfuncquery('rexxlibregister')
if foo=1 then do                /* no rexxlib, give up */
    return '?ERROR: rexxlib not available'
end 

nowcursor=cursor()

/* save current screen */
foo=scrsize()
parse var foo scrrows scrcols
do jj=1 to scrrows
   oldscreen.jj=scrread(jj,1,scrcols,'B')
end 
oldscreen.0=scrrows

aa1=aa0
do forever              /* iterate to search directories */
  aa=chose_file_2(aa,aa0,dirok)
  if dirok=1 | dirok=2 then leave
  if right(strip(aa),1)='\' then do 
     aa0=aa1
     aa1=aa
     iterate
  end 
  leave
end

retit:
do jj=1 to oldscreen.0
   ff=scrput(jj,1,oldscreen.jj,'B')
end 
parse var nowcursor cx cy .
foo=cursor(cx,cy)
return strip(aa)

/*************/
/* this does each dir */
chose_file_2:procedure
parse arg startdir,view1,dironly
signal on novalue name errno

foo=scrsize()
parse var foo scrrows scrcols

uparrow=d2c(24)
downarrow=d2c(25)
vertbar=d2c(179)
view1=strip(translate(view1))

/* display attributes */
attribs.1=15   /* .. directory */
attribs.2=15    /* subdirectory */
attribs.3=7     /* normal file display */
attribs.4=8     /* too-long filename file display */
attribs.5=113    /* current selection */
attribs.6=11    /* drive */

/* is startdir legit? */
startdir=strip(startdir)
tpath=''
icolon=pos(':',startdir)
if icolon=0 then do
   curdrive=dosdrive()
   curpath=startdir
end 
else do
   curdrive=left(startdir,1)
   tpath=doscd(curdrive)
   if tpath='' then return  '?ERROR: no such drive: 'curdrive
   curpath=substr(startdir,icolon+1)
end
curpath=strip(curpath)

if abbrev(curpath,'\')=0 then do        /* relative path */
   if tpath='' then tpath=doscd(curdrive)
   curpath=tpath||'\'||curpath
end 

curdir0=curdrive||':'||strip(curpath,'t','\')
curdir=curdir0||'\'


if pos('\',view1)=0 then view1=translate(curdir||strip(view1))


aa=sysfiletree(curdir||'*','fils.','F')
aa=sysfiletree(curdir||'*','dirs.','Do')

ff=scrclear()
/* write header info */
kk=curdir0
if right(kk,1)=':' then kk=kk'\'
nn=left('Viewing directory: 'strip(kk),scrcols-10,' ')||'  F1=Help'
cc=scrwrite(1,1,nn ,scrcols,,32)

/* assign display positions */


/* write super and subdirs */
/* superdir ... */
inext=1
disp.=''
iselected=0

/* Disp.n = to return
   disp.n.0 = info
   disp.n.1 = display attribute
   dips.n.!SHOW = what to display 
*/

if curpath<>'\' then do
  foo=lastpos('\',strip(curdir,'t','\'))
  disp.1=left(curdir,foo)
  disp.1.0=disp.1
  disp.1.!SHOW=uparrow||' .. '
  disp.1.1=1
  inext=2
  if view1=strip(translate(disp.1)) then iselected=1
end
else do         /* display drive letters */
  fooo=sysdrivemap()
  inext=0
  do ii=1 to words(fooo)
    inext=inext+1
    aadr=strip(word(fooo,ii))
    disp.inext=aadr||'\'
    disp.inext.0=disp.inext
    disp.inext.!SHOW=downarrow||' '||disp.inext
    disp.inext.1=6
  end
end

do mm=1 to dirs.0
   foo=lastpos('\',strip(dirs.mm,'t','\'))
   adir=substr(dirs.mm,foo+1)
   disp.inext=strip(dirs.mm,'t','\')||'\'
   disp.inext.0=dirs.mm
   disp.inext.!show=downarrow||' '||adir
   disp.inext.1=2
   if view1=strip(translate(disp.inext)) then do
       iselected=inext
   end 
   inext=inext+1
end 

file_start=inext
if dironly=2 then fils.0=0
do mm=1 to fils.0
  parse var fils.mm adate atime asize . afile
  afile0=filespec('n',afile)

  disp.inext=afile
  disp.inext.0=afile0||' ('||adate||' '||atime||' '||addcomma(asize)||')'
  disp.inext.!SHOW=afile0
  if lengtH(afile0)>19 then
    disp.inext.1=4
  else
    disp.inext.1=3
  if view1=strip(translate(disp.inext)) then iselected=inext
  inext=inext+1
end
disp.0=inext-1
if iselected=0 then iselected=1

/* write first screen of info */

i1=1   /* start writing at disp.iat */
rowsend=scrrows-4       /* rows to write in */

inrow=trunc(scrcols/20)
nrows=rowsend-1


stp2:

call chose_file_disp i1

/* highlight chosen one */
if iselected>=nowdisp.!START | iselected<=nowdisp.!END then do
   foo=scrwrite(nowdisp.iselected.!row,nowdisp.iselected.!col,,
             nowdisp.iselected.!disp,,,attribs.5)
end

if nowdisp.!END<disp.0 then
  foo=scrwrite(scrrows-3,1,copies(d2c(196),scrcols),,,7)
else
  foo=scrwrite(scrrows-3,1,copies(d2c(205),scrcols),,,7)

wasselected=iselected
do forever
  i1was=i1
  foo=scrwrite(scrrows-2,1,disp.iselected.0,scrcols,,attribs.5)
  foo=cursor(scrrows-2,1)
  akey=inkey()
  if akey=''  then akey=' '
  funckey=''
  if length(akey)=1 then do
     ikey=c2d(akey)
     if ikey=27 then return ''  /* esc -- return '' */
     if ikey=13 | ikey=10 then return nowdisp.iselected.!actual
  end
  else do
     ikey=c2x(right(akey,1))
     akey=''
     if ikey='4B' then  funckey='L'
     if ikey='4D' then  funckey='R'
     if ikey='48' then  funckey='U'
     if ikey='50' then  funckey='D'
     if ikey='51' then  funckey='PGDN'
     if ikey='49' then  funckey='PGUP'
     if ikey='47' then  funckey='HOME'
     if ikey='4F' then  funckey='END'
     if ikey='3B' then  funckey='HELP'
  end
  select

    when pos(translate(akey),'ABCDEFGHIJKLMNOPQRSTUVWXYZ')>0 then do
        takey=translate(akey);tm1=0
        do iz=file_start to disp.0
           if translate(left(disp.iz.!SHOW,1))>=takey then do
              iselected=iz ;tm1=1
              leave  
           end 
           if tm1=0 then iselected=disp.0
        end 
    end 

    when funckey='HELP' then do
       call chose_file_help
       signal stp2
    end 
    when funckey='L' then iselected=max(1,iselected-1)
    when funckey='U' then iselected=max(1,iselected-inrow)   
    when funckey='PGUP' then do 
        iselected=max(nowdisp.!start-(inrow*nrows),1)
    end 
    when funckey='R' then iselected=min(iselected+1,disp.0)
    when funckey='D' then iselected=min(iselected+inrow,disp.0)
    when funckey='PGDN' then do
       iselected=min(nowdisp.!END+1,disp.0)
    end
    when funckey='HOME' then do
        tt=iselected//4
        if tt<>1 then do
           if tt=0 then tt=4
           tt=tt-1
           iselected=iselected-tt
        end
        else do
           if iselected>nowdisp.!START then do
                iselected=nowdisp.!start
           end 
           else do
              iselected=1
           end
        end
    end
    when funckey='END' then do 
        tt=iselected//4
        if tt<>0 then do
           iselected=iselected+(4-tt)
        end
        else do
           if iselected<nowdisp.!END then do
                iselected=nowdisp.!end
           end 
           else do
              iselected=disp.0 
           end
        end
    end 
    otherwise 
  end 

  if iselected<>wasselected then do             /* unhighlight prior */
    iatt=nowdisp.wasselected.!attribute
    foo=scrwrite(nowdisp.wasselected.!row,nowdisp.wasselected.!col,,
             nowdisp.wasselected.!disp,,,attribs.iatt)
     wasselected=iselected
  end 

  if i1<>i1was then signal stp2
  if iselected<nowdisp.!START | iselected>nowdisp.!END then do
     i1=(trunc(iselected/(inrow*nrows))*(inrow*nrows))+1
     signal stp2
  end 

/* highlight chosen one */
  foo=scrwrite(nowdisp.iselected.!row,nowdisp.iselected.!col,,
             nowdisp.iselected.!disp,,,attribs.5)

end 

exit


errno:
say "no value at " sigl
exit

/******************/
chose_file_help:

aesc='1B'x
cyanon=aesc||'[37;46;m'
normal=aesc||'[0;m'
reverse=aesc||'[7;m'
bold=aesc||'[1;m'


foo=scrclear(,,2,1)
c=cursor(2,1)
say cyanon||'Navigation keys '||normal
say bold"Enter "normal||normal||'             Select this file or directory '  
say bold"ESC "normal||normal||'               Exit (do not select a file or directory)'
say bold"Left, Right Arrow "||normal||' Move left, or right, one column '
say bold"Up, Down Arrow "||normal||'    Move up, or down, one page '
say bold"PgUp, PgDn "normal||'        Move up, or down, one page row '
say bold"Home "normal||'              Beginning of line, or beginning of page, or first file '
say bold"End "normal||'               End of line, or end of page,  or last file '
say bold"A,B,...,Z"||normal||'          First file beginning with this character '
say
call charout,reverse||'... hit any key to continue ...'||normal
foo=inkey()
return 1



/******************/
chose_file_disp:
parse arg ii

nowrow=2
nowcol=1

foo=scrclear(,,2,1)

nowdisp.=''
nowdisp.!start=ii

ii=ii-1
do forever
  ii=ii+1
  if ii>disp.0 then do      /* all info written */
     nowdisp.!end=ii-1
     leave
  end

  idisp=disp.ii.1 ; if idisp='' then idisp=3
  toshow=left(disp.ii.!show,19,' ')||vertbar
  foo=scrwrite(nowrow,nowcol,toshow,20,' ',attribs.idisp)

  nowdisp.ii.!row=nowrow
  nowdisp.ii.!col=nowcol
  nowdisp.ii.!disp=toshow
  nowdisp.ii.!actual=disp.ii
  nowdisp.ii.!info=disp.ii.0
  nowdisp.ii.!attribute=disp.ii.1

  nowcol=nowcol+20
  if (nowcol+19)>scrcols then do
      if inrow=0 then inrow=ii
      nowcol=1
      nowrow=nowrow+1
      if nowrow>rowsend then do/* rows all used up */
        nowdisp.!end=ii
        leave
      end
  end
end

return 1

/************/
/* ADD COMMAS TO A NUMBER */
addcomma:procedure
parse arg aval,ndec
parse var aval p1 '.' p2

if ndec='' then do
   p2=''
end
else do
   p2='.'||left(p2,ndec,'0')
end /* do */

plen=length(p1)
p1new=''
do i=1 to 10000 while plen>3
   p1new=','right(p1,3)||p1new
   p1=delstr(p1,plen-2)
   plen=plen-3
end /* do */

return p1||p1new||p2