home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / a2.0bemacs-src.lha / Emacs-19.25 / src / amiga_rexx.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-28  |  13.5 KB  |  464 lines
  1. /* low level ARexx code for use in amiga version of Emacs.
  2.    Copyright (C) 1993 Christian E. Hopps.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "SimpleRexx.h"
  21. #include <proto/exec.h>
  22. #include "config.h"
  23. #include "lisp.h"
  24.  
  25. #include "amiga.h"
  26.  
  27. #ifdef USE_PROTOS
  28. #include "protos.h"
  29. #endif
  30.  
  31. #define XLRXMSG(x) ((struct LispRexxMsg *) XPNTR((x)))
  32. #define XSETLRXMSG(x,v) (XSET((x), Lisp_Int, v))
  33.  
  34. static AREXXCONTEXT far handle;
  35. static int amiga_arexx_initialized;
  36.  
  37. /* This structure should be allocated with emacs_malloc() its pointer will be */
  38. /* used as an msgid. (emacs XUINT())*/
  39. struct LispRexxMsg {
  40.   struct MinNode  lrm_Node;              /* A node for tracking messages. */
  41.   struct RexxMsg *lrm_Msg;              /* The actual Rexx Msg. */
  42.   ULONG  lrm_Flags;
  43. };
  44. /* Flags for LispRexxMessage indicating what to do with it. */
  45. #define LRMF_SENTCMD (1L << 0)              /* this msg originated here. */
  46. #define LRMF_DOERRORS (1L << 1)              /* handle error replies */
  47. #define LRMF_DORESULTS (1L << 2)          /* handle result strings */
  48.  
  49. struct LispRexxList {
  50.     struct MinList lrl_List;
  51.     int    lrl_Count;
  52. };
  53.  
  54. struct LispRexxList pending;              /* The list of pending */
  55.                           /* (outgoing) Rexx Messages. */
  56. struct LispRexxList returned;              /* The list of pending */
  57.                           /* (outgoing) Rexx Messages */
  58.                           /* that have been received. */
  59. struct LispRexxList incoming;              /* The message that are */
  60.                           /* incoming to Emacs (sent */
  61.                           /* from some other rexx host. */
  62.  
  63. /* allocate a rexx message properly */
  64. Lisp_Object alloc_rexx_msg(ULONG flags)
  65. {
  66.     Lisp_Object rm = Qnil;
  67.     struct LispRexxMsg *lrm = (struct LispRexxMsg *)malloc(sizeof(*lrm));
  68.     if(lrm) {
  69.     lrm->lrm_Flags = flags;
  70.     XSETLRXMSG(rm,lrm);
  71.     return(rm);
  72.     }
  73.     return(Qnil);
  74. }
  75.  
  76. /* free an arexx message allocated with alloc_arexx_msg() */
  77. void free_rexx_msg (Lisp_Object rm)
  78. {
  79.     if(!NILP(rm)) {
  80.     void *mem = XLRXMSG(rm);
  81.     free(mem);
  82.     }
  83. }
  84.  
  85. /* The next 2 functions imlement FIFO lists. */
  86.  
  87. /* add LispRexxMsg to a LispRexxLisp Tail. */
  88. void add_rexx_msg_to_tail(struct LispRexxList *rl, Lisp_Object rm)
  89. {
  90.     AddTail((struct List *)rl,(struct Node *)XPNTR(rm));
  91.     rl->lrl_Count++;
  92. }
  93.  
  94. /* remove LispRexxMsg from head of a LispRexxLisp. */
  95. Lisp_Object remove_rexx_msg_from_head(struct LispRexxList *rl)
  96. {
  97.     Lisp_Object rm = (Lisp_Object)RemHead((struct List *)rl);
  98.     if(rm != 0) {
  99.     rl->lrl_Count--;
  100.     return(rm);
  101.     } else {
  102.         return Qnil;
  103.     }
  104. }
  105.  
  106. void remove_rexx_msg(struct LispRexxList *rl, Lisp_Object rm)
  107. {
  108.     Remove((struct Node *)XPNTR(rm));
  109.     rl->lrl_Count--;
  110. }
  111.  
  112.  
  113. /* find a rexx message on a list given an msgid (ptr) */
  114. int is_rexx_msgid_on_list(struct LispRexxList *rl,
  115.                     Lisp_Object id)
  116. {
  117.     struct MinNode *mn = rl->lrl_List.mlh_Head;
  118.     for(mn; mn->mln_Succ; mn = mn->mln_Succ) {
  119.     Lisp_Object cmpid = Qnil;
  120.     XSETLRXMSG(cmpid,mn);
  121.     if( EQ(cmpid,id)) {
  122.         return(1);
  123.     }
  124.     }
  125.     return(0);
  126. }
  127.  
  128. Lisp_Object find_rexx_msg_on_list(struct LispRexxList *rl,
  129.                   struct RexxMsg *msg)
  130. {
  131.     Lisp_Object pnt = Qnil;
  132.     struct MinNode *mn = rl->lrl_List.mlh_Head;
  133.     for(mn; mn->mln_Succ; mn = mn->mln_Succ) {
  134.     if( ((struct LispRexxMsg *)mn)->lrm_Msg == msg) {
  135.         XSETLRXMSG(pnt,mn);
  136.     }
  137.     }
  138.     return(pnt);
  139. }
  140.  
  141. /* This function is given a RexxMsg and it goes and find (or doesn't) the */
  142. /* corisponding pending message, removes it from the list and sets up the lisp */
  143. /* list for return values.  if it is not found nil is returned. (it deals with */
  144. /* the errors for incoming messages properly.  Some thought is needed on how to */
  145. /* handle errors from replied sent commands that were not asking for results. */
  146. Lisp_Object handle_rexx_msg_replied(struct RexxMsg *msg)
  147. {
  148.     Lisp_Object rm = find_rexx_msg_on_list(&pending, msg);
  149.     if(!NILP(rm)) {
  150.     /* Process the command.  If it was requesting results strings handle */
  151.     /* them otherwise just delete. */
  152.     struct LispRexxMsg *lrm = XLRXMSG(rm);
  153.     remove_rexx_msg(&pending, rm);
  154.  
  155.     if(msg->rm_Result1 == 0) {
  156.         if(lrm->lrm_Flags & LRMF_DORESULTS) {
  157.         /* add to returned so that result can be fetched. */
  158.         add_rexx_msg_to_tail(&returned,rm);
  159.         } else {
  160.         /* simply delete rexx message. */
  161.         DeleteARexxMsg(handle,msg);
  162.         free_rexx_msg(rm);
  163.         }
  164.     } else {
  165.         /* an error occured with our message. */
  166.         if(lrm->lrm_Flags & LRMF_DOERRORS) {
  167.         /* add to returned so that error can be fetched. */
  168.         add_rexx_msg_to_tail(&returned,rm);
  169.         } else {
  170.         /* simply delete rexx message. */
  171.         DeleteARexxMsg(handle,msg);
  172.         free_rexx_msg(rm);
  173.         }
  174.     }
  175.     } else {
  176.     /* This should never happen we received a rexx message reply */
  177.     /* that we never sent out. */
  178.     DeleteARexxMsg(handle,msg);
  179.     }
  180. }
  181.  
  182. /* This function takes incoming messages and place them on the incoming msg */
  183. /* list.  */
  184. Lisp_Object handle_rexx_msg_received(struct RexxMsg *msg)
  185. {
  186.     Lisp_Object rm = alloc_rexx_msg(LRMF_DORESULTS|LRMF_DOERRORS);
  187.     if(!NILP(rm)) {
  188.     /* Add message to incoming list. */
  189.     struct LispRexxMsg *lrm = XLRXMSG(rm);
  190.     lrm->lrm_Msg = msg;              /* set msg pointer. */
  191.     add_rexx_msg_to_tail(&incoming,rm);
  192.     } else {
  193.     /* This should never happen we received a rexx message but ran out of */
  194.     /* memory.  Set last error msg. and reply with fail. */
  195.     SetARexxLastError(handle, msg, "Out of emacs memory.");
  196.     ReplyARexxMsg(handle, msg, 0, 20);
  197.     }
  198. }
  199.  
  200. /* Almost the same as old one, but we now call handle_pending_arexx_reply() for */
  201. /* replied messages that we sent, so that we can setup result strings and such. */
  202. int check_arexx(int force, int kbd)
  203. {
  204.     struct RexxMsg *msg;
  205.     int msg_received = FALSE;
  206.     while (msg = GetARexxMsg(handle)) {
  207.     msg_received = TRUE;
  208.     if(msg->rm_Node.mn_Node.ln_Type == NT_REPLYMSG)    {
  209.         /* This is a reply to a rexx command we send out. */
  210.         handle_rexx_msg_replied(msg);
  211.     } else {
  212.         handle_rexx_msg_received(msg);
  213.     }
  214.     }
  215.     if ((kbd && amiga_arexx_initialized)) {
  216.     /* if we got a message or we have some out, or we have some waiting to */
  217.     /* be processes then enque the Key sequence that will call the rexx */
  218.     /* message handler.  We obviously don't do this for returned commands :^) */
  219.     if ((msg_received || force && incoming.lrl_Count > 0) &&
  220.         get_ttycount() == 0) {
  221.         enque(AMIGASEQ, FALSE, FALSE); enque('X', FALSE, FALSE);
  222.     }
  223.     }
  224.     return msg_received;
  225. }
  226.  
  227. DEFUN ("amiga-arexx-wait", Famiga_arexx_wait, Samiga_arexx_wait, 0, 0, 0,
  228.        "Wait for an ARexx event (command or reply) before proceeding.")
  229.     ()
  230. {
  231.     while (!check_arexx(FALSE, FALSE)) Wait(ARexxSignal(handle));
  232. }
  233.  
  234. DEFUN ("amiga-arexx-check-command",
  235.        Famiga_arexx_check_command, Samiga_arexx_check_command, 1, 1, 0,
  236.        "Return t if command ID has finished, nil otherwise.")
  237.     (id)
  238. Lisp_Object id;
  239. {
  240.     CHECK_NUMBER(id,0);
  241.  
  242.     if(is_rexx_msgid_on_list(&pending,id)) {
  243.     /* still on pending return false. */
  244.     return Qnil;
  245.     } else if(is_rexx_msgid_on_list(&returned,id)) {
  246.     /* is waiting to be processed return true. */
  247.     return Qt;
  248.     }
  249.  
  250.     /* is nowhere to be found. error. */
  251.     error("id not found.");
  252.     return Qnil;
  253. }
  254.  
  255. DEFUN ("amiga-arexx-get-next-msg", Famiga_arexx_get_next_msg,
  256.        Samiga_get_next_msg, 0, 0, 0,
  257. "Returns the oldest arexx msg sent to emacs rexx port.\n\
  258. When you are through with this message call (amiga-arexx-reply).\n\
  259. if the msg is not replied this function will continue to\n\
  260. return that msg until it has been replied to.")
  261.   ()
  262. {
  263.     struct RexxMsg *rmsg;
  264.  
  265.     check_arexx(FALSE, FALSE);
  266.     if (incoming.lrl_Count) {
  267.     struct RexxMsg *msg = ((struct LispRexxMsg *)
  268.                    incoming.lrl_List.mlh_Head)->lrm_Msg;
  269.     return build_string(ARG0(msg));
  270.     }
  271.     /* nothing to be gotten. */
  272.     return Qnil;
  273. }
  274.  
  275. DEFUN("amiga-arexx-get-msg-results", Famiga_arexx_get_msg_results,
  276.       Samiga_arexx_get_msg_results, 1,1,0,
  277. "Returns the results from MSGID. will be a list of the form:\n\
  278.   (msgid resultcode secondary)\n\n\
  279. If resultcode is 0 then secondary will be a string or nil.\n\
  280. else resulcode will be greater than 0 and secondary will be\n\
  281. an error-code (int).\n\n\
  282. If MSGID has not yet completed nil is returned.\n\
  283. if MSGID has been dealt with or is invalid and error will occur.")
  284.     (msgid)
  285. Lisp_Object msgid;
  286. {
  287.     CHECK_NUMBER(msgid,0);
  288.  
  289.     if(is_rexx_msgid_on_list(&returned,msgid)) {
  290.     /* msgid has completed build list and delete LispRexxMsg. */
  291.     struct LispRexxMsg *lrm = XLRXMSG(msgid);
  292.     Lisp_Object rc, error_or_string, ret;
  293.     struct RexxMsg *msg = lrm->lrm_Msg;
  294.  
  295.     remove_rexx_msg(&returned,msgid);
  296.  
  297.     rc = make_number(msg->rm_Result1);
  298.     if(msg->rm_Result1 == 0) {
  299.         error_or_string = msg->rm_Result2 ? build_string((char *) msg->rm_Result2) : 0;
  300.     } else {
  301.         /* error occurred */
  302.         error_or_string = make_number(msg->rm_Result2); /* save error code. */
  303.     }
  304.     free_rexx_msg(msgid);              /* free our rexx msg. */
  305.     DeleteARexxMsg(handle,msg);          /* free ARexx msg proper */
  306.  
  307.     /* build lisp list. */
  308.     ret = Fcons( msgid, Fcons( rc, Fcons(error_or_string, Qnil)));
  309.     if(NILP(ret)) {
  310.         error("Couldn't get memory.");
  311.     }
  312.     return(ret);
  313.     } else if(is_rexx_msgid_on_list(&pending,msgid)) {
  314.     return Qnil;                  /* this msgid has not yet completed. */
  315.     } else {
  316.     error("Unknown MSGID.");
  317.     return Qnil;
  318.     }
  319. }
  320.  
  321. DEFUN ("amiga-arexx-reply", Famiga_arexx_reply, Samiga_arexx_reply,
  322.        2, 2, 0,
  323. "Replies to the first arexx message (the one got via amiga-arexx-get-event)\n\
  324. with RC as return code.\n\
  325. If RC=0, TEXT is the result, otherwise it is the error text. It can be nil.")
  326.     (rc, text)
  327. Lisp_Object rc, text;
  328. {
  329.     int retcode, ok = TRUE;
  330.     char *result;
  331.     struct RexxMsg *rmsg;
  332.     Lisp_Object rm = remove_rexx_msg_from_head(&incoming);
  333.     struct LispRexxMsg *lrm = XLRXMSG(rm);
  334.  
  335.     if (NILP(rm))
  336.     error("No ARexx message to reply to.");
  337.  
  338.     rmsg = lrm->lrm_Msg;
  339.  
  340.     CHECK_NUMBER(rc, 0);
  341.     retcode = XINT(rc);
  342.  
  343.     if (!NILP (text)) {
  344.     CHECK_STRING(text, 0);
  345.     result = XSTRING (text)->data;
  346.     } else {
  347.     result = 0;
  348.     }
  349.     if (retcode && result)
  350.     ok = SetARexxLastError(handle, rmsg, result);
  351.     ReplyARexxMsg(handle, rmsg, result, retcode);
  352.  
  353.     if (!ok)
  354.     error("Failed to set ARexx error message.");
  355.  
  356.     return Qnil;
  357. }
  358.  
  359. Lisp_Object send_rexx_command(Lisp_Object str, Lisp_Object as_file,
  360.                   ULONG flags)
  361. {
  362.     struct RexxMsg *rmsg;
  363.     int i;
  364.     Lisp_Object id, rm;
  365.     struct LispRexxMsg *lrm;
  366.  
  367.     rm = alloc_rexx_msg(flags);
  368.     if(NILP(rm)) {
  369.     error("Failed to send command to ARexx.");
  370.     return Qnil;
  371.     }
  372.  
  373.     CHECK_STRING (str, 0);
  374.     if (!(rmsg = SendARexxMsg(handle, XSTRING (str)->data,!NILP (as_file),
  375.                   (flags & LRMF_DORESULTS ? 1 : 0)))) {
  376.     free_rexx_msg(rm);
  377.     error("Failed to send command to ARexx.");
  378.     return Qnil;
  379.     }
  380.     lrm = XLRXMSG(rm);
  381.     lrm->lrm_Msg = rmsg;              /* set rexx message pointer. */
  382.     add_rexx_msg_to_tail(&pending,rm);          /* add to pending list. */
  383.  
  384.     return(rm);
  385. }
  386.  
  387. DEFUN ("amiga-arexx-send-command", Famiga_arexx_send_command,
  388.        Samiga_arexx_send_command, 1, 2, 0,
  389. "Sends a command to ARexx for execution.\n\
  390. If the second arg is non-nil, the command is directly interpreted.\n\
  391. Returns an integer that uniquely identifies this message.  This must\n\
  392. then be used to get the results from the command.\n\
  393. NOTE: this is very different from old way things worked.\n\
  394.       earlier versions of emacs discarded successful results\n\
  395.       and errors always got replied to becuase they caused failures\n\
  396.       Neither of these are true now.\
  397. This function is also no longer interactive.\n\
  398. Use (amiga-arexx-do-command)\n")
  399.     (str, as_file)
  400. Lisp_Object str, as_file;
  401. {
  402.     return(send_rexx_command(str,as_file,
  403.                  LRMF_DORESULTS|
  404.                  LRMF_DOERRORS|
  405.                  LRMF_SENTCMD));
  406. }
  407.  
  408. void init_amiga_rexx(void)
  409. {
  410.     extern ULONG inputsig;
  411.     int i;
  412.  
  413.     handle = InitARexx("Emacs", "elx");
  414.     inputsig |= ARexxSignal(handle);
  415.  
  416.     /* init exec lists. */
  417.     NewList((struct List *)&incoming.lrl_List);
  418.     incoming.lrl_Count = 0;
  419.  
  420.     NewList((struct List *)&pending.lrl_List);
  421.     pending.lrl_Count = 0;
  422.  
  423.     NewList((struct List *)&returned.lrl_List);
  424.     returned.lrl_Count = 0;
  425. }
  426.  
  427. void cleanup_amiga_rexx(void)
  428. {
  429.     /* Delete and reply all rexx messages we have gotten. */
  430.     Lisp_Object rm = remove_rexx_msg_from_head(&returned);
  431.     while(!NILP(rm)) {
  432.     struct LispRexxMsg *lrm = XLRXMSG(rm);
  433.     DeleteARexxMsg(handle,lrm->lrm_Msg);
  434.     free_rexx_msg(rm);
  435.     rm = remove_rexx_msg_from_head(&returned);
  436.     }
  437.  
  438.     rm = remove_rexx_msg_from_head(&incoming);
  439.     while(!NILP(rm)) {
  440.     struct LispRexxMsg *lrm = XLRXMSG(rm);
  441.     ReplyARexxMsg(handle, lrm->lrm_Msg, 0, 20);
  442.     free_rexx_msg(rm);
  443.     rm = remove_rexx_msg_from_head(&incoming);
  444.     }
  445.  
  446.     /* Free the rest of rexx, will wait for pending msgs to return */
  447.     FreeARexx(handle);
  448. }
  449.  
  450. void syms_of_amiga_rexx(void)
  451. {
  452.     DEFVAR_BOOL ("amiga-arexx-initialized", &amiga_arexx_initialized,
  453.          "Set this to t when Emacs is ready to respond to ARexx messages.\n"
  454.          "(ie C-\ X causes all pending ARexx messages to be answered)");
  455.     amiga_arexx_initialized = 0;
  456.  
  457.     defsubr(&Samiga_arexx_send_command);
  458.     defsubr(&Samiga_arexx_reply);
  459.     defsubr(&Samiga_get_next_msg);
  460.     defsubr(&Samiga_arexx_get_msg_results);
  461.     defsubr(&Samiga_arexx_check_command);
  462.     defsubr(&Samiga_arexx_wait);
  463. }
  464.