home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The AGA Experience 2
/
agavol2.iso
/
software
/
utilities
/
icon_tools
/
opticon-1.8
/
opticon.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1978-06-28
|
8KB
|
309 lines
/*
* $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 */