/*

Code:       comm.rexx
Author:     Russell Leighton
Revision:   11 Jan 1996

Comments:   This is script used to perform file operations.  It is executed
when certain gadgets are selected in the muidir GUI.

*/

options results
signal on error

/* TAG ID definitions */

Draggable =                       0x80420b6e /* V11 isg BOOL              */
Dirlist_Directory =               0x8042ea41 /* V4  isg STRPTR            */
Dirlist_RejectIcons =             0x80424808 /* V4  is. BOOL              */
List_Quiet =                      0x8042d8c7 /* V4  .s. BOOL              */

/* TAG variable definitions */

TRUE = 1
FALSE = 0
List_Insert_Bottom = -3

parse arg portname comm' ['name']'

call pragma('Directory','muidir:')

address VALUE portname

comm = strip(comm)

group ID DIR REGISTER
ndir = result

select

/* copy the selected files from the source to destination directory */

    when index(comm,'COPY') = 1 then call copyfiles(3)

/* move the selected files from the source to destination directory */

    when index(comm,'MOVE') = 1 then do
        dirlist ID DIR||ndir ATTRS Dirlist_Directory
        sdir = import(d2c(result))
        dirlist ID DIR||(3-ndir) ATTRS Dirlist_Directory
        ddir = import(d2c(result))
        if substr(sdir,1,pos(':',sdir)) = substr(ddir,1,pos(':',ddir)) then
            copy = 1
        else copy = 2
        call copyfiles(copy)
    end

/* delete the selected files from the source directory */

    when index(comm,'DELETE') = 1 then do
        request ID MDIR TITLE '" "' GADGETS '"OK|Cancel"' "Delete selected entries?"
        if result = 1 then do
            do forever
                dirlist ID DIR||ndir
                sfile = result
                if sfile = '' then break
                address command 'delete > T:err "'sfile'" ALL QUIET'
                list ID HST INSERT POS List_Insert_Bottom STRING 'delete 'sfile' ALL QUIET'
                check ID ICN||ndir
                if result = '1' & exists(sfile'.info') then do
                    address command 'delete > T:err "'sfile'.info" ALL QUIET'
                    list ID HST INSERT POS List_Insert_Bottom STRING 'delete 'sfile'.info ALL QUIET'
                end
            end
            if exists('T:err') then address command 'delete T:err quiet'
            check ID ICN||ndir
            dirlist ID DIR||ndir REREAD ATTRS Dirlist_RejectIcons result
        end
    end

/* either display the selected files icon or change source to the selected 
   directory */

    when index(comm,'DIR') = 1 then do
        name = strip(name)
        if index(statef(name),'DIR') ~= 0 then do

/* the selected entry is a directory, so change to it */

            call changedir(name)
            exit
        end
        else do

/* otherwise, if the entry does not exist assume it is suppose to be a
directory and create it */

            if ~exists(name) then do
                address command 'makedir "'name'"'
                list ID HST INSERT POS List_Insert_Bottom STRING 'makedir 'name
                if rc = 0 then call changedir(name)
                exit
            end
            call defcomm portname name
        end
    end
    when index(comm,'ICON') = 1 then do
        name = strip(name)
        if lastpos('/',name) ~= 0 then file = substr(name,lastpos('/',name)+1)
        else file = substr(name,lastpos(':',name)+1)

/*      text ID NAM||ndir LABEL file */

        group ID GRP||ndir
            button ID IMG||ndir ICON deficon(name) COMMAND '"muidir:defcomm 'portname' %s"' ATTRS Draggable TRUE LABEL name
        endgroup
    end

/* clear the text icon and string */

    when index(comm,'CLEAR') = 1 then do
        group ID GRP||ndir
            image ID IMG||ndir ICON '""' LABEL ' '
        endgroup
    end
    when index(comm,'HCLEAR') = 1 then do
        list ID HST STRING
    end
    when index(comm,'HEXE') = 1 then do
        do forever

        /* get next entry */

            list ID HST
            line = result
            if line = '' then break

        /* execute entry */

            address command line' >T:err'
        end
        if exists('T:err') then address command 'delete T:err quiet'
    end

/* compile a list of files to copy from the source to destination directory */

    when index(comm,'CCOPY') = 1 then do

        /* clear the copy list */

        list ID CLST STRING

        /* get the source directory name */

        dirlist ID DIR||ndir ATTRS Dirlist_Directory
        sname = import(d2c(result))

        /* get the destination directory name */

        dirlist ID DIR||(3-ndir) ATTRS Dirlist_Directory
        dname = import(d2c(result))

        /* temporarily disable list update */

        list ID CLST ATTRS List_Quiet TRUE

        /* call the nextcopy procedure to process the current directory */

        call nextcopy sname';'dname

        /* update the copy list (i.e. display the contents) */

        list ID CLST ATTRS List_Quiet FALSE
    end

/* perform copy based on list of compiled files */

    when index(comm,'MCOPY') = 1 then do
        do forever

        /* get next entry */

            list ID CLST
            line = result
            if line = '' then break

        /* parse entry */

            parse var line sfile' -> 'dfile' ['flags']'

        /* execute copy */

            address command 'copy > T:err "'sfile'" to "'dfile'" 'flags' CLONE QUIET'
        end
        if exists('T:err') then address command 'delete T:err quiet'

        /* update dirlist */

        check ID ICN||(3-ndir)
        dirlist ID DIR||(3-ndir) REREAD ATTRS Dirlist_RejectIcons result
    end

/* compile a list of files to delete from the destination directory */

    when index(comm,'CDEL') = 1 then do

        /* clear the delete list */

        list ID DLST STRING

        /* get the source directory name */

        dirlist ID DIR||ndir ATTRS Dirlist_Directory
        sname = import(d2c(result))

        /* get the destination directory name */

        dirlist ID DIR||(3-ndir) ATTRS Dirlist_Directory
        dname = import(d2c(result))

        /* temporarily disable list update */

        list ID DLST ATTRS List_Quiet TRUE

        /* call the nextdel procedure to process the current directory */

        call nextdel sname';'dname

        /* update the delete list (i.e. display the contents) */

        list ID DLST ATTRS List_Quiet FALSE
    end

/* perform delete based on list of compiled files */

    when index(comm,'MDEL') = 1 then do
        do forever

        /* get next entry */

            list ID DLST
            line = result
            if line = '' then break

        /* parse entry */

            parse var line sfile' ['flags']'

        /* execute delete */

            address command 'delete > T:err "'sfile'" 'flags' QUIET'
        end
        if exists('T:err') then address command 'delete T:err quiet'

        /* update dirlist */

        check ID ICN||(3-ndir)
        dirlist ID DIR||(3-ndir) REREAD ATTRS Dirlist_RejectIcons result
    end

/* Edit selected files */

    when index(comm,'EDIT') = 1 then do
        getvar screen
        pub = result
        files = ''
        do forever
            dirlist ID DIR||ndir
            sfile = result
            if sfile = '' then break
            files = files' "'sfile'"'
        end
        address command 'ced -pubscreen='pub' 'files
    end

/* View selected files */

    when index(comm,'VIEW') = 1 then do
        files = ''
        do forever
            dirlist ID DIR||ndir
            sfile = result
            if sfile = '' then break
            files = files' "'sfile'"'
        end
        address command 'tools:graphics/PicassoII/Viewer/IntuiView now'files
    end

/* Make icons for selected files */

    when index(comm,'ICON') = 1 then do
        files = ''
        do forever
            dirlist ID DIR||ndir
            sfile = result
            if sfile = '' then break
            files = files' "'sfile'"'
        end
        address command 'tools:graphics/Picticon/Picticon ADDICON=YES CHUNKYMODE=YES FREE_ICON_POS=YES NEWICON=YES OVERWRITE=YES QUIET=YES TEMPLATE_ICON=tools:graphics/Picticon/envsys/def_picture'files
    end

/* Execute selected files */

    when index(comm,'EXECUTE') = 1 then do
        do forever
            dirlist ID DIR||ndir
            sfile = result
            if sfile = '' then break
            address command sfile
        end
    end
end

exit

/* procedure to change the source dirlist directory */

changedir:
parse arg name

    dirlist ID DIR||ndir ATTRS Dirlist_Directory
    if result = 0 then dirname = ''
    else dirname = import(d2c(result))

/* if the name is empty then set directory to RAM: */

    if strip(name) = '' then name = 'RAM:'

/* if the name is the currently displayed directory then just reread it */

/*
    if name = dirname then do
        check ID ICN||ndir
        dirlist ID DIR||ndir REREAD ATTRS Dirlist_RejectIcons result
        return
    end
*/

/* if the name is a / then get parent directory */

    if index(name,'/') = 1 then do
        if lastpos('/',dirname) ~= 0 then name = substr(dirname,1,lastpos('/',dirname)-1)
        else name = substr(dirname,1,lastpos(':',dirname))
    end

/* if the name is not a directory then extract directory name */

    if index(statef(name),'DIR') = 0 then do
        if lastpos('/',name) ~= 0 then name = substr(name,1,lastpos('/',name)-1)
        else name = substr(name,1,lastpos(':',name))
    end

/* determine volume name and percentage full */

    vol = substr(name,1,pos(':',name))
    address command 'assign >pipe: exists "'vol'"'
    call open('pipe','pipe:','R')
    line = readln('pipe')
    call close('pipe')
    parse var line vname aname
    aname = strip(aname)
    if index(aname,'[Mounted]') = 1 then vname = vname':'
    else do
        if aname = '' then vname = vol
        else vname = substr(aname,1,lastpos(':',aname))
    end
    address command 'info >pipe: 'vname
    call open('pipe','pipe:','R')
    line = readln('pipe')
    line = readln('pipe')
    line = readln('pipe')
    line = readln('pipe')
    parse var line unit size used free full errs status vname
    do until eof('pipe')
        line = readln('pipe')
    end
    call close('pipe')

    if lastpos('/',name) = length(name) then name = substr(name,1,length(name)-1)

/* set appropriate gadgets with information */

    text ID TXT||ndir LABEL strip(vname)'  'full' full'
    string ID SRC||ndir CONTENT name
    check ID ICN||ndir
    dirlist ID DIR||ndir PATH '"'name'"' ATTRS Dirlist_RejectIcons result
    group ID REG REGISTER LABEL "Directory"
    list ID LST NODUP INSERT STRING name
return

/* procedure to copy, rename, or move files from source to destination */

copyfiles:
parse arg type

dirlist ID DIR||(3-ndir) ATTRS Dirlist_Directory
ddir = import(d2c(result))
if lastpos('/',ddir) ~= length(ddir) then do
    if lastpos(':',ddir) ~= length(ddir) then ddir = ddir'/'
end

do forever

/* find next selected file */

    dirlist ID DIR||ndir
    sfile = result

/* if there is no selected file then reread dirlist and return */

    if sfile = '' then do
        check ID ICN||ndir
        flag = result
        dirlist ID DIR||ndir REREAD ATTRS Dirlist_RejectIcons flag
        dirlist ID DIR||(3-ndir) REREAD ATTRS Dirlist_RejectIcons flag
        return
    end
    if lastpos('/',sfile) ~= 0 then dfile = ddir||substr(sfile,lastpos('/',sfile)+1)
    else dfile = ddir||substr(sfile,lastpos(':',sfile)+1)

/* if the file exists at the destination then put up a requester to allow
the user to decide on the action */

    if exists(dfile) & (type > 0) then do
        request ID MDIR TITLE '" "' GADGETS '"_OK|_ALL|_SKIP|_CANCEL"' '\033bFile already exists!\033n Do you wish to overwrite?'
        select
            when result = 0 then return
            when result = 1 then nop
            when result = 2 then type = 0-type
            when result = 3 then iterate
            otherwise return
        end
    end

    if type < 0 then ctype = 0 - type
    else ctype = type

    call file portname ndir ctype sfile';'dfile
end
return

/* this procedure is used to determine names of files and directories to be
   copied.  It is called recursivily to traverse directory trees. */

nextcopy: procedure
parse arg sname';'dname

sname = strip(sname)
dname = strip(dname)
if sname = '' | dname = '' then return

/* get list of entries in source directory */

slist = showdir(sname,'ALL',';')

if lastpos('/',sname) ~= length(sname) then do
    if lastpos(':',sname) ~= length(sname) then sname = sname'/'
end
if lastpos('/',dname) ~= length(dname) then do
    if lastpos(':',dname) ~= length(dname) then dname = dname'/'
end

/* process each entry */

do while slist ~= ''
    parse var slist sfile';'slist

/* assemble full path names for source and destination files */

    dfile = dname||sfile
    sfile = sname||sfile

/* get file information */

    state = statef(sfile)
    parse var state type size blocks protect s1 s2 s3 .

/* create time numerical stamp */

    sstamp = right(s1,4,'0')||right(s2,4,'0')||right(s3,4,'0')

/* if destination file exists then do the following */

    if exists(dfile) then do

/* if entry is a directory then recursivily call this routine with the
   subdirectory name as the argument */

        if index(type,'DIR') then call nextcopy sfile';'dfile

/* else compare the destination time stamp to the source */

        else do
            state = statef(dfile)
            parse var state type size blocks protect s1 s2 s3 .
            dstamp = right(s1,4,'0')||right(s2,4,'0')||right(s3,4,'0')

/* if the source file is newer then add entry to copy list */

            if sstamp > dstamp then do
                list ID CLST INSERT POS List_Insert_Bottom STRING sfile '->' dfile' [] *'
            end
        end
    end

/* if destination file does not exist then add entry to copy list */

    else do
        if index(type,'DIR') then list ID CLST INSERT POS List_Insert_Bottom STRING sfile '->' dfile' [ALL]'
        else list ID CLST INSERT POS List_Insert_Bottom STRING sfile '->' dfile' []'
    end
end
return

/* this procedure is used to determine names of files and directories to be
   deleted.  It is called recursivily to traverse directory trees. */

nextdel: procedure
parse arg sname';'dname

sname = strip(sname)
dname = strip(dname)
if sname = '' | dname = '' then return

/* get list of entries in destination directory */

dlist = showdir(dname,'ALL',';')

if lastpos('/',sname) ~= length(sname) then do
    if lastpos(':',sname) ~= length(sname) then sname = sname'/'
end
if lastpos('/',dname) ~= length(dname) then do
    if lastpos(':',dname) ~= length(dname) then dname = dname'/'
end

/* process each entry */

do while dlist ~= ''
    parse var dlist dfile';'dlist

/* assemble full path names for source and destination files */

    sfile = sname||dfile
    dfile = dname||dfile

/* get file information */

    state = statef(dfile)
    parse var state type size blocks protect stamp

/* if source file exists then do the following */

    if exists(sfile) then do

/* if entry is a directory then recursivily call this routine with the

   subdirectory name as the argument */
        if index(type,'DIR') then call nextdel sfile';'dfile
    end

/* else add the file or directory to the delete list */

    else do
        if index(type,'DIR') then list ID DLST INSERT POS List_Insert_Bottom STRING dfile' [ALL]'
        else list ID DLST INSERT POS List_Insert_Bottom STRING dfile' []'
    end
end
return

/* if an error occurs then display it */

error:
    if exists('T:err') then do
        call open('err','T:err')
        err = readln('err')
        call close('err')
        address command 'delete T:err quiet'
        request ID MDIR TITLE '" "' GADGETS '"OK"' err
    end
exit