home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / system / filerexx / txt / filerexx.mod next >
Text File  |  1995-02-27  |  15KB  |  493 lines
  1. (* ----------------------------------------------------------------------------
  2.  
  3. :Program.       FileRexx.mod
  4. :Contents.      Filerequester-Program with ARexx-Port in order to replace e.g.
  5. :Contents.      the ugly, non-standard TurboText-Filerequester
  6. :Author.        Michael 'Mick' Hohmann
  7. :Address.       Carl-Schilling-Str. 10, 8701 Kirchheim, Germany
  8. :Phone.         09 31 / 35 31 54 - 0
  9. :Copyright.     Freely Distributable
  10. :Language.      Oberon
  11. :Translator.    AmigaOberon v3.01d
  12. :Support.       Rexx-Part from hartmut Goebel
  13. :Imports.       MoreIntuition [mick], MoreStrings [hG], SimpleRexx [hG]
  14. :History.       v0.1 [mick] Aug-92 first Version
  15. :History.       v1.2 [hG] Apr-93 some REXX-Bugfixes
  16. :History.       v1.2a [mick,fbs,kai] Apr-93 Added FilePart/PathPart and
  17.                       MakeFJRTag
  18. :History.       v1.3 [mick,kai,fbs,hG] Mai-93 Finally got the Top/Left-Pos
  19.                       working
  20.  
  21. ---------------------------------------------------------------------------- *)
  22.  
  23. MODULE FileRexx;
  24.  
  25. IMPORT
  26.   NoGuru,            (** nach Beendigung der BETA-Phase entfernen **)
  27.   ASL,
  28.   BasicTypes,
  29.   D:=Dos,
  30.   E:=Exec,
  31.   G:=Graphics,
  32.   I:=Intuition,
  33.   MI:=MoreIntuition,
  34.   MS:=MoreStrings,
  35.   OL:=OberonLib,
  36.   RX:=Rexx,
  37.   RXS:=RexxSysLib,
  38.   RVI,
  39.   Requests,
  40.   SR:=SimpleRexx,
  41.   Strings,
  42.   SYSTEM,
  43.   Utility;
  44.  
  45. CONST
  46.   strLen             = 80;
  47.   argTemplate        = "FILE,PAT=PATTERN/K,TITLE/K,TOP/K/N,LEFT/K/N,WIDTH/K/N,HEIGHT/K/N,"
  48.                        "PS=PUBSCREEN/K,ENVVAR/K,LOCAL/S,SM=SAVEMODE/S,DRAWERSONLY/S,"
  49.                        "RX=REXXHOST/S,PORTNAME/K,HELP/S";
  50.   rxTemplate         = "FILE,PAT=PATTERN/K,TITLE/K,TOP/K/N,LEFT/K/N,WIDTH/K/N,HEIGHT/K/N,"
  51.                        "PS=PUBSCREEN/K,VAR/K";
  52.   oProgName          = "FileRexx";
  53.   version            = " 1.3";
  54.   date               = " (16.5.93)";
  55.   versionString      = "$VER: FileRexx 1.3 (16.5.93)";
  56.   need20             = "This programm needs at least Kick 2.04!";
  57.   leererString       = "";
  58.  
  59. TYPE
  60.   PubString          = ARRAY I.maxPubScreenName+1 OF CHAR;
  61.   DosArgs            = STRUCT
  62.                          file      : E.STRPTR;
  63.                          pattern   : E.STRPTR;
  64.                          title     : E.STRPTR;
  65.                          top       : UNTRACED POINTER TO LONGINT;
  66.                          left      : UNTRACED POINTER TO LONGINT;
  67.                          width     : UNTRACED POINTER TO LONGINT;
  68.                          height    : UNTRACED POINTER TO LONGINT;
  69.                          pubScreen : E.STRPTR;
  70.                          envVar    : E.STRPTR;
  71.                          local     : LONGINT;
  72.                          saveMode  : LONGINT;
  73.                          dirOnly   : LONGINT;
  74.                          rexxHost  : LONGINT;
  75.                          portName  : E.STRPTR;
  76.                          help      : LONGINT
  77.                        END;
  78.  
  79.  
  80. VAR
  81.   dArgs,rArgs        : DosArgs;
  82.   pubScrName         : PubString;
  83.   activeScreen       : I.ScreenPtr;
  84.   reqWindow          : I.WindowPtr;
  85.   aslReq             : ASL.FileRequesterPtr;
  86.   reqWidth,reqHeight : LONGINT;
  87.   top,left           : LONGINT;
  88.   width,height       : LONGINT;
  89.   rxHost             : SR.RexxHost;
  90.   progName           : E.STRING;
  91.   progNamePtr        : E.STRPTR;
  92.   sMsg               : RX.RexxMsgPtr;
  93.   hisPort            : E.MsgPortPtr;
  94.   useRexx            : BOOLEAN; (* !!! *)
  95.  
  96. (*****************************************************************************)
  97.  
  98. PROCEDURE MakeFJRTag(tag: LONGINT; data: SYSTEM.ADDRESS):LONGINT;
  99.  
  100. BEGIN
  101.  
  102.   IF data = NIL THEN
  103.     RETURN Utility.ignore
  104.   ELSE
  105.     RETURN tag
  106.   END
  107.  
  108. END MakeFJRTag;
  109.  
  110. (*****************************************************************************)
  111.  
  112. PROCEDURE CleanUp(); (** Alle Locks werden wieder freigegeben **)
  113.  
  114. BEGIN
  115.  
  116.   IF activeScreen#NIL THEN
  117.     I.UnlockPubScreen(NIL,activeScreen);
  118.     activeScreen:=NIL
  119.   END;
  120.  
  121.   IF reqWindow#NIL THEN
  122.     I.CloseWindow(reqWindow);   (** Window wieder schliessen **)
  123.     reqWindow:=NIL
  124.   END;
  125.  
  126. END CleanUp;
  127.  
  128. (*****************************************************************************)
  129.  
  130.  
  131. (** Setzt die Option und öffnet dann den ASL-Req **)
  132. PROCEDURE OpenReq(pArgs : DosArgs; VAR outBuffer: ARRAY OF CHAR);
  133.  
  134. VAR
  135.   screenRect         : G.Rectangle;
  136.   screenModeID       : LONGINT;
  137.   aslFlags           : LONGSET;
  138.   aslExtFlags        : LONGSET;
  139.   buffer             : E.STRING;
  140.   fileNamePtr        : E.STRPTR;
  141.   pathNamePtr        : E.STRPTR;
  142.   backupChar         : CHAR;
  143.   fileName,pathName  : E.STRING;
  144.   viewPortExtra      : G.ViewPortExtra;
  145.  
  146. BEGIN
  147.  
  148.   aslFlags:=LONGSET{};
  149.   aslExtFlags:=LONGSET{};
  150.  
  151.   fileNamePtr:=D.FilePart(pArgs.file^);
  152.   COPY(fileNamePtr^,fileName);
  153.   pathNamePtr:=D.PathPart(pArgs.file^);
  154.   backupChar:=pathNamePtr^[0];
  155.   pathNamePtr^[0]:=0X;
  156.   COPY(pArgs.file^,pathName);
  157.   progNamePtr^[0]:=backupChar;
  158.  
  159.   IF pArgs.saveMode#D.DOSFALSE THEN
  160.     INCL(aslFlags,ASL.save);
  161.   END; (* IF *)
  162.  
  163.   IF pArgs.dirOnly#D.DOSFALSE THEN
  164.     INCL(aslExtFlags,ASL.drawersOnly);
  165.   END; (* IF *)
  166.  
  167.   IF pArgs.pattern#SYSTEM.ADR(leererString) THEN
  168.     INCL(aslFlags,ASL.patGad);
  169.     IF pArgs.dirOnly#D.DOSFALSE THEN
  170.       INCL(aslExtFlags,ASL.filterDrawers);
  171.     END; (* IF *)
  172.   END; (* IF *)
  173.  
  174.   IF pArgs.pubScreen#NIL THEN
  175.     COPY(pArgs.pubScreen^,pubScrName)
  176.   END; (* IF *)
  177.   activeScreen:=MI.LockFrontPubScr(pubScrName);   (** Den vordersten PubScreen, oder die WB locken **)
  178.  
  179.   IF (pArgs.width=NIL) OR (pArgs.height=NIL) OR (pArgs.top=NIL) OR (pArgs.left=NIL) THEN
  180. (**
  181.  **    IF NOT G.VideoControlTagList(activeScreen.viewPort.colorMap,G.vTagViewPortExtraGet,
  182.  **                                 SYSTEM.ADR(viewPortExtra),Utility.done) THEN
  183.  **      HALT (20)
  184.  **    END; (* IF *)
  185.  **)
  186.     viewPortExtra:=activeScreen.viewPort.colorMap.vpe^;
  187.     screenRect:=viewPortExtra.displayClip;
  188.  
  189.     IF pArgs.width=NIL THEN
  190.       width:=screenRect.maxX - screenRect.minX + 1;
  191.       width:=(width * 45) DIV 100;
  192.       pArgs.width:=SYSTEM.ADR(width)
  193.     END; (* IF *)
  194.  
  195.     IF pArgs.height=NIL THEN
  196.       height:=screenRect.maxY - screenRect.minY + 1;
  197.       height:=(height * 8) DIV 10;
  198.       pArgs.height:=SYSTEM.ADR(height)
  199.     END; (* IF *)
  200.  
  201.     IF pArgs.top=NIL THEN
  202.       top:= - activeScreen.topEdge;
  203.       IF top < 0 THEN top:=0 END;
  204.       INC(top,(height DIV 10));
  205.       pArgs.top:=SYSTEM.ADR(top)
  206.     END; (* IF *)
  207.  
  208.     IF pArgs.left=NIL THEN
  209.       left:= - activeScreen.leftEdge;
  210.       IF left < 0 THEN left:=0 END;
  211.       INC(left,(width DIV 10));
  212.       pArgs.left:=SYSTEM.ADR(left)
  213.     END; (* IF *)
  214.  
  215.   END; (* IF *)
  216.  
  217.   IF activeScreen=NIL THEN   (** Falls der vorderste Screen kein PubScreen, dann WB nach vorne **)
  218.     IF I.WBenchToFront() THEN END
  219.   END; (* IF *)
  220.  
  221.   reqWindow:=I.OpenWindowTagsA(NIL,I.waLeft,30,   (** WindowTags definieren und Window öffnen **)
  222.                                    I.waTop,1,
  223.                                    I.waWidth,1,
  224.                                    I.waHeight,1,
  225.                                    I.waBackdrop,E.true,
  226.                                    I.waBorderless,E.true,
  227.                                    I.waPubScreen,activeScreen,
  228.                                    I.waPubScreenFallBack,E.true,Utility.done);
  229.  
  230.   Requests.Assert(reqWindow#NIL,"Sorry, couldn't open the window");
  231.  
  232.   IF ASL.AslRequestTags(aslReq,ASL.hail,pArgs.title,   (** ASL-Req allozieren und Tags definieren **)
  233.                                ASL.window,reqWindow,
  234.                                MakeFJRTag(ASL.leftEdge,pArgs.left),pArgs.left^,
  235.                                MakeFJRTag(ASL.topEdge,pArgs.top),pArgs.top^,
  236.                                MakeFJRTag(ASL.width,pArgs.width),pArgs.width^,
  237.                                MakeFJRTag(ASL.height,pArgs.height),pArgs.height^,
  238.                                MakeFJRTag(ASL.file,SYSTEM.ADR(fileName)),SYSTEM.ADR(fileName),
  239.                                MakeFJRTag(ASL.dir,SYSTEM.ADR(pathName)),SYSTEM.ADR(pathName),
  240.                                MakeFJRTag(ASL.pattern,pArgs.pattern),pArgs.pattern,
  241.                                ASL.extFlags1,aslExtFlags,
  242.                                ASL.funcFlags,aslFlags,Utility.done)#NIL THEN
  243.     E.CopyMem(aslReq.dir^,buffer,MS.CLength(aslReq.dir));
  244.     IF D.AddPart(buffer,aslReq.file^,SIZE(buffer)) THEN END;
  245.     IF useRexx THEN (* !!! hG !!!  zusätzlich erst abfragen *)
  246.       COPY(buffer,outBuffer);
  247.     ELSE
  248.       IF (pArgs.envVar # NIL) THEN
  249.         IF pArgs.local # D.DOSFALSE THEN
  250.           IF D.SetVar(pArgs.envVar^,buffer,LEN(buffer),LONGSET{D.localOnly}) THEN END;
  251.         ELSE
  252.           IF D.SetVar(pArgs.envVar^,buffer,LEN(buffer),LONGSET{D.globalOnly}) THEN END;
  253.         END;
  254.       ELSE
  255.         D.PrintF("%s\n",SYSTEM.ADR(buffer))
  256.       END
  257.     END
  258.   END; (* IF *)
  259.  
  260.   CleanUp
  261.  
  262. END OpenReq;
  263.  
  264. (*****************************************************************************)
  265.  
  266. PROCEDURE RexxLoop(); (** Abarbeitung der Rexx-Commands **)
  267.  
  268. VAR
  269.   quit: BOOLEAN;
  270.   rMsg: E.MessagePtr;
  271.   mask  : LONGSET;
  272.  
  273.  
  274.   PROCEDURE DoRxCommand(com: E.STRPTR); (** Berarbeitung der einzelnen Commandos **)
  275.  
  276.   VAR
  277.    buf   : BasicTypes.DynString;
  278.    argIn : D.RDArgsPtr;
  279.    i     : INTEGER;
  280.    rCom  : ARRAY 30 OF CHAR;
  281.    fileBuffer: E.STRING;
  282.  
  283.   BEGIN
  284.  
  285.     i:=0;
  286.     WHILE (com[i]#" ") & (com[i]#CHR(0)) DO
  287.       rCom[i]:=CAP(com[i]);
  288.       INC(i)
  289.     END; (* WHILE *)
  290.  
  291.     rCom[i]:=CHR(0);
  292.  
  293.     IF rCom="QUIT" THEN
  294.       quit:=TRUE;
  295.       SR.ReplyRexxCommand(rMsg,0,0,NIL);
  296.       RETURN
  297.     END; (* IF *)
  298.  
  299.     WHILE (com[i]=" ") & (com[i]#CHR(0)) DO
  300.       INC(i)
  301.     END; (* WHILE *)
  302.  
  303.     buf:=MS.CopyCStringAdd(SYSTEM.ADR(com[i]),1);
  304.     IF buf=NIL THEN
  305.       SR.ReplyRexxCommand(rMsg,20,3,NIL);
  306.       RETURN
  307.     END;
  308.  
  309.     Strings.AppendChar(buf^,"\n");
  310.     argIn:=D.AllocDosObject(D.rdArgs,NIL);
  311.     IF argIn=NIL THEN
  312.       SR.ReplyRexxCommand(rMsg,20,3,NIL);
  313.       (* $IFNOT GarbageCollector *)
  314.         DISPOSE(buf);
  315.       (* $END *)
  316.       RETURN
  317.     END; (* IF *)
  318.  
  319.     rArgs:=dArgs;
  320.  
  321.     argIn.source.buffer:=SYSTEM.ADR(buf^);
  322.     argIn.source.length:=Strings.Length(buf^);
  323.     argIn.source.curChr:=0;
  324.     argIn.flags:=LONGSET{D.noPrompt};
  325.  
  326.     IF D.ReadArgs(rxTemplate,rArgs,argIn)=NIL THEN
  327.       SR.ReplyRexxCommand(rMsg,20,D.IoErr(),NIL);
  328.     END; (* IF *)
  329.  
  330.     IF rCom="GETFILESAVE" THEN
  331.       rArgs.saveMode:=D.DOSTRUE
  332.  
  333.     ELSIF rCom="GETDIR" THEN
  334.       rArgs.dirOnly:=D.DOSTRUE
  335.  
  336.     ELSIF rCom#"GETFILE" THEN
  337.       SR.ReplyRexxCommand(rMsg,10,11,NIL);
  338.       (* $IFNOT GarbageCollector *)
  339.         DISPOSE(buf);
  340.       (* $END *)
  341.       D.FreeDosObject(D.rdArgs,argIn);
  342.       RETURN
  343.     END; (* IF *)
  344.  
  345.     OpenReq(rArgs,fileBuffer);
  346.  
  347.  
  348.     IF rArgs.envVar#NIL THEN
  349.       IF RVI.SetRexxVar(rMsg,rArgs.envVar^,fileBuffer,Strings.Length(fileBuffer))=NIL THEN END;
  350.       SR.ReplyRexxCommand(rMsg,0,NIL,NIL);
  351.     ELSE
  352.       SR.ReplyRexxCommand(rMsg,0,NIL,SYSTEM.ADR(fileBuffer));
  353.     END; (* IF *)
  354.  
  355.   END DoRxCommand;
  356.  
  357.  
  358. BEGIN
  359.  
  360.   REPEAT
  361.     mask := E.Wait(LONGSET{rxHost.port.sigBit, D.ctrlC});
  362.     IF rxHost.port.sigBit IN mask THEN
  363.       rMsg := E.GetMsg(rxHost.port);
  364.  
  365.       IF RXS.IsRexxMsg(rMsg) THEN
  366.  
  367.         IF RX.ActionCode(rMsg(RX.RexxMsg).action) = RX.rxComm THEN
  368.           DoRxCommand(rMsg(RX.RexxMsg).args[0]);
  369.         ELSIF RX.ActionCode(rMsg(RX.RexxMsg).action) = RX.rxClose THEN
  370.           quit := TRUE;
  371.           E.ReplyMsg(rMsg);
  372.         ELSE
  373.           rMsg(RX.RexxMsg).result1:=10;
  374.           rMsg(RX.RexxMsg).result2:=10;
  375.           E.ReplyMsg(rMsg);
  376.         END; (* IF *)
  377.  
  378.       ELSE
  379.         E.ReplyMsg(rMsg);
  380.       END; (* IF *)
  381.     ELSIF D.ctrlC IN mask THEN
  382.        quit := TRUE;
  383.     END; (* IF *)
  384.   UNTIL quit;
  385.  
  386. END RexxLoop;
  387.  
  388. (*****************************************************************************)
  389.  
  390. BEGIN
  391.   (** Das Programm laeuft nur >= Kick 2.x **)
  392.   IF OL.wbStarted THEN HALT(20); END;   (* sinnlos von WB *)
  393.   IF D.dos.lib.version < 37 THEN
  394.     IF D.Write(D.Output(),need20,SIZE(need20)) = 0 THEN END;
  395.     HALT(20);
  396.   END;
  397.   SYSTEM.SETREG(0,SYSTEM.ADR(versionString));
  398.   IF D.GetProgramName(progName,LEN(progName)) THEN
  399.     progNamePtr:=D.FilePart(progName);
  400.     COPY(progNamePtr^,progName)
  401.   ELSE
  402.     progName:=oProgName
  403.   END;
  404.  
  405.   (** Initialisierung der Variablen **)
  406.   dArgs:=DosArgs(SYSTEM.ADR(leererString),SYSTEM.ADR(leererString),
  407.                  NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,0,0,0,NIL,0);
  408.   top:=40; left:=40; width:=320; height:=380;
  409.   pubScrName:="";
  410.  
  411.   (** Hole die Argumente von dem CLI **)
  412.   IF D.ReadArgs(argTemplate,dArgs,NIL)=NIL THEN
  413.     IF D.PrintFault(D.IoErr(),progName) THEN END;
  414.     HALT(10)
  415.   END; (* IF *)
  416.  
  417.   IF dArgs.help#0 THEN
  418.     D.PrintF("\n\[33m%ls%s\[0m © 1993 by Michael 'Mick' Hohmann and Harmut Goebel"
  419.              "%s\n\nOpens an ASL-FileRequester and returns the Result either"
  420.              " to StdOut or\nto an Env-Variable. It is also possible to use"
  421.              " it as an RexxHost with\nthe following commands:\n · GETFILE\n"
  422.              " · GETFILESAVE\n · GETDIR\n · QUIT\nFor more help please take"
  423.              " a look at the Manual!\n\n",SYSTEM.ADR(progName),SYSTEM.ADR(version),SYSTEM.ADR(date));
  424.     HALT(0)
  425.   END; (* IF *)
  426.  
  427.   aslReq:=ASL.AllocAslRequestTags(ASL.fileRequest,NIL);
  428.  
  429.   IF dArgs.rexxHost # NIL THEN
  430.     rxHost.port:=E.CreateMsgPort();
  431.     rxHost.port.node.pri:=0;
  432.  
  433.     IF dArgs.portName#NIL THEN
  434.       rxHost.port.node.name:=dArgs.portName
  435.     ELSE
  436.       rxHost.port.node.name:=SYSTEM.ADR("FILEREXX")
  437.     END; (* IF *)
  438.  
  439.     E.Forbid;
  440.  
  441.     hisPort:=E.FindPort(rxHost.port.node.name^);
  442.  
  443.     IF hisPort#NIL THEN
  444.       sMsg:=RXS.CreateRexxMsg(rxHost.port,NIL,hisPort.node.name^);
  445.       IF sMsg#NIL THEN
  446.         sMsg.action:=RX.rxClose;
  447.         sMsg.node.node.name := SYSTEM.ADR(RX.rxsDir);
  448.         E.PutMsg(hisPort,sMsg);
  449.         E.Permit;
  450.       ELSE
  451.         E.Permit;
  452.         E.DeleteMsgPort(rxHost.port);
  453.         HALT(20);
  454.       END;
  455.       D.PrintF("... Port already exists --- removing FileRexx\n\n");
  456.       E.WaitPort(rxHost.port);
  457.       RXS.DeleteRexxMsg(E.GetMsg(rxHost.port)); (* kann nur sMsg sein! *)
  458.       E.DeleteMsgPort(rxHost.port);
  459.       HALT(0);
  460.     END;
  461.     E.AddPort(rxHost.port);
  462.     E.Permit;
  463.     D.PrintF("Just opened an ARexx-Port ...\n"); (* !!! hG erst wenn auch geklpatt hat !!! *)
  464.     useRexx := TRUE; (* !!! *)
  465.  
  466.     RexxLoop;
  467.  
  468.     E.RemPort(rxHost.port);
  469.     LOOP
  470.       sMsg := E.GetMsg(rxHost.port);
  471.       IF sMsg = NIL THEN EXIT END;
  472.       E.ReplyMsg(sMsg);
  473.     END;
  474.     E.DeleteMsgPort(rxHost.port);
  475.  
  476.   ELSE
  477.  
  478.    useRexx := FALSE;
  479.    OpenReq(dArgs,progName);
  480.  
  481.   END; (* IF *)
  482.  
  483.  
  484. CLOSE
  485.  
  486.   CleanUp;
  487.  
  488.   IF aslReq#NIL THEN
  489.     ASL.FreeAslRequest(aslReq);   (** ASL-RequesterStruktur wieder freigeben **)
  490.   END;
  491.  
  492. END FileRexx.
  493.