tools/src/libcdl/interp.cxx

   1 //{{{  Banner
   2
   3 //============================================================================
   4 //
   5 //      interp.cxx
   6 //
   7 //      Provide access to Tcl interpreters
   8 //
   9 //============================================================================
  10 //####COPYRIGHTBEGIN####
  11 //
  12 // ----------------------------------------------------------------------------
  13 // Copyright (C) 2002 Bart Veer
  14 // Copyright (C) 1999, 2000, 2001 Red Hat, Inc.
  15 //
  16 // This file is part of the eCos host tools.
  17 //
  18 // This program is free software; you can redistribute it and/or modify it
  19 // under the terms of the GNU General Public License as published by the Free
  20 // Software Foundation; either version 2 of the License, or (at your option)
  21 // any later version.
  22 //
  23 // This program is distributed in the hope that it will be useful, but WITHOUT
  24 // ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  25 // FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  26 // more details.
  27 //
  28 // You should have received a copy of the GNU General Public License along with
  29 // this program; if not, write to the Free Software Foundation, Inc.,
  30 // 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  31 //
  32 // ----------------------------------------------------------------------------
  33 //
  34 //####COPYRIGHTEND####
  35 //============================================================================
  36 //#####DESCRIPTIONBEGIN####
  37 //
  38 // Author(s):   bartv
  39 // Contact(s):  bartv
  40 // Date:        1999/01/20
  41 // Version:     0.02
  42 //
  43 //####DESCRIPTIONEND####
  44 //============================================================================
  45
  46 //}}}
  47 //{{{  #include's
  48
  49 // ----------------------------------------------------------------------------
  50 #include "cdlconfig.h"
  51
  52 // Get the infrastructure types, assertions, tracing and similar
  53 // facilities.
  54 #include <cyg/infra/cyg_ass.h>
  55 #include <cyg/infra/cyg_trac.h>
  56
  57 // <cdl.hxx> defines everything implemented in this module.
  58 // It implicitly supplies <string>, <vector> and <map> because
  59 // the class definitions rely on these headers. It also brings
  60 // in <tcl.h>
  61 #include <cdlcore.hxx>
  62
  63 //}}}
  64
  65 //{{{  Statics
  66
  67 // ----------------------------------------------------------------------------
  68 // This key is used for accessing AssocData in the Tcl interpreters,
  69 // specifically the CdlInterpreter object.
  70 char* CdlInterpreterBody::cdlinterpreter_assoc_data_key = "__cdlinterpreter";
  71
  72 CYGDBG_DEFINE_MEMLEAK_COUNTER(CdlInterpreterBody);
  73
  74 //}}}
  75 //{{{  CdlInterpreter:: creation
  76
  77 // ----------------------------------------------------------------------------
  78 // Default constructor. This will only get invoked via the make() static
  79 // member.
  80
  81 CdlInterpreterBody::CdlInterpreterBody(Tcl_Interp* tcl_interp_arg)
  82 {
  83     CYG_REPORT_FUNCNAME("CdlInterpreter:: default constructor");
  84     CYG_REPORT_FUNCARG2XV(this, tcl_interp_arg);
  85     CYG_PRECONDITIONC(0 != tcl_interp_arg);
  86
  87     tcl_interp          = tcl_interp_arg;
  88     owns_interp         = false;
  89     parent              = 0;
  90     toplevel            = 0;
  91     transaction         = 0;
  92     loadable            = 0;
  93     container           = 0;
  94     node                = 0;
  95     context             = "";
  96     error_fn_ptr        = 0;
  97     warning_fn_ptr      = 0;
  98     current_commands    = 0;
  99     cdl_result          = false;
 100
 101     CYGDBG_MEMLEAK_CONSTRUCTOR();
 102     cdlinterpreterbody_cookie   = CdlInterpreterBody_Magic;
 103
 104     Tcl_SetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0, static_cast<ClientData>(this));
 105
 106
 107     CYG_POSTCONDITION_THISC();
 108     CYG_REPORT_RETURN();
 109 }
 110
 111 // ----------------------------------------------------------------------------
 112 // Create a new CDL interpreter. The underlying Tcl interpreter can be
 113 // supplied by the caller, or else a suitable interpreter will be created
 114 // with default settings. This default interpreter will only support Tcl,
 115 // not Tk. There is no call to any AppInit() function, no support for
 116 // autoloading packages, the "unknown" command is not implemented, and
 117 // no command files will be read in.
 118 //
 119 // It is convenient to provide immediate access to two Tcl variables,
 120 // cdl_version and cdl_interactive.
 121
 122 CdlInterpreter
 123 CdlInterpreterBody::make(Tcl_Interp* tcl_interp_arg)
 124 {
 125     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::make", "interpreter %p");
 126     CYG_REPORT_FUNCARG1XV(tcl_interp_arg);
 127
 128     Tcl_Interp* tcl_interp = tcl_interp_arg;
 129     if (0 == tcl_interp) {
 130         tcl_interp = Tcl_CreateInterp();
 131         if (0 == tcl_interp) {
 132             throw std::bad_alloc();
 133         }
 134     } else {
 135         // Make sure that this Tcl interpreter is not already used
 136         // for another CdlInterpreter object.
 137         ClientData tmp = Tcl_GetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0);
 138         if (0 != tmp) {
 139             CYG_FAIL("Attempt to use a Tcl interpreter for multiple CDL interpreters");
 140             throw std::bad_alloc();
 141         }
 142     }
 143
 144     CdlInterpreter result = 0;
 145     try {
 146         result = new CdlInterpreterBody(tcl_interp);
 147
 148         std::string version = Cdl::get_library_version();
 149         if (0 == Tcl_SetVar(tcl_interp, "cdl_version", CDL_TCL_CONST_CAST(char*,version.c_str()), TCL_GLOBAL_ONLY)) {
 150             throw std::bad_alloc();
 151         }
 152         if (0 == Tcl_SetVar(tcl_interp, "cdl_interactive", CDL_TCL_CONST_CAST(char*, (Cdl::is_interactive() ? "1" : "0")),
 153                             TCL_GLOBAL_ONLY)) {
 154             throw std::bad_alloc();
 155         }
 156     }
 157     catch(std::bad_alloc) {
 158         if (0 == tcl_interp_arg) {
 159             Tcl_DeleteInterp(tcl_interp);
 160         }
 161         throw;
 162     }
 163     if (0 == tcl_interp_arg) {
 164         result->owns_interp     = true;
 165     }
 166     CYG_POSTCONDITION_CLASSC(result);
 167     CYG_REPORT_RETVAL(result);
 168     return result;
 169 }
 170
 171 // ----------------------------------------------------------------------------
 172 // Given a toplevel and a loadable, create a new slave interpreter
 173 // for that loadable. There should be master interpreter associated
 174 // with the toplevel already.
 175 //
 176 // FIXME: do slave interpreters automatically see cdl_version and
 177 // cdl_interactive?
 178
 179 CdlInterpreter
 180 CdlInterpreterBody::create_slave(CdlLoadable loadable_arg, bool safe)
 181 {
 182     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::create_slave", "slave %p");
 183     CYG_REPORT_FUNCARG3XV(this, loadable_arg, safe);
 184     CYG_PRECONDITION_THISC();
 185     CYG_PRECONDITION(0 == parent, "slave interpreters cannot be created inside slaves");
 186     CYG_PRECONDITION(0 != toplevel, "CDL's slave interpreters need an associated toplevel");
 187     CYG_PRECONDITION_CLASSC(loadable_arg);
 188
 189     // Slave interpreters need a name. Use a counter to create them uniquely.
 190     static cdl_int      next_slave = 1;
 191     std::string         slave_name;
 192     Cdl::integer_to_string(next_slave++, slave_name);
 193     slave_name = "slave" + slave_name;
 194
 195     // FIXME: creating a slave that is not safe appears to fail.
 196 #if 0
 197     Tcl_Interp* slave = Tcl_CreateSlave(interp, CDL_TCL_CONST_CAST(char*, slave_name.c_str()), safe);
 198 #else
 199     Tcl_Interp* slave = Tcl_CreateInterp();
 200 #endif
 201     if (0 == slave) {
 202         throw std::bad_alloc();
 203     }
 204
 205     CdlInterpreter result = 0;
 206     try {
 207         result = new CdlInterpreterBody(slave);
 208     }
 209     catch(std::bad_alloc) {
 210         Tcl_DeleteInterp(slave);
 211         throw;
 212     }
 213     result->owns_interp = true;
 214 #if 0
 215     try {
 216         slaves.push_back(result);
 217     }
 218     catch(std::bad_alloc) {
 219         delete result;
 220         throw;
 221     }
 222 #endif
 223
 224     result->parent      = this;
 225     result->set_toplevel(toplevel);
 226     result->loadable    = loadable_arg;
 227     result->set_variable("cdl_version", get_variable("cdl_version"));
 228     result->set_variable("cdl_interactive", get_variable("cdl_interactive"));
 229
 230     CYG_POSTCONDITION_CLASSC(result);
 231     CYG_REPORT_RETVAL(result);
 232     return result;
 233 }
 234
 235 // ----------------------------------------------------------------------------
 236 // Given an existing interpreter, turn it into a safe one. This is a one-way
 237 // transformation.
 238 void
 239 CdlInterpreterBody::make_safe(void)
 240 {
 241     CYG_REPORT_FUNCNAME("CdlInterpreter::make_safe");
 242     CYG_PRECONDITION_THISC();
 243
 244     if (0 != Tcl_MakeSafe(tcl_interp)) {
 245         throw std::bad_alloc();
 246     }
 247     CYG_REPORT_RETURN();
 248 }
 249
 250 //}}}
 251 //{{{  CdlInterpreter:: destructor
 252
 253 // ----------------------------------------------------------------------------
 254 // Default destructor. It is necessary to worry about any slave
 255 // interpreters, but otherwise there are no complications.
 256
 257 CdlInterpreterBody::~CdlInterpreterBody()
 258 {
 259     CYG_REPORT_FUNCNAME("CdlInterpreter:: destructor");
 260     CYG_REPORT_FUNCARG1XV(this);
 261     CYG_PRECONDITION_THISC();
 262
 263     cdlinterpreterbody_cookie   = CdlInterpreterBody_Invalid;
 264     parent                      = 0;
 265     toplevel                    = 0;
 266     transaction                 = 0;
 267     loadable                    = 0;
 268     container                   = 0;
 269     node                        = 0;
 270     context                     = "";
 271     error_fn_ptr                = 0;
 272     warning_fn_ptr              = 0;
 273     current_commands            = 0;
 274     cdl_result                  = false;
 275
 276     // Make sure slave interpreters get deleted before the current one
 277     for (std::vector<CdlInterpreter>::iterator i = slaves.begin(); i != slaves.end(); i++) {
 278         delete *i;
 279         *i = 0;
 280     }
 281
 282     Tcl_DeleteAssocData(tcl_interp, cdlinterpreter_assoc_data_key);
 283     if (owns_interp) {
 284         Tcl_DeleteInterp(tcl_interp);
 285     }
 286     owns_interp = false;
 287     tcl_interp  = 0;
 288     CYGDBG_MEMLEAK_DESTRUCTOR();
 289
 290     CYG_REPORT_RETURN();
 291 }
 292
 293 //}}}
 294 //{{{  CdlInterpreter:: check_this()
 295
 296 // ----------------------------------------------------------------------------
 297 // check_this().
 298
 299 bool
 300 CdlInterpreterBody::check_this(cyg_assert_class_zeal zeal) const
 301 {
 302     if (CdlInterpreterBody_Magic != cdlinterpreterbody_cookie)
 303         return false;
 304
 305     CYGDBG_MEMLEAK_CHECKTHIS();
 306
 307     switch(zeal) {
 308       case cyg_system_test  :
 309       case cyg_extreme      :
 310           if (slaves.size() > 0) {
 311               for (std::vector<CdlInterpreter>::const_iterator i = slaves.begin(); i != slaves.end(); i++) {
 312                   if (!(*i)->check_this(cyg_quick)) {
 313                       return false;
 314                   }
 315               }
 316           }
 317       case cyg_thorough     :
 318           if ((0 != toplevel) && !toplevel->check_this(cyg_quick)) {
 319               return false;
 320           }
 321           if ((0 != transaction) && !transaction->check_this(cyg_quick)) {
 322               return false;
 323           }
 324           if ((0 != loadable) && !loadable->check_this(cyg_quick)) {
 325               return false;
 326           }
 327           if ((0 != container) && !container->check_this(cyg_quick)) {
 328               return false;
 329           }
 330           if ((0 != node) && !node->check_this(cyg_quick)) {
 331               return false;
 332           }
 333       case cyg_quick        :
 334           // For now only the toplevel interpreter should have slaves.
 335           if ((0 != parent) && (slaves.size() > 0)) {
 336               return false;
 337           }
 338           if( 0 == tcl_interp) {
 339               return false;
 340           }
 341       case cyg_trivial      :
 342       case cyg_none         :
 343           break;
 344     }
 345     return true;
 346 }
 347
 348 //}}}
 349 //{{{  CdlInterpreter:: set_toplevel() etc.
 350
 351 // ----------------------------------------------------------------------------
 352 // Keep track of the current toplevel, container, etc. This gives commands
 353 // added to the Tcl interpreter a simple way of figuring out the current
 354 // state of the world so that properties get added to the right node, etc.
 355 //
 356 // set_toplevel() should only be called once, for the master interpreter
 357 // associated with a toplevel. All slave interpreters inherit this value.
 358 //
 359 // There is no set_loadable(), instead the loadable field is filled in
 360 // by create_slave() and cannot be changed.
 361
 362 CdlToplevel
 363 CdlInterpreterBody::get_toplevel() const
 364 {
 365     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_toplevel", "result %p");
 366     CYG_REPORT_FUNCARG1XV(this);
 367     CYG_PRECONDITION_THISC();
 368
 369     CdlToplevel result = toplevel;
 370     CYG_REPORT_RETVAL(result);
 371     return result;
 372 }
 373
 374 CdlTransaction
 375 CdlInterpreterBody::get_transaction() const
 376 {
 377     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_transaction", "result %p");
 378     CYG_REPORT_FUNCARG1XV(this);
 379     CYG_PRECONDITION_THISC();
 380
 381     CdlTransaction result = transaction;
 382     CYG_REPORT_RETVAL(result);
 383     return result;
 384 }
 385
 386 CdlLoadable
 387 CdlInterpreterBody::get_loadable() const
 388 {
 389     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter:get_loadable", "result %p");
 390     CYG_REPORT_FUNCARG1XV(this);
 391     CYG_PRECONDITION_THISC();
 392
 393     CdlLoadable result = loadable;
 394     CYG_REPORT_RETVAL(result);
 395     return result;
 396 }
 397
 398 CdlContainer
 399 CdlInterpreterBody::get_container() const
 400 {
 401     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_container", "result %p");
 402     CYG_REPORT_FUNCARG1XV(this);
 403     CYG_PRECONDITION_THISC();
 404
 405     CdlContainer result = container;
 406     CYG_REPORT_RETVAL(result);
 407     return result;
 408 }
 409
 410 CdlNode
 411 CdlInterpreterBody::get_node() const
 412 {
 413     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_node", "result %p");
 414     CYG_REPORT_FUNCARG1XV(this);
 415     CYG_PRECONDITION_THISC();
 416
 417     CdlNode result = node;
 418     CYG_REPORT_RETVAL(result);
 419     return result;
 420 }
 421
 422 std::string
 423 CdlInterpreterBody::get_context() const
 424 {
 425     CYG_REPORT_FUNCNAME("CdlInterpreter::get_context");
 426     CYG_REPORT_FUNCARG1XV(this);
 427     CYG_PRECONDITION_THISC();
 428
 429     CYG_REPORT_RETURN();
 430     return context;
 431 }
 432
 433 CdlDiagnosticFnPtr
 434 CdlInterpreterBody::get_error_fn_ptr() const
 435 {
 436     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_error_fn_ptr", "result %p");
 437     CYG_REPORT_FUNCARG1XV(this);
 438     CYG_PRECONDITION_THISC();
 439
 440     CdlDiagnosticFnPtr result = error_fn_ptr;
 441     CYG_REPORT_RETVAL(result);
 442     return result;
 443 }
 444
 445 CdlDiagnosticFnPtr
 446 CdlInterpreterBody::get_warning_fn_ptr() const
 447 {
 448     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_warning_fn_ptr", "result %p");
 449     CYG_REPORT_FUNCARG1XV(this);
 450     CYG_PRECONDITION_THISC();
 451
 452     CdlDiagnosticFnPtr result = warning_fn_ptr;
 453     CYG_REPORT_RETVAL(result);
 454     return result;
 455 }
 456
 457 void
 458 CdlInterpreterBody::set_toplevel(CdlToplevel new_toplevel)
 459 {
 460     CYG_REPORT_FUNCNAME("CdlInterpreter::set_toplevel");
 461     CYG_REPORT_FUNCARG2XV(this, new_toplevel);
 462     CYG_PRECONDITION_THISC();
 463     CYG_PRECONDITION(0 == toplevel, "changing toplevels is not allowed");
 464     CYG_PRECONDITION_CLASSC(new_toplevel);
 465
 466     toplevel = new_toplevel;
 467     CYG_REPORT_RETURN();
 468 }
 469
 470 void
 471 CdlInterpreterBody::set_transaction(CdlTransaction new_transaction)
 472 {
 473     CYG_REPORT_FUNCNAME("CdlInterpreter::set_transaction");
 474     CYG_REPORT_FUNCARG2XV(this, new_transaction);
 475     CYG_PRECONDITION_THISC();
 476     CYG_PRECONDITION_ZERO_OR_CLASSC(new_transaction);
 477
 478     transaction = new_transaction;
 479     CYG_REPORT_RETURN();
 480 }
 481
 482 CdlContainer
 483 CdlInterpreterBody::push_container(CdlContainer new_container)
 484 {
 485     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_container", "result %p");
 486     CYG_REPORT_FUNCARG2XV(this, new_container);
 487     CYG_PRECONDITION_THISC();
 488     CYG_PRECONDITION_CLASSC(new_container);
 489
 490     CdlContainer result = container;
 491     container = new_container;
 492     CYG_REPORT_RETVAL(result);
 493     return result;
 494 }
 495
 496 void
 497 CdlInterpreterBody::pop_container(CdlContainer old_container)
 498 {
 499     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_container");
 500     CYG_REPORT_FUNCARG2XV(this, old_container);
 501     CYG_PRECONDITION_THISC();
 502     CYG_PRECONDITION_ZERO_OR_CLASSC(old_container);
 503     CYG_PRECONDITIONC(0 != container);
 504
 505     container = old_container;
 506
 507     CYG_REPORT_RETURN();
 508 }
 509
 510 CdlNode
 511 CdlInterpreterBody::push_node(CdlNode new_node)
 512 {
 513     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_node", "result %p");
 514     CYG_REPORT_FUNCARG2XV(this, new_node);
 515     CYG_PRECONDITION_THISC();
 516     CYG_PRECONDITION_CLASSC(new_node);
 517
 518     CdlNode result = node;
 519     node = new_node;
 520     CYG_REPORT_RETVAL(result);
 521     return result;
 522 }
 523
 524 void
 525 CdlInterpreterBody::pop_node(CdlNode old_node)
 526 {
 527     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_node");
 528     CYG_REPORT_FUNCARG2XV(this, old_node);
 529     CYG_PRECONDITION_THISC();
 530     CYG_PRECONDITIONC(0 != node);
 531     CYG_PRECONDITION_ZERO_OR_CLASSC(old_node);
 532
 533     node = old_node;
 534
 535     CYG_REPORT_RETURN();
 536 }
 537
 538 std::string
 539 CdlInterpreterBody::push_context(std::string new_context)
 540 {
 541     CYG_REPORT_FUNCNAME("CdlInterpreter::push_context");
 542     CYG_REPORT_FUNCARG1XV(this);
 543     CYG_PRECONDITION_THISC();
 544     CYG_PRECONDITIONC("" != new_context);
 545
 546     std::string result = context;
 547     context = new_context;
 548     return result;
 549 }
 550
 551 void
 552 CdlInterpreterBody::pop_context(std::string old_context)
 553 {
 554     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_context");
 555     CYG_REPORT_FUNCARG1XV(this);
 556     CYG_PRECONDITION_THISC();
 557     CYG_PRECONDITIONC("" != context);
 558
 559     context = old_context;
 560
 561     CYG_REPORT_RETURN();
 562 }
 563
 564 CdlDiagnosticFnPtr
 565 CdlInterpreterBody::push_error_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)
 566 {
 567     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_error_fn_ptr", "result %p");
 568     CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);
 569     CYG_PRECONDITION_THISC();
 570     CYG_PRECONDITIONC(0 != new_fn_ptr);
 571
 572     CdlDiagnosticFnPtr result = error_fn_ptr;
 573     error_fn_ptr = new_fn_ptr;
 574     CYG_REPORT_RETVAL(result);
 575     return result;
 576 }
 577
 578 void
 579 CdlInterpreterBody::pop_error_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)
 580 {
 581     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_error_fn_ptr");
 582     CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);
 583     CYG_PRECONDITION_THISC();
 584     CYG_PRECONDITIONC(0 != error_fn_ptr);
 585
 586     error_fn_ptr = old_fn_ptr;
 587
 588     CYG_REPORT_RETURN();
 589 }
 590
 591 CdlDiagnosticFnPtr
 592 CdlInterpreterBody::push_warning_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)
 593 {
 594     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_warning_fn_ptr", "result %p");
 595     CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);
 596     CYG_PRECONDITION_THISC();
 597     CYG_PRECONDITIONC(0 != new_fn_ptr);
 598
 599     CdlDiagnosticFnPtr result = warning_fn_ptr;
 600     warning_fn_ptr = new_fn_ptr;
 601     CYG_REPORT_RETVAL(result);
 602     return result;
 603 }
 604
 605 void
 606 CdlInterpreterBody::pop_warning_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)
 607 {
 608     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_warning_fn_ptr");
 609     CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);
 610     CYG_PRECONDITION_THISC();
 611     CYG_PRECONDITIONC(0 != warning_fn_ptr);
 612
 613     warning_fn_ptr = old_fn_ptr;
 614
 615     CYG_REPORT_RETURN();
 616 }
 617
 618 //}}}
 619 //{{{  CdlInterpreter:: get information
 620
 621 // ----------------------------------------------------------------------------
 622 // Get hold of the underlying Tcl interpreter. This makes it easier to
 623 // use miscellaneous Tcl library facilities such as Tcl_SplitList()
 624 Tcl_Interp*
 625 CdlInterpreterBody::get_tcl_interpreter(void) const
 626 {
 627     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_tcl_interpreter", "interpreter %p");
 628     CYG_REPORT_FUNCARG1XV(this);
 629     CYG_PRECONDITION_THISC();
 630
 631     Tcl_Interp* result = tcl_interp;
 632     CYG_REPORT_RETVAL(result);
 633     return result;
 634 }
 635
 636 //}}}
 637 //{{{  CdlInterpreter:: eval()
 638
 639 // ----------------------------------------------------------------------------
 640 // Evaluate a Cdl script held in a string. The result of this evaluation,
 641 // e.g. TCL_OK, is returned directly. The string result is made available
 642 // in an in-out parameter.
 643 //
 644 // According to the spec the underlying Tcl_Eval() routine needs to be able
 645 // to make temporary changes to the script, so the latter must be held in
 646 // writable memory. This requires a copy operation.
 647
 648 int
 649 CdlInterpreterBody::eval(std::string script, std::string& str_result)
 650 {
 651     CYG_REPORT_FUNCNAMETYPE("CdInterpreter::eval", "result %d");
 652     CYG_REPORT_FUNCARG1XV(this);
 653     CYG_PRECONDITION_THISC();
 654
 655     int result  = TCL_OK;
 656     int size    = script.size();
 657
 658     // Distinguish between results set by the Tcl interpreter and results
 659     // set by CDL-related commands running in that interpreter.
 660     cdl_result = false;
 661
 662     if (size < 2048) {
 663         char buf[2048];
 664         script.copy(buf, size, 0);
 665         buf[size] = '\0';
 666         result = Tcl_Eval(tcl_interp, buf);
 667     } else {
 668         char* buf = static_cast<char*>(malloc(script.size() + 1));
 669         if (0 == buf) {
 670             this->set_result(CdlParse::construct_diagnostic(this, "internal error", "", "Out of memory"));
 671             result = TCL_ERROR;
 672         } else {
 673             script.copy(buf, size, 0);
 674             buf[size] = '\0';
 675             result = Tcl_Eval(tcl_interp, buf);
 676             free(buf);
 677         }
 678     }
 679
 680     // The distinction between TCL_OK and TCL_RETURN is probably not worth
 681     // worrying about.
 682     if (TCL_RETURN == result) {
 683         result = TCL_OK;
 684     }
 685
 686     // If we have an error condition that was raised by the Tcl
 687     // interpreter rather than by the library, it needs to be
 688     // raised up to the library level. That way the error count
 689     // etc. are kept accurate.
 690     if ((TCL_OK != result) && !cdl_result) {
 691         const char* tcl_result = Tcl_GetStringResult(tcl_interp);
 692         if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
 693             tcl_result = "Internal error, no additional information available.";
 694         }
 695         CdlParse::report_error(this, "", tcl_result);
 696     }
 697
 698     str_result = Tcl_GetStringResult(tcl_interp);
 699     CYG_REPORT_RETVAL(result);
 700     return result;
 701 }
 702
 703 // Ditto for Tcl Code that comes from a CDL file. Currently this is held
 704 // as a string. In future it may be appropriate to store a byte-compiled
 705 // version as well.
 706 int
 707 CdlInterpreterBody::eval_cdl_code(const cdl_tcl_code script, std::string& str_result)
 708 {
 709     CYG_REPORT_FUNCNAMETYPE("CdInterpreter::eval_cdl_code", "result %d");
 710     CYG_REPORT_FUNCARG1XV(this);
 711     CYG_PRECONDITION_THISC();
 712
 713     int result  = TCL_OK;
 714     int size    = script.size();
 715     // Distinguish between results set by the Tcl interpreter and results
 716     // set by CDL-related commands running in that interpreter.
 717     cdl_result = false;
 718
 719     if (size < 2048) {
 720         char buf[2048];
 721         script.copy(buf, size, 0);
 722         buf[size] = '\0';
 723         result = Tcl_Eval(tcl_interp, buf);
 724     } else {
 725         char* buf = static_cast<char*>(malloc(script.size() + 1));
 726         if (0 == buf) {
 727             this->set_result(CdlParse::construct_diagnostic(this, "internal error", "", "Out of memory"));
 728             result = TCL_ERROR;
 729         } else {
 730             script.copy(buf, size, 0);
 731             buf[size] = '\0';
 732             result = Tcl_Eval(tcl_interp, buf);
 733             free(buf);
 734         }
 735     }
 736     // The distinction between TCL_OK and TCL_RETURN is probably not worth
 737     // worrying about.
 738     if (TCL_RETURN == result) {
 739         result = TCL_OK;
 740     }
 741
 742     // If we have an error condition that was raised by the Tcl
 743     // interpreter rather than by the library, it needs to be
 744     // raised up to the library level. That way the error count
 745     // etc. are kept accurate.
 746     if ((TCL_OK != result) && !cdl_result) {
 747         const char* tcl_result = Tcl_GetStringResult(tcl_interp);
 748         if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
 749             tcl_result = "Internal error, no additional information available.";
 750         }
 751         CdlParse::report_error(this, "", tcl_result);
 752     }
 753
 754     str_result = Tcl_GetStringResult(tcl_interp);
 755     CYG_REPORT_RETVAL(result);
 756     return result;
 757 }
 758
 759 // Ditto for evaluating an entire file.
 760 int
 761 CdlInterpreterBody::eval_file(std::string script, std::string& str_result)
 762 {
 763     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::eval_file", "result %d");
 764     CYG_REPORT_FUNCARG1XV(this);
 765     CYG_PRECONDITION_THISC();
 766     CYG_PRECONDITIONC("" != script);
 767
 768     // Distinguish between results set by the Tcl interpreter and results
 769     // set by CDL-related commands running in that interpreter.
 770     cdl_result = false;
 771
 772     int result = Tcl_EvalFile(tcl_interp, CDL_TCL_CONST_CAST(char*, script.c_str()));
 773     // The distinction between TCL_OK and TCL_RETURN is probably not worth
 774     // worrying about.
 775     if (TCL_RETURN == result) {
 776         result = TCL_OK;
 777     }
 778
 779     // If we have an error condition that was raised by the Tcl
 780     // interpreter rather than by the library, it needs to be
 781     // raised up to the library level. That way the error count
 782     // etc. are kept accurate.
 783     if ((TCL_OK != result) && !cdl_result) {
 784         const char* tcl_result = Tcl_GetStringResult(tcl_interp);
 785         if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
 786             tcl_result = "Internal error, no additional information available.";
 787         }
 788         CdlParse::report_error(this, "", tcl_result);
 789     }
 790
 791     str_result = Tcl_GetStringResult(tcl_interp);
 792     CYG_REPORT_RETVAL(result);
 793     return result;
 794 }
 795
 796 // Variants for when the result string is of no interest
 797 int
 798 CdlInterpreterBody::eval(std::string script)
 799 {
 800     std::string result_string;
 801     return this->eval(script, result_string);
 802 }
 803
 804 int
 805 CdlInterpreterBody::eval_cdl_code(const cdl_tcl_code script)
 806 {
 807     std::string result_string;
 808     return this->eval_cdl_code(script, result_string);
 809 }
 810
 811 int
 812 CdlInterpreterBody::eval_file(std::string filename)
 813 {
 814     std::string result_string;
 815     return this->eval_file(filename, result_string);
 816 }
 817
 818 //}}}
 819 //{{{  CdlInterpreter:: set_result()
 820
 821 // ----------------------------------------------------------------------------
 822 // Provide a way of setting an interpreter's result from a command implemented
 823 // in C++.
 824
 825 void
 826 CdlInterpreterBody::set_result(std::string result)
 827 {
 828     CYG_REPORT_FUNCNAME("CdlInterpreter::set_result");
 829     CYG_PRECONDITION_THISC();
 830
 831     Tcl_SetResult(tcl_interp, const_cast<char*>(result.c_str()), TCL_VOLATILE);
 832     this->cdl_result = true;
 833
 834     CYG_REPORT_RETURN();
 835 }
 836
 837 bool
 838 CdlInterpreterBody::result_set_by_cdl()
 839 {
 840     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::result_set_by_cdl", "result %d");
 841     CYG_PRECONDITION_THISC();
 842
 843     bool result = this->cdl_result;
 844     CYG_REPORT_RETVAL(result);
 845     return result;
 846 }
 847
 848 // ----------------------------------------------------------------------------
 849 // Also allow the result to be extracted again.
 850 std::string
 851 CdlInterpreterBody::get_result()
 852 {
 853     CYG_REPORT_FUNCNAME("CdlInterpreter::get_result");
 854     CYG_PRECONDITION_THISC();
 855
 856     std::string result = Tcl_GetStringResult(tcl_interp);
 857
 858     CYG_REPORT_RETURN();
 859     return result;
 860 }
 861
 862 //}}}
 863 //{{{  CdlInterpreter:: add and remove commands
 864
 865 // ----------------------------------------------------------------------------
 866 // This is the Tcl command proc that gets used for all CdlInterpreter
 867 // commands. The ClientData field will be a CdlInterpreterCommand,
 868 // i.e. a function pointer. That function needs a pointer to the
 869 // CdlInterpreter object, which can be accessed via AssocData.
 870 int
 871 CdlInterpreterBody::tcl_command_proc(ClientData data, Tcl_Interp* tcl_interp, int argc, const char* argv[])
 872 {
 873     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::tcl_command_proc", "result %d");
 874     CYG_REPORT_FUNCARG3XV(data, tcl_interp, argc);
 875     CYG_PRECONDITIONC(0 != data);
 876
 877     int result = TCL_OK;
 878
 879     union {
 880         ClientData            data;
 881         CdlInterpreterCommand command;
 882     } x;
 883     x.data = data;
 884     CdlInterpreterCommand command = x.command;
 885
 886     data = Tcl_GetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0);
 887     CdlInterpreter interp = static_cast<CdlInterpreter>(data);
 888     CYG_ASSERT_CLASSC(interp);
 889
 890     try {
 891         result = (*command)(interp, argc, argv);
 892     } catch(std::bad_alloc e) {
 893         interp->set_result(CdlParse::construct_diagnostic(interp, "internal error", "", "Out of memory."));
 894         result = TCL_ERROR;
 895     } catch(CdlStringException e) {
 896         interp->set_result(e.get_message());
 897         result = TCL_ERROR;
 898     } catch(...) {
 899         CYG_FAIL("Unexpected C++ exception");
 900         interp->set_result(CdlParse::construct_diagnostic(interp, "internal error", "", "Unexpected C++ exception."));
 901         result = TCL_ERROR;
 902     }
 903
 904     CYG_REPORT_RETVAL(result);
 905     return result;
 906 }
 907
 908 void
 909 CdlInterpreterBody::add_command(std::string name, CdlInterpreterCommand command)
 910 {
 911     CYG_REPORT_FUNCNAME("CdlInterpreter::add_command");
 912     CYG_REPORT_FUNCARG2XV(this, command);
 913
 914     CYG_PRECONDITION_THISC();
 915     CYG_PRECONDITIONC("" != name);
 916     CYG_CHECK_FUNC_PTRC(command);
 917
 918     union {
 919         CdlInterpreterCommand command;
 920         ClientData            data;
 921     } x;
 922     x.command = command;
 923
 924     // Tcl 8.4 involves some incompatible API changes
 925 #if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))
 926     if (0 == Tcl_CreateCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), &tcl_command_proc, x.data, 0)) {
 927         throw std::bad_alloc();
 928     }
 929 #else
 930     if (0 == Tcl_CreateCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()),
 931                                (int (*)(ClientData,Tcl_Interp*, int, char*[])) &tcl_command_proc,
 932                                x.data, 0)) {
 933         throw std::bad_alloc();
 934     }
 935 #endif
 936
 937     CYG_REPORT_RETURN();
 938 }
 939
 940 // ----------------------------------------------------------------------------
 941 // Remove a command from an interpreter. This is just a wrapper for the
 942 // Tcl_DeleteCommand() routine.
 943
 944 void
 945 CdlInterpreterBody::remove_command(std::string name)
 946 {
 947     CYG_REPORT_FUNCNAME("CdlInterpreter::remove_command");
 948     CYG_REPORT_FUNCARG1XV(this);
 949     CYG_PRECONDITION_THISC();
 950     CYG_PRECONDITIONC("" != name);
 951
 952     if (0 != Tcl_DeleteCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()))) {
 953         CYG_FAIL("attempt to delete non-existant command");
 954     }
 955     CYG_REPORT_RETURN();
 956 }
 957
 958 // ----------------------------------------------------------------------------
 959 // It is also possible to add and remove whole sets of commands in one go,
 960 // keeping track of the current set.
 961
 962 std::vector<CdlInterpreterCommandEntry>*
 963 CdlInterpreterBody::push_commands(std::vector<CdlInterpreterCommandEntry>& new_commands)
 964 {
 965     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_commands", "result %p");
 966     CYG_REPORT_FUNCARG2XV(this, &new_commands);
 967     CYG_PRECONDITION_THISC();
 968
 969     std::vector<CdlInterpreterCommandEntry>* result = current_commands;
 970     std::vector<CdlInterpreterCommandEntry>::iterator i;
 971
 972     // First uninstall all the old commands, if any
 973     if (0 != current_commands) {
 974         for (i = current_commands->begin(); i != current_commands->end(); i++) {
 975             remove_command(i->name);
 976         }
 977     }
 978
 979     // Now install the new commands
 980     for (i = new_commands.begin(); i != new_commands.end(); i++) {
 981         add_command(i->name, i->command);
 982     }
 983
 984     // Remember the current set in case of a subsequent push operation
 985     current_commands = &new_commands;
 986
 987     CYG_REPORT_RETVAL(result);
 988     return result;
 989 }
 990
 991 void
 992 CdlInterpreterBody::pop_commands(std::vector<CdlInterpreterCommandEntry>* original_commands)
 993 {
 994     CYG_REPORT_FUNCNAME("CdlInterpreter::pop_commands");
 995     CYG_REPORT_FUNCARG2XV(this, &original_commands);
 996     CYG_PRECONDITION_THISC();
 997     CYG_PRECONDITION(0 != current_commands, "no pop without a previous push please");
 998
 999     std::vector<CdlInterpreterCommandEntry>::iterator i;
1000     // Uninstall the most recent set of commands
1001     for (i = current_commands->begin(); i != current_commands->end(); i++) {
1002         remove_command(i->name);
1003     }
1004
1005     // Reinstall the previous set, if any
1006     if (0 != original_commands) {
1007         for (i = original_commands->begin(); i != original_commands->end(); i++) {
1008             add_command(i->name, i->command);
1009         }
1010     }
1011     current_commands = original_commands;
1012     CYG_REPORT_RETURN();
1013 }
1014
1015 std::vector<CdlInterpreterCommandEntry>*
1016 CdlInterpreterBody::get_pushed_commands() const
1017 {
1018     CYG_REPORT_FUNCNAME("CdlInterpreter::get_pushed_commands");
1019     CYG_REPORT_FUNCARG1XV(this);
1020     CYG_PRECONDITION_THISC();
1021
1022     CYG_REPORT_RETURN();
1023     return current_commands;
1024 }
1025
1026 //}}}
1027 //{{{  CdlInterpreter:: variables
1028
1029 // ----------------------------------------------------------------------------
1030 // Provide some more stubs, this time for accessing Tcl global variables.
1031 void
1032 CdlInterpreterBody::set_variable(std::string name, std::string value)
1033 {
1034     CYG_REPORT_FUNCNAME("CdlInterpreter::set_variable");
1035     CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1036     CYG_PRECONDITION_THISC();
1037     CYG_PRECONDITIONC("" != name);
1038     if (0 == Tcl_SetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), CDL_TCL_CONST_CAST(char*, value.c_str()), TCL_GLOBAL_ONLY)) {
1039         throw std::bad_alloc();
1040     }
1041     CYG_REPORT_RETURN();
1042 }
1043
1044 void
1045 CdlInterpreterBody::unset_variable(std::string name)
1046 {
1047     CYG_REPORT_FUNCNAME("CdlInterpreter::unset_variable");
1048     CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1049     CYG_PRECONDITION_THISC();
1050     CYG_PRECONDITIONC("" != name);
1051
1052     Tcl_UnsetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), TCL_GLOBAL_ONLY);
1053     CYG_REPORT_RETURN();
1054 }
1055
1056 std::string
1057 CdlInterpreterBody::get_variable(std::string name)
1058 {
1059     CYG_REPORT_FUNCNAME("CdlInterpreter::get_variable");
1060     CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1061     CYG_PRECONDITION_THISC();
1062     CYG_PRECONDITIONC("" != name);
1063
1064     std::string result = "";
1065     const char *tmp = Tcl_GetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), TCL_GLOBAL_ONLY);
1066     if (0 != tmp) {
1067         result = tmp;
1068     }
1069
1070     CYG_REPORT_RETURN();
1071     return result;
1072 }
1073
1074 //}}}
1075 //{{{  CdlInterpreter:: assoc data
1076
1077 // ----------------------------------------------------------------------------
1078 // Associated data. It is useful to be able to store some C++ data with
1079 // Tcl interpreters, so that the implementations of various commands
1080 // can retrieve details of the current state. Tcl provides the necessary
1081 // underlying support via routines Tcl_SetAssocData() etc., and the
1082 // routines here are just stubs for the underlying Tcl ones.
1083
1084 void
1085 CdlInterpreterBody::set_assoc_data(const char* key, ClientData data, Tcl_InterpDeleteProc* del_proc)
1086 {
1087     CYG_REPORT_FUNCNAME("CdlInterpreter::set_assoc_data");
1088     CYG_REPORT_FUNCARG3("this %p, key %s, data %p", this, key, data);
1089     CYG_PRECONDITION_THISC();
1090     CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1091
1092     Tcl_SetAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key), del_proc, data);
1093     CYG_REPORT_RETURN();
1094 }
1095
1096 ClientData
1097 CdlInterpreterBody::get_assoc_data(const char* key)
1098 {
1099     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_assoc_data", "result %p");
1100     CYG_REPORT_FUNCARG2("this %p, key %s", this, key);
1101     CYG_PRECONDITION_THISC();
1102     CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1103
1104     ClientData result = Tcl_GetAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key), 0);
1105     CYG_REPORT_RETVAL(result);
1106     return result;
1107 }
1108
1109 void
1110 CdlInterpreterBody::delete_assoc_data(const char* key)
1111 {
1112     CYG_REPORT_FUNCNAME("CdlInterpreter::delete_assoc_data");
1113     CYG_REPORT_FUNCARG2("this %p, key %s", this, key);
1114     CYG_PRECONDITION_THISC();
1115     CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1116
1117     Tcl_DeleteAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key));
1118     CYG_REPORT_RETURN();
1119 }
1120
1121 //}}}
1122 //{{{  CdlInterpreter:: file I/O
1123
1124 // ----------------------------------------------------------------------------
1125 // Tcl provides file I/O facilities that are already known to be portable
1126 // to the platforms of interest.
1127
1128 bool
1129 CdlInterpreterBody::is_directory(std::string name)
1130 {
1131     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::is_directory", "result %d");
1132     CYG_REPORT_FUNCARG1XV(this);
1133     CYG_PRECONDITION_THISC();
1134     CYG_PRECONDITIONC("" != name);
1135
1136     bool result = false;
1137     std::string command = "file isdirectory \"" + name + "\"";
1138     std::string tcl_result;
1139     if ((TCL_OK == this->eval(command, tcl_result)) && ("1" == tcl_result)) {
1140         result = true;
1141     }
1142
1143     CYG_REPORT_RETVAL(result);
1144     return result;
1145 }
1146
1147 bool
1148 CdlInterpreterBody::is_file(std::string name)
1149 {
1150     CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::is_file", "result %d");
1151     CYG_REPORT_FUNCARG1XV(this);
1152     CYG_PRECONDITION_THISC();
1153     CYG_PRECONDITIONC("" != name);
1154
1155     bool result = false;
1156     std::string command = "file isfile \"" + name + "\"";
1157     std::string tcl_result;
1158     if ((TCL_OK == this->eval(command, tcl_result)) && ("1" == tcl_result)) {
1159         result = true;
1160     }
1161
1162     CYG_REPORT_RETVAL(result);
1163     return result;
1164 }
1165
1166 // ----------------------------------------------------------------------------
1167
1168 void
1169 CdlInterpreterBody::locate_subdirs(std::string directory, std::vector<std::string>& result)
1170 {
1171     CYG_REPORT_FUNCNAME("CdlInterpreter::locate_subdirs");
1172     CYG_REPORT_FUNCARG2XV(this, &result);
1173     CYG_PRECONDITION_THISC();
1174
1175     static char locate_subdirs_script[] = "\
1176 set pattern [file join \"$::cdl_locate_subdirs_path\" * .]  \n\
1177 set result {}                                               \n\
1178 foreach entry [glob -nocomplain -- $pattern] {              \n\
1179     set entry [file tail [file dirname $entry]]             \n\
1180     if {($entry != \"CVS\") && ($entry != \"cvs\")} {       \n\
1181         lappend result $entry                               \n\
1182     }                                                       \n\
1183 }                                                           \n\
1184 return $result                                              \n\
1185 ";
1186
1187     std::string                 tcl_result = "";
1188     set_variable("::cdl_locate_subdirs_path", directory);
1189     if (TCL_OK != eval(locate_subdirs_script, tcl_result)) {
1190         CYG_FAIL("Internal error evaluating Tcl script");
1191     }
1192
1193     int             count;
1194     const char**    array;
1195     if (TCL_OK != Tcl_SplitList(tcl_interp, CDL_TCL_CONST_CAST(char*, tcl_result.c_str()), &count, CDL_TCL_CONST_CAST(char***, &array))) {
1196         throw std::bad_alloc();
1197     }
1198     for (int i = 0; i < count; i++) {
1199         result.push_back(array[i]);
1200     }
1201     Tcl_Free((char*) array);
1202
1203     CYG_REPORT_RETURN();
1204 }
1205
1206 // ----------------------------------------------------------------------------
1207 // Locating all subdirs requires some simple recursion
1208 void
1209 CdlInterpreterBody::locate_all_subdirs(std::string directory, std::vector<std::string>& result)
1210 {
1211     CYG_REPORT_FUNCNAME("CdlInterpreter::locate_all_subdirs");
1212     CYG_REPORT_FUNCARG2XV(this, &result);
1213     CYG_PRECONDITION_THISC();
1214     CYG_PRECONDITIONC("" != directory);
1215
1216     std::vector<std::string> subdirs;
1217     locate_subdirs(directory, subdirs);
1218     std::vector<std::string>::const_iterator i, j;
1219
1220     for (i = subdirs.begin(); i != subdirs.end(); i++) {
1221         result.push_back(*i);
1222         std::vector<std::string> its_subdirs;
1223         locate_all_subdirs(directory + "/" + *i, its_subdirs);
1224         for (j = its_subdirs.begin(); j != its_subdirs.end(); j++) {
1225             result.push_back(*i + "/" + *j);
1226         }
1227     }
1228
1229     CYG_REPORT_RETURN();
1230 }
1231
1232 // ----------------------------------------------------------------------------
1233 // Locating the files in a particular subdirectory. This requires another
1234 // simple Tcl script.
1235 void
1236 CdlInterpreterBody::locate_files(std::string directory, std::vector<std::string>& result)
1237 {
1238     CYG_REPORT_FUNCNAME("CdlInterpreter::locate_files");
1239     CYG_REPORT_FUNCARG2XV(this, &result);
1240     CYG_PRECONDITION_THISC();
1241     CYG_PRECONDITIONC("" != directory);
1242
1243     static char locate_files_script[] = "\
1244 set pattern [file join \"$::cdl_locate_files_path\" *]  \n\
1245 set result {}                                           \n\
1246 foreach entry [glob -nocomplain -- $pattern] {          \n\
1247     if ([file isdirectory $entry]) {                    \n\
1248         continue                                        \n\
1249     }                                                   \n\
1250     lappend result [file tail $entry]                   \n\
1251  }                                                      \n\
1252 return $result                                          \n\
1253 ";
1254
1255     std::string                 tcl_result;
1256     set_variable("::cdl_locate_files_path", directory);
1257     if (TCL_OK != eval(locate_files_script, tcl_result)) {
1258         CYG_FAIL("Internal error evaluating Tcl script");
1259     }
1260     int             count;
1261     const char**    array;
1262     if (TCL_OK != Tcl_SplitList(tcl_interp, CDL_TCL_CONST_CAST(char*, tcl_result.c_str()), &count, CDL_TCL_CONST_CAST(char***, &array))) {
1263         throw std::bad_alloc();
1264     }
1265     for (int i = 0; i < count; i++) {
1266         result.push_back(array[i]);
1267     }
1268     Tcl_Free((char*) array);
1269
1270     CYG_REPORT_RETURN();
1271 }
1272
1273 // ----------------------------------------------------------------------------
1274 // Locating all files can be achieved by combining locate_all_subdirs()
1275 // and locate_files().
1276 void
1277 CdlInterpreterBody::locate_all_files(std::string directory, std::vector<std::string>& result)
1278 {
1279     CYG_REPORT_FUNCNAME("CdlInterpreter::locate_all_files");
1280     CYG_REPORT_FUNCARG2XV(this, &result);
1281     CYG_PRECONDITION_THISC();
1282     CYG_PRECONDITIONC("" != directory);
1283
1284     std::vector<std::string> files;
1285     std::vector<std::string>::const_iterator i, j;
1286     locate_files(directory, files);
1287     for (i = files.begin(); i != files.end(); i++) {
1288         result.push_back(*i);
1289     }
1290
1291     std::vector<std::string> all_subdirs;
1292     locate_all_subdirs(directory, all_subdirs);
1293     for (i = all_subdirs.begin(); i != all_subdirs.end(); i++) {
1294         std::vector<std::string> subdir_files;
1295         locate_files(directory + "/" + *i, subdir_files);
1296         for (j = subdir_files.begin(); j != subdir_files.end(); j++) {
1297             result.push_back(*i + "/" + *j);
1298         }
1299     }
1300
1301     CYG_REPORT_RETURN();
1302 }
1303
1304 // ----------------------------------------------------------------------------
1305 // Write some data to a file, throwing an I/O exception on failure. This
1306 // functionality is needed whenever savefile data is generated, it is
1307 // convenient to have a utility function to do the job. Also, performing
1308 // the Tcl_Write involves passing const data as a non-const argument:
1309 // if this ever causes problems in future it is a good idea to isolate
1310 // the problem here.
1311
1312 void
1313 CdlInterpreterBody::write_data(Tcl_Channel chan, std::string data)
1314 {
1315     CYG_REPORT_FUNCNAME("CdlInterpreter::write_data");
1316     CYG_REPORT_FUNCARG2XV(this, chan);
1317     CYG_PRECONDITION_THISC();
1318
1319     if (-1 == Tcl_Write(chan, CDL_TCL_CONST_CAST(char*, data.data()), data.size())) {
1320         std::string msg = "Unexpected error writing to file " + this->get_context() + " : " + Tcl_PosixError(tcl_interp);
1321         throw CdlInputOutputException(msg);
1322     }
1323
1324     CYG_REPORT_RETURN();
1325 }
1326
1327 //}}}
1328 //{{{  CdlInterpreter:: quote() etc.
1329
1330 // ----------------------------------------------------------------------------
1331 // Given a string, quote it in such a way that the Tcl interpreter will
1332 // process it as a single word, but keep the result as human-readable
1333 // as possible. If there are no special characters then just return the
1334 // string itself. Otherwise quoting is necessary.
1335 //
1336 // The choice is between braces and double quotes. Generally braces
1337 // are better and more consistent, but there is a problem if the
1338 // string argument itself contains braces. These could be
1339 // backslash-escaped, but the Tcl interpreter will not automatically
1340 // remove the backslashes so we would end up with a discrepancy
1341 // between the original data and what is seen by the parser. In this
1342 // case quote marks have to be used instead.
1343 //
1344 // NOTE: this code may not behave sensibly when it comes to i18n
1345 // issues.
1346
1347 std::string
1348 CdlInterpreterBody::quote(std::string src)
1349 {
1350     CYG_REPORT_FUNCNAME("CdlInterpreter::quote");
1351
1352     std::string  result = "";
1353     bool         contains_specials = false;
1354     unsigned int i;
1355
1356     if (0 == src.size()) {
1357         // An empty string. The best way to represent this is an empty
1358         // set of quotes.
1359         result = "\"\"";
1360         CYG_REPORT_RETURN();
1361         return result;
1362     }
1363
1364     if ('#' == src[0]) {
1365         contains_specials = true;
1366     }
1367
1368     for (i = 0; (i < src.size()) && !contains_specials; i++) {
1369         if (isspace(src[i])) {
1370             contains_specials = true;
1371             break;
1372         }
1373         switch(src[i]) {
1374           case '{':
1375           case '}':
1376           case '\\':
1377           case '$':
1378           case '"':
1379           case '[':
1380           case ']':
1381           case '#':
1382           case ';':
1383               contains_specials = true;
1384               break;
1385
1386           default:
1387               break;
1388         }
1389     }
1390
1391     if (!contains_specials) {
1392         result = src;
1393     } else{
1394         // If the data is a multiline item, it is better to start it in column 0.
1395         // Unfortunately there is the question of what to do with the opening
1396         // quote. Putting it on the current line, followed by a backslash-escaped
1397         // newline, introduces a space into the string. If the string begins with
1398         // a space anyway then arguably this would be harmless, but it could
1399         // be confusing to the user. Putting the opening double quote into column 0
1400         // means that the first line of data is indented relative to the rest of
1401         // the data, but still appears to be the best alternative.
1402         if (src.find('\n') != std::string::npos) {
1403             result += "\\\n";
1404         }
1405         result += '\"';
1406         for (i = 0; i < src.size(); i++) {
1407             switch(src[i]) {
1408               case '\\':
1409               case '$':
1410               case '"':
1411               case '[':
1412               case ']':
1413                   result += '\\';
1414                   result += src[i];
1415                   break;
1416
1417               default:
1418                 result += src[i];
1419                 break;
1420             }
1421         }
1422         result += '\"';
1423     }
1424
1425     CYG_REPORT_RETURN();
1426     return result;
1427 }
1428
1429 // ----------------------------------------------------------------------------
1430 // Given some data which may be multiline, return a string which corresponds
1431 // to that data turned into a comment.
1432
1433 std::string
1434 CdlInterpreterBody::multiline_comment(const std::string& orig, int first_indent, int second_indent)
1435 {
1436     CYG_REPORT_FUNCNAME("CdlInterpreter::multiline_comment");
1437
1438     std::string indent  = std::string(first_indent, ' ') + "# " + std::string(second_indent, ' ');
1439     std::string result  = "";
1440     bool indent_needed = true;
1441
1442     std::string::const_iterator str_i;
1443     for (str_i = orig.begin(); str_i != orig.end(); str_i++) {
1444         if (indent_needed) {
1445             result += indent;
1446             indent_needed = false;
1447         }
1448         result += *str_i;
1449         if ('\n' == *str_i) {
1450             indent_needed = true;
1451         }
1452     }
1453
1454     CYG_REPORT_RETURN();
1455     return result;
1456 }
1457
1458 // ----------------------------------------------------------------------------
1459 // Given some data, append it to the current line and add additional commented
1460 // and indented lines as required.
1461 std::string
1462 CdlInterpreterBody::extend_comment(const std::string& orig, int first_indent, int second_indent)
1463 {
1464     CYG_REPORT_FUNCNAME("CdlInterpreter::extend_comment");
1465
1466     std::string indent  = std::string(first_indent, ' ') + "# " + std::string(second_indent, ' ');
1467     std::string result = "";
1468     bool indent_needed = false;
1469
1470     std::string::const_iterator str_i;
1471     for (str_i = orig.begin(); str_i != orig.end(); str_i++) {
1472         if (indent_needed) {
1473             result += indent;
1474             indent_needed = false;
1475         }
1476         result += *str_i;
1477         if ('\n' == *str_i) {
1478             indent_needed = true;
1479         }
1480     }
1481
1482     CYG_REPORT_RETURN();
1483     return result;
1484 }
1485
1486 //}}}