OS/2 Shareware BBS: 18 REXX/18-REXX.zip/rexxlb.zip/SAMPLES/FL.CMD

OS/2 REXX Batch file | 1993-02-05 | 20KB | 740 lines

/*****************************************************************************/
/*                                                                           */
/* (c) Copyright 1988-1993, Quercus Systems                                  */
/* All rights reserved                                                       */
/*                                                                           */
/* REXXLIB sample program: file manager/command shell                        */
/*                                                                           */
/* This sample is an implementation of a file manager similar to the CMS     */
/* FILELIST utility. It provides extensive illustration of the use of        */
/* RXWINDOW functions to build a text mode full screen interface. Many       */
/* other REXXLIB functions are also used, such as:                           */
/*                                                                           */
/*     arraysort     dosdrive      scrput                                    */
/*     cursor        dosenv        scrread                                   */
/*     cursortype    lower         scrsize                                   */
/*     doscd         parsefn       scrwrite                                  */
/*     dosdir        pcram         sound                                     */
/*     dosdisk       scrclear      upper                                     */
/*                                                                           */
/*****************************************************************************/

signal on novalue
call load_rxwindow

level = 0
parse value scrsize() with height width .
height = height - 3
ctype = cursortype(32,32)
call main_init
w1 = w_open(2, 1, height, width, attr)
w2 = w_open(height+2, 1, 2, width, 79)
call w_put w2, 1, 1, "=====>"
do i = 1 to 10
    call w_put w2, 2, (i-1)*8 + 1, i//10
    call w_put w2, 2, (i-1)*8 + 2, keyname.i, , attr
    end
call flist arg(1)
call w_close w1
call w_close w2
parse var ctype a b .
call cursortype a, b
call clrscrn
exit

/* generate file list */
flist: procedure expose level w1 w2 attr height width ctype dosattr
level = level + 1
call w_put w2, 1, 1, "["level"]"
call initialize
command. = ''
cnum = 1
w0 = w_open(1, 1, 1, width, 79)
filespec = arg(1)
if list_files(filespec) \= 0 then do
    call w_close w0
    return 3
    end
linesize = width
top = 1
current = 1
title = left(left(filespec,40)||right(dosmem()%1024,4)'K memory,'||,
    right(dosdisk('f',fmode)%1024,6)'K disk',69)||'   1 of'right(count,4)
call w_put w0, 1, 1, title
call show

/*
current = line number within window
item = number of item highlighted
top = number of item in first line of window
*/

/* main loop */
command_line = ''
cmdpos = 0
cmdnum = 0
do until quit
    item = top + current - 1
    if item > count then do
        call w_put w1, current, 1, "", 2, attr
        item = count
        if item < top then do
            top = max(1, item - current + 1)
            current = 0
            call show
            end
        current = item - top + 1
        call w_put w1, current, 1, "=>", 2, attr
        end
    call w_put w0, 1, 70, right(item,4)
    cmdstr = command_line
    command_line = w_get(w2, 1, 8, 73, cmdstr, , '00'x, 'f')
    key = _activation_key
    select
        when key = down then do
            if item = count then iterate
            if current = height then do
                top = top + 1
                call show
                end
            else do
                call w_put w1, current , 1, "", 2, attr
                current = current + 1
                item = top + current - 1
                call w_put w1, current , 1, "=>", 2, attr
                end
            end
        when key = up then do
            if current = 1 then do
                if top = 1 then iterate
                else do
                    top = top - 1
                    call show
                    end
                end
            else do
                call w_put w1, current, 1, "", 2, attr
                current = current - 1
                item = top + current - 1
                call w_put w1, current, 1, "=>", 2, attr
                end
            end
        when key = pgdn then do
            if top + height > count then iterate
            else top = top + height
            if top + current - 1 > count
                then current = count - top + 1
            call show
            end
        when key = pgup then do
            if item = 1 then iterate
            if top <= height then top = 1
            else top = top - height
            call show
            end
        when key = ctrlpgup then do
            if item = 1 then iterate
            top = 1
            call show
            end
        when key = ctrlpgdn then do
            if count <= height then iterate
            top = count - height + 1
            call show
            end
        when key = esc then command_line = ''
        when key = enter then do
            if command_line = '' then iterate
            if command_line \= cmdstr then do
                command.cmdnum = command_line
                cmdpos = cmdnum
                cmdnum = cmdnum + 1
                end
            else if cmdnum > 0 then
                cmdpos = (cmdpos + 1) // cmdnum
            call execute
            end
        when key = pf1 then call help
        when key = pf2 then call shell
        when key = pf3 then leave
        when key = pf4 then do
            command_line = 'kedit'
            call execute
            end
        when key = pf5 then do
            command_line = 'copy / a:'
            call execute
            end
        when key = pf6 then do
            command_line = 'copy / b:'
            call execute
            end
        when key = pf7 then call mark
        when key = pf8 then call refresh
        when key = pf9 then do
            command_line = 'fb'
            call execute
            end
        when key = pf10 then do
            command_line = command.cmdpos
            if cmdpos > 0 then cmdpos = cmdpos - 1
            else if cmdnum > 0 then cmdpos = cmdnum - 1
            end
        when key = alt_pf10 then do
            if cmdnum > 0 then
                cmdpos = (cmdpos + 1) // cmdnum
            command_line = command.cmdpos
            end
        otherwise nop
        end
    end

level = level - 1
call w_close w0
return 0

/* show help information */
help: procedure expose attr height width
hw = w_open(1,1,height+3,width,attr)
help.1 = "Function key usage:"
help.2 = ""
help.3 = "   F1 - Help (this screen)"
help.4 = "   F2 - OS/2 command line"
help.5 = "   F3 - Exit from this level"
help.6 = "   F4 - Invoke KEDIT"
help.7 = "   F5 - Copy file(s) to A:"
help.8 = "   F6 - Copy file(s) to B:"
help.9 = "   F7 - Mark/unmark files"
help.10 = "   F8 - Refresh file list"
help.11 = "   F9 - File browser"
help.12 = "   F10 - Recall previous commands"
help.13 = ""
help.14 = "/ - Previous/next file"
help.15 = "PgUp/PgDn - Previous/next page"
help.16 = "Ctrl-PgUp/Ctrl-PgDn - Top/bottom page"
help.17 = ""
help.18 = "Press any key to continue"
do i = 1 to 18
    call w_put hw, i, 1, help.i
    end
call inkey
call w_close hw
return

/* invoke dos shell */
shell:
call save_screen
call clrscrn
parse var ctype a b .
call cursortype a, b
address cmd dosenv('comspec')
call restore_screen
call cursortype 32, 32
return

/* get a fresh list */
refresh:
call list_files filespec
if result \= 0 then
    return
call show
call w_put w0, 1, 77, right(count,4)
call disk_size
return

/* display disk space available */
disk_size:
call w_put w0, 1, 54, right(dosdisk('f',fmode)%1024,6)
return

/* mark a file */
mark:
if \mark.item then do
    mark.item = 1
    attr.item = reverse
    marked = marked + 1
    call w_attr w1, current, 3, length(file.item), reverse
    end
else do
    mark.item = 0
    attr.item = attr
    marked = marked - 1
    call w_attr w1, current, 3, length(file.item), attr
    end
return

/* execute a command */
execute:
if command_line = '' then return
parse var command_line verb rest
verb = alias(verb)
if verb = 'flist' then do
    call flist rest
    call show
    command_line = ''
    call w_put w2, 1, 1, "["level"]"
    return
    end
else if verb = 'quit' then do
    quit = 1
    return
    end
else if verb = 'run' then do
    command_line = rest
    end
call save_screen
call clrscrn
parse var ctype a b .
call cursortype a, b
prompt = prompt()
signal on halt
if marked = 0 then do
    cmd = substitute(command_line,item)
    say prompt||cmd
    address cmd cmd
    end
else do i = 1 to count
    if \mark.i then iterate
    cmd = substitute(command_line,i)
    say prompt||cmd
    address cmd cmd
    end
after_halt:
say ''
say 'Press any key to continue.'
call cursortype 32, 32
call inkey
call restore_screen
if marked > 0 then do
    marked = 0
    mark. = 0
    attr. = attr
    call show
    end
command_line = ''
return

/* handle control break */
/* this should be activated only from the 'execute' routine */
halt:
signal after_halt

/* parse command line & perform substitutions */
substitute: procedure expose file. fmode fpath
parse arg verb rest, item
if verb = '/' then do
    parse arg rest, item
    verb = ''
    end
tail = ''
state = 0
subst = 0
parse var file.item fn ft . 13 fsize fdate ftime fp .
do i = 1 to length(rest)
    c = lower(substr(rest,i,1))
    select
        when state = 0 then do
            if c = '/' then state = 1
            else tail = tail||c
            end
        when state = 1 then do
            select
                when c = 'n' then do
                    tail = tail||fn
                    subst = 1
                    end
                when c = 't' | c = 'e' then do
                    tail = tail||ft
                    subst = 1
                    end
                when c = 'd' | c = 'm' then do
                    tail = tail||fmode':'
                    subst = 1
                    end
                when c = 'p' then do
                    if fp \= '' then do
                        if substr(fp,2,1) = ':' then
                            fp = substr(fp,3)
                        tail = tail||fp
                        end
                    else
                        tail = tail||fpath
                    subst = 1
                    end
                when c == ' ' then do
                    if \subst then do
                        tail = tail||filename(item)||' '
                        subst = 1
                        end
                    else tail = tail||' '
                    state = 0
                    end
                when c = 'o' then do
                    subst = 1
                    state = 0
                    end
                otherwise do
                    tail = tail||c
                    state = 0
                    end
                end /* inner select */
            end /* do group */
        end /* outer select */
    end /* outer loop */

if \subst then do
    fname = filename(item)
    if tail \== '' then
        tail = tail fname
    else
        tail = fname
    end

verb = alias(verb)
return verb tail

/* compute a file name */
filename: procedure expose file. fmode fpath
arg item
parse var file.item fn ft . 13 fsize fdate ftime fp .
fileid = fn'.'ft
if fp \= '' then
    fileid = fp||fileid
else
    fileid = fmode':'||fpath||fileid
return fileid

/* expand the DOS prompt */
prompt: procedure
dos_prompt = dosenv('prompt')
ans = ''
do i = 1 to length(dos_prompt)
    c = substr(dos_prompt,i,1)
    if c \= '$' then do
        ans = ans||c
        iterate
        end
    if i = length(dos_prompt) then do
        ans = ans'$'
        leave
        end
    i = i + 1
    x = substr(dos_prompt,i,1)
    c = lower(x)
    select
        when c = '$' then s = '$'
        when c = 't' then do
            t = time()
            s = substr(t,1,2)//12||substr(t,3,8)
            end
        when c = 'd' then do
            d = date('s')
            s = substr(date('w'),1,3) substr(d,5,2)'-'substr(d,7,2)||,
                '-'substr(d,1,4)
            end
        when c = 'p' then s = dosdrive()':'doscd()
        when c = 'v' then s = dosversion()
        when c = 'n' then s = dosdrive()
        when c = 'g' then s = '>'
        when c = 'l' then s = '<'
        when c = 'b' then s = '|'
        when c = 'q' then s = '='
        when c = 'h' then s = '08'x
        when c = 'e' then s = '1b'x
        when c = '-' then s = '0d0a'x
        otherwise s = x
        end
    ans = ans||s
    end
return ans

/* compute a command alias */
alias:
word = lower(arg(1))
do i = 1 by 1 while symbol('abbr.i.name') = 'VAR'
    if word == substr(abbr.i.name,1,max(length(word),abbr.i.min))
        then return abbr.i.name
    end
return word

/* build the list of files */
list_files:
file. = ''
marked = 0
attr. = attr
mark. = 0
parse arg list '(' options
if list = '' then
    list = '*.*'
parsedname = parsefn(list)
if parsedname = '' then do
    call errormsg "Invalid file specification:" list
    return 1
    end
parse value lower(parsefn(list)) with fmode fpath fname ftype
if fmode = '-' then fmode = lower(dosdrive())
if fpath = '-' then fpath = lower(doscd(substr(fmode,1,1)))
if right(fpath,1) \= '\' then
    fpath = fpath||'\'
if fname = '-' then do
    fname = '*'
    ftype = '*'
    end
if ftype = '-' then
    ftype = '*'
filespec = fmode':'fpath||fname'.'ftype

/* scan options */
options = upper(options)
tree_option = 0
sort_option = 0
do i = 1 to words(options)
    opt = word(options,i)
    if abbrev('TREE',opt,2) then
        tree_option = 1
    else if abbrev('SORTD',opt,4) | abbrev('SORTA',opt,4) then
        sort_option = 1
    end

if \tree_option & dosdir(filespec) = '' then do
    call errormsg "Files not found:" filespec
    return 2
    end

if sort_option then
    sort = ''
else do
    if tree_option then
        sort = 'sort path sortd d'
    else
        sort = 'sortd d'
    end

call listfile filespec '(' sort options
count = file.0
if rc \= 0 then
    return 1
return 0

/* show the list of lists */
show:
call w_clear w1
do i = 1 to height
    index = top + i - 1
    call w_put w1, i, 3, file.index, , attr.index
    if i = current then
        call w_put w1, i, 1, "=>", , attr
    end
return

/* show error messages */
errormsg:
hline = height - 1
ew = w_open(4,5,4,60,error_attr)
if ew \= '' then do
    call w_border ew
    call w_put ew, 2, 3, arg(1)
    call w_put ew, 3, 3, 'Press any key to continue.'
    end
else do
    save1 = scrread(hline,1,width,'b')
    save2 = scrread(hline+1,1,width,'b')
    call scrwrite hline, 1, arg(1), width
    call scrwrite hline+1, 1, 'Press any key to continue.'
    end
call sound ,.5
call inkey
if ew \= '' then
    call w_close ew
else do
    call scrput hline, 1, save1, 'b'
    call scrput hline+1, 1, save2, 'b'
    end
return

/* simulate listfile command */
listfile: procedure expose file. rc
parse arg names '(' options
if names = '' then
    names = '*.*'
sorts = 0
sort_types = '/name /ext /size /date'
do i = 1 to words(options)
    opt = lower(word(options, i))
    select
        when opt = 'sort' | opt = 'sorta' then do
            if i = words(options) then
                break
            i = i + 1
            sorts = sorts + 1
            x = pos('/'lower(word(options, i)), sort_types)
            parse var sort_types =(x) '/' sortype .
            sort.sorts = sortype 'a'
            end
        when opt = 'sortd' then do
            if i = words(options) then
                break
            i = i + 1
            sorts = sorts + 1
            x = pos('/'lower(word(options, i)), sort_types)
            parse var sort_types =(x) '/' sortype .
            sort.sorts = sortype 'd'
            end
        otherwise nop
        end
    end
count = 0
do i = 1 to words(names)
    call filelist word(names, i), 'temp'
    do j = 1 to temp.0
        parse var temp.j dt tm sz at fid
        count = count + 1
        fspec = filespec('n', fid)
        x = lastpos('.', fspec)
        if x = 0 then do
            fn = fspec
            ft = ''
            end
        else do
            fn = left(fspec, x-1)
            ft = substr(fspec, x+1)
            end
        file.count = left(fn, 9) || left(ft, 4) || right(sz, 8) ||,
            '  'dt || '  'tm
        end
    end
file.0 = count

/* build an arglist for arraysort */
sortspec = ''
do i = 1 to sorts
    parse var sort.i type direction
    select
        when type = 'date' then
            sortspec = sortspec||'30,2,"'direction'","c",'||,
                                 '24,5,"'direction'","c",'||,
                                 '34,8,"'direction'","c",'
        when type = 'name' then
            sortspec = sortspec||'1,8,"'direction'","c",'||,
                                 '10,3,"'direction'","c",'
        when type = 'ext' then
            sortspec = sortspec||'10,3,"'direction'","c",'||,
                                 '1,8,"'direction'","c",'
        when type = 'size' then
            sortspec = sortspec||'14,8,"'direction'","c",'
        otherwise nop
        end
    end
interpret 'call arraysort "file",1,count,'strip(sortspec,'t',',')
rc = 0
return

/* make a list of files, with date, time, size, etc. */
filelist:
parse arg filespec, stem
n = 0
file = dosdir(filespec, 'dtsan', 'hs')
do while file \= ''
    n = n + 1
    call value stem'.n', file
    file = dosdir(, 'dtsan', 'hs')
    end
call value stem'.0', n
return

/* initialize data */
initialize:
/* determine current screen attribute */
call cursor 1, 1
old_char = scrread(1,1,1,'b')
call charout , ' '
new_char = scrread(1,1,1,'b')
call scrput 1, 1, old_char, 'b'
dosattr = c2d(substr(old_char,2))

quit = 0
esc = '1b'x
border = 14
reverse = 113
error_attr = 79         /* white on red */
enter = '0d'x
up = '0048'x
down = '0050'x
left = '004b'x
right = '004d'x
pgup = '0049'x
pgdn = '0051'x
ctrlpgup = '0084'x
ctrlpgdn = '0076'x
pf1 = '003b'x
pf2 = '003c'x
pf3 = '003d'x
pf4 = '003e'x
pf5 = '003f'x
pf6 = '0040'x
pf7 = '0041'x
pf8 = '0042'x
pf9 = '0043'x
pf10 = '0044'x
alt_pf10 = '0071'x
temp = dosenv('RAMDISK')||'$flist.tmp'

/* abbreviations */
abbr.1.name = 'fb'
abbr.1.min = 1
abbr.2.name = 'browse'
abbr.2.min = 1
abbr.3.name = 'kedit'
abbr.3.min = 1
abbr.4.name = 'flist'
abbr.4.min = 2
abbr.5.name = 'quit'
abbr.5.min = 1

return

/* initialize global variables */
main_init:
esc = '1b'x
attr = 31

/* key names */
keyname.1 = 'Help'
keyname.2 = 'Shell'
keyname.3 = 'Exit'
keyname.4 = 'Kedit'
keyname.5 = 'Copy A'
keyname.6 = 'Copy B'
keyname.7 = 'Mark'
keyname.8 = 'Refresh'
keyname.9 =  'FB'
keyname.10 = 'Recall'
return

/* save the current screen */
save_screen:
saved_screen = scrread(1,1,(height+3)*width,'b')
return 0

/* restore the screen */
restore_screen:
call scrput 1, 1, saved_screen, 'b'
return

/* clear the screen */
clrscrn:
call scrclear dosattr
call cursor 1, 1
return

/* dosmem - to support os/2 */
dosmem: procedure
return pcram() * 1024

/* load rxwindow package if required to */
load_rxwindow: procedure
call rxfuncdrop 'w_register'
call rxfuncadd  'w_register', 'rxwin30', 'rxwindow'
call w_register
return