/*
 *  $VER: $Id: opticon.rexx,v 1.3 1994/07/17 22:41:17 tf Exp $
 */

/*
 * (c)Copyright 1994 by Tobias Ferber
 *
 * This file is part of the Icon2C and OptIcon distribution.
 *
 * Icon2C and OptIcon are free software; you can redistribute them and/or
 * modify them under the terms of the GNU General Public License as published
 * by the Free Software Foundation; either version 1 of the License,
 * or (at your option) any later version.
 *
 * Icon2C and Opticon are distributed in the hope that they will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with these programs; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 */

OPTIONS FAILAT 10

pathname = ""
destpath = ""
planes   = 0
pattern  = "#?.info"
tempfile = "T:OptIconTemp." || pragma('Id')
template = "FROM/K/A,TO/K,ALL/S,PAT/K,DEPTH=PLANES/K/A,NOEXPAND/S"
args     = ""
cliopts  = ""
optiargs = ""
lsargs   = ""

/* parse args */

IF ( ARG() < 1 ) | ( (ARG() = 1) & ARG(1)= '?' )  THEN DO
  OPTIONS PROMPT template': '
  PARSE PULL args
  END
ELSE DO n=1 FOR ARG() /* RXFB_TOKEN for RX ?! */
  ARGS= ARGS || ARG(n)
  END

DO WHILE WORDS(args) > 0
  av= next_arg()
  SELECT

    /* script args */

    WHEN UPPER(av) = "FROM" THEN DO
      IF WORDS(args) > 0 THEN DO
        pathname= next_arg()
        IF WORDS(pathname) < 1 THEN pathname= PRAGMA('D')
        END
      ELSE EXIT bad_args("Missing pathname after FROM keyword")
      END /* FROM */

    WHEN UPPER(av) = "TO" THEN DO
      IF WORDS(args) > 0 THEN DO
        destpath= next_arg()
        IF WORDS(destpath) < 1 THEN destpath= PARGMA('D')
        END
      ELSE EXIT bad_args("Missing pathname after TO keyword")
      END /* TO */

    /* OptIcon args */

    WHEN (UPPER(av) = "DEPTH") | (UPPER(av) = "PLANES") THEN DO
      IF WORDS(args) > 0 THEN planes= next_arg()
      ELSE EXIT bad_args("Missing #of bitplanes " UPPER(av) "keyword")
      IF (LENGTH(planes) > 1) | (LENGTH(COMPRESS(planes,"12345678")) > 0) THEN
        EXIT bad_args("Illegal #of bitplanes:" planes "Should be one of 1,2,...,8.")
      END /* DEPTH=PLANES */

    WHEN UPPER(av) = "NOEXPAND" then optiargs = "NOEXPAND"

    /* List args */

    WHEN UPPER(av) = "ALL" THEN DO
      IF POS("ALL",lsopts) < 1 THEN lsargs = lsargs || " ALL"
      END /* ALL */

    WHEN UPPER(av) = "PAT" THEN DO
      IF WORDS(args) > 0 THEN pattern= next_arg()
      ELSE EXIT bad_args("Missing pattern after PAT keyword")
      END /* PAT */

    /* illegal args */

    OTHERWISE DO
      IF av ~= '?' THEN EXIT bad_args("Unknown keyword" av)
                   ELSE EXIT bad_args("")
      END

  END /* SELECT */

END /* DO */

IF planes = 0 THEN EXIT bad_args("Missing #of bitplanes for DEPTH=PLANES/K/A")

CALL PRAGMA('W','N')

/* try to get missing pathname */

IF (WORDS(pathname) < 1) & (EXISTS('c:RequestFile')) THEN DO
  cwd= PRAGMA('D')
  ADDRESS COMMAND 'RequestFile >' tempfile 'DRAWER "'cwd'" TITLE "Select a path..." DRAWERSONLY NOICONS'

  IF OPEN('fp',tempfile,'R') THEN DO
    pathname= STRIP(READLN('fp'),'B','"')
    CALL CLOSE('fp')
    ADDRESS COMMAND 'Delete QUIET FILE' tempfile
    END
  ELSE pathname= ""
  END

IF WORDS(pathname) < 1 THEN EXIT bad_args("missing FROM pathname")

IF ~EXISTS(pathname) THEN DO
  SAY 'Failed to locate your FROM path "'pathname'"'
  EXIT 10
  END

/**/

IF ~canexist(destpath) THEN DO
  SAY 'Illegal destination directory "'destpath'"'
  EXIT 10
  END

/**/

SAY 'Collecting icons ...  Please wait ...'

cwd= PRAGMA('D',pathname)
ADDRESS COMMAND 'List FILES PAT' pattern 'LFORMAT "%p%n"' lsargs 'TO "'tempfile'"'
CALL PRAGMA('D',cwd)

SIGNAL ON HALT
SIGNAL ON BREAK_C
SIGNAL ON BREAK_D

IF ~OPEN('fp',tempfile,'R') THEN DO
  SAY 'Error: could not open temporary file "'tempfile'"'
  EXIT 10
  END

DO UNTIL EOF('fp')
  fname= STRIP( READLN('fp') )
  IF WORDS(fname) > 0 THEN DO
    fromfile= tackon(pathname,fname)

    IF WORDS(destpath) > 0 THEN DO
      pname= tackon(destpath,pathonly(fname))

      IF ~EXISTS(pname) & canexist(pname) THEN DO
        IF POS('m',cliopts) > 0 THEN CALL makepath(pname)
        ELSE DO
          OPTIONS PROMPT 'Destination path "'pname'" does not exist.  Shall I create it? (Y/n/a) '
          PULL yna
          IF LEFT(yna,1) ~= 'N' THEN DO
            CALL makepath(pname)
            IF LEFT(yna,1) = 'A' THEN cliopts = cliopts || 'm'
            END
          END
        IF EXISTS(pname) THEN SAY pname '  [created]'
        END

      IF EXISTS(pname) THEN DO
        iconfile= tackon(destpath,fname)
        /*SAY 'Copying' fname 'TO' iconfile*/
        ADDRESS COMMAND 'Copy QUIET FROM' transquote(fromfile) 'TO' transquote(iconfile)
        END

      ELSE DO
        SAY 'No such directory "'pname'" ... ' fileonly(fname) 'skipped.'
        iconfile= ""
        END

      END
    ELSE iconfile= fromfile

    IF WORDS(iconfile) > 0 THEN DO
      SAY '  ' iconfile
      ADDRESS COMMAND 'OptIcon NAME' transquote(iconfile) 'PLANES' planes optiargs
      END

    END

  END /* DO */

CALL CLOSE('fp')
ADDRESS COMMAND 'DELETE QUIET FILE "'tempfile'"'
SAY 'done.'
EXIT

/**/

bad_args: PROCEDURE EXPOSE template
  PARSE ARG str
  IF WORDS(str) > 0 THEN SAY str
  SAY "Template:" template
  SAY "Usage: rx Opticon.rexx FROM <pathname> [TO <destpath>] [ALL] [PAT <pattern>] PLANES [1..8] [NOEXPAND]"
  RETURN 10

/*@*/

/* get the next command-line argument from global 'args' string */

next_arg: PROCEDURE EXPOSE args
  args= STRIP(args)
  IF LEFT(args,1) = '"' THEN PARSE VAR args '"' a '"' args
                        ELSE PARSE VAR args     a     args
  RETURN STRIP(a,'b','"');


/* translate '"' into '*"' and '*' into '**' */

transquote: PROCEDURE
  PARSE ARG s
  t= s
  q= MAX( LASTPOS('*',s), LASTPOS('"',s) )
  DO WHILE q > 0
    t= INSERT('*',t,q-1,1)
    s= LEFT(s,q-1)
    q= MAX( LASTPOS('*',s), LASTPOS('"',s) )
    END
  RETURN '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: PROCEDURE
  PARSE ARG path
  IF (WORDS(path) > 0) & (RIGHT(path,1) ~= ':') THEN DO
    IF RIGHT(path,1) = '/' THEN path= LEFT(path,LENGTH(path)-1)
    IF LASTPOS('/',path) > LASTPOS(':',path) THEN path= LEFT(path,LASTPOS('/',path)-1)
                                             ELSE path= LEFT(path,LASTPOS(':',path))
    END
  RETURN path


/* return the file part of a pathname */

fileonly: PROCEDURE
  PARSE ARG path
  IF RIGHT(path,1) = '/' THEN PATH= LEFT(path,LENGTH(path)-1)
  p= MAX( LASTPOS(':',path), LASTPOS('/',path) )
  IF(p>0) THEN RETURN substr(path,p+1)
          ELSE RETURN path


/* concatenate the filename to the pathname and return the resulting string */

tackon: PROCEDURE
  PARSE ARG path,file
  DO WHILE LEFT(file,1) = '/'
    file= SUBSTR(file,2)
    path= pathonly(path)
    END
  IF (WORDS(path) > 0) & (RIGHT(path,1) ~= '/') & (RIGHT(path,1) ~= ':') THEN path= path || '/'
  IF (RIGHT(file,1) = '/') THEN file= LEFT(file,LENGTH(file)-1)
  RETURN path || file


/* create all non-existant directories in a path */

makepath: PROCEDURE
  PARSE ARG path
  IF RIGHT(path,1) = '/' THEN path= LEFT(path,LENGTH(path)-1)
  IF ~EXISTS(path) THEN DO
    CALL makepath( pathonly(path) )
    ADDRESS COMMAND 'MakeDir NAME "'path'"'
    END
  RETURN 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: PROCEDURE
  PARSE UPPER ARG path
  IF POS(':',path) < 1 THEN RETURN 1 /* current device */
  CALL PRAGMA('W','N')
  RETURN EXISTS( LEFT(path,LASTPOS(':',path)) )


/* break traps */

HALT:
BREAK_C:
BREAK_D:
  SIGNAL OFF HALT
  SIGNAL OFF BREAK_C
  SIGNAL OFF BREAK_D

  SAY 'Execution halted.'
  EXIT


/* EOF */