/*$VER: emp_delete!.dopus5 1.1 (19.10.97) B00ze
 * God even basic Diskmaster functionality is a pain to add to Dopus.
 * For questions or comments email Booze@Videotron.CA
 * Compressed by CrunchRexx v1.1
 */
PN='Delete!.dopus5'
SH=0;WIN=0;LF='0A'x
Options results
Signal ON SYNTAX
Signal ON BREAK_C
Signal ON FAILURE
Parse ARG P F SH DH A .
Address VALUE P
If Upper(F)='INIT' Then Do
'Dopus Command emp_Delete! Program emp_delete! Desc "Delete!ALL" SOURCE'
Exit 0
End
Options failat 21
If ~GSL() Then Call ReqERR('No Source Lister To Work With!')
'Lister Query' SH 'Numselentries'
If RESULT=0|RESULT="RESULT" Then Exit 10
'Lister Set' SH 'Busy 1'
RC=ReqEZ('DELETE ALL SELECTED FILES?'LF'Selected files will be Lost!','Yes_ Delete|CANCEL!')
If RC=0 Then Exit 0
LP=GLP(SH)
Call Pragma('D',LP)
FL.=0
'Lister Query' SH 'Selentries Stem FL.'
If FL.count>0 Then Do
'Lister Set' SH 'Title Working...'
'Lister Refresh' SH 'FULL'
Address COMMAND
y=FL.count-1
Do x=0 To y;'Delete "'FL.x'" ALL QUIET';End
End
Else Call ReqERR('Unable To Obtain Selected Entries!')
Address VALUE P
'Lister Set' SH 'Title'
'Lister Set' SH 'Busy 0'
'Lister Read' SH '"'LP'"'
'Lister Refresh' SH 'FULL'
Exit 0
GSL: PROCEDURE EXPOSE P LF PN SH WIN
If Datatype(SH)~="NUM" Then Call ReqERR('UnInitialized SH/SourceHandle!')
If SH=0 Then Do
Parse UPPER ARG STyp
If STyp~="D"|STyp~="A" Then STyp="S"
SL.=0
'Lister Query Source Stem SL.'
If SL.count=0 Then If STyp="S" Then Return(0)
Else Do
'Lister Query Dest Stem SL.'
If SL.count=0 Then If STyp="D" Then Return(0)
Else Do
'Lister Query ALL Stem SL.'
If SL.count=0 Then Return(0)
End
End
SH=SL.0
End
'Lister Set' SH 'Source'
'Lister Query' SH 'Window'
If RESULT~=0&Datatype(RESULT)='NUM' Then WIN=RESULT
Else WIN=0
Return(1)
GLP: PROCEDURE EXPOSE P LF PN SH WIN
Parse ARG LH
'Lister Query' LH 'PATH'
If RESULT=""|RESULT="RESULT" Then Call ReqERR('Unable To Obtain Lister PATH!')
Else Do
LP=RESULT
If Right(LP,1)~=':'&Right(LP,1)~='/' Then LP=LP'/'
End
Return(LP)
ReqEZ: PROCEDURE EXPOSE P LF PN SH WIN
Parse ARG TXT,GADGETS,A
A=Upper(A)
If ~Show('L',"rexxreqtools.library") Then CALL AddLib('rexxreqtools.library',0,-30,0)
If ~Show('L',"rexxreqtools.library") Then Do
GADGETS=Compress(GADGETS,'_')
If SH=0|Datatype(SH)~="NUM"|A="NW" Then RCMD='Dopus Request'
Else RCMD='Lister Request 'SH
RCMD' "'TXT'" 'GADGETS
Choice=RC
End
Else Do
If WIN=0|Datatype(WIN)~="NUM"|A="NW" Then Do
'Dopus Screen'
Parse VAR RESULT S .
RTAG='RT_PubScrName='S' rt_reqpos=reqpos_centerscr'
End
Else RTAG='RT_Window='WIN' rt_reqpos=reqpos_centerwin'
Choice=rtEZRequest(TXT,GADGETS,PN,RTAG' rtez_flags=ezreqf_centertext')
End
Return Choice
ReqERR: PROCEDURE EXPOSE P LF PN SH WIN
Parse ARG TXT,A
A=Upper(A)
'Command Flash'
If ~Show('L',"rexxreqtools.library") Then CALL AddLib('rexxreqtools.library',0,-30,0)
If ~Show('L',"rexxreqtools.library") Then Do
If SH=0|Datatype(SH)~="NUM"|A="NW" Then RCMD='Dopus Request'
Else RCMD='Lister Request 'SH
RCMD' "+++ 'PN' Error +++'LF||TXT'" OK'
End
Else Do
If WIN=0|Datatype(WIN)~="NUM"|A="NW" Then Do
'Dopus Screen'
Parse VAR RESULT S .
RTAG='RT_PubScrName='S' rt_reqpos=reqpos_centerscr'
End
Else RTAG='RT_Window='WIN' rt_reqpos=reqpos_centerwin'
CALL rtEZRequest('+++ 'PN' Error +++'LF||TXT,,PN,RTAG' rtez_flags=ezreqf_centertext rt_idcmpflags=idcmp_vanillakey')
End
If SH~=0 Then Do
'Lister Set' SH 'Busy 0'
'Lister Set' SH 'Title'
'Lister Refresh' SH 'FULL'
End
Exit 20
BREAK_C:
Address VALUE P
If SH~=0 Then Do
'Lister Set' SH 'Busy 0'
'Lister Set' SH 'Title'
'Lister Refresh' SH 'FULL'
RCMD='Lister Request 'SH
End
Else RCMD='Dopus Request'
'Command Flash'
RCMD' "+++ Break! +++" OK'
Exit 0
SYNTAX:
RCX=RC
Address VALUE P
If SH~=0 Then Do
'Lister Set' SH 'Busy 0'
'Lister Set' SH 'Title'
'Lister Refresh' SH 'FULL'
RCMD='Lister Request 'SH
End
Else RCMD='Dopus Request'
'Command Flash'
RCMD' "+++ Syntax Error +++'LF'('RCX') at line 'SIGL||LF||errortext(RCX)'" OK'
Exit 20
FAILURE:
Address VALUE P
If SH~=0 Then Do
'Lister Set' SH 'Busy 0'
'Lister Set' SH 'Title'
'Lister Refresh' SH 'FULL'
RCMD='Lister Request 'SH
End
Else RCMD='Dopus Request'
'Command Flash'
RCMD' "+++ Failure +++'LF'Something failed at line 'SIGL'" OK'
Exit 20