"Fossies" - the Fresh Open Source Software Archive

Member "Pansophica-src-1.3/BAF/tcl/BAF_tclapi.c" (1 Feb 2008, 42018 Bytes) of package /linux/www/old/Pansophica-src-1.3-1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "BAF_tclapi.c" see the Fossies "Dox" file reference documentation.

    1 /******************************************************************************
    2 
    3  Pansophica, An intelligent, virtual-reality, web search agent
    4  Copyright (C) MMVIII, NeuralVR Technologies Ltd.
    5 
    6  This program 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 3 of the License, or
    9  (at your option) any later version.
   10 
   11  This program 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 this program.  If not, see http://www.gnu.org/licenses/.
   18 
   19  MODULE: BAF_tclapi.c
   20  $Id: BAF_tclapi.c,v 1.13 2008/02/01 18:03:33 dean Exp $
   21 
   22  SYNOPSIS
   23  Tcl interfaces for BAF
   24 
   25  HISTORY
   26  $Log: BAF_tclapi.c,v $
   27  Revision 1.13  2008/02/01 18:03:33  dean
   28  first GPL version, mac ready
   29 
   30  Revision 1.12  2003/11/14 04:25:57  dean
   31  ERROR and CLEANUP tags prefaced with BAF_
   32 
   33  Revision 1.11  2003/11/13 20:17:25  dean
   34  removal of generic macros in favour of 'baf_' prefixed macros
   35 
   36  Revision 1.10  2003/11/12 19:06:16  dean
   37  boolean to BAF_BOOLEAN, true to BAF_TRUE, false to BAF_FALSE
   38 
   39  Revision 1.9  2003/10/22 03:54:11  dean
   40  changed copyrighting
   41 
   42  Revision 1.8  2003/05/08 03:09:37  dean
   43  elimination of tcl compile warnings
   44 
   45  Revision 1.7  2003/04/29 22:30:17  dean
   46  updated for redhat 9
   47 
   48  Revision 1.6  1999/10/16 00:27:23  dean
   49  passing user_data part of session status back to tcl
   50 
   51  Revision 1.5  1999/10/15 23:10:34  dean
   52  vastly improved handling of failure and reply tcl callbacks
   53 
   54  Revision 1.4  1999/10/12 17:24:19  dean
   55  free up the point proc on message when session canceled
   56 
   57  Revision 1.3  1999/09/02 00:23:54  dean
   58  better error reporting on tcl_eval's
   59 
   60  Revision 1.2  1999/02/25 22:16:59  dean
   61  interface with queue reference for app queue rather than int id
   62 
   63  Revision 1.1.1.1  1999/01/14 21:54:23  dean
   64  Initial import of debugged and running BAF
   65 
   66 
   67 ******************************************************************************/
   68 
   69 
   70 #include <tcl.h>
   71 #include <stdlib.h>
   72 #include <string.h>
   73 
   74 #include "BAF_tclapi.h"
   75 #include "util_tree.h"
   76 #include "util_debug.h"
   77 #include "util_mem.h"
   78 
   79 #define MAX_MEMORY_ADDRESS_SIZE_IN_CHAR 40
   80 #define ERROR_STRING "ERROR"
   81 #define SUCCESS_STRING "SUCCESS"
   82 #define  EMPTY_TCL_TAG_VALUE "NULL"
   83 
   84 typedef struct GUI_USER_TAG {
   85   char *tcl_command;
   86   char *tcl_tag;
   87 } GUI_USER_TAG;
   88 
   89 
   90 /* : globals for session validity tracking */
   91 static UTIL_TREE_REF g_gui_invalid_tree = NULL;
   92 
   93 /* prototypes */
   94 static int BAF_treat_response_msg(Tcl_Interp *interp, 
   95                   ENDO_MSG_REF response);
   96 
   97 static int BAF_send_simple_msg(ClientData clientData, 
   98                    Tcl_Interp *interp, 
   99                    int argc, 
  100                    char *argv[]);
  101 static int BAF_send_simple_msg_in_new_session(ClientData clientData, 
  102                           Tcl_Interp *interp, 
  103                           int argc, 
  104                           char *argv[]);
  105 static int BAF_session_cmd(ClientData clientData, 
  106                Tcl_Interp *interp, 
  107                int argc, 
  108                char *argv[]);
  109 static int BAF_send_msg_wait_reply(ClientData clientData, 
  110                    Tcl_Interp *interp, 
  111                    int argc, 
  112                    char *argv[]);
  113 static int BAF_send_msg_reply(ClientData clientData, 
  114                   Tcl_Interp *interp, 
  115                   int argc, 
  116                   char *argv[]);
  117 #if 0  /* not used */
  118 static int BAF_send_msg2(ClientData clientData, 
  119              Tcl_Interp *interp, 
  120              int argc, 
  121              char *argv[]);
  122 #endif
  123 
  124 /* debug functions */
  125 static int BAF_debug_trace(ClientData clientData, 
  126                Tcl_Interp *interp, 
  127                int argc, 
  128                char *argv[]);
  129 static int BAF_set_debug_level(ClientData clientData, 
  130                    Tcl_Interp *interp, 
  131                    int argc, 
  132                    char *argv[]);
  133 static int BAF_get_debug_level(ClientData clientData, 
  134                    Tcl_Interp *interp, 
  135                    int argc, 
  136                    char *argv[]);
  137 static int BAF_set_memory_level(ClientData clientData, 
  138                 Tcl_Interp *interp, 
  139                 int argc, 
  140                 char *argv[]);
  141 static int BAF_get_memory_level(ClientData clientData, 
  142                 Tcl_Interp *interp, 
  143                 int argc, 
  144                 char *argv[]);
  145 static int BAF_is_debug_compiled_in(ClientData clientData, 
  146                     Tcl_Interp *interp, 
  147                     int argc, 
  148                     char *argv[]);
  149 static int BAF_is_memory_compiled_in(ClientData clientData, 
  150                      Tcl_Interp *interp, 
  151                      int argc, 
  152                      char *argv[]);
  153 static int BAF_get_debug_tree_list(ClientData clientData, 
  154                    Tcl_Interp *interp, 
  155                    int argc, 
  156                    char *argv[]);
  157 static int BAF_debug_file_on(ClientData clientData, 
  158                  Tcl_Interp *interp, 
  159                  int argc, 
  160                  char *argv[]);
  161 static int BAF_debug_file_off(ClientData clientData, 
  162                   Tcl_Interp *interp, 
  163                   int argc, 
  164                   char *argv[]);
  165 
  166 /******************************************************************************
  167 
  168  PUBLIC: BAF_tcl_init
  169 
  170  SYNOPSIS
  171  Initialise the Tcl, Tk, and the API, and return the interp ref
  172 
  173  HISTORY
  174  Created Oct 21, 1998 by LeoP:
  175 
  176 ******************************************************************************/
  177 
  178 BAF_TCL_RESULT
  179 BAF_tcl_init(
  180 char *application_name,
  181 Tcl_Interp *interp
  182 )
  183 {
  184   BAF_IN(PUBLIC);
  185 
  186   /* Send a simple message with no response */
  187   Tcl_CreateCommand(interp, "BAF_SendSimpleMsg",
  188             (Tcl_CmdProc*)BAF_send_simple_msg,
  189             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  190 
  191   /* Send a simple message in a new SESSION with no response */
  192   Tcl_CreateCommand(interp, "BAF_SendSimpleMsgInNewSession",
  193             (Tcl_CmdProc*) BAF_send_simple_msg_in_new_session,
  194             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  195 
  196   /* Send a message and wait for the reply */
  197   Tcl_CreateCommand(interp, "BAF_SendMsgWaitReply",
  198             (Tcl_CmdProc*) BAF_send_msg_wait_reply,
  199             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  200 
  201   /* Send a message and ask for the reply */
  202   Tcl_CreateCommand(interp, "BAF_SendMsgReply",
  203             (Tcl_CmdProc*) BAF_send_msg_reply,
  204             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  205 
  206   /* DEBUGGING CALLS */
  207   Tcl_CreateCommand(interp, "debug",
  208             (Tcl_CmdProc*) BAF_debug_trace,
  209             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  210   Tcl_CreateCommand(interp, "BAF_set_debug_level",
  211             (Tcl_CmdProc*) BAF_set_debug_level,
  212             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  213   Tcl_CreateCommand(interp, "BAF_get_debug_level",
  214             (Tcl_CmdProc*) BAF_get_debug_level,
  215             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  216   Tcl_CreateCommand(interp, "BAF_set_memory_level",
  217             (Tcl_CmdProc*) BAF_set_memory_level,
  218             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  219   Tcl_CreateCommand(interp, "BAF_get_memory_level",
  220             (Tcl_CmdProc*) BAF_get_memory_level,
  221             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  222   Tcl_CreateCommand(interp, "BAF_is_debug_compiled_in",
  223             (Tcl_CmdProc*) BAF_is_debug_compiled_in,
  224             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  225   Tcl_CreateCommand(interp, "BAF_is_memory_compiled_in",
  226             (Tcl_CmdProc*) BAF_is_memory_compiled_in,
  227             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  228   Tcl_CreateCommand(interp, "BAF_get_debug_tree_list",
  229             (Tcl_CmdProc*) BAF_get_debug_tree_list,
  230             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  231   Tcl_CreateCommand(interp, "BAF_debug_file_on",
  232             (Tcl_CmdProc*) BAF_debug_file_on,
  233             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  234   Tcl_CreateCommand(interp, "BAF_debug_file_off",
  235             (Tcl_CmdProc*) BAF_debug_file_off,
  236             (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
  237 
  238   BAF_OUT(PUBLIC);
  239 }
  240 
  241 
  242 /******************************************************************************
  243 
  244  FUNCTION: BAF_get_one_event
  245 
  246  SYNOPSIS
  247  Gets a gui event from the gui event queue
  248 
  249 ******************************************************************************/
  250 
  251 BAF_TCL_RESULT 
  252 BAF_get_one_event(
  253 Tcl_Interp *interp,
  254 OS_ENDO_QUEUE_REF msg_queue_ref
  255 )
  256 {
  257   ENDO_RESULT endo_result;
  258   ENDO_MSG_REF msg_ref = NULL;
  259   char *tcl_command = NULL;
  260   ENDO_MSG_REF orig_msg = NULL;
  261 
  262   /* : too much telemetry */
  263   /*  BAF_IN(PRIVATE); */
  264 
  265   /* get the next message in the APPLICATION queue, if any (not
  266      SUCCESS == none ) */
  267   endo_result = endo_msg_get_next_application(msg_queue_ref, &msg_ref);
  268   if (endo_result == ENDO_MESSAGE_QUEUE_EMPTY) {
  269     return BAF_TCL_NO_EVENT;
  270   } else if (endo_result == ENDO_SUCCESS) {
  271 
  272     /* get the address of the message which represents the Tcl command */
  273     TAKE(tcl_command, (char *), 
  274      sizeof(char) * MAX_MEMORY_ADDRESS_SIZE_IN_CHAR) {
  275       BAF_ERROR_MSG("error allocating memory for for the tcl command name");
  276     }
  277     sprintf(tcl_command, "%p", msg_ref);
  278 
  279     /* treat the response msg */
  280     BAF_CATCH( BAF_treat_response_msg(interp, msg_ref) ) {
  281       BAF_ERROR_MSG("can't treat the response");
  282     }
  283 
  284     /* : get the original message and mark it as invalid for cancel and status
  285        : checking.  This must be done after treating the response and calling
  286        : back.  See notes in gui_treat_response_msg. */
  287     BAF_CATCH( endo_msg_response_get_original_msg( msg_ref, &orig_msg ) ) {
  288       BAF_ERROR_MSG("can't get original message");
  289     }
  290 
  291     BAF_CATCH( BAF_session_valid_mark_invalid( orig_msg ) ) {
  292       BAF_ERROR_MSG("can't mark session invalid");
  293     }
  294 
  295     /* delete the Tcl command */
  296     Tcl_DeleteCommand(interp, tcl_command );
  297 
  298     /* delete the msg */
  299     BAF_CATCH( endo_msg_dispose_application_response(&msg_ref) ) {
  300       BAF_ERROR_MSG("couldn't dispose");
  301     }
  302     GIVE( tcl_command );
  303 
  304     /*  BAF_OUT(PRIVATE); */
  305     return BAF_TCL_SUCCESS;
  306 
  307   } else {
  308     return BAF_TCL_FAILED;
  309   }
  310 
  311 
  312  BAF_ERROR:
  313   
  314   /* delete the Tcl command */
  315   if (tcl_command != NULL) {
  316     Tcl_DeleteCommand(interp, tcl_command);
  317     GIVE(tcl_command);
  318   }
  319   
  320   /* kill the orig */
  321   BAF_CATCH( endo_msg_response_get_original_msg( msg_ref, &orig_msg )) {
  322     MSG(PRIVATE,"couldn't get original on cleanup");
  323   } else {
  324     BAF_session_valid_mark_invalid( orig_msg );
  325   }
  326 
  327   /* : kill the response */
  328   endo_msg_dispose_application_response( &msg_ref );
  329 
  330   return BAF_TCL_FAILED;
  331 }
  332 
  333 /******************************************************************************
  334 
  335  FUNCTION: BAF_treat_response_msg
  336 
  337  SYNOPSIS
  338  handle a response message by calling the Tcl callback. 
  339 
  340  HISTORY
  341  Created Jun 30, 1998 by LeoP:
  342 
  343 ******************************************************************************/
  344 
  345 static int
  346 BAF_treat_response_msg(
  347 Tcl_Interp *interp,
  348 ENDO_MSG_REF response
  349 )
  350 {
  351   BAF_BOOLEAN is_success;
  352   GUI_USER_TAG *gui_user_tag = NULL;
  353   char *args_string = NULL;
  354   char *result_string = NULL;
  355   void *data = NULL;
  356   char *tcl_command = NULL;
  357   char *tcl_tag = NULL;
  358   char *work_ptr = NULL;
  359   Tcl_DString ds;
  360   int tcl_err = 0;
  361   const char *tcl_string_res = NULL;
  362   Tcl_DString es;
  363 
  364   BAF_IN(PRIVATE);
  365 
  366   /* : init these off the top so that we can clean up without event */
  367   Tcl_DStringInit( &ds );
  368 
  369   /* : Get the user tag right off the top, we'll need this to call back with
  370      : an error which is the normal failure situation.  So, normally, the
  371      : callback is called in a success situation or calls back with an
  372      : error. */
  373   /* : The exceptions occur when we can't call back, even with failure. */
  374   /* : One exception is when we have a failure before we can get the 
  375      : callback. */
  376   /* : A second exception is where we fail calling back ( error section ). */
  377   /* : In this exceptional case, we'll have to detect the error through status
  378      : polling.  The status polling will return failure because the message
  379      : becomes invalid after this call.  So ... IFF ...
  380      : - status poll returns failure AND
  381      : - we have NOT been through our callback
  382      : THEN we have this situation, whatever the reason.
  383      : To handle this add a global flag to the callback and set this flag
  384      : when you go through the callback. 
  385      : In your progress polling procedure, test this flag.  If you have an
  386      : error in status polling, without this flag being set, you have this
  387      : exceptional circumstance. */
  388 
  389   BAF_CATCH(endo_msg_response_get_data(response, &data)) {
  390     BAF_THROW_MSG("can't get the user data, failing without callback");
  391   }
  392   if (data != NULL) {
  393     /* : cast to our data type */
  394     gui_user_tag = (GUI_USER_TAG *) data;
  395     /* get the tcl command and the tcl tag */
  396     tcl_command = gui_user_tag->tcl_command;
  397     tcl_tag = gui_user_tag->tcl_tag;
  398   }
  399 
  400   /* : if we don't have a tcl_command at this point, we can't go on */
  401   if ( tcl_command == NULL ) {
  402     /* : still try to clean up a bit */
  403     if (gui_user_tag != NULL) {
  404       GIVE(gui_user_tag->tcl_command);
  405       GIVE(gui_user_tag->tcl_tag);
  406       GIVE(gui_user_tag);
  407     }
  408     BAF_THROW_MSG("can't get the user data, failing without callback");
  409   }
  410 
  411   /* determine if we have a successfull response */
  412   BAF_CATCH(endo_msg_response_is_success(response, &is_success)) {
  413     BAF_ERROR_MSG("can't determine is this is a successfull msg");
  414   }
  415 
  416   /* if this response is not successfull, get the error string */
  417   if (!is_success) {
  418     BAF_CATCH(endo_msg_response_get_error_string(response, &result_string)) {
  419       BAF_ERROR_MSG("can't get the error string in the response msg");
  420     }
  421     BAF_ERROR_MSG("message not successful, normal failure");
  422   }
  423 
  424   /* get the arguments from the message */
  425   BAF_CATCH(endo_msg_make_string_from_args(response, &args_string)) {
  426     BAF_ERROR_MSG("error putting the arguments from the message into a file");
  427   }
  428 
  429   /* : make the tcl command */
  430   Tcl_DStringAppend( &ds, tcl_command, -1 );
  431 
  432   if ( args_string != NULL ) {
  433     Tcl_DStringAppend( &ds, " ", -1 );
  434     Tcl_DStringAppend( &ds, args_string, -1 );
  435   }
  436 
  437   if ( tcl_tag != NULL ) {
  438     Tcl_DStringAppend( &ds, " ", -1 );
  439     Tcl_DStringAppend( &ds, tcl_tag, -1 );
  440   }
  441 
  442   /* : the results */
  443   Tcl_DStringAppend( &ds, " ", -1 );
  444   Tcl_DStringAppend( &ds, "\"SUCCESS\"", -1 );
  445 
  446   /* execute the TCL final command */
  447   MSG(PRIVATE, "about to execute TCL <%s>", Tcl_DStringValue(&ds) );
  448 
  449   /* : test before evaluating */
  450   if ( !(Tcl_CommandComplete( Tcl_DStringValue( &ds ) )) ) {
  451     BAF_ERROR_MSG("Didn't build valid command");
  452   }
  453 
  454   BAF_CATCH_ERR( tcl_err, Tcl_Eval(interp, Tcl_DStringValue(&ds) )) {
  455 
  456     MSG(PRIVATE, "tcl_err: %d", tcl_err );
  457     tcl_string_res = Tcl_GetStringResult(interp);
  458     BAF_ERROR_MSG("Error in evaluating the Tcl command <%s>", tcl_string_res);
  459 
  460   }
  461 
  462   /* : clean up */
  463   if (gui_user_tag != NULL) {
  464     GIVE(gui_user_tag->tcl_command);
  465     GIVE(gui_user_tag->tcl_tag);
  466     GIVE(gui_user_tag);
  467   }
  468   GIVE(args_string);
  469   GIVE(work_ptr);
  470   GIVE(result_string);
  471   Tcl_DStringFree( &ds );
  472 
  473   BAF_OUT(PRIVATE);
  474 
  475 
  476  BAF_ERROR:
  477 
  478   /* : call the callback with an error indication if possible */
  479   if ( gui_user_tag != NULL ) {
  480     if ( gui_user_tag->tcl_command != NULL ) {
  481 
  482       Tcl_DStringInit( &es );
  483 
  484       /* : we have a callback */
  485       Tcl_DStringAppend( &es, tcl_command, -1 );
  486       Tcl_DStringAppend( &es, " ", -1 );
  487 
  488       /* : if the result string has a value it's from msg_get_error_string */
  489       if ( result_string != NULL ) {
  490 
  491     /* : this can be a multi-word result so we'll need to quote it */
  492     TAKE( work_ptr, (char *), strlen(result_string)+4 ) {
  493       Tcl_DStringAppend( &es, "\"ERROR\"", -1 );
  494     } else {
  495       sprintf( work_ptr, "\"%s\"", result_string );
  496       Tcl_DStringAppend( &es, " ", -1 );
  497       Tcl_DStringAppend( &es, work_ptr, -1 );
  498     }
  499 
  500       }
  501       else {
  502 
  503     /* : append a generic result string */
  504     Tcl_DStringAppend( &es, "\"ERROR\"", -1 );
  505 
  506       }
  507       
  508       MSG(PRIVATE, "about to execute TCL <%s>", Tcl_DStringValue(&es) );
  509 
  510       if ( !(Tcl_CommandComplete( Tcl_DStringValue( &es ) )) ) {
  511     MSG(PRIVATE,"Didn't build valid error callback command");
  512     goto BAIL;
  513       }
  514 
  515       BAF_CATCH_ERR( tcl_err, Tcl_Eval(interp, Tcl_DStringValue(&es) )) {
  516 
  517     MSG(PRIVATE, "tcl_err: %d", tcl_err );
  518     tcl_string_res = Tcl_GetStringResult(interp);
  519     MSG(PRIVATE,"Error in evaluating the error callback <%s>",
  520           tcl_string_res);
  521     goto BAIL;
  522       }
  523 
  524       Tcl_DStringFree( &es );
  525     }
  526   } /* gui_user_tag != NULL, for error callback */
  527 
  528   /* : an extra tag to handle errors in the error reporting */
  529  BAIL:
  530 
  531   if (gui_user_tag != NULL) {
  532     GIVE(gui_user_tag->tcl_command);
  533     GIVE(gui_user_tag->tcl_tag);
  534     GIVE(gui_user_tag);
  535   }
  536   GIVE(args_string);
  537   GIVE(work_ptr);
  538   GIVE(result_string);
  539   Tcl_DStringFree( &ds );
  540 
  541   BAF_THROW();
  542 }
  543 
  544 
  545 /******************************************************************************
  546 
  547  FUNCTION: BAF_send_simple_msg_in_new_session
  548 
  549  SYNOPSIS
  550  Tcl command function to send a simple msg in a new session with No Response. 
  551 
  552  HISTORY
  553  Created Jun 11, 1998 by LeoP:
  554 
  555 ******************************************************************************/
  556 
  557 static int 
  558 BAF_send_simple_msg_in_new_session(
  559 ClientData clientData, 
  560 Tcl_Interp *interp, 
  561 int argc, 
  562 char *argv[]
  563 )
  564 {
  565   ENDO_DESC_REF desc_args;
  566   ENDO_MSG_REF msg_ref = NULL;
  567   int argv_format_position = 5; /* indicates where user args begin */
  568   char w_buff[32];
  569   
  570   BAF_IN(PRIVATE);
  571   
  572   /* insert the arguments in a descriptor */
  573   BAF_CATCH(endo_msg_make_desc_from_argv(&desc_args, argv, argv_format_position)) {
  574     Tcl_SetResult( interp, "error making desc", TCL_STATIC );
  575     BAF_THROW();
  576   }
  577 
  578   /* print telemetry on the arguments */
  579   MSG(PRIVATE, 
  580       "argv values: sender=<%s> recipient=<%s> action=<%s> argv_format=<%s>", 
  581       argv[2], argv[3], argv[4], argv[5]);
  582 
  583   /* send the message */
  584   BAF_CATCH(endo_msg_send_ex(BAF_TRUE,
  585              NULL,
  586              &msg_ref,
  587              argv[2],
  588              argv[3],
  589              argv[4],
  590              NULL,
  591              NULL,
  592              NULL,
  593              NULL,
  594              ENDO_RESPONSE_NONE,
  595              NULL,
  596              desc_args )) {
  597 
  598     /* set return result */
  599     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  600     BAF_THROW();
  601   }
  602   
  603   /* Create a command ...
  604      - address location as the command name
  605      - msg_ref as client_data
  606 
  607      When calling the SessionCmd, we will have this internal client_data
  608      which contains our msg_ref
  609   */
  610 
  611   sprintf( w_buff, "%p", msg_ref );
  612   Tcl_SetResult( interp, w_buff, TCL_VOLATILE );
  613 
  614   Tcl_CreateCommand( interp, w_buff,
  615              (Tcl_CmdProc *)BAF_session_cmd, (ClientData) msg_ref,
  616             (Tcl_CmdDeleteProc *) NULL);
  617 
  618   BAF_OUT(PRIVATE);
  619 }
  620 
  621 /******************************************************************************
  622 
  623  FUNCTION: BAF_session_cmd
  624 
  625  SYNOPSIS
  626  Tcl commands on a SESSION object. 
  627 
  628  HISTORY
  629  Created Jun 11, 1998 by LeoP:
  630 
  631 ******************************************************************************/
  632 
  633 static int 
  634 BAF_session_cmd(
  635 ClientData clientData, 
  636 Tcl_Interp *interp, 
  637 int argc, 
  638 char *argv[]
  639 )
  640 {
  641   ENDO_MSG_REF msg_ref = NULL;
  642   BAF_BOOLEAN is_canceled;
  643   BAF_BOOLEAN is_valid = BAF_FALSE;
  644 
  645   BAF_IN(PRIVATE);
  646 
  647   msg_ref = (ENDO_MSG_REF) clientData;
  648 
  649   /* : only work with valid messages */
  650   BAF_CATCH(BAF_session_valid_is_valid( msg_ref, &is_valid ) ) {
  651     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  652     BAF_THROW_MSG("can't determine message validity");
  653   }
  654 
  655   if ( is_valid == BAF_FALSE ) {
  656     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  657     BAF_THROW_MSG("message part of invalid session");
  658   }
  659 
  660   if (argc != 2) {
  661     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
  662     BAF_THROW();
  663   }
  664 
  665   if (strcmp(argv[1], "cancel") == 0) {
  666 
  667     char *tcl_command = NULL;
  668 
  669     BAF_CATCH(endo_msg_session_cancel(msg_ref)) {
  670       Tcl_SetResult( interp, "can't cancel", TCL_STATIC );
  671       BAF_THROW();
  672     }
  673 
  674     MSG(PRIVATE, "BAF_session_cmd, Success in cancelling session");
  675 
  676     /* : need to delete the command */
  677     TAKE(tcl_command, (char *), 
  678      sizeof(char) * MAX_MEMORY_ADDRESS_SIZE_IN_CHAR) {
  679       MSG(PRIVATE,"error allocating memory for for the tcl command name");
  680     }
  681     else {
  682  
  683       sprintf(tcl_command, "%p", msg_ref);
  684 
  685       /* delete the Tcl command */
  686       Tcl_DeleteCommand(interp, tcl_command );
  687 
  688     }
  689 
  690   } else if (strcmp(argv[1], "is_canceled") == 0) {
  691 
  692     BAF_CATCH(endo_msg_session_is_canceled(msg_ref, &is_canceled)) {
  693       Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  694       BAF_THROW();
  695     }
  696 
  697     if (is_canceled) {
  698       Tcl_SetResult( interp, "TRUE", TCL_STATIC );
  699     } else {
  700       Tcl_SetResult( interp, "FALSE", TCL_STATIC );
  701     }
  702 
  703     /* : getting the status */
  704   } else if ( strcmp( argv[1], "get_status" ) == 0 ) {
  705 
  706     /* : a list seems the best way to return a variable number of results.
  707      : in this case, just an error with string or success with all the
  708      : results */
  709     ENDO_SESSION_STATUS_BLOCK b_status;
  710     char total_str[16];
  711     char amount_str[16];
  712     char *str = NULL;
  713     char *user_str = NULL;
  714 
  715     BAF_CATCH( endo_msg_session_status_get( msg_ref, &b_status ) ) {
  716 
  717       Tcl_AppendElement( interp, ERROR_STRING );
  718       Tcl_AppendElement( interp, "can't get session status" );
  719       BAF_THROW();
  720 
  721     }
  722 
  723     /* : total(int), amount(int), str(cstr), user_data(void *) */
  724     sprintf( total_str, "%d", b_status.total );
  725     sprintf( amount_str, "%d", b_status.amount );
  726     str = b_status.str;
  727     if ( b_status.user_data != NULL ) {
  728       user_str = (char *)b_status.user_data;
  729     }
  730 
  731     /* : append all the elements to the returned list */
  732     Tcl_AppendElement( interp, SUCCESS_STRING );
  733     Tcl_AppendElement( interp, total_str );
  734     Tcl_AppendElement( interp, amount_str );
  735     Tcl_AppendElement( interp, str );
  736 
  737     if ( user_str != NULL ) {
  738       Tcl_AppendElement( interp, user_str );
  739     } else {
  740       Tcl_AppendElement( interp, "  " );
  741     }
  742 
  743     /* : we must give the string out the block, others are stack arrays */
  744     GIVE( str );
  745 
  746     BAF_OUT(PRIVATE);
  747 
  748   } else {
  749 
  750     Tcl_AppendResult(interp, "bad BAF_session_cmd \"", argv[1], 
  751              "\": should be cancel or is_canceled", (char *) NULL);
  752     BAF_THROW();
  753   }
  754 
  755   BAF_OUT(PRIVATE);
  756 }
  757 
  758 
  759 /******************************************************************************
  760 
  761  FUNCTION: BAF_send_msg
  762 
  763  SYNOPSIS
  764  Tcl command function to send a simple msg with No Response. 
  765 
  766  HISTORY
  767  Created Apr 28, 1998 by LeoP:
  768 
  769 ******************************************************************************/
  770 
  771 static int 
  772 BAF_send_simple_msg(
  773 ClientData clientData, 
  774 Tcl_Interp *interp, 
  775 int argc, 
  776 char *argv[]
  777 )
  778 {
  779   ENDO_DESC_REF desc_args;
  780   ENDO_MSG_REF msg_ref = NULL;
  781   int argv_format_position;
  782 
  783   BAF_IN(PRIVATE);
  784 
  785   /* indicate the position in the argv array where the user arguments begins */
  786   argv_format_position = 5;
  787 
  788   BAF_CATCH(endo_msg_make_desc_from_argv(&desc_args, argv, argv_format_position)) {
  789     Tcl_SetResult( interp, "error making desc", TCL_STATIC );
  790     BAF_THROW();
  791   }
  792 
  793   /* print telemetry on the arguments */
  794   MSG(PRIVATE, 
  795       "argv values: sender=<%s> recipient=<%s> action=<%s> argv_format=<%s>", 
  796       argv[2], argv[3], argv[4], argv[5]);
  797 
  798   /* set the original msg if any */
  799   if ((strcmp(argv[1], "NULL") == 0) || (strcmp(argv[1], "") == 0)) {
  800     msg_ref = NULL;
  801   } else {
  802     msg_ref = (void *) atol(argv[1]);
  803   }
  804 
  805   /* send the message */
  806   BAF_CATCH(endo_msg_send_ex(BAF_FALSE,
  807              msg_ref,
  808              NULL,
  809              argv[2],
  810              argv[3],
  811              argv[4],
  812              NULL,
  813              NULL,
  814              NULL,
  815              NULL,
  816              ENDO_RESPONSE_NONE,
  817              NULL,
  818              desc_args )) {
  819     Tcl_SetResult( interp, "error sending msg", TCL_STATIC );
  820     BAF_THROW();
  821   }
  822 
  823   Tcl_SetResult( interp, SUCCESS_STRING, TCL_STATIC );
  824 
  825   BAF_OUT(PRIVATE);
  826 }
  827 
  828 
  829 /******************************************************************************
  830 
  831  FUNCTION: BAF_send_msg_repl
  832 
  833  SYNOPSIS
  834  Tcl command function to send a  msg in a new session and asking for a reply. 
  835 
  836  HISTORY
  837  Created Jun 30, 1998 by LeoP:
  838  IncrDev Oct 28, 1998 by LeoP: Added a parameter (the first one) to contain
  839                                the name of the sending module.
  840 
  841 ******************************************************************************/
  842 
  843 static int 
  844 BAF_send_msg_reply(
  845 ClientData clientData, 
  846 Tcl_Interp *interp, 
  847 int argc, 
  848 char *argv[]
  849 )
  850 {
  851   ENDO_DESC_REF desc_args;
  852   ENDO_MSG_REF msg_ref = NULL;
  853   int argv_format_position = 6; /* position where user args begin */
  854   GUI_USER_TAG *gui_user_tag = NULL;
  855   size_t length;
  856   char w_buff[32];
  857 
  858   BAF_IN(PRIVATE);
  859   
  860   /* insert the arguments in a descriptor */
  861   BAF_CATCH(endo_msg_make_desc_from_argv(&desc_args, argv, argv_format_position)) {
  862     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  863     BAF_THROW();
  864   }
  865 
  866   /* print telemetry on the arguments */
  867   MSG(PRIVATE, 
  868       "argv values:  sender=<%s> recipient=<%s> action=<%s> callback=<%s> tags=<%s> argv_format=<%s>", 
  869       argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]);
  870 
  871   /* allocate memory for the user tag */
  872   TAKE(gui_user_tag, (GUI_USER_TAG *), sizeof(GUI_USER_TAG)) {
  873     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  874     BAF_THROW_MSG("can't allocate memory for the gui user tag");
  875   }
  876 
  877   /* insert the tcl command in the user tag structure */
  878   length = strlen(argv[4]);
  879   TAKE(gui_user_tag->tcl_command, (char *), sizeof(char) * (length + 1)){
  880     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  881     BAF_THROW_MSG("can't allocate memory for the tcl command");
  882   }
  883   strcpy(gui_user_tag->tcl_command, argv[4]);
  884 
  885   /* insert the tags in the user tag structure */
  886   if (strcmp(argv[5], EMPTY_TCL_TAG_VALUE) != 0) {
  887     length = strlen(argv[5]);
  888     TAKE(gui_user_tag->tcl_tag, (char *), sizeof(char) * (length + 1)){
  889       Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  890       BAF_THROW_MSG("can't allocate memory for the tcl tag");
  891     }
  892     strcpy(gui_user_tag->tcl_tag, argv[5]);
  893   }
  894 
  895   /* send the message */
  896   BAF_CATCH(endo_msg_send_ex(BAF_TRUE,
  897              NULL,
  898              &msg_ref,
  899              argv[1],
  900              argv[2],
  901              argv[3],
  902              NULL,
  903              NULL,
  904              (void *) gui_user_tag,
  905              NULL,
  906              ENDO_RESPONSE_ASYNC,
  907              NULL,
  908              desc_args )) {
  909 
  910 
  911     /* set return result */
  912     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  913     BAF_THROW();
  914   }
  915 
  916   /* : mark the message as valid for status and cancel checking */
  917   BAF_CATCH(BAF_session_valid_mark_valid( msg_ref ) ) {
  918     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  919     BAF_THROW_MSG("can't mark session valid");
  920   }
  921   
  922   /* Create a command ...
  923      - address location as the command name
  924      - msg_ref as client_data
  925 
  926      When calling the SessionCmd, we will have this internal client_data
  927      which contains our msg_ref
  928   */
  929 
  930   sprintf( w_buff, "%p", msg_ref);
  931   Tcl_SetResult( interp, w_buff, TCL_VOLATILE );
  932 
  933   Tcl_CreateCommand(interp, w_buff,
  934             (Tcl_CmdProc *)BAF_session_cmd, (ClientData) msg_ref,
  935             (Tcl_CmdDeleteProc *) NULL);
  936 
  937   BAF_OUT(PRIVATE);
  938 }
  939 
  940 /******************************************************************************
  941 
  942  FUNCTION: BAF_send_msg_wait_reply
  943 
  944  SYNOPSIS
  945  Tcl command function to send a msg and waiting for a reply. 
  946 
  947  HISTORY
  948  Created Jun 30, 1998 by LeoP:
  949  IncrDev Oct 28, 1998 by LeoP: Added a parameter (the first one) to contain
  950                                the name of the sending module.
  951 
  952 ******************************************************************************/
  953 
  954 static int 
  955 BAF_send_msg_wait_reply(
  956 ClientData clientData, 
  957 Tcl_Interp *interp, 
  958 int argc, 
  959 char *argv[]
  960 )
  961 {
  962   ENDO_DESC_REF desc_args;
  963   ENDO_MSG_REF response = NULL;
  964   int argv_format_position = 6; /* position where user args begin */
  965   GUI_USER_TAG *gui_user_tag = NULL;
  966   size_t length;
  967 
  968   BAF_IN(PRIVATE);
  969   
  970   /* insert the arguments in a descriptor */
  971   BAF_CATCH(endo_msg_make_desc_from_argv(&desc_args, argv, argv_format_position)) {
  972     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  973     BAF_THROW();
  974   }
  975 
  976   /* print telemetry on the arguments */
  977   MSG(PRIVATE, 
  978       "argv values:  sender= <%s> recipient=<%s> action=<%s> callback=<%s> tags=<%s> argv_format=<%s>", 
  979       argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]);
  980 
  981   /* allocate memory for the user tag */
  982   TAKE(gui_user_tag, (GUI_USER_TAG *), sizeof(GUI_USER_TAG)) {
  983     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  984     BAF_THROW_MSG("can't allocate memory for the gui user tag");
  985   }
  986 
  987   /* insert the tcl command in the user tag structure */
  988   length = strlen(argv[4]);
  989   TAKE(gui_user_tag->tcl_command, (char *), sizeof(char) * (length + 1)){
  990     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
  991     BAF_THROW_MSG("can't allocate memory for the tcl command");
  992   }
  993   strcpy(gui_user_tag->tcl_command, argv[4]);
  994 
  995   /* insert the tags in the user tag structure */
  996   if (strcmp(argv[5], EMPTY_TCL_TAG_VALUE) != 0) {
  997     length = strlen(argv[5]);
  998     TAKE(gui_user_tag->tcl_tag, (char *), sizeof(char) * (length + 1)){
  999       Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
 1000       BAF_THROW_MSG("can't allocate memory for the tcl tag");
 1001     }
 1002     strcpy(gui_user_tag->tcl_tag, argv[5]);
 1003   }
 1004 
 1005   /* send the message */
 1006   BAF_CATCH(endo_msg_send_ex(BAF_FALSE,
 1007              NULL,
 1008              NULL,
 1009              argv[1],
 1010              argv[2],
 1011              argv[3],
 1012              NULL,
 1013              NULL,
 1014              (void *) gui_user_tag,
 1015              NULL,
 1016              ENDO_RESPONSE_WAIT,
 1017              &response,
 1018              desc_args )) {
 1019 
 1020 
 1021     /* set return result */
 1022     Tcl_SetResult( interp, ERROR_STRING, TCL_STATIC );
 1023     BAF_THROW();
 1024   }
 1025   
 1026   /* treat the response msg */
 1027   BAF_CATCH(BAF_treat_response_msg(interp, response)) {
 1028     Tcl_SetResult(interp, ERROR_STRING, TCL_STATIC );
 1029     endo_msg_dispose_application_response(&response);
 1030     BAF_THROW();
 1031   }
 1032 
 1033   Tcl_SetResult( interp, SUCCESS_STRING, TCL_STATIC );
 1034   BAF_CATCH(endo_msg_dispose_application_response(&response)) {
 1035     BAF_THROW_MSG("error deleting the response");
 1036   }
 1037 
 1038   BAF_OUT(PRIVATE);
 1039 }
 1040 
 1041 
 1042 /******************************************************************************
 1043 
 1044  FUNCTION: gui_debug_trace
 1045 
 1046  SYNOPSIS
 1047  Tcl command function for printing out a message to standard output. 
 1048 
 1049 
 1050  HISTORY
 1051  Created Apr 08, 1998 by LeoP:
 1052 
 1053 ******************************************************************************/
 1054 
 1055 static int 
 1056 BAF_debug_trace(
 1057 ClientData clientData, 
 1058 Tcl_Interp *interp, 
 1059 int argc, 
 1060 char *argv[]
 1061 )
 1062 {
 1063   MSG(PUBLIC, "%s", argv[1]);
 1064   Tcl_SetResult( interp, SUCCESS_STRING, TCL_STATIC );
 1065   return 0;
 1066 }
 1067 
 1068 
 1069 /******************************************************************************
 1070 
 1071  FUNCTION: BAF_set_debug_level
 1072 
 1073  SYNOPSIS
 1074  Set the debug level.
 1075 
 1076  HISTORY
 1077  Created Sep 24, 1998 by LeoP:
 1078 
 1079 ******************************************************************************/
 1080 
 1081 static int 
 1082 BAF_set_debug_level(
 1083 ClientData clientData, 
 1084 Tcl_Interp *interp, 
 1085 int argc, 
 1086 char *argv[]
 1087 )
 1088 {
 1089 
 1090   BAF_IN(PRIVATE);
 1091 
 1092   if (argc != 2) {
 1093     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
 1094     BAF_THROW_MSG("Wrong number of parameters");
 1095   }
 1096   if (strcmp(argv[1], "0") == 0) {
 1097     util_debug_set_level(UTIL_DEBUG_NONE);
 1098   } else if (strcmp(argv[1], "1") == 0) {
 1099     util_debug_set_level(UTIL_DEBUG_ALL);
 1100   } else if (strcmp(argv[1], "2") == 0) {
 1101     util_debug_set_level(UTIL_DEBUG_PUBLIC);
 1102   } else if (strcmp(argv[1], "3") == 0) {
 1103     util_debug_set_level(UTIL_DEBUG_PRIVATE);
 1104   } else if (strcmp(argv[1], "4") == 0) {
 1105     util_debug_set_level(UTIL_DEBUG_SELECT);
 1106   } else {
 1107     Tcl_SetResult( interp, "Invalid argument, should be 0, 1, 2 or 3", 
 1108            TCL_STATIC );
 1109     BAF_THROW_MSG("Invalid argument, should be 0 or 1");
 1110   }
 1111   Tcl_SetResult( interp, SUCCESS_STRING, TCL_STATIC );
 1112 
 1113   BAF_OUT(PRIVATE);
 1114 }
 1115 
 1116 
 1117 /******************************************************************************
 1118 
 1119  FUNCTION: BAF_get_debug_level
 1120 
 1121  SYNOPSIS
 1122  Returns the debug level type.
 1123 
 1124  HISTORY
 1125  Created Sep 24, 1998 by LeoP:
 1126 
 1127 ******************************************************************************/
 1128 
 1129 static int 
 1130 BAF_get_debug_level(
 1131 ClientData clientData, 
 1132 Tcl_Interp *interp, 
 1133 int argc, 
 1134 char *argv[]
 1135 )
 1136 {
 1137   UTIL_DEBUG_LEVEL level;
 1138 
 1139   BAF_IN(PRIVATE);
 1140   BAF_CATCH(util_debug_get_level(&level)) {
 1141     Tcl_SetResult( interp, "Unable to get the debug level", TCL_STATIC );
 1142     BAF_THROW_MSG("Unable to get the debug level");
 1143   }
 1144   sprintf(interp->result, "%d", level);
 1145   BAF_OUT(PRIVATE);
 1146 }
 1147 
 1148 
 1149 /******************************************************************************
 1150 
 1151  FUNCTION: BAF_set_memory_level
 1152 
 1153  SYNOPSIS
 1154  Set the meory debug level.
 1155 
 1156  HISTORY
 1157  Created Sep 26, 1998 by LeoP:
 1158 
 1159 ******************************************************************************/
 1160 
 1161 static int 
 1162 BAF_set_memory_level(
 1163 ClientData clientData, 
 1164 Tcl_Interp *interp, 
 1165 int argc, 
 1166 char *argv[]
 1167 )
 1168 {
 1169 
 1170   BAF_IN(PRIVATE);
 1171 
 1172   if (argc != 2) {
 1173     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
 1174     BAF_THROW_MSG("Wrong number of parameters");
 1175   }
 1176   if (strcmp(argv[1], "0") == 0) {
 1177     util_debug_set_memory_level(MEMORY_NONE);
 1178   } else if (strcmp(argv[1], "1") == 0) {
 1179     util_debug_set_memory_level(MEMORY_ALL);
 1180   } else if (strcmp(argv[1], "2") == 0) {
 1181     util_debug_set_memory_level(MEMORY_SELECT);
 1182   } else {
 1183     Tcl_SetResult( interp, "Invalid argument, should be 0 or 1", TCL_STATIC );
 1184     BAF_THROW_MSG("Invalid argument, should be 0 or 1");
 1185   }
 1186   Tcl_SetResult( interp, SUCCESS_STRING, TCL_STATIC );
 1187   BAF_OUT(PRIVATE);
 1188 }
 1189 
 1190 
 1191 /******************************************************************************
 1192 
 1193  FUNCTION: BAF_get_memory_level
 1194 
 1195  SYNOPSIS
 1196  Returns the memory debug level type.
 1197 
 1198  HISTORY
 1199  Created Sep 26, 1998 by LeoP:
 1200 
 1201 ******************************************************************************/
 1202 
 1203 static int 
 1204 BAF_get_memory_level(
 1205 ClientData clientData, 
 1206 Tcl_Interp *interp, 
 1207 int argc, 
 1208 char *argv[]
 1209 )
 1210 {
 1211   MEMORY_DEBUG_LEVEL level;
 1212 
 1213   BAF_IN(PRIVATE);
 1214   BAF_CATCH(util_debug_get_memory_level(&level)) {
 1215     Tcl_SetResult( interp, "Unable to get the memory debug level", TCL_STATIC );
 1216     BAF_THROW_MSG("Unable to get the memory debug level");
 1217   }
 1218   sprintf(interp->result, "%d", level);
 1219   BAF_OUT(PRIVATE);
 1220 }
 1221 
 1222 
 1223 /******************************************************************************
 1224 
 1225  FUNCTION: BAF_is_debug_compiled_in
 1226 
 1227  SYNOPSIS
 1228  Returns "1" if the debug flag is compiled in, else "0" is returned
 1229 
 1230  HISTORY
 1231  Created Sep 27, 1998 by LeoP:
 1232 
 1233 ******************************************************************************/
 1234 
 1235 static int 
 1236 BAF_is_debug_compiled_in(
 1237 ClientData clientData, 
 1238 Tcl_Interp *interp, 
 1239 int argc, 
 1240 char *argv[]
 1241 )
 1242 {
 1243   BAF_IN(PRIVATE);
 1244 #ifdef DEBUG
 1245   Tcl_SetResult( interp, "1", TCL_STATIC);
 1246 #else
 1247   Tcl_SetResult( interp, "0", TCL_STATIC);
 1248 #endif
 1249   BAF_OUT(PRIVATE);
 1250 }
 1251 
 1252 
 1253 /******************************************************************************
 1254 
 1255  FUNCTION: BAF_is_memory_compiled_in
 1256 
 1257  SYNOPSIS
 1258  Returns "1" if the memory debug flag is compiled in, else "0" is returned
 1259 
 1260  HISTORY
 1261  Created Sep 27, 1998 by LeoP:
 1262 
 1263 ******************************************************************************/
 1264 
 1265 static int 
 1266 BAF_is_memory_compiled_in(
 1267 ClientData clientData, 
 1268 Tcl_Interp *interp, 
 1269 int argc, 
 1270 char *argv[]
 1271 )
 1272 {
 1273   BAF_IN(PRIVATE);
 1274 #ifdef DEBUG_MEM
 1275   Tcl_SetResult( interp, "1", TCL_STATIC);
 1276 #else
 1277   Tcl_SetResult( interp, "0", TCL_STATIC);
 1278 #endif
 1279   BAF_OUT(PRIVATE);
 1280 }
 1281 
 1282 
 1283 /******************************************************************************
 1284 
 1285  FUNCTION: BAF_get_debug_tree_list
 1286 
 1287  SYNOPSIS
 1288  Get a string containing all the files in a debug tree.
 1289 
 1290  HISTORY
 1291  Created Sep 29, 1998 by LeoP:
 1292 
 1293 ******************************************************************************/
 1294 
 1295 static int 
 1296 BAF_get_debug_tree_list(
 1297 ClientData clientData, 
 1298 Tcl_Interp *interp, 
 1299 int argc, 
 1300 char *argv[]
 1301 )
 1302 {
 1303   int tree_type;
 1304   int counter;
 1305   char *list;
 1306 
 1307   BAF_IN(PUBLIC);
 1308   if (argc != 2) {
 1309     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
 1310     BAF_THROW_MSG("Wrong number of parameters");
 1311   }
 1312 
 1313   /* get the type of tree (PUBLIC, PRIVATE or MEMORY) */
 1314   if (Tcl_GetInt(interp, argv[1], &tree_type) != TCL_OK) {
 1315     Tcl_SetResult( interp, "Error getting the tree type argument", 
 1316            TCL_STATIC );
 1317     BAF_THROW_MSG("Error getting the tree type argument");
 1318   }
 1319 
 1320   /* Get the list */
 1321   if ((tree_type >= 0) && (tree_type <= 3)) {
 1322     util_debug_get_tree_list_and_count(tree_type, &counter, &list);
 1323     Tcl_SetResult(interp, list, TCL_VOLATILE);
 1324     GIVE(list);
 1325   } else {
 1326     Tcl_SetResult( interp, "Invalid tree type:must specify 0, 1 or 2", 
 1327            TCL_STATIC );
 1328     BAF_THROW_MSG("Invalid tree type, must be 0, 1 or 2");
 1329   }
 1330 
 1331   BAF_OUT(PUBLIC);
 1332 }
 1333 
 1334 
 1335 /******************************************************************************
 1336 
 1337  FUNCTION: BAF_debug_file_on
 1338 
 1339  SYNOPSIS
 1340 
 1341  HISTORY
 1342  Created Oct 07, 1998 by LeoP:
 1343 
 1344 ******************************************************************************/
 1345 
 1346 static int 
 1347 BAF_debug_file_on(
 1348 ClientData clientData, 
 1349 Tcl_Interp *interp, 
 1350 int argc, 
 1351 char *argv[]
 1352 )
 1353 {
 1354   int tree_type;
 1355 
 1356   BAF_IN(PUBLIC);
 1357 
 1358   if (argc != 3) {
 1359     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
 1360     BAF_THROW_MSG("Wrong number of parameters");
 1361   }
 1362 
 1363   /* get the type of tree (PUBLIC, PRIVATE or MEMORY) */
 1364   if (Tcl_GetInt(interp, argv[1], &tree_type) != TCL_OK) {
 1365     Tcl_SetResult( interp, "Error getting tree type argument", TCL_STATIC );
 1366     BAF_THROW_MSG("Error getting the tree type argument");
 1367   }
 1368 
 1369   switch (tree_type) {
 1370     case 0:
 1371       BAF_CATCH(util_debug_file_private_on(argv[2])) {
 1372     Tcl_SetResult( interp, "Error adding a private debug file", 
 1373                TCL_STATIC );
 1374     BAF_THROW_MSG("Error adding a private debug file");
 1375       }
 1376       break;
 1377       
 1378   case 1: 
 1379     BAF_CATCH(util_debug_file_public_on(argv[2])) {
 1380     Tcl_SetResult( interp, "Error adding a public debug file", 
 1381                TCL_STATIC );
 1382     BAF_THROW_MSG("Error adding a public debug file");
 1383     }
 1384     break;
 1385     
 1386   case 2:
 1387     BAF_CATCH(util_debug_file_memory_on(argv[2])) {
 1388       Tcl_SetResult( interp, "Error adding a memory debug file", TCL_STATIC );
 1389     BAF_THROW_MSG("Error adding a memeory debug file");
 1390     }
 1391     break;
 1392 
 1393   default:
 1394     Tcl_SetResult( interp, "Invalid tree type:must specify 0, 1 or 2", 
 1395            TCL_STATIC );
 1396     BAF_THROW_MSG("Invalid tree type, must be 0, 1 or 2");
 1397     break;
 1398   }
 1399 
 1400   BAF_OUT(PUBLIC);
 1401 }
 1402 
 1403 
 1404 /******************************************************************************
 1405 
 1406  FUNCTION: BAF_debug_file_off
 1407 
 1408  SYNOPSIS
 1409 
 1410  HISTORY
 1411  Created Oct 07, 1998 by LeoP:
 1412 
 1413 ******************************************************************************/
 1414 
 1415 static int 
 1416 BAF_debug_file_off(
 1417 ClientData clientData, 
 1418 Tcl_Interp *interp, 
 1419 int argc, 
 1420 char *argv[]
 1421 )
 1422 {
 1423   int tree_type;
 1424 
 1425   BAF_IN(PUBLIC);
 1426 
 1427   if (argc != 3) {
 1428     Tcl_SetResult( interp, "wrong # of args", TCL_STATIC );
 1429     BAF_THROW_MSG("Wrong number of parameters");
 1430   }
 1431 
 1432   /* get the type of tree (PUBLIC, PRIVATE or MEMORY) */
 1433   if (Tcl_GetInt(interp, argv[1], &tree_type) != TCL_OK) {
 1434     Tcl_SetResult( interp, "Error getting the tree type argument", 
 1435            TCL_STATIC );
 1436     BAF_THROW_MSG("Error getting the tree type argument");
 1437   }
 1438 
 1439   switch (tree_type) {
 1440     case 0:
 1441       BAF_CATCH(util_debug_file_private_off(argv[2])) {
 1442     Tcl_SetResult( interp, "Error removing a private debug file", 
 1443                TCL_STATIC );
 1444     BAF_THROW_MSG("Error removing a private debug file");
 1445       }
 1446       break;
 1447       
 1448   case 1: 
 1449     BAF_CATCH(util_debug_file_public_off(argv[2])) {
 1450     Tcl_SetResult( interp, "Error removing a public debug file", 
 1451                TCL_STATIC );
 1452     BAF_THROW_MSG("Error removing a public debug file");
 1453     }
 1454     break;
 1455     
 1456   case 2:
 1457     BAF_CATCH(util_debug_file_memory_off(argv[2])) {
 1458       Tcl_SetResult( interp, "Error removing a memory debug file", 
 1459              TCL_STATIC );
 1460     BAF_THROW_MSG("Error removing a memory debug file");
 1461     }
 1462     break;
 1463 
 1464   default:
 1465     Tcl_SetResult( interp, "Invalid tree type:must specify 0, 1 or 2", 
 1466            TCL_STATIC );
 1467     BAF_THROW_MSG("Invalid tree type, must be 0, 1 or 2");
 1468     break;
 1469   }
 1470 
 1471   BAF_OUT(PUBLIC);
 1472 }
 1473 
 1474 
 1475 /* session calls */
 1476 /******************************************************************************
 1477 
 1478  FUNCTION: BAF_session_valid_mark_invalid
 1479 
 1480  SYNOPSIS
 1481  Marks a session as invalid 
 1482 
 1483  HISTORY
 1484  Created Jul 15, 1998 by Dean
 1485 
 1486  NOTES
 1487  If it's in our valid tree, we remove it
 1488 
 1489 ******************************************************************************/
 1490 
 1491 int
 1492 BAF_session_valid_mark_invalid(
 1493 ENDO_MSG_REF msg
 1494 )
 1495 {
 1496   UTIL_TREE_REF test_node = NULL;
 1497 
 1498   BAF_IN(PRIVATE);
 1499 
 1500   /* : if it's in the tree, remove it */
 1501   test_node = util_tree_find( (int)msg, g_gui_invalid_tree );
 1502   if ( test_node != NULL ) {
 1503     test_node = util_tree_delete( (int)msg, (void *)msg, g_gui_invalid_tree );
 1504     if ( test_node == NULL ) {
 1505       BAF_THROW();
 1506     }
 1507     g_gui_invalid_tree = test_node;
 1508   }
 1509 
 1510   BAF_OUT(PRIVATE);
 1511 }
 1512 
 1513 
 1514 /******************************************************************************
 1515 
 1516  FUNCTION: BAF_session_valid_mark_valid
 1517 
 1518  SYNOPSIS
 1519  Marks a session as valid
 1520 
 1521  HISTORY
 1522  Created Jul 15, 1998 by Dean
 1523 
 1524  NOTES
 1525  Inserts the msg into our valid tree
 1526 
 1527 ******************************************************************************/
 1528 
 1529 int
 1530 BAF_session_valid_mark_valid(
 1531 ENDO_MSG_REF msg
 1532 )
 1533 {
 1534   UTIL_TREE_REF test_node = NULL;
 1535 
 1536   BAF_IN(PRIVATE);
 1537 
 1538   /* : if it's not in the tree, then add it */
 1539   test_node = util_tree_find( (int)msg, g_gui_invalid_tree );
 1540   if ( test_node == NULL ) {
 1541     test_node = util_tree_insert( (int)msg, g_gui_invalid_tree, 0, NULL );
 1542     if ( test_node == NULL ) {
 1543       BAF_THROW();
 1544     }
 1545 
 1546     g_gui_invalid_tree = test_node;
 1547   }
 1548 
 1549   BAF_OUT(PRIVATE);
 1550 }
 1551 
 1552 
 1553 /******************************************************************************
 1554  
 1555  FUNCTION: BAF_session_valid_is_valid
 1556 
 1557  SYNOPSIS
 1558  Query whether a session is valid
 1559 
 1560  HISTORY
 1561  Created Jul 15, 1998 by Dean
 1562 
 1563  NOTES
 1564  Only valid sessions are in our tree
 1565 
 1566 ******************************************************************************/
 1567 
 1568 int
 1569 BAF_session_valid_is_valid(
 1570 ENDO_MSG_REF msg,
 1571 BAF_BOOLEAN *is_valid
 1572 )
 1573 {
 1574   UTIL_TREE_REF test_node = NULL;
 1575 
 1576   BAF_IN(PRIVATE);
 1577 
 1578   *is_valid = BAF_FALSE;
 1579 
 1580   /* : if it's in the tree, it's valid */
 1581   test_node = util_tree_find( (int)msg, g_gui_invalid_tree );
 1582   if ( test_node != NULL ) {
 1583     *is_valid = BAF_TRUE;
 1584   }
 1585 
 1586   BAF_OUT(PRIVATE);
 1587 }
 1588 
 1589 
 1590 /******************************************************************************
 1591 
 1592  FUNCTION: BAF_session_valid_deinit
 1593 
 1594  SYNOPSIS
 1595  Cleans up anything that might be left in the tree
 1596 
 1597  HISTORY
 1598  Created Jul 15, 1998 by Dean
 1599 
 1600 ******************************************************************************/
 1601 
 1602 int
 1603 BAF_session_valid_deinit(
 1604 void
 1605 )
 1606 {
 1607   BAF_IN(PRIVATE);
 1608 
 1609   if ( g_gui_invalid_tree != NULL ) {
 1610     util_tree_dispose_whole_tree( &g_gui_invalid_tree );
 1611     g_gui_invalid_tree = NULL;
 1612   }
 1613 
 1614   BAF_OUT(PRIVATE);
 1615 }