/* XPKCed.ced */
/*************************************************************************
** $VER: XPKCed.ced 1.1 (16.12.97)					**
**									**
** Copyright ©1996 Frédéric Delacroix, FreeWare				**
**									**
** This ARexx script handles XPK-crunched files from within Cygnus-Ed	**
** 3.5 (not tested with other versions of CED). This way you will be	**
** able to open and save XPK files.					**
**									**
** This program requires rexxxpk.library and rexxreqtools.library.	**
**	rexxxpk.library is ©1996 Frédéric Delacroix			**
**	rexxreqtools.library is ©1992-1993 Rafael D'Halleweyn		**
** If the "List packers" option is to be used in the string requester,	**
** you need the "RequestList" command (or compatible), which is		**
** copyright ©1995 Adam Dawes.						**
**									**
** Installation:							**
**	copy XPKCed.ced to REXX: and be sure RexxMast was launched	**
**	before using this program (this should have been done at	**
**	startup). Copy the rexxxpk.library to LIBS:.			**
**									**
**	It's quite useful to bind a key to this program. I personnally	**
**	did bind right amiga ` to XPKCed GUI (defined as a CEd macro).	**
**	If you want, you can replace (with this method) the keyboard	**
**	shortcuts of Ced's menus (Open, Save, Save as, etc.) with calls **
**	to this macro with corresponding arguments. I don't do this	**
**	personnally.							**
**									**
** Usage (launched from Cygnus-Ed):					**
**									**
**  _ XPKCed GUI							**
**	presents you with a reqtools requester for you to select what	**
**	to do: OPEN, INCLUDE, SAVE, SAVEAS or SAVEQUIT. A status (as	**
**	produced by XPKCed STATUS) is also shown in the requester.	**
**									**
**  _ XPKCed OPEN [Password]						**
**	will open a (possibly) crunched file. The password will be used	**
**	if the file is crypted. If the file is crypted and no password	**
**	is given a requester will appear.				**
**									**
**  _ XPKCed INCLUDE [Password]						**
**	will include a file into the current one, automatically		**
**	handling XPK compression.					**
**									**
**  _ XPKCed SAVE [Packer[.efficiency] [Password]]			**
**	will save the file with its previous name, crunched with the	**
**	mentionned packer. The password, if given, will be used to	**
**	encrypt the data, provided the packer supports encryption.	**
**									**
**  _ XPKCed SAVEAS [Packer[.efficiency] [Password]]			**
**	does the same as SAVE, except that a file requester appears for	**
**	you to select the name of the file to save to.			**
**									**
**  _ XPKCed SAVEQUIT [Packer[.efficiency] [Password]]			**
**	same as SAVE, except that Ced will quit after saving the file.	**
**									**
**  _ XPKCed STATUS							**
**	displays a requester displaying XPK information about the last	**
**	XPKCed operation.						**
**									**
** WARNINGS:								**
**	1) The filenotes are used to store important data.		**
**	2) If you open a crunched file, it is first decrunched on disk, **
**	   so there should be enough room (but it won't cause damage if **
**	   you don't since the original file is only overwritten if the **
**	   XPK operation succeeds. Remember to save the file again      **
**	   even if you didn't modify it, or else it will remain		**
**	   in uncompressed form.
**									**
** History:								**
**	1.00 (16.10.96) - hardly released at all, just a personnal tool **
**			  for my everyday Amiga use :-)			**
**	1.01 (16.12.97) - well, 14 months later! Isn't that sustained	**
**			  development ? :-) I just fixed a small bug    **
**			  and added some documentation.			**
**			  It might be about time for the first aminet	**
**			  release...					**
**									**
** THIS PROGRAM IS FREEWARE, MEANING THAT IT IS OFFERED TO YOU AS A	**
** GIFT, YOU DO NOT HAVE TO PAY ANYTHING FOR IT, EXCEPT FOR MINIMAL	**
** COPY & SHIPPING FEES. YOU MAY DISTRIBUTE COPIES OF IT TO ANYONE YOU	**
** WANT, BUT YOU MUST DISTRIBUTE THE ENTIRE AND UNMODIFIED ARCHIVE.	**
** COMMERCIAL USAGE IS FORBIDDEN WITHOUT MY WRITTEN PERMISSION.		**
** MOREOVER, I WILL NOT BE HELD RESPONSIBLE FOR ANY DAMAGE THE USE	**
** OF THIS PROGRAM MAY CAUSE. ALL USE IS AT YOUR OWN RISK. BY USING	**
** THIS PROGRAM AND RELATED FILES, YOU AGREE WITH THIS DISCLAIMER.	**
**									**
**	Feel free to contact me:					**
**	- Snail-Mail (new address!):					**
**		Frédéric Delacroix					**
**		4, rue Mirland						**
**		59300 VALENCIENNES					**
**		FRANCE							**
**	- Fidonet:							**
**		sorry, not available for now				**
**	_ Francomédia:							**
**		101:176/114.8						**
**	- Internet (not very reliable):					**
**		frederic.delacroix@p8.f20.n322.z2.fidonet.org		**
**									**
*************************************************************************/

IF ~SHOW('Libraries','rexxxpk.library') THEN
	IF ~ADDLIB('rexxxpk.library',0,-30,1) THEN EXIT 20
IF ~SHOW('Libraries','rexxreqtools.library') THEN
	IF ~ADDLIB('rexxreqtools.library',0,-30,1) THEN EXIT 20
IF ~SHOW('Libraries','rexxsupport.library') THEN
	IF ~ADDLIB('rexxsupport.library',0,-30,1) THEN EXIT 20

OPTIONS RESULTS
PARSE ARG action arguments
UPPER action

SELECT
	WHEN	action=="GUI" THEN XPKGui(arguments)
	WHEN	action=="OPEN" THEN XPKOpen(arguments)
	WHEN	action=="INCLUDE" THEN XPKInclude(arguments)
	WHEN	action=="SAVE" THEN XPKSave(arguments)
	WHEN	action=="SAVEAS" THEN XPKSaveAs(arguments)
	WHEN	action=="SAVEQUIT" THEN XPKSaveQuit(arguments)
	WHEN	action=="STATUS" THEN XPKStatus(arguments)
	OTHERWISE	rtezrequest("Unknown action.",,"XPKCed: Problem.",eztags)
END

EXIT

/**** XPKGui ****/

XPKGui: PROCEDURE

CALL GetRexxTags
msg='0A'X || '0A'X || "Please select operation:"
o=rtezrequest(XPKStatMsg() || msg,"_Open...|_Include...|_Save|Save _as...|Save and _Quit|_Cancel","XPKCed: GUI mode",eztags,)
SELECT
	WHEN o=1 THEN XPKOpen(ARG(1))
	WHEN o=2 THEN XPKInclude(ARG(1))
	WHEN o=3 THEN XPKSave(ARG(1))
	WHEN o=4 THEN XPKSaveAs(ARG(1))
	WHEN o=5 THEN XPKSaveQuit(ARG(1))
	OTHERWISE NOP
END
RETURN 0

/**** XPKOpen ****/

XPKOpen: PROCEDURE

PARSE ARG password .
CALL GetRexxTags
IF AskLose() THEN RETURN 0
status dirname
dirname=RESULT
status restname
filename=RESULT
filename=rtfilerequest(dirname,filename,"XPK Open","_Open",multiselecttags,files)
IF filename="" THEN RETURN 0
IF DecompressFile(files.1) THEN RETURN 0
"Open" losefile '22'X || files.1 || '22'X
IF files.count>1 THEN DO i=2 TO files.count
	IF DecompressFile(files.i) THEN RETURN 0
	"Open new"
	"Open" '22'X || files.i || '22'X
END
RETURN 0


/**** XPKInclude ****/

XPKInclude: PROCEDURE

PARSE ARG password .
CALL GetRexxTags
filename=rtfilerequest(,,"XPK Include","_Include",fileselecttags,)
IF (filename="") | (~rtresult) THEN RETURN 0
IF DecompressFile(filename) THEN RETURN 0
"Include file" '22'X || filename || '22'X
RETURN 0


/**** XPKSave ****/

XPKSave: PROCEDURE

PARSE ARG packer password .
CALL GetRexxTags
status filename
fname=RESULT
fstate=STATEF(fname)
defpacker=packer
IF defpacker="" THEN PARSE UPPER VAR fstate . . . . . . . defpacker . .
"Save"
IF ~RESULT THEN RETURN 0
status filename
fname=RESULT
IF CompressFile(fname) THEN RETURN 0
RETURN 0


/**** XPKSaveAs ****/

XPKSaveAs: PROCEDURE

PARSE ARG packer password .
CALL GetRexxTags
status filename
fname=RESULT
fstate=STATEF(fname)
defpacker=packer
IF defpacker="" THEN PARSE UPPER VAR fstate . . . . . . . defpacker . .
"Save as"
IF ~RESULT THEN RETURN 0
status filename
fname=RESULT
IF CompressFile(fname) THEN RETURN 0
RETURN 0


/**** XPKSaveQuit ****/

XPKSaveQuit: PROCEDURE

PARSE ARG packer password .
CALL GetRexxTags
status filename
fname=RESULT
fstate=STATEF(fname)
defpacker=packer
IF defpacker="" THEN PARSE UPPER VAR fstate . . . . . . . defpacker . .
"Save"
IF ~RESULT THEN RETURN 0
status filename
fname=RESULT
IF CompressFile(fname) THEN RETURN 0
OPTIONS FAILAT 11	/* to counter Ced's strange behavior with last quit */
"Quit"
RETURN 0


/**** XPKStatus ****/

XPKStatus: PROCEDURE

CALL GetRexxTags
rtezrequest(XPKStatMsg(),,"XPKCed: status",eztags,)
RETURN 0


/**** Other functions ****/

/* XPKStatMsg: returns the status message to display in requesters
of STATUS and GUI */

XPKStatMsg: PROCEDURE

xpkclip=GetClip(XPKCed)
IF xpkclip="" THEN xpkclip="0 ???? 0 0 0 0"
PARSE VAR xpkclip xpkerror xpkpacker xpkclen xpkulen xpkrate xpkspeed .
msg="Statistics for the last XPKCed operation:" || '0A'X ||,
	"Error code            :" xpkerror "(" || XPKError(xpkerror) || ")" || '0A'X ||,
	"Packer used           :" xpkpacker || '0A'X ||,
	"Crunched file length  :" xpkclen "bytes" || '0A'X ||,
	"Decrunched file length:" xpkulen "bytes" || '0A'X ||,
	"Compression ratio     :" xpkrate "%%" || '0A'X ||,
	"(De)compression speed :" xpkspeed "bytes/sec."
RETURN msg


/* Asklose: Checks whether the file was saved, and, if it wasn't,
asks the user if it is to be lost. Returns 1 to cancel the operation,
0 to go ahead and lose the file. In this case, the variable losefile
is suitable for a Open statement. */

AskLose: PROCEDURE EXPOSE losefile

CALL GetRexxTags
status numviews
views=RESULT
status numchanges
changes=RESULT
status actualsize
actualsize=RESULT
status restname
fname=RESULT
IF (changes~=0) & (views=1) & (actualsize~=0) THEN DO
	msg=changes "changes have been made to '" || fname || "'." || '0A'X || "They will be lost." || '0A'X ||"Ok to load another file over to of it?"
	IF rtezrequest(msg,"_OK|_Cancel","XPK: Open.",eztags,) THEN DO
		losefile="1"
		ret=0
	END
	ELSE ret=1
END
ELSE DO
	losefile=""
	ret=0
END
RETURN ret


/* DecompressFile: Checks if the file is compressed and decompresses
it to the same name. Asks for password if needed. */

DecompressFile: PROCEDURE EXPOSE password

CALL GetRexxTags
file=Arg(1)
DO i=0 FOR 100 UNTIL ~EXISTS(tofile)
	tofile=file || ".temp" || i
END
ParseXPK(UnpackFile(file,tofile,password))
IF (xpkerror=-13)&(password="") THEN DO
	passmsg="The file" file "is encrypted" || '0A'X || "Please enter the password:"
	password=rtGetString(,passmsg,"XPK: Password","OK",passwordtags,)
	ParseXPK(UnpackFile(file,tofile,password))
END
err=0
IF (xpkerror~=0)&(xpkerror~=-23) THEN DO
	DisplayXPKerror(xpkerror)
	err=1
END
IF xpkerror=0 THEN DO /* do not change anything if xpkerror=23: data not packed! */
	ADDRESS COMMAND
	"delete" '22'X || file || '22'X "FORCE QUIET"
	"rename" '22'X || tofile || '22'X "AS" '22'X || file || '22'X "QUIET"
	"filenote" '22'X || file || '22'X '22'X || xpkpacker " XPKCed " || '22'X "QUIET"
	ADDRESS
END
RETURN err


/* GetPass: Ask the user for a password, double-entry for verification */

GetPass: PROCEDURE

CALL GetRexxTags
passmsg=ARG(1)
passver="Please verify:"
DO UNTIL password==passverify
	password=rtGetString(,passmsg,"XPK: Password","OK",passwordtags,)
	passverify=rtGetString(,passver,"XPK: Password","OK",passwordtags,)
	passmsg="The two passwords are not the same." || '0A'X || "Please reenter password:"
END
RETURN password

/* CompressFile: Ask the user for packer and password and then compress
the file. */

CompressFile: PROCEDURE EXPOSE packer password defpacker

CALL GetRexxTags
file=Arg(1)
DO i=0 FOR 100 UNTIL ~EXISTS(tofile)
	tofile=file || ".temp" || i
END
msg="Please indicate the (four-letter) packer name to use for" || '0A'X || "crunching this file. You can also add an efficiency code" || '0A'X || "(ex. FEAL.095)."
IF packer="" THEN DO
	packer=rtgetstring(defpacker,msg,"XPK: Packer","_Pack|_List packers|Pack & _Crypt|_Don't pack",pubtag,)
	IF rtresult=0 THEN RETURN 0
	IF rtresult=2 THEN DO
		pak=ListXPKPackers()
		IF OPEN(Packers,"PIPE:XPKPackers","Write") THEN DO
			status pubscreenname
			line='Run <>NIL: RequestList >PIPE:ChosenPacker "Available packers" PIPE:XPKPackers PUBSCREEN' RESULT 'FULL LINES' WORDS(pak)
			ADDRESS COMMAND line
			DO i=1 TO WORDS(pak)
				WRITELN(Packers,WORD(pak,i))
			END
			CLOSE(Packers)
		END
		IF OPEN(chosen,"PIPE:ChosenPacker","Read") THEN DO
			packer=READLN(chosen)
			CLOSE(chosen)
		END
	END
	IF rtresult=1 THEN password=""
	IF (rtresult=3)&(password="") THEN password=GetPass("Please enter password for crypting the file:")
END
DO i=0 FOR 100 UNTIL ~EXISTS(tofile)
	tofile=file || ".temp" || i
END
ParseXPK(PackFile(file,tofile,packer,password))
IF (xpkerror=-13) THEN DO
	password=GetPass("A password is needed with this compressor, please enter" || '0A'X || "password for crypting the file:")
	ParseXPK(PackFile(file,tofile,packer,password))
END
IF (xpkerror~=0) THEN DO
	DisplayXPKerror(xpkerror)
	err=1
END
ELSE DO
	ADDRESS COMMAND
	"delete" '22'X || file || '22'X "FORCE QUIET"
	"rename" '22'X || tofile || '22'X "AS" '22'X || file ||'22'X "QUIET"
	"filenote" '22'X || file || '22'X '22'X || xpkpacker " XPKCed " || '22'X "QUIET"
	ADDRESS
	err=0
END
RETURN err


/* ParseXPK: Analyses the output of the rexxxpk.library, in order
to set the variables xpkerror, xpkpacker, xpkclen, xpkulen, xpkrate
and xpkspeed. Also sets a few environment variables and a clip list
entry (used by XPKCed STATUS). */

ParseXPK: PROCEDURE EXPOSE xpkerror xpkpacker xpkclen xpkulen xpkrate xpkspeed

PARSE ARG xpkerror xpkpacker xpkclen xpkulen xpkrate xpkspeed .
ADDRESS COMMAND
"setenv CEd/xpkerror" xpkerror
"setenv CEd/xpkpacker" xpkpacker
"setenv CEd/xpkclen" xpkclen
"setenv CEd/xpkulen" xpkulen
"setenv CEd/xpkrate" xpkrate
"setenv CEd/xpkspeed" xpkspeed
ADDRESS
SetClip(XPKCed,ARG(1))
RETURN xpkerror



/* DisplayXPKError: Displays the meaning of an error code in a
rexxreqtools requester. */

DisplayXPKError: PROCEDURE

CALL GetRexxTags
RETURN rtezrequest(XPKError(ARG(1)),,"XPK: XPK error.",eztags,)



/* XPKError: returns the error message corresponding to the XPK error
code given in argument. */

XPKError: PROCEDURE

i=ARG(1)
SELECT
	WHEN i=0 THEN msg="No error"
	WHEN i=-1 THEN msg="Function not implemented"
	WHEN i=-2 THEN msg="No files allowed for this function"
	WHEN i=-3 THEN msg="Input error"
	WHEN i=-4 THEN msg="Output error"
	WHEN i=-5 THEN msg="Checksum error"
	WHEN i=-6 THEN msg="Packed file's version newer than library's"
	WHEN i=-7 THEN msg="Out of memory"
	WHEN i=-8 THEN msg="Non-reentrant library"
	WHEN i=-9 THEN msg="File was not packed with this library"
	WHEN i=-10 THEN msg="Output buffer too small"
	WHEN i=-11 THEN msg="Input buffer too large"
	WHEN i=-12 THEN msg="Packing mode not supported"
	WHEN i=-13 THEN msg="Password needed"
	WHEN i=-14 THEN msg="Packed file is corrupt"
	WHEN i=-15 THEN msg="Required library is missing"
	WHEN i=-16 THEN msg="Caller's TagList was screwed up"
	WHEN i=-17 THEN msg="Would have caused data expansion"
	WHEN i=-18 THEN msg="Can't find requested method"
	WHEN i=-19 THEN msg="Operation aborted by user"
	WHEN i=-20 THEN msg="Input file is truncated"
	WHEN i=-21 THEN msg="Better CPU required for this library"
	WHEN i=-22 THEN msg="Data are already XPacked"
	WHEN i=-23 THEN msg="Data not packed"
	WHEN i=-24 THEN msg="File already exists"
	WHEN i=-25 THEN msg="Master library too old"
	WHEN i=-26 THEN msg="Sub library too old"
	WHEN i=-27 THEN msg="Cannot encrypt"
	WHEN i=-28 THEN msg="Can't get info on that packer"
	WHEN i=-29 THEN msg="This compression method is lossy"
	WHEN i=-30 THEN msg="Compression hardware required"
	WHEN i=-31 THEN msg="Compression hardware failed"
	WHEN i=-32 THEN msg="Wrong password"
	OTHERWISE msg="Unknown error"
END
RETURN msg

/* GetRexxTags: initializes the tags used for rexxreqtools */

GetRexxTags: PROCEDURE EXPOSE eztags multiselecttags fileselecttags passwordtags pubtag

status pubscreenname
pubtag="rt_pubscrname=" || RESULT
eztags=pubtag
multiselecttags=pubtag "rtfi_flags=freqf_multiselect|freqf_patgad rtfi_matchpat=~(#?.(bak|info|auts))"
fileselecttags=pubtag "rtfi_flags=freqf_patgad rtfi_matchpat=~(#?.(bak|info|auts))"
passwordtags=pubtag "rtgs_invisible=true rtgs_flags=gsreqf_centertext"
RETURN