home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / cmdpk164.zip / fl.cmd < prev    next >
OS/2 REXX Batch file  |  1997-11-26  |  47KB  |  1,206 lines
  1. /* fl.cmd - A FILELIST clone                                   971125 */
  2.  
  3. /* Work in progress :
  4.  *
  5.  * implementing 'CURSOR ...';
  6.  * new options: (Append and (File;
  7.  */
  8.  
  9. '@echo off'; trace off
  10.  
  11. call main_init arg(1)
  12. bg = VioReadCellStr(0,0)
  13. w0 = 0 0;                     w0_x = word(w0,1); w0_y = word(w0,2)
  14. w1 = 1 + (commandLine = 1) 6; w1_x = word(w1,1); w1_y = word(w1,2)
  15. w3 = 1 + (commandLine = 1) 0; w3_x = word(w3,1); w3_y = word(w3,2)
  16. w2 = commandLine 0;           w2_x = word(w2,1); w2_y = word(w2,2)
  17. w4 = height+2 0;              w4_x = word(w4,1); w4_y = word(w4,2)
  18. call drawall
  19.  
  20. /* main loop */
  21. do until quit
  22.    if file.level._CURRENT \= commandLine then do
  23.       item = file.level._TOP + file.level._CURRENT - 1
  24.       if item > file.level.0 then do
  25.          item = file.level.0
  26.          if item < file.level._TOP then do
  27.             file.level._TOP = max(1, item - file.level._CURRENT + 1)
  28.             file.level._CURRENT = 0
  29.             call show
  30.             end
  31.          file.level._CURRENT = item - file.level._TOP + 1
  32.          end
  33.       else
  34.       if item < 2 then do
  35.          item = 2
  36.          file.level._CURRENT = 3 - file.level._TOP
  37.          end
  38.       if file.level._WIDE then do
  39.          if file.level._COL = 1 then file.level._COL = 7
  40.          if file.level._COL = 6 then file.level._COL = width
  41.          item = (item-2)*file.level._NCOL + 2 + (file.level._COL-7) % file.level._MAXWIDTH
  42.          if item > file.level.0 then do
  43.             item = file.level.0
  44.             file.level._CURRENT = 3 + (item - file.level._TOP*file.level._NCOL) % file.level._NCOL
  45.             end
  46.          end
  47.       end
  48.    else do
  49.       if redrawCL then do
  50.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  51.          redrawCL = 0
  52.          end
  53.       item = 2 + (file.level._TOP + currentLine - 3) * file.level._NCOL
  54.       if file.level._COL = 1 then file.level._COL = 7
  55.       if file.level._COL = 6 then file.level._COL = width
  56.       end
  57.    if olditem \= item then do
  58.       call VioWrtCharStr 0, itemnumber, right(item-1,4)
  59.       olditem = item
  60.       end
  61.    call SysCurPos file.level._CURRENT, file.level._COL-1
  62.    key = inkey()
  63.    select
  64.       when symbol('keys._'c2x(key)) = 'VAR' then call execute 'CMDKEY', value('keys._'c2x(key)), item
  65.       when key = CURD then do
  66.          file.level._CURRENT = file.level._CURRENT // (height + 1) + 1
  67.          if file.level._WIDE = 0 & file.level._TOP + file.level._CURRENT - 1 > file.level.0 then file.level._CURRENT = commandLine
  68.          if file.level._WIDE = 1 & (file.level._TOP + file.level._CURRENT - 3) * file.level._NCOL + 2 > file.level.0 then file.level._CURRENT = commandLine
  69.          if file.level._CURRENT = commandLine then file.level._COL = 7
  70.          end
  71.       when key = CURU then do
  72.          if file.level._CURRENT = 1 | file.level._TOP + file.level._CURRENT - 1 <= 2 then do
  73.             file.level._CURRENT = commandLine
  74.             file.level._COL = 7
  75.             end
  76.          else file.level._CURRENT = file.level._CURRENT - 1
  77.          end
  78.       when key = CURR then
  79.          file.level._COL = 1 + file.level._COL // width
  80.       when key = CURL then
  81.          file.level._COL = 1 + (width+file.level._COL-2) // width
  82.       when key = HOME then do
  83.          if file.level._CURRENT = commandLine then do
  84.             file.level._CURRENT = file.level._OLDCURRENT
  85.             file.level._COL = file.level._OLDCOL
  86.             end
  87.          else do
  88.             file.level._OLDCURRENT = file.level._CURRENT
  89.             file.level._OLDCOL = file.level._COL
  90.             file.level._CURRENT = commandLine
  91.             file.level._COL = 7
  92.             end
  93.          end
  94.       when key = ENTER then do
  95.          if file.level._CURRENT = commandLine then do
  96.             if command_line = '' then iterate
  97.             command.cmdnum = command_line
  98.             cmdpos = cmdnum
  99.             cmdnum = cmdnum + 1
  100.             call execute 'CMDLINE', command_line, item
  101.             parse value '1 7' with redrawCL file.level._COL command_line
  102.             end
  103.          else do
  104.             executed = 0
  105.             do idCmd = 1 to file.level.0+1
  106.                if symbol('file.'level'.PCMD.'idCmd) = 'VAR' & file.level.PCMD.idCmd \= '' then do
  107.                   if file.level.PCMD.idCmd = '*' then do
  108.                      drop file.level.PCMD.idCmd
  109.                      iterate
  110.                      end
  111.                   if file.level.PCMD.idCmd \= '"' then
  112.                      cl = file.level.PCMD.idCmd
  113.                   call execute 'PREFIX', cl, idCmd
  114.                   if cmdrc = 0 then
  115.                      file.level.PCMD.idCmd = '*'
  116.                   end
  117.             end /* do */
  118.             if executed then do
  119.                say
  120.                say 'Press any key to continue.'
  121.                call inkey
  122.                call VioWrtCellStr 0, 0, saved_screen
  123.                end
  124.             call show
  125.             end
  126.          if showlevel \= level then do
  127.             level = showlevel
  128.             call redraw
  129.             end
  130.          end
  131.       when length(key) = 1 then call execute 'CMDKEY', 'TEXT 'key
  132.       when key = F2 then
  133.          if list_files(file.level._CURDIR) = 0 then
  134.             call redraw
  135.       when key = F10 then do
  136.          command_line = command.cmdpos
  137.          if cmdpos > 0 then cmdpos = cmdpos - 1
  138.          else if cmdnum > 0 then cmdpos = cmdnum - 1
  139.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  140.          end
  141.       when key = A_F10 then do
  142.          if cmdnum > 0 then
  143.             cmdpos = (cmdpos + 1) // cmdnum
  144.          command_line = command.cmdpos
  145.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  146.          end
  147.    otherwise
  148.    end /* select */
  149. end /* do */
  150.  
  151. call SysCurPos row, col
  152. call VioWrtCellStr 0, 0, bg
  153. exit
  154.  
  155. /* redraw current line */
  156. redrawline:
  157.    l = length(file.level.PCMD.item)
  158.    if l < 6 then
  159.       call VioWrtCharStrAttr file.level._CURRENT, 0, file.level._PREFIX.num.item ,,prefixattr
  160.    else
  161.    if l < width then
  162.       if file.level._CURRENT = currentLine then
  163.          call VioWrtCharStrAttr file.level._CURRENT, l, substr(file.level.item,l-2,1) ,,currentattr
  164.       else
  165.          call VioWrtCharStrAttr file.level._CURRENT, l, substr(file.level.item,l-2,1) ,,attr
  166.    call VioWrtCharStrAttr file.level._CURRENT, 0, file.level.PCMD.item ,,prefixcmdattr
  167.    return
  168.  
  169. /* redraw current screen */
  170. drawall:
  171.    call VioScrollUp w2_x, w2_y, w2_x, w2_y+width-1,255,, cmdattr
  172.    do i = 1 to 12
  173.       call w_put w4, 1, (i-1)*8 + 1, i//10, ,attr
  174.       call w_put w4, 1, (i-1)*8 + 2, keyname.i, 7, msgattr
  175.       end
  176. redraw:
  177.    fmode = left(filespec('D',file.level._CURDIR),1)
  178.    fpath = filespec('P',file.level._CURDIR)
  179.    call VioWrtCharStrAttr w2_x, 0, overlay('['wordpos(level,allLevels)']','====> '), ,arrowattr
  180.    call VioWrtCharStrAttr w0_x, w0_y, left(left(file.level._CURDIR,width-23)||,
  181.         right(word(SysDriveInfo(fmode),2)%1024,6)'K disk',width-11)||right(item-1,4)' of'right(file.level.0-1,4), ,msgattr
  182.    call show
  183.    return
  184.  
  185. /* execute CMDLINE, CMDKEY or PREFIX commands */
  186. execute:
  187.    cmd = arg(2)
  188.    parse value '0 1 0' cmd with cmdrc ret nowait verb rest
  189.    verb = alias(verb)
  190.    if verb = 'SET' then do
  191.       parse var rest verb rest
  192.       verb = alias(verb)
  193.       end
  194.    select
  195.       when verb = 'TEXT' then do
  196.          rest = translate(rest,case,xrange('A','Z')xrange('a','z'))
  197.          if file.level._CURRENT = commandLine then do
  198.             command_line = insert(rest, command_line, file.level._COL - 7)
  199.             redrawCL = 1
  200.             end
  201.          else do
  202.             if symbol('file.'level'.PCMD.'item) = 'BAD' then iterate
  203.             if symbol('file.'level'.PCMD.'item) = 'LIT' | file.level.PCMD.item = '*' then do
  204.                file.level.PCMD.item = rest
  205.                file.level._COL = 1
  206.                end
  207.             else
  208.                file.level.PCMD.item = insert(rest, file.level.PCMD.item, file.level._COL - 1)
  209.             call VioWrtCharStrAttr file.level._CURRENT, 0, file.level.PCMD.item ,,prefixcmdattr
  210.             end
  211.          file.level._COL = file.level._COL + length(rest)
  212.          end
  213.       when verb = 'SOS' then
  214.          select
  215.             when abbrev('DELBACK',translate(rest),5) then
  216.                if file.level._CURRENT = commandLine then do
  217.                   if file.level._COL <= 7 then return
  218.                   file.level._COL = file.level._COL - 1
  219.                   command_line = delstr(command_line, file.level._COL - 6, 1)
  220.                   redrawCL = 1
  221.                   end
  222.                else
  223.                if (file.level._COL > 1) & (symbol('file.'level'.PCMD.'item) = 'VAR') then do
  224.                   file.level._COL = file.level._COL - 1
  225.                   file.level.PCMD.item = delstr(file.level.PCMD.item, file.level._COL, 1)
  226.                   call redrawline
  227.                   end
  228.             when abbrev('DELCHAR',translate(rest),4) then
  229.                if file.level._CURRENT = commandLine then do
  230.                   command_line = delstr(command_line, file.level._COL - 6, 1)
  231.                   redrawCL = 1
  232.                   end
  233.                else
  234.                if symbol('file.'level'.PCMD.'item) = 'VAR' then do
  235.                   file.level.PCMD.item = delstr(file.level.PCMD.item, file.level._COL, 1)
  236.                   call redrawline
  237.                   end
  238.             when abbrev('TABFIELDF',translate(rest),8) then
  239.                select
  240.                   when file.level._CURRENT = commandLine then do
  241.                      file.level._CURRENT = 1
  242.                      file.level._COL = 1+file.level._WIDE*6
  243.                      end
  244.                   when file.level._WIDE & file.level._COL-7 < file.level._MAXWIDTH*(file.level._NCOL-1) & item < file.level.0 then
  245.                      file.level._COL = 7+(1+(file.level._COL-7)%file.level._MAXWIDTH)*file.level._MAXWIDTH
  246.                otherwise
  247.                   file.level._CURRENT = file.level._CURRENT // (height + 1) + 1
  248.                   if file.level._WIDE = 0 & file.level._TOP + file.level._CURRENT - 1 > file.level.0 then file.level._CURRENT = commandLine
  249.                   if file.level._WIDE = 1 & (file.level._TOP + file.level._CURRENT - 3) * file.level._NCOL + 2 > file.level.0 then file.level._CURRENT = commandLine
  250.                   file.level._COL = 1+file.level._WIDE*6
  251.                end  /* select */
  252.             when translate(rest) = 'TABFIELDB' then
  253.                select
  254.                   when file.level._CURRENT = commandLine & file.level._COL = 7 then do
  255.                      file.level._CURRENT = file.level._CURRENT - 1
  256.                      file.level._COL = 1+file.level._WIDE*(6+(file.level._NCOL-1)*file.level._MAXWIDTH)
  257.                      end
  258.                   when file.level._COL = 1+6*file.level._WIDE & (file.level._CURRENT = 1 | file.level._TOP + file.level._CURRENT - 1 <= 2) then do
  259.                      file.level._COL = 7
  260.                      file.level._CURRENT = commandLine
  261.                      end
  262.                   when file.level._WIDE & file.level._COL > 7 then
  263.                      file.level._COL = max(7,7+min(file.level._NCOL-1,(file.level._COL+file.level._MAXWIDTH-8)%file.level._MAXWIDTH-1)*file.level._MAXWIDTH)
  264.                   when \file.level._WIDE & file.level._COL > 1 then file.level._COL = 1
  265.                otherwise
  266.                   file.level._CURRENT = file.level._CURRENT - 1
  267.                   file.level._COL = 1+file.level._WIDE*(6+(file.level._NCOL-1)*file.level._MAXWIDTH)
  268.                end  /* select */
  269.             when abbrev('STARTENDCHAR',translate(rest),9) then do
  270.                if file.level._CURRENT = commandLine then
  271.                   len = length(command_line)
  272.                else
  273.                   len = length(file.level.item)
  274.                if file.level._COL = 7 + len then
  275.                   file.level._COL = 7
  276.                else
  277.                   file.level._COL = 7 + len
  278.                end
  279.             when translate(rest) = 'UNDO' then do
  280.                if file.level._CURRENT = commandLine then
  281.                   parse value '1 7' with redrawCL file.level._COL command_line
  282.                else do
  283.                   drop file.level.PCMD.item
  284.                   call VioWrtCharStrAttr file.level._CURRENT, 0, file.level._PREFIX.num.item ,,prefixattr
  285.                   if file.level._CURRENT = currentLine then
  286.                      call VioWrtCharStrAttr file.level._CURRENT, 6, left(file.level.item,fwidth),, currentattr
  287.                   else
  288.                      call VioWrtCharStrAttr file.level._CURRENT, 6, left(file.level.item,fwidth),, attr
  289.                   end
  290.                end
  291.          otherwise
  292.             call errormsg 'Error 0041: Invalid SOS command:' rest
  293.          end  /* select */
  294.       when verb = 'FLIST' & (arg(1) \= 'CMDLINE' | rest \= '') then do
  295.          if rest = '' then rest = filename(arg(3))
  296.          else if word(rest,1) = '/' then rest = filename(arg(3))'\*.*' subword(rest,2)
  297.          iExec = 1
  298.          do while wordpos(iExec, allLevels) \= 0
  299.             iExec = iExec + 1
  300.          end /* do */
  301.          opath = fpath; omode = fmode; olevel = level
  302.          level = iExec
  303.          if list_files(rest) = 0 then do
  304.             allLevels = subword(allLevels,1,wordpos(olevel, allLevels)) iExec subword(allLevels,wordpos(olevel,allLevels)+1)
  305.             showlevel = iExec
  306.             end
  307.          fpath = opath; fmode = omode; level = olevel
  308.          end
  309.       when verb = 'XEDIT' | verb = 'EDIT' then do
  310.          if rest = '' then rest = filename(arg(3))
  311.          iExec = 1
  312.          do while wordpos(iExec, allLevels) \= 0
  313.             iExec = iExec + 1
  314.          end /* do */
  315.          opath = fpath; omode = fmode; olevel = level
  316.          allLevels = subword(allLevels,1,wordpos(level, allLevels)) iExec subword(allLevels,wordpos(level,allLevels)+1)
  317.          level = iExec
  318.          count = 2
  319.          do while lines(rest)
  320.             file.level.count = linein(rest)
  321.             file.level._PREFIX.0.count = left(fill,6)
  322.             file.level._PREFIX.1.count = left(right(count-1,length(fill),'0'),6)
  323.             count = count + 1
  324.          end /* do */
  325.          call stream rest, 'c', 'close'
  326.          call initlevel rest, 'File', 0, fwidth
  327.          showlevel = level
  328.          fpath = opath; fmode = omode; level = olevel
  329.          end
  330.       when verb = 'HELP' then do
  331.          iExec = 1
  332.          do while wordpos(iExec, allLevels) \= 0
  333.             iExec = iExec + 1
  334.          end /* do */
  335.          allLevels = subword(allLevels,1,wordpos(level, allLevels)) iExec subword(allLevels,wordpos(level,allLevels)+1)
  336.          level = iExec
  337.          count = 2
  338.          helpFile = SysSearchPath('DPATH','fl.hlp')
  339.          do while lines(helpFile)
  340.             file.level.count = linein(helpFile)
  341.             file.level._PREFIX.0.count = left(fill,6)
  342.             file.level._PREFIX.1.count = left(right(count-1,length(fill),'0'),6)
  343.             count = count + 1
  344.          end /* do */
  345.          call stream helpFile, 'c', 'close'
  346.          call initlevel helpFile, 'Help', 0, fwidth
  347.          call redraw
  348.          showlevel = level
  349.          end
  350.       when verb = 'TOP' then call execute arg(1), 'BACKWARD *'
  351.       when verb = 'BOTTOM' then call execute arg(1), 'FORWARD *'
  352.       when verb = 'FORWARD' | verb = 'BACKWARD' then do
  353.          if rest = ''  then rest = 1
  354.          if rest = '*' then do
  355.             rest = file.level.0
  356.             if file.level._CURRENT \= commandLine then file.level._CURRENT = currentLine
  357.             end
  358.          if verb = 'FORWARD' then do
  359.             if file.level._TOP = file.level.0 - currentLine + 1 then return
  360.             file.level._TOP = min(file.level._TOP + rest * height, file.level.0 - currentLine + 1)
  361.             if file.level._WIDE then
  362.                file.level._TOP = min(file.level._TOP, (file.level.0-2) % file.level._NCOL - currentLine + 3)
  363.             end
  364.          else do
  365.             if file.level._TOP = -currentLine + 3 then return
  366.             file.level._TOP = max(file.level._TOP - rest * height, -currentLine + 3)
  367.             end
  368.          call show
  369.          end
  370.       /* SET commands */
  371.       when verb = 'COLOR' | verb = 'COLOUR' then do
  372.          parse upper value rest with area rest
  373.          select
  374.             when abbrev('ARROW',area,1) then arrowattr = color(rest,arrowattr)
  375.             when abbrev('CMDLINE',area,1) then cmdattr = color(rest,cmdattr)
  376.             when abbrev('CURLINE',area,2) then currentattr = color(rest,currentattr)
  377.             when abbrev('FILEAREA',area,1) then attr = color(rest,attr)
  378.             when abbrev('IDLINE',area,1) then msgattr = color(rest,msgattr)
  379.             when abbrev('MSGLINE',area,1) then error_attr = color(rest,error_attr)
  380.             when abbrev('PENDING',area,1) then prefixcmdattr = color(rest,prefixcmdattr)
  381.             when abbrev('PREFIX',area,2) then prefixattr = color(rest,prefixattr)
  382.             when abbrev('STATAREA',area,2) then call color rest,0
  383.             when abbrev('TOFEOF',area,2) then call color rest,0
  384.          otherwise
  385.             call errormsg 'Error 0001: Invalid operand:' area
  386.          end  /* select */
  387.          if \inprofile then
  388.             call drawall
  389.          end
  390.       when verb = 'CASE' then
  391.          select
  392.             when abbrev('UPPER',translate(rest),1) then case = xrange('A','Z')xrange('A','Z')
  393.             when abbrev('LOWER',translate(rest),1) then case = xrange('a','z')xrange('a','z')
  394.             when abbrev('MIXED',translate(rest),1) then case = xrange('A','Z')xrange('a','z')
  395.          otherwise
  396.             call errormsg 'Error 0001: Invalid operand:' rest
  397.          end  /* select */
  398.       when verb = 'IMPOS' | abbrev('IMPCMSCP',verb,3) then
  399.          if wordpos(translate(rest),'ON OFF') > 0 then
  400.             impos = 2 - wordpos(translate(rest),'ON OFF')
  401.          else
  402.             call errormsg 'Error 0001: Invalid operand:' rest
  403.       when abbrev('MSGLINE',verb,4) then interpret 'hLine =' subword(rest,2) '; IF hLine < 0 THEN hLine = 2 + height + hLine'
  404.       when abbrev('NUMBER',verb,3) then
  405.          if wordpos(translate(rest),'ON OFF') > 0 then do
  406.             num = 2 - wordpos(translate(rest),'ON OFF')
  407.             if \inprofile then
  408.                call show
  409.             end
  410.          else
  411.             call errormsg 'Error 0001: Invalid operand:' rest
  412.       when abbrev('CURLINE',verb,4) then do
  413.          interpret 'rest =' rest '; IF rest < 0 THEN rest = 1 + height + rest'
  414.          if \inprofile then
  415.             file.level._TOP = file.level._TOP + currentLine - rest
  416.          currentLine = rest
  417.          if \inprofile then
  418.             call show
  419.          end
  420.       /* end of SET commands */
  421.       when verb = 'QUIT' then do
  422.          if words(allLevels) = 1 then do
  423.             quit = 1
  424.             return
  425.             end
  426.          do idx = 1 to file.level.0+1
  427.             drop file.level.PCMD.idx
  428.          end /* do */
  429.          level = wordpos(level,allLevels)
  430.          allLevels = delword(allLevels,level,1)
  431.          level = level - 1
  432.          if level = 0 then level = words(allLevels)
  433.          level = word(allLevels,level)
  434.          showlevel = level
  435.          call redraw
  436.          end
  437.       when verb = 'OSNOWAIT' | verb = 'DOSNOWAIT' then
  438.          parse value '0 1' rest with ret nowait cmd
  439.       when verb = 'RUN' | verb = 'OS' | verb = 'DOS' then do
  440.          if rest = '' | translate(rest) = '/O' then
  441.             cmd = value('comspec',,'OS2ENVIRONMENT') '/o'
  442.          else
  443.             cmd = rest
  444.          ret = 0
  445.          end
  446.       when verb = 'NEXTWINDOW' | (verb = 'FLIST' & rest = '' & arg(1) = 'CMDLINE') then do
  447.          nlevel = 1 + wordpos(level,allLevels)
  448.          if nlevel > words(allLevels) then nlevel = 1
  449.          showlevel = word(allLevels,nlevel)
  450.          if level \= showlevel then do
  451.             level = showlevel
  452.             call redraw
  453.             end
  454.          end
  455.       when verb = 'RESET' then do
  456.          rest = translate(rest)
  457.          if (rest = 'ALL') | abbrev('PREFIX',rest,1) then
  458.             do idx = 1 to file.level.0+1
  459.                drop file.level.PCMD.idx
  460.             end /* do */
  461.          call show
  462.          end
  463.       when verb = 'CCANCEL' & arg(1) = 'CMDLINE' then quit = 1
  464.       when verb = '/' then file.level._TOP = item - currentLine + 1
  465.       when verb = 'NEXT' | verb = 'DOWN' then do
  466.          if rest = '' then rest = 1
  467.          if rest = '*' then
  468.             file.level._TOP = file.level.0 - currentLine + 1
  469.          else
  470.             file.level._TOP = min(file.level._TOP + rest, file.level.0 - currentLine + 1)
  471.          if file.level._WIDE then
  472.             file.level._TOP = min(file.level._TOP, (file.level.0-2) % file.level._NCOL - currentLine + 3)
  473.          call show
  474.          end
  475.       when verb = 'UP' then do
  476.          if rest = '' then rest = 1
  477.          if rest = '*' then
  478.             file.level._TOP = -currentLine+3
  479.          else
  480.             file.level._TOP = max(file.level._TOP - rest, -currentLine+3)
  481.          call show
  482.          end
  483.       when verb = 'DEFINE' then do
  484.          parse var rest key rest
  485.          if length(key) > 1 then
  486.             key = value(translate(key,'_','-'))
  487.          if rest \= '' then
  488.             call value 'keys._'c2x(key), rest
  489.          else
  490.             interpret 'drop keys._'c2x(key)
  491.          end
  492.       when verb = 'SHOWKEY' then do
  493.          msg = 'Press the key to be translated...spacebar to exit'
  494.          do forever
  495.             key = errormsg(msg)
  496.             if key = ' ' then leave
  497.             if symbol('keys._'c2x(key)) = 'VAR' then
  498.                msg = 'Key: 'physicalkey(key)' - assigned to '''value('keys._'c2x(key))''''
  499.             else
  500.                msg = 'Key: 'physicalkey(key)' - unassigned'
  501.          end /* do */
  502.          end
  503.    otherwise
  504.       if impos then
  505.          ret = 0
  506.       else
  507.          call errormsg 'Error 0000: Invalid command: 'cmd
  508.    end /* select */
  509.    if ret then
  510.       return
  511.    if arg(1) \= 'PREFIX' | \ executed then do
  512.       saved_screen = VioReadCellStr(0,0,(height+3)*width*2)
  513.       call SysCls
  514.       executed = 1
  515.       end
  516.    prompt = prompt()
  517.    signal on halt
  518.    if arg(1) \= 'CMDLINE' then
  519.       cmd = substitute(cmd,arg(3))
  520.    else
  521.       cmd = substitute(cmd '/o',arg(3))
  522.    say prompt||cmd
  523.    address cmd cmd
  524.    if stream(filename(arg(3)),'c','query datetime') = '' then
  525.       call value 'file.level.'arg(3), overlay(rod,value('file.level.'arg(3)))
  526.    cmdrc = rc
  527. after_halt:
  528.    if arg(1) \= 'PREFIX' then do
  529.       if \ nowait then do
  530.          say
  531.          say 'Press any key to continue.'
  532.          call inkey
  533.          end
  534.       call VioWrtCellStr 0, 0, saved_screen
  535.       end
  536.    return
  537.  
  538. /* handle control break */
  539. /* this should be activated only from the 'execute' routine */
  540. halt:
  541.    signal after_halt
  542.  
  543. /* parse command line & perform substitutions */
  544. substitute: procedure expose file. fmode fpath level
  545.    parse arg verb rest, item
  546.    if verb = '/' then do
  547.       parse arg rest, item
  548.       verb = ''
  549.       end
  550.    parse value '0 0' with state subst tail
  551.    parse var file.level.item fdate ftime fsize feasize fileid
  552.    fileid = strip(fileid)
  553.    if pos('.',fileid) \= 0 then do
  554.       fn = substr(fileid,1,lastpos('.',fileid)-1)
  555.       ft = substr(fileid,lastpos('.',fileid)+1)
  556.       end
  557.    else do
  558.       fn = fileid
  559.       ft = ''
  560.       end
  561.    do i = 1 to length(rest)
  562.       c = translate(substr(rest,i,1))
  563.       select
  564.          when state = 0 then do
  565.             if c = '/' then state = 1
  566.             else tail = tail||substr(rest,i,1)
  567.             end
  568.          when state = 1 then do
  569.             select
  570.                when c = 'N' then do
  571.                   tail = tail||fn
  572.                   subst = 1
  573.                   end
  574.                when c = 'T' | c = 'E' then do
  575.                   tail = tail||ft
  576.                   subst = 1
  577.                   end
  578.                when c = 'D' | c = 'M' then do
  579.                   tail = tail||fmode':'
  580.                   subst = 1
  581.                   end
  582.                when c = 'P' then do
  583.                   tail = tail||fpath
  584.                   subst = 1
  585.                   end
  586.                when c == ' ' then do
  587.                   tail = tail||filename(item)||' '
  588.                   subst = 1
  589.                   end
  590.                when c = 'O' then do
  591.                   subst = 1
  592.                   end
  593.             otherwise do
  594.                tail = tail||substr(rest,i,1)
  595.                end
  596.             end /* inner select */
  597.             state = 0
  598.             end /* do group */
  599.       end /* outer select */
  600.    end /* outer loop */
  601.  
  602.    if state then tail = tail||filename(item)
  603.  
  604.    if \subst then do
  605.       fname = filename(item)
  606.       if tail \== '' then
  607.          tail = tail fname
  608.       else
  609.          tail = fname
  610.       end
  611.  
  612.    verb = alias(verb)
  613.    return verb tail
  614.    
  615. /* infer the physical key from a keycode */
  616. physicalkey: procedure
  617.    key = arg(1)
  618.    num = c2d(key)
  619.    select
  620.       when key = '1b'x then return 'ESC'
  621.       when key = '0d'x then return 'ENTER'
  622.       when key = '08'x then return 'BKSP'
  623.       when key = '09'x then return 'TAB'
  624.       when key = '000F'x then return 'S-TAB'
  625.       when key = '0053'x then return 'DEL'
  626.       when key = '0048'x then return 'CURU'
  627.       when key = '0050'x then return 'CURD'
  628.       when key = '004b'x then return 'CURL'
  629.       when key = '004d'x then return 'CURR'
  630.       when key = '0049'x then return 'PGUP'
  631.       when key = '0051'x then return 'PGDN'
  632.       when key = '0084'x then return 'C-PGUP'
  633.       when key = '0076'x then return 'C-PGDN'
  634.       when key = '0047'x then return 'HOME'
  635.       when key = '004F'x then return 'END'
  636.       when key = '003b'x then return 'F1'
  637.       when key = '003c'x then return 'F2'
  638.       when key = '003d'x then return 'F3'
  639.       when key = '003e'x then return 'F4'
  640.       when key = '003f'x then return 'F5'
  641.       when key = '0040'x then return 'F6'
  642.       when key = '0041'x then return 'F7'
  643.       when key = '0042'x then return 'F8'
  644.       when key = '0043'x then return 'F9'
  645.       when key = '0044'x then return 'F10'
  646.       when key = '0085'x then return 'F11'
  647.       when key = '0086'x then return 'F12'
  648.       when key = '0071'x then return 'A-F10'
  649.       when key = '001e'x then return 'A-A'
  650.       when key = '0030'x then return 'A-B'
  651.       when key = '002e'x then return 'A-C'
  652.       when key = '0020'x then return 'A-D'
  653.       when key = '0012'x then return 'A-E'
  654.       when key = '0021'x then return 'A-F'
  655.       when key = '0022'x then return 'A-G'
  656.       when key = '0023'x then return 'A-H'
  657.       when key = '0017'x then return 'A-I'
  658.       when key = '0024'x then return 'A-J'
  659.       when key = '0025'x then return 'A-K'
  660.       when key = '0026'x then return 'A-L'
  661.       when key = '0032'x then return 'A-M'
  662.       when key = '0031'x then return 'A-N'
  663.       when key = '0018'x then return 'A-O'
  664.       when key = '0019'x then return 'A-P'
  665.       when key = '0010'x then return 'A-Q'
  666.       when key = '0013'x then return 'A-R'
  667.       when key = '001f'x then return 'A-S'
  668.       when key = '0014'x then return 'A-T'
  669.       when key = '0016'x then return 'A-U'
  670.       when key = '002f'x then return 'A-V'
  671.       when key = '0011'x then return 'A-W'
  672.       when key = '002d'x then return 'A-X'
  673.       when key = '0015'x then return 'A-Y'
  674.       when key = '002c'x then return 'A-Z'
  675.       when key = '0078'x then return 'A-1'
  676.       when key = '007a'x then return 'A-3'
  677.       when key = '007b'x then return 'A-4'
  678.       when key = '007c'x then return 'A-5'
  679.       when key = '007d'x then return 'A-6'
  680.       when key = '007f'x then return 'A-8'
  681.       when key = '0080'x then return 'A-9'
  682.       when key = '0081'x then return 'A-0'
  683.       when num < 32 then return 'C-'d2c(num+64)
  684.    otherwise
  685.       return key
  686.    end
  687.  
  688. /* compute a file name */
  689. filename: procedure expose file. fmode fpath level
  690.    arg item
  691.    parse var file.level.item fdate ftime fsize feasize fileid
  692.    fileid = fmode':'||fpath||strip(fileid)
  693.  
  694.    if pos(' ',fileid) \= 0 then
  695.       return '"'fileid'"'
  696.    else
  697.       return fileid
  698.  
  699. /* expand the OS/2 prompt */
  700. prompt: procedure
  701.    prmpt = value('PROMPT',,'OS2ENVIRONMENT')
  702.    if (prmpt == '') then
  703.       prmpt = '[$p]'
  704.  
  705.    str = ''
  706.  
  707.    do i = 1 to length(prmpt)
  708.       key = substr(prmpt,i,1)
  709.       if (key = '$') then
  710.          do
  711.          i = i+1; key = translate(substr(prmpt,i,1))
  712.          select
  713.             when key = '$' then str = str||'$'
  714.             when key = 'A' then str = str||'&'
  715.             when key = 'B' then str = str||'|'
  716.             when key = 'C' then str = str||'('
  717.             when key = 'D' then str = str||date()
  718.             when key = 'E' then str = str||'1b'x
  719.             when key = 'F' then str = str||')'
  720.             when key = 'G' then str = str||'>'
  721.             when key = 'H' then str = str||'08'x
  722.             when key = 'I' then nop
  723.             when key = 'L' then str = str||'<'
  724.             when key = 'N' then str = str||filespec("d",directory())
  725.             when key = 'P' then str = str||directory()
  726.             when key = 'Q' then str = str||'='
  727.             when key = 'R' then str = str||rc
  728.             when key = 'S' then str = str||' '
  729.             when key = 'T' then str = str||time()
  730.             when key = 'V' then str = str||'Operating System/2 version' SysOS2Ver()
  731.             when key = '_' then str = str||'0d'x
  732.          otherwise
  733.             str = str||substr(prmpt,i,1)
  734.          end  /* select */
  735.          end
  736.       else
  737.          str = str||key
  738.    end /* do */
  739.    return str
  740.  
  741. /* compute a command alias */
  742. alias:
  743.    word = translate(arg(1))
  744.    do i = 1 by 1 while symbol('abbr.i.name') = 'VAR'
  745.       if abbrev(abbr.i.name,word,abbr.i.min) then
  746.          return abbr.i.name
  747.    end /* do */
  748.    return word
  749.  
  750. /* expand file spec */
  751. expandspec:
  752.    fmode = filespec('d',arg(1))
  753.    fpath = filespec('p',arg(1))
  754.    fname = filespec('n',arg(1))
  755.    if fmode = '' then
  756.       fmode = filespec('d',directory())
  757.    if fpath = '' then
  758.       fpath = doscd(substr(fmode,1,1))
  759.    if right(fpath,1) \= '\' then
  760.       fpath = fpath||'\'
  761.    if fname = '' then
  762.       fname = '*'
  763.    if pos('*',fname) = 0 then
  764.       fname = fname||'\*'
  765.    if \fileexists then do
  766.       fileexists = stream(fmode||fpath||fname,'c','query exists') \= ''
  767.       if \fileexists then do
  768.          call DosFileTree fmode||fpath||fname, FEXIST.
  769.          fileexists = (FEXIST.0 \= 0)
  770.          end
  771.       end
  772.    return fmode||fpath||fname
  773.  
  774. /* build the list of files */
  775. list_files:
  776.    drop file.level.
  777.    parse arg list '(' options
  778.    if list = '' then
  779.       list = '*'
  780.    filespec = ''
  781.    fileexists = 0
  782.    do while list \= ''
  783.       parse value list with pre '"' main '"' list
  784.       do i = 1 to words(pre)
  785.          filespec = filespec expandspec(word(pre,i))
  786.       end /* do */
  787.       if main \= '' then
  788.          filespec = filespec '"'expandspec(main)'"'
  789.    end /* do */
  790.    filespec = strip(filespec)
  791.  
  792.    /* scan options */
  793.    options = translate(options, ' ', ')')
  794.    parse value '0 0' translate(options) with tree_option sort_option options
  795.    do i = 1 to words(options)
  796.       opt = word(options,i)
  797.       if abbrev('TREE',opt,2) then
  798.          tree_option = 1
  799.       else if abbrev('SORTD',opt,4) | abbrev('SORTA',opt,4) then
  800.          sort_option = 1
  801.    end /* do */
  802.  
  803.    if \tree_option & \fileexists then do
  804.       call errormsg 'Error 0009: Files not found:' filespec
  805.       return 2
  806.       end
  807.  
  808.    if sort_option then
  809.       sort = ''
  810.    else do
  811.       if tree_option then
  812.          sort = 'sort path sortd d'
  813.       else
  814.          sort = 'sort n'
  815.       end
  816.  
  817.    call listfile filespec '(' sort options
  818.    count = file.level.0
  819.    if rc \= 0 then
  820.       return 1
  821.    return 0
  822.  
  823. /* show the list of files */
  824. show:
  825.    if file.level._WIDE \= 1 then do
  826.       i_init = 0; i_end = height-1
  827.       if file.level._TOP < 1 then do
  828.          call VioScrollUp w3_x, w3_y, w3_x-file.level._TOP, w3_y+5,height,,prefixattr
  829.          call VioScrollUp w1_x, w1_y, w1_x-file.level._TOP, w1_y+fwidth-1,height,,attr
  830.          i_init = 1 - file.level._TOP
  831.          end
  832.       if file.level._TOP + i_end > 1 + file.level.0 then
  833.          i_end = 1 + file.level.0 - file.level._TOP
  834.       do i = i_init to currentLine-2
  835.          index = file.level._TOP + i; delta = w1_x+i /* = w3_x+i */
  836.          call VioWrtCharStrAttr delta, w3_y, file.level._PREFIX.num.index,,prefixattr
  837.          call VioWrtCharStrAttr delta, w1_y, left(file.level.index,fwidth) ,,attr
  838.          if (symbol('file.'level'.PCMD.'index) = 'VAR') then
  839.             call VioWrtCharStrAttr delta, 0, file.level.PCMD.index ,,prefixcmdattr
  840.       end /* do */
  841.       index = file.level._TOP + i; delta = w1_x+i /* = w3_x+i */
  842.       call VioWrtCharStrAttr delta, w3_y, file.level._PREFIX.num.index,,prefixattr
  843.       call VioWrtCharStrAttr delta, w1_y, left(file.level.index,fwidth) ,,currentattr
  844.       if (symbol('file.'level'.PCMD.'index) = 'VAR') then
  845.          call VioWrtCharStrAttr delta, 0, file.level.PCMD.index ,,prefixcmdattr
  846.       do i = currentLine to i_end
  847.          index = file.level._TOP + i; delta = w1_x+i /* = w3_x+i */
  848.          call VioWrtCharStrAttr delta, w3_y, file.level._PREFIX.num.index,,prefixattr
  849.          call VioWrtCharStrAttr delta, w1_y, left(file.level.index,fwidth) ,,attr
  850.          if (symbol('file.'level'.PCMD.'index) = 'VAR') then
  851.             call VioWrtCharStrAttr delta, 0, file.level.PCMD.index ,,prefixcmdattr
  852.       end /* do */
  853.       if i_end \= height + 1 then do
  854.          call VioScrollUp delta+1, w3_y, w3_x+height-1, w3_y+5,height,,prefixattr
  855.          call VioScrollUp delta+1, w1_y, w1_x+height-1, w1_y+fwidth-1,height,,attr
  856.          end
  857.       end
  858.    else
  859.       do i = 1 to height
  860.          index = file.level._TOP + i - 1
  861.          if index <= 1 | 3+(index-2)*file.level._NCOL > 1 + file.level.0 then do
  862.             call w_put w3, i, 1, '      ', ,prefixattr
  863.             if index < 1 | 3+(index-3)*file.level._NCOL > 1 + file.level.0 then call w_put w1, i, 1, '', fwidth, attr
  864.             else
  865.             if index = 1 then call w_put w1, i, 1, file.level.1, fwidth, attr
  866.             else
  867.                call w_put w1, i, 1, value('file.level.'file.level.0+1), fwidth, attr
  868.             iterate
  869.             end
  870.          index = 2+(index-2)*file.level._NCOL
  871.          shortnames = ''
  872.          call w_put w3, i, 1, file.level._PREFIX.num.index, ,prefixattr
  873.          do j = index to index+file.level._NCOL-1
  874.             if substr(file.level.j,26,1) = '>' then
  875.                shortnames = shortnames||'['substr(file.level.j']',41,file.level._MAXWIDTH-1)
  876.             else
  877.                shortnames = shortnames||substr(file.level.j,41,file.level._MAXWIDTH)
  878.          end /* do */
  879.          if i = currentLine then
  880.             call w_put w1, i, 1, shortnames, fwidth, currentAttr
  881.          else
  882.             call w_put w1, i, 1, shortnames, fwidth, attr
  883.       end /* do */
  884.    return
  885.  
  886. /* show error messages */
  887. errormsg:
  888.    if inprofile then do
  889.       say arg(1)
  890.       return
  891.       end
  892.    save1 = VioReadCellStr(hline-1,0,width*2)
  893.    call VioWrtCharStrAttr hline-1, 0, left(arg(1),width), width, error_attr
  894.    key = inkey()
  895.    call VioWrtCellStr hline-1, 0, save1
  896.    return key
  897.  
  898. /* simulate listfile command */
  899. listfile: procedure expose file. rc height fill level currentLine commandLine olevel fwidth
  900.    parse arg names '(' options
  901.    options = translate(options, ' ', ')')
  902.    parse value '0 0 /NAME /EXT /SIZE /DATE' with wide sorts sort_types
  903.    do i = 1 to words(options)
  904.       opt = translate(word(options, i))
  905.       select
  906.          when opt = 'SORT' | opt = 'SORTA' then do
  907.             if i = words(options) then
  908.                break
  909.             i = i + 1
  910.             sorts = sorts + 1
  911.             x = pos('/'translate(word(options, i)), sort_types)
  912.             parse var sort_types =(x) '/' sortype .
  913.             sort.sorts = sortype 'a'
  914.             end
  915.          when opt = 'SORTD' then do
  916.             if i = words(options) then
  917.                break
  918.             i = i + 1
  919.             sorts = sorts + 1
  920.             x = pos('/'translate(word(options, i)), sort_types)
  921.             parse var sort_types =(x) '/' sortype .
  922.             sort.sorts = sortype 'd'
  923.             end
  924.          when abbrev('WIDE',opt,1) | abbrev('(WIDE',opt,2) then wide = 1
  925.          when opt = 'APPEND' | opt = '(APPEND' then nop
  926.       otherwise
  927.       end /* select */
  928.    end /* do */
  929.  
  930.    count = 1
  931.    do while names \= ''
  932.       parse value names with file _ '"' main '"' names
  933.       select
  934.          when file = '' & main = '' then iterate
  935.          when file = '' then file = main
  936.          when main = '' then names = _ names
  937.       otherwise
  938.          names = _ '"'main'"' names
  939.       end  /* select */
  940.       lastfile = file
  941.  
  942.       call DosFileTree file, 'temp.', 'T'
  943.  
  944.       maxwidth = 0
  945.       /* temporary location -- should be moved to main_init */
  946.       dirLabel = strip(SysGetMessage(1054)) /* <DIR> */
  947.       ci = DosQueryCtryInfo()
  948.       iDate = c2d(substr(ci,9,1))   /* 0 = MDY, 1 = DMY, 2 = YMD */
  949.       iTime = c2d(substr(ci,28,1))  /* 0 = 12 Hour clock, 1 = 24 */
  950.       sDate = substr(ci,22,1)       /* '/' */
  951.       sTime = substr(ci,24,1)       /* ':' */
  952.  
  953.       do j = 1 to temp.0
  954.          parse var temp.j year '/' month '/' day '/' hour '/' min sz ea at fid
  955.          count = count + 1
  956.          fspec = filespec('n', fid)
  957.          if pos('D',at) \= 0 then do
  958.             sz = dirLabel
  959.             end
  960.             
  961.          /* localizing raw result */
  962.          ea = ea / 2
  963.          if ea = 2 then ea = 0
  964.          year = right(year,2)
  965.          select
  966.             when iDate = 0 then date = format(month) || sDate || day || sDate || year
  967.             when iDate = 1 then date = format(day) || sDate || month || sDate || year
  968.             when iDate = 2 then date = year || sDate || month || sDate || day
  969.          end  /* select */
  970.          if iTime = 1 then
  971.             time = format(hour) || sTime || min' '
  972.          else
  973.             if hour < 13 then 
  974.                time = format(hour) || sTime || min'a'
  975.             else
  976.                time = format(hour-12) || sTime || min'p'
  977.          file.level.count = right(date,8) right(time,7) right(sz,9) right(ea,11)'  'fspec
  978.  
  979.          maxwidth = max(maxwidth,length(fspec)+2*(pos('D',at) \= 0))
  980.          file.level._PREFIX.0.count = left(fill,6)
  981.          file.level._PREFIX.1.count = left(right(count-1,length(fill),'0'),6)
  982.       end /* do */
  983.    end /* do */
  984.    count = count+1
  985.    call initlevel lastfile, "List", wide, maxwidth
  986.  
  987.    /* build an arglist for arraysort */
  988.    sortspec = ''
  989.    do i = 1 to sorts
  990.       parse var sort.i type direction
  991.       select
  992.          when type = 'DATE' then
  993.             sortspec = sortspec||'10,2,"'direction'","c",4,5,"'direction'","c",'
  994.          when type = 'NAME' then
  995.             sortspec = sortspec||'34,,"'direction'","c",'
  996.          when type = 'EXT' then
  997.             sortspec = sortspec||'1,3,"'direction'","c",34,,"a","c",'
  998.          when type = 'SIZE' then
  999.             sortspec = sortspec||'22,10,"'direction'","c",'
  1000.       otherwise
  1001.       end /* select */
  1002.    end /* do */
  1003. /*   interpret 'call arraysort "file."level,2,count-2,'strip(sortspec,'t',',') */
  1004.    rc = 0
  1005.    return
  1006.  
  1007. /* initialize level data  --  arg(1) is level title & arg(2) is level type */
  1008. initlevel:
  1009.    file.level.1 = "═════ Top Of "arg(2)" ═════"
  1010.    file.level._PREFIX.0.1 = '      '
  1011.    file.level._PREFIX.1.1 = '      '
  1012.    file.level.count = "═════ Bottom Of "arg(2)" ═════"
  1013.    file.level._PREFIX.0.count = '      '
  1014.    file.level._PREFIX.1.count = '      '
  1015.    file.level._TOP = -currentLine+3
  1016.    file.level._CURRENT = commandLine
  1017.    file.level._COL = 7
  1018.    file.level._OLDCOL = 7
  1019.    file.level._OLDCURRENT = 2
  1020.    file.level._CURDIR = arg(1)
  1021.    file.level._WIDE = arg(3)
  1022.    file.level._MAXWIDTH = arg(4)+2
  1023.    if arg(3) then
  1024.       file.level._NCOL = fwidth % (arg(4)+2)
  1025.    else
  1026.       file.level._NCOL = 1
  1027.    file.level.0 = count-1
  1028.    return
  1029.  
  1030. /* initialize data and global variables */
  1031. main_init:
  1032.  
  1033.    if RxFuncQuery("SysLoadFuncs") then
  1034.       do
  1035.       call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
  1036.       call SysLoadFuncs
  1037.       end
  1038.  
  1039.    if RxFuncQuery("VioLoadFuncs") then
  1040.       do
  1041.       call RxFuncAdd 'VioLoadFuncs', 'REXXVIO', 'VioLoadFuncs'
  1042.       call VioLoadFuncs
  1043.       end
  1044.  
  1045.    ESC = '1b'x;                     keys._1B   = 'sos undo'
  1046.    ENTER = '0d'x
  1047.    BKSP = '08'x;                    keys._08   = 'sos delback'
  1048.    TAB = '09'x;                     keys._09   = 'sos tabfieldf'
  1049.    S_TAB = '000F'x;                 keys._000F = 'sos tabfieldb'
  1050.    DEL = '0053'x;                   keys._0053 = 'sos delchar'
  1051.    CURU = '0048'x
  1052.    CURD = '0050'x
  1053.    CURL = '004b'x
  1054.    CURR = '004d'x
  1055.    PGUP = '0049'x;                  keys._0049 = 'backward 1'
  1056.    PGDN = '0051'x;                  keys._0051 = 'forward 1'
  1057.    C_PGUP = '0084'x;                keys._0084 = 'backward *'
  1058.    C_PGDN = '0076'x;                keys._0076 = 'forward *'
  1059.    HOME = '0047'x
  1060.    END = '004F'x;                   keys._004F = 'sos startendchar'
  1061.    F1 = '003b'x;                    keys._003B = 'help'
  1062.    F2 = '003c'x
  1063.    F3 = '003d'x;                    keys._003D = 'quit'
  1064.    F4 = '003e'x;                    keys._003E = 'xedit'
  1065.    F5 = '003f'x;                    keys._003F = 'copy / a:'
  1066.    F6 = '0040'x;                    keys._0040 = 'copy / b:'
  1067.    F7 = '0041'x;                    keys._0041 = 'backward 1'
  1068.    F8 = '0042'x;                    keys._0042 = 'forward 1'
  1069.    F9 = '0043'x;                    keys._0043 = 'os'
  1070.    F10 = '0044'x
  1071.    F11 = '0085'x
  1072.    F12 = '0086'x;                   keys._0086 = 'nextwindow'
  1073.    A_F10 = '0071'x
  1074.    A_1 = '0078'x;                   keys._0078 = 'xedit'
  1075.    A_X = '002D'x;                   keys._002D = 'xedit'
  1076.  
  1077.    /* abbreviations */
  1078.    abbr.1.name = 'FB';              abbr.1.min = 1
  1079.    abbr.2.name = 'BROWSE';          abbr.2.min = 1
  1080.    abbr.3.name = 'FLIST';           abbr.3.min = 2
  1081.    abbr.4.name = 'RESET';           abbr.4.min = 3
  1082.    abbr.5.name = 'NEXTWINDOW';      abbr.5.min = 5
  1083.    abbr.6.name = 'CCANCEL';         abbr.6.min = 2
  1084.    abbr.7.name = 'BOTTOM';          abbr.7.min = 3
  1085.    abbr.8.name = 'BACKWARD';        abbr.8.min = 2
  1086.    abbr.9.name = 'FORWARD';         abbr.9.min = 2
  1087.    abbr.10.name = 'NEXT';           abbr.10.min = 1
  1088.    abbr.11.name = 'UP';             abbr.11.min = 1
  1089.    abbr.12.name = 'DOWN';           abbr.12.min = 1
  1090.    abbr.13.name = 'SHOWKEY';        abbr.13.min = 4
  1091.    abbr.14.name = 'DEFINE';         abbr.14.min = 3
  1092.    abbr.15.name = 'OSNOWAIT';       abbr.15.min = 3
  1093.    abbr.16.name = 'DOSNOWAIT';      abbr.16.min = 4
  1094.    abbr.17.name = 'EDIT';           abbr.17.min = 1
  1095.    abbr.18.name = 'XEDIT';          abbr.18.min = 1
  1096.  
  1097.    parse value '1 1 1' SysTextScreenSize() SysCurPos(),
  1098.          with showlevel level allLevels height width row col command_line command.
  1099.  
  1100.    height = height - 3
  1101.  
  1102.    parse value height%2 width-11 '2 0 0 0 0 0 0 ======',
  1103.          with M itemnumber item olevel cmdpos cmdnum redrawCL quit executed fill
  1104.  
  1105.    rod = '--- renamed or discarded ---          '
  1106.  
  1107.    /* main area color */
  1108.    parse value '116 23 49 49 49 113 116 31',
  1109.          with error_attr attr cmdattr arrowattr prefixattr msgattr prefixcmdattr currentattr
  1110.  
  1111.    /* SETtable values */
  1112.    parse value xrange('A','Z')xrange('a','z') width-6 height+1 '0 1 7 2',
  1113.          with case fwidth commandLine num impos currentLine hLine
  1114.  
  1115.    prefixSpace = '      '
  1116.    mainSpace = copies(' ',fwidth)
  1117.  
  1118.    /* key names */
  1119.    keyname.1 = 'Help'
  1120.    keyname.2 = 'Refresh'
  1121.    keyname.3 = 'Exit'
  1122.    keyname.4 = 'Xedit'
  1123.    keyname.5 = 'Copy A'
  1124.    keyname.6 = 'Copy B'
  1125.    keyname.7 = 'PgUp'
  1126.    keyname.8 = 'PgDn'
  1127.    keyname.9 =  'Shell'
  1128.    keyname.10 = 'Recall'
  1129.    keyname.11 = ''
  1130.    keyname.12 = 'NextW'
  1131.  
  1132.    /* profile support */
  1133.    profileName = 'profile.fl'
  1134.  
  1135.    parse upper value arg(1) with _ '(N' +0 profile
  1136.    if abbrev('(NOPROFILE', translate(word(profile,1), ' ', ')'),2) then
  1137.       profileName = ''
  1138.  
  1139.    parse upper value arg(1) with _ '(P' +0 profile
  1140.    if abbrev('(PROFILE', word(profile,1),2) then
  1141.       profileName = word(translate(profile, ' ', ')'),2)
  1142.  
  1143.    inprofile = 1
  1144.    if profileName \= '' then
  1145.       profileFile = SysSearchPath('DPATH',profileName)
  1146.    else
  1147.       profileFile = ''
  1148.    if profileFile \= '' then do
  1149.       do while lines(profileFile)
  1150.          line = linein(profileFile)
  1151.          if left(line,1) = "'" | left(line,1) = '"' then
  1152.             call execute 'CMDLINE', strip(line,,left(line,1))
  1153.          else
  1154.             interpret line
  1155.       end /* do */
  1156.       call stream profileFile, 'c', 'close'
  1157.       end
  1158.    if list_files(arg(1)) \= 0 then
  1159.       exit 3
  1160.    inprofile = 0
  1161.  
  1162.    return
  1163.  
  1164. /* convert color name */
  1165. color: procedure expose hline width error_attr inprofile
  1166.    arg word1 rest
  1167.    parse value '0 0 BLACK BLUE GREEN CYAN RED MAGENTA YELLOW WHITE' with col bg name
  1168.    do while word1 \= ''
  1169.       select
  1170.          when \bg & word1 = 'BLINK' then col = col + 128
  1171.          when \bg & wordpos(word1,'BOLD BRIGHT HIGH') > 0 then col = col + 8
  1172.          when \bg & wordpos(word1,name) > 0 then do
  1173.             col = col + wordpos(word1,name) - 1
  1174.             bg = 1
  1175.             end
  1176.          when bg & wordpos(word1,name) > 0 then col = col + 16 * (wordpos(word1,name)-1)
  1177.       otherwise
  1178.          call errormsg 'Error 0001: Invalid operand:' word1
  1179.          return arg(2)
  1180.       end  /* select */
  1181.       parse value rest with word1 rest
  1182.    end /* do */
  1183.    return col
  1184.  
  1185. /* quick and dirty rexxlib replacement funcs */
  1186. doscd: procedure
  1187.   arg drive
  1188.   current = directory()
  1189.   specified = directory(drive':')
  1190.   call directory current
  1191.   return substr(specified,3)
  1192.  
  1193. w_put:
  1194.   if arg(5) = '' then
  1195.     return VioWrtCharStrAttr(word(arg(1),1)+arg(2)-1,word(arg(1),2)+arg(3)-1,arg(4),,arg(6))
  1196.   else
  1197.     return VioWrtCharStrAttr(word(arg(1),1)+arg(2)-1,word(arg(1),2)+arg(3)-1,left(arg(4),arg(5)),arg(5),arg(6))
  1198.  
  1199. inkey: procedure
  1200.   key  = SysGetKey("NOECHO")
  1201.                          
  1202.   if (key = "E0"x) | (key = "00"x) then        
  1203.     return "00"x || SysGetKey("NOECHO")
  1204.   else
  1205.     return key
  1206.