/*

                  $VER: MM_DeleteAreas.rexx 0.21  (28.03.96)

                            (C) 1996 Robert Hofmann

*/

parse arg opts

options cache
options failat 99
options results

signal on break_c
signal on break_d
signal on break_e
signal on break_f
signal on halt
signal on ioerr
signal on syntax

address 'MAILMANAGER'


Main:

	call Init
	call Header
	call Parse_Args(opts)
	call Delete_Areas

call Quit(0, 'All done.')
exit


break_c:; break_d:; break_e:; break_f:; halt:

	signal off break_c
	signal off break_d
	signal off break_e
	signal off break_f
	signal off halt

	return_code		=	5
	error_line    = 0
	error_msg			= 'Execution halted!!!'
	rc						= 0
signal Exit


Command: procedure Expose system.

	parse arg cmd

	address command cmd

	if rc>5 then call Log('*** ERROR: Command "'strip(cmd)'" returned' rc'.', 1)
return rc


Delete_Areas: procedure Expose system.

	if ~system.arg.noreq then Show

	MM_Free

	call Log(' Analysing areas to remove...')

	tmp 		= system.arg.area
	delete	= ''

	do while tmp~=''
		parse var tmp area tmp

		if ~Get_AreaInfo(area) | system.arg.force then delete = delete area
	end

	tmp.    = 0

	if system.arg.file~='' then
		do
			call Log(' Reading arealist from file' system.arg.file'...')

			MM_ReadStem system.arg.file 'tmp'
			if RC~=0 then call Quit(23, 'Unable to open' system.arg.file 'for read!!!')
		end

	do n=0 to tmp.count-1
		parse var tmp.n tmp.n .
		tmp.n	= strip(tmp.n, 'l', '+- ')

		if ~Get_AreaInfo(tmp.n) | system.arg.force then delete = delete tmp.n
	end

	upper delete


	call Log(' Deleting areas from' system.oldcfg'...')

	if ~open(oldcfg, system.oldcfg, 'r') then
		call Quit(21, 'Unable to open' system.oldcfg 'for read!!!')

	if ~open(newcfg, system.newcfg, 'w') then
		call Quit(22, 'Unable to open' system.oldcfg 'for write!!!')


	typ	= ''

	if system.arg.echo	then typ = typ 'ECHO'
	if system.arg.fecho	then typ = typ 'FECHO'
	if system.arg.tick	then typ = typ 'TICK'

	do l=1 while ~eof(oldcfg)
		line	= strip(readln(oldcfg))

		if left(line, 1)~='#' then
			do
				call writeln(newcfg, line)
				iterate
			end

		parse value upper(translate(line, ' ', '9'x)) with . '#' key 'AREA' rest
		if key~='TICK' then parse var rest . '"' . '"' area .
		else								parse var rest area .

		if key='' | find(typ, key)=0 | find(delete, upper(area))=0 then
			do
				call writeln(newcfg, line)
				iterate
			end

		delall	= system.arg.all & key~='TICK'
		rm			= 1

		call Get_Areainfo(area)

		if ~system.arg.noreq then
			do
				if length(strip(area.desc))>2	then	tmp.1 = area.desc'\n'
				else																tmp.1	= ''

				if delall											then	tmp.2	= '\n('area.path' will also be deleted!)'
				else																tmp.2	= ''

				txt = '\c\nShall I delete the' area.type'-area\n\n'area'\n'tmp.1'\nfrom your configuration?'tmp.2
				ret = Request_Choice(txt, ' _NO  | _QUIT | _ALL |* _YES ', '0 3 2 1')

				select
					when ret=0 then rm = 0
					when ret=1 then rm = 1
					when ret=2 then
						do
							system.all				= 1
							system.arg.noreq	= 1
							rm								= 1
						end
					when ret=3 then call Quit(5, 'Aborted by user.')
					otherwise exit 999
				end
			end

		if rm then
			do
				call Log('  Deleting area' area)

				do while strip(readln(oldcfg))~=''; end

				if delall then
					do
						call Log('  Deleting dir ' area.path)
						if exists(area.path) then call Command('c:delete' area.path 'all quiet force noreq')
					end
			end
		else call writeln(newcfg, line)
	end

	call close(oldcfg)
	call close(newcfg)

	if system.all then system.arg.noreq = 0

	if system.arg.replace then
		do
			rep	= 1

			if ~system.arg.noreq then rep	= Request_Choice('\c\nShall I replace the',
				'configuration-file\n\n'system.oldcfg'\n\nwith\n\n'system.newcfg'\n\n???',,
				' _NO  |* _YES ', '0 1')

			if ~rep then break

			call Log(' Replacing' system.oldcfg 'with' system.newcfg'...')

			MM_MoveFile system.oldcfg system.oldcfg
			MM_MoveFile system.newcfg system.oldcfg

			call Log(' Reloading config...')

			MM_LoadCfg
		end

	if ~system.arg.noreq then call Request_Choice('   All done.   ', '* _Ok ', '0')

return


Exit:

	select
		when return_code>=40 then error = 'INTERNAL-ERROR:'
		when return_code>=30 then error = 'IO-ERROR:'
		when return_code>=20 then error = 'ERROR:'
		when return_code>=10 then error = 'WARNING:'
		when return_code>=5  then error = 'INFO:'
		otherwise									error = ''
	end

  call Log()
	call Log('***' strip(error error_msg) '***', '+')
	call Log(,'\')

	call setclip('MM_LogPre', system.mm.logpre)

	MM_CloseLog

exit return_code


Expand_Path: procedure

	parse arg path

	if pos(':', path)+pos('/', path)=0 then path = path(pragma('d')) || path

return path


Get_AreaInfo: procedure Expose system. area.

	parse arg area

	MM_GetAreainfo area 'area'

	if RC~=0 then call Log('  Area' area 'does not exist!')

return RC~=0


Get_Arg: procedure Expose args system.

  arg keyword, mode, old

	uargs	= upper(args)
	p			= find(uargs, keyword)

	if p=0	then
		do
			p = pos(' 'keyword'=', ' 'uargs)

			if p>0 then	args	= overlay(' ', args, p+length(keyword))

      p = find(upper(args), keyword)
		end

	system.cmdopt.keyword	= p>0

	select
		when mode=0	then
			if p>0 then
				do
					ret		= 1
					args	= delword(args, p, 1)
				end
			else ret	= old

		when mode=1 then
			if p>0 then
				do
					left	= subword(args, 1, p-1)
					rest	= subword(args, p+1)

					if left(rest, 1)='"' then	parse var rest . '"'	ret '"'	rest
					else											parse var rest				ret			rest

					args	= strip(left strip(rest))
				end
			else ret	= old

		when mode=2 then
			do
				if left(args, 1)='"'	then	parse var args . '"'	ret '"'	args
				else												parse var args				ret 		args

				if strip(ret)=''			then	ret = old
			end

		otherwise exit 99
	end

	args	= strip(args)
	ret		= strip(ret, 'b', '" ')

return ret


Get_Version: procedure

	parse arg mode

	parse value sourceline(3-mode) with . . ver .
	parse var ver tst 'ß' .

	if ~datatype(strip(tst, 'b', '/ce '), 'N') then
		if ~mode then ver = Get_Version(1)
		else exit 99

return ver


Header:

	call Log(,'/')
	call Log('***' system.prg.id '***', '+')
	call Log('  'system.prg.cr)
	call Log()

return


Init:

	system.						= 0

	MM_GetTaskPri				'system.taskpri'
	call								pragma('p', system.taskpri)

	system.prg.ver		= Get_Version(0)
	system.prg.name		= 'MM_DeleteAreas'
	system.prg.id			= system.prg.name 'v'system.prg.ver
	system.prg.cr			= '(C) 1996 Robert Hofmann'
	system.mm.logpre  = getclip('MM_LogPre')
	system.prg.logpre = system.mm.logpre'|'
	system.cmdopts		= 'CFG/K/A,NEWCFG/K,AREA/K/M,FILE/K,ECHO/S,FECHO/S,TICK/S,NOREQ/S,REPLACE/S,FORCE/S'
	system.status			= ''
	call               	setclip('MM_LogPre', system.prg.logpre)

	call Include_Lib('rexxsupport')
return


Include_Lib: procedure Expose system.

	parse arg lib, prio
	if right(upper(lib), 8)~='.LIBRARY' then lib	= lib'.library'
	if prio=''													then prio	= 0

	if ~show('l', lib) then
		if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!')

return


IOerr:

	signal off ioerr

	return_code		= 20
	error_line    = sigl
	error_msg			= 'IO-error' rc 'at line' sigl '['errortext(rc)']')
	rc						= 0
signal Exit


Log: procedure Expose system.

	parse arg text, pre

	tmp		= word('PRG MM', (pre~='')+1)
	text	= system.tmp.logpre || pre' 'text

	MM_WriteLog 'text' '2'
return


Parse_Args: procedure Expose system.

	parse arg args

	tpl		= system.cmdopts',?/S'
	args	= translate(args, ' ', '9'x)

	pk		= pos('/K', tpl)
	ps		= pos('/S', tpl)

	select
		when pk=0	& ps=0	then	p	= 0
		when pk=0 & ps>0	then  p	= ps
		when ps=0 & pk>0	then	p	= pk
		otherwise								p	= min(pk, ps)
	end

	p			= lastpos(',', left(tpl, p))
	tpl		= substr(tpl',', p+1) || left(tpl, max(p-1, 0))

	do while tpl~=''
		parse var tpl template ',' tpl
		parse var template keyword '/' .

		bool	= pos('/S',	template)>0
		key		= pos('/K', template)>0
		must	= pos('/A', template)>0
		num		= pos('/N', template)>0

		select
			when must then		system.arg.keyword	= '0'x
			when bool	then		system.arg.keyword	= 0
			when num	then		system.arg.keyword	= 0

			otherwise					system.arg.keyword	= ''
		end

		if bool | key	then	mode	= ~bool
		else								mode	= 2

		system.arg.keyword	= Get_Arg(keyword, mode, system.arg.keyword)

		if keyword='?' & system.arg.keyword=1 then leave

		if must & system.arg.keyword='0'x then
			do
				tmp	= template 'missing!!!'

				say
				say ' ***' tmp '***'

				signal Usage
			end

		if num & ~datatype(system.arg.keyword, 'N') then
			if ~must & system.arg.keyword='' then	system.arg.keyword	= 0
			else
				do
					tmp	= 'Numeric value expected for' template', but is "'system.arg.keyword'"!!!'

					say
					say ' ***' tmp '***'

					signal Usage
				end
	end

	tmp	= '?'; if system.arg.tmp then signal Usage

	if args~='' then call Quit(10, 'Unknown option(s):' args)


	if system.arg.replace & system.arg.newcfg='' then system.arg.newcfg = system.arg.cfg'.new'

	if system.arg.file~='' then system.arg.file	= Expand_Path(system.arg.file)
	system.newcfg	= Expand_Path(system.arg.newcfg)
  system.oldcfg	= Expand_Path(system.arg.cfg)

	if ~exists(system.oldcfg)		then call Quit(30, system.oldcfg 'does not exist!')

	if ~system.arg.force then
		if exists(system.newcfg)	then call Quit(31, system.newcfg 'does already exist!')

	if system.arg.echo+system.arg.fecho+system.arg.tick=0 then signal Usage

return


Path: procedure

   parse arg path

   if right(path,1) ~= '/' & right(path,1) ~= ':' then path = path'/'

return path


Quit:

	parse arg return_code, error_msg

	error_line    = 0
	rc						= 0
signal Exit


Replace: procedure

	parse arg string, new, old

	do while index(string, old) ~= 0
		interpret "parse var string l '"old"' r"
		string = l || new || r
	end

return string


Request_Choice: procedure Expose system.

	parse arg text, buttons, ret_vals

	title	= system.prg.name'-Requester'
	text	= translate(Replace(text, '0A'x, '\n'), '1b'x, '\')

	if length(text)<40 then text = center(text, 40)

	MM_Requester title 'text' 'buttons'

	if rc=0 then rc=words(ret_vals)

return compress(word(ret_vals, rc), '_')


Syntax:

	signal off syntax

	return_code		= 40
	error_line    = sigl
	error_msg			= 'Syntax-error' rc 'at line' sigl '['errortext(rc)']'
	rc						= 0
signal Exit


Usage:

	rx.			= ''
	rx.0.0	= '[rx] '
	rx.0.1	= '[.rexx]'
	m				=	pos('/e', system.prg.ver)>0

	say
	say 'Usage:' rx.m.0 || system.prg.name || rx.m.1 system.cmdopts
	say
call Quit(0, 'Usage requested...')