/* *********************************************************** ** ** ** ToOtherDir ** ** ** ** PicSort extention to sort images to configurable dir ** ** ** ** (c) 1996-97 PDS Peters Daten-Systeme ** ** ** *********************************************************** */ PARSE ARG Slot prefs dummy SIGNAL ON break_c SIGNAL ON failure SIGNAL ON halt SIGNAL ON ioerr SIGNAL ON syntax OPTIONS FAILAT 50 dir = "Ram:" method = 0 askfor = 1 automatic = 0 meth.0 = 2 meth.1 = "Copy files" meth.2 = "Move files" prefswin = '00000000'x /* *********************************************************** ** import current picture name and PicSort directory ** *********************************************************** */ LoadRexx("t:slot."||slot,"") /* Filename contains the current picture name PicSortPath contains the path to PicSort related.0 Number of extentions for related Files related.1 .. (related.0) filename extentions */ /* *********************************************************** ** Init ** *********************************************************** */ appname = "ToOtherDir" applongname = "Protect (c) 1997 PDS Peters Daten-Systeme" appinfo = "PicSort extention to copy file to configurable dir" appintver = "$VER: ToOtherDir (07.12.1997) (c) PDS Peters Daten-Systeme" appversion = "1.0" appdate = "07.12.1997" IF ~Exists('LIBS:tritonrexx.library') THEN Address Command "Assign Libs: " || PicSortPath || "libs/ ADD" IF ~Exists('LIBS:triton.library') THEN Address Command "Assign Libs: " || PicSortPath || "libs/ ADD" IF ~SHOW('LIBRARIES','tritonrexx.library') THEN DO IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN DO SAY "Could not open tritonrexx.library" EXIT 10 END END app = TR_CREATEAPP('TRCA_Name ' '"' appname '"', 'TRCA_LongName ' '"' applongname '"', 'TRCA_Info ' '"' appinfo '"', 'TRCA_Version ' '"' appintver '"' , 'TRCA_Release ' '"' appversion '"' , 'TRCA_Date ' '"' appdate '"', 'TAG_END') /* *********************************************************** ** look for prefs file ** *********************************************************** */ pfile = PicSortPath||"Scripts/Prefs/ToOtherDir"||slot||".prefs" IF EXISTS(pfile) THEN LoadRexx(pfile,"") else IF prefs ~= "GET" THEN prefs = "ASK" /* *********************************************************** ** Main program ** *********************************************************** */ CALL Init() IF app ~= '00000000'x THEN DO IF Prefs ~= "" THEN DO CALL Prefswindow() CALL Updateprefswindow() if c2D(Prefswin) ~= 0 THEN DO psende = 0 DO WHILE psende=0 CALL TR_WAIT(app,'') DO WHILE TR_HANDLEMSG(app,'event') if (event.trm_project = Prefswin) THEN DO if (event.trm_class = 'TRMS_CLOSEWINDOW') THEN psende = 2 id = event.trm_id SELECT WHEN id = 101 THEN DO dir = TR_GetAttribute(prefswin,101,"TROB_STRING") END WHEN id = 102 THEN DO GetTheDir() END WHEN id = 103 THEN method = TR_GetAttribute(prefswin,103,"TRAT_VALUE") WHEN id = 104 THEN askfor = TR_GetAttribute(prefswin,104,"TRAT_VALUE") WHEN id = 106 THEN psende = 1 WHEN id = 107 THEN psende = 2 OTHERWISE say id END END updateprefswindow() END END IF psende = 1 THEN DO dummy = Open(exp,pfile,"W") WriteLn(exp,"/* Prefs for ToOtherDir */") WriteLn(exp,"dir = '" || dir || "'") WriteLn(exp,"method = " || method) WriteLn(exp,"askfor = " || askfor) dummy = Close(exp) END END else do say "CANNOT OPEN GUI for prefswin" ende() end END IF prefs ~= "GET" THEN DO if askfor = 1 THEN GetTheDir() IF exists(dir)&(dir~="") THEN DO ADDRESS COMMAND 'COPY "' || Filename || '" "' || dir ||'" CLONE' if (method = 1)&(RC=0) THEN DO ADDRESS COMMAND 'Protect "' || Filename || '" D ADD' ADDRESS COMMAND 'DELETE "' || Filename || '"' END if rc = 0 THEN ADDRESS COMMAND 'DELETE t:Slot.'||slot if (related.0 > 0) THEN DO DO i = 1 to related.0 ADDRESS COMMAND 'COPY "' || Filename || related.i || '" "' || dir ||'" CLONE' if (method = 1) & (rc = 0) THEN DO DO i = 1 to related.0 ADDRESS COMMAND 'Protect "' || Filename || related.i || '" D ADD' ADDRESS COMMAND 'DELETE "' || Filename || related.i || '"' END END END END dummy = Open(exp,pfile,"W") WriteLn(exp,"/* Prefs for ToOtherDir */") WriteLn(exp,"dir = '" || dir || "'") WriteLn(exp,"method = " || method) WriteLn(exp,"askfor = " || askfor) dummy = Close(exp) END END ende: CALL TR_DELETEAPP(app) END EXIT 0 /* *********************************************************** ** End of main program ** *********************************************************** */ /* *********************************************************** ** GetTheDir ** *********************************************************** */ GetTheDir: IF ASL_RequestFile(prefswin,'newdir',GetDrawer("Select destination","_Select",dir) ) ~=0 THEN DO ndir = newdir.1 END if exists(ndir)&(ndir~="") then dir = ndir RETURN 0 /* *********************************************************** ** Prefs window ** *********************************************************** */ prefswindow: prefswin = TR_OPENPROJECT(app,WindowID(1), WindowFlags('TRWF_NOESCCLOSE|TRWF_NOZIPGADGET'), WindowPosition('TRWP_MOUSEPOINTER'), WindowTitle('ToOtherDir Prefs'), HorizGroupEAC, Space, VertGroupSAC, Space, HorizGroupSAC, TextID("_Directory",101), Space, GetDrawerButton(102), EndGroup, Space, HorizGroupEAC, StringGadget(dir,101), EndGroup, Space, HorizGroupSAC, Space, TextID("_Method ",103), MXGadgetR(meth,method,103), Space, EndGroup, Space, HorizSeparator, Space, HorizGroupSAC, Space, TextID("Ask _for dir ",104), CheckBox(104), Space, EndGroup, Space, HorizSeparator, Space, HorizGroupSAC, Button('_Okay',106), Space, Button('_Cancel',107), EndGroup, Space, EndGroup, Space, EndGroup, EndProject) updateprefswindow() RETURN 0 updateprefswindow: TR_SetAttribute(prefswin,101,"TROB_STRING",dir) TR_SetAttribute(prefswin,103,"TRAT_VALUE",method) TR_SetAttribute(prefswin,104,"TRAT_VALUE",askfor) RETURN 0 /* *********************************************************** ** Execute external Rexx Subprogram ** *********************************************************** */ LoadRexx: PARSE ARG file,store IF ~OPEN('rexxfile',file,'R') THEN RETURN(FALSE) rexxtext = READCH('rexxfile',64000) INTERPRET rexxtext CALL CLOSE('rexxfile') IF store ~= '' THEN INTERPRET store '= rexxtext' DROP rexxtext RETURN(TRUE) /* *********************************************************** ** misc. subroutines ** *********************************************************** */ GetFileName: PARSE ARG OldFilename FirstChar = LEFT( OldFilename, 1 ) if (FirstChar = '"') | (FirstChar = '''') THEN OldFilename = STRIP( OldFilename, "B", FirstChar ) FNameSepPos = LASTPOS( '/', OldFilename ) if (FNameSepPos = 0) THEN FNameSepPos = LASTPOS( ':', OldFilename ) if (FNameSepPos ~= 0) THEN FileOnly = RIGHT( OldFilename, LENGTH( OldFilename ) - FNameSepPos ) else FileOnly = OldFilename RETURN FileOnly GetPath: PARSE ARG OldFilename FirstChar = LEFT( OldFilename, 1 ) if (FirstChar = '"') | (FirstChar = '''') THEN OldFilename = STRIP( OldFilename, "B", FirstChar ) FNameSepPos = LASTPOS( '/', OldFilename ) if (FNameSepPos = 0) THEN FNameSepPos = LASTPOS( ':', OldFilename ) if (FNameSepPos ~= 0) THEN PathOnly = LEFT( OldFilename, FNameSepPos ) else PathOnly = "" RETURN PathOnly GetFileDate: PARSE ARG mfile ADDRESS COMMAND 'LIST >t:filedate "' || mfile || '" QUICK NOHEAD FILES LFORMAT="%D %T"' dummy = Open(fdimp,"t:filedate","R") val = ReadLn(fdimp) dummy = Close(fdimp) RETURN val /* *********************************************************** ** Init ** *********************************************************** */ init: NL = d2c(13) RETURN 0 /* *********************************************************** ** Errorhandling ** *********************************************************** */ break_c: failure: halt: ioerr: syntax: SAY 'Error ' rc '(' ERRORTEXT(rc) ') in line 'sigl SAY SOURCELINE(sigl) SAY TR_GetLastError(app) SAY TR_GetErrorString(TR_GetLastError(app)) IF app ~= '00000000'x THEN CALL TR_DELETEAPP(app) EXIT 10