Changeset 1065545 in tol for toltcl/generic


Ignore:
Timestamp:
Oct 8, 2009, 8:02:32 PM (17 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
865a7b9d
Parents:
dd045c73
Message:

first approach to #740

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1505 be4846ae-f051-483a-831f-b64e7d08527f

Location:
toltcl/generic
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • toltcl/generic/tolaccess.cpp

    rdd045c73 r1065545  
    469469 *
    470470 */
    471 const BSyntaxObject * Tol_FindGlobalContainer(const char* Type,
    472                                               const char* obj_name,
    473                                               Tcl_Obj*    obj_result)
     471BSyntaxObject * Tol_FindGlobalContainer(const char* Type,
     472                                        const char* obj_name,
     473                                        Tcl_Obj*    obj_result)
    474474{
    475475  BGrammar *gra;
    … …  
    515515 */
    516516
    517 const BSyntaxObject * Tol_FindChild(Tcl_Interp    *interp,
    518                                     const BSyntaxObject *syn_obj,
    519                                     Tcl_Obj       **indexes, int n,
    520                                     Tcl_Obj       *obj_result)
     517BSyntaxObject * Tol_FindChild(Tcl_Interp    *interp,
     518                              BSyntaxObject *syn_obj,
     519                              Tcl_Obj       **indexes, int n,
     520                              Tcl_Obj       *obj_result)
    521521{
    522522  int tcl_code;
    … …  
    570570 */
    571571
    572 const BSyntaxObject * Tol_ResolveObject(Tcl_Interp *interp,
    573                                         Tcl_Obj    *obj_ref,
    574                                         Tcl_Obj    *obj_result)
     572BSyntaxObject * Tol_ResolveObject(Tcl_Interp *interp,
     573                                  Tcl_Obj    *obj_ref,
     574                                  Tcl_Obj    *obj_result)
    575575{
    576576  Tcl_Obj ** items;
    … …  
    587587
    588588  // this Tcl_Obj is to leave error messages
    589   const BSyntaxObject * syn = NULL;
     589  BSyntaxObject * syn = NULL;
    590590
    591591  if (n >= 2) {
    … …  
    666666{
    667667  int j;
    668   const BSyntaxObject * so;
     668  BSyntaxObject * so;
    669669 
    670670  for (j = 1; j <= ptrSet->Card(); j++) {
    … …  
    806806}
    807807
     808class ContainerIterator
     809{
     810public:
     811
     812  static ContainerIterator *New( BSyntaxObject *obj );
     813 
     814  enum status_t { VALID, INVALID };
     815
     816  virtual ~ContainerIterator( ) { }
     817 
     818  status_t GetStatus() const {
     819    return m_status;
     820  }
     821 
     822  virtual status_t Begin( ) = 0;
     823  virtual BSyntaxObject *Next( ) = 0;
     824
     825protected:
     826
     827  ContainerIterator() : m_status( INVALID ) { }
     828 
     829  status_t m_status;
     830};
     831
     832class SetIterator : public ContainerIterator
     833{
     834public:
     835  SetIterator( BSet *set )
     836  {
     837    m_set = set;
     838    Begin();
     839  }
     840
     841  virtual ~SetIterator( )
     842  {
     843  }
     844 
     845  virtual ContainerIterator::status_t Begin()
     846  {
     847    m_idx = 0;
     848    m_status = m_set ? VALID : INVALID;
     849    return m_status;
     850  }
     851 
     852  virtual BSyntaxObject *Next()
     853  {
     854    BSyntaxObject *so = _next();
     855    if ( !so ) {
     856      /* start over */
     857      Begin();
     858    }
     859    return so;
     860  }
     861
     862protected:
     863
     864  BSyntaxObject *_next()
     865  {
     866    if ( m_set ) {
     867      ++m_idx;
     868      return ( m_idx > m_set->Card( ) ) ? NULL : ( *m_set )[ m_idx ];
     869    }
     870    return NULL;
     871  }
     872
     873  size_t m_idx;
     874  BSet *m_set;
     875};
     876
     877class USetIterator : public SetIterator
     878{
     879public:
     880  USetIterator( BUserSet *uset )
     881    : SetIterator( &( uset->Contens( ) ) )
     882  {
     883  }
     884  virtual ~USetIterator() { }
     885};
     886
     887class UNameBlockIterator : public SetIterator
     888{
     889public:
     890  UNameBlockIterator( BUserNameBlock *unb )
     891    : SetIterator( &( unb->Contens( ).Set( ) ) ),
     892      m_data_static( NULL ),
     893      m_methods_static( NULL ),
     894      m_methods_instance( NULL ),
     895      m_ptr_item( NULL )
     896  {
     897    const BClass *cls = unb->Contens( ).Class( );
     898    if ( cls ) {
     899      m_data_static = cls->SelectStaticMembers( NULL );
     900      m_methods_static = cls->SelectStaticMethods( NULL );
     901      m_methods_instance = cls->SelectNonStaticMethods( NULL );
     902    }
     903  }
     904
     905  virtual ~UNameBlockIterator( )
     906  {
     907    DESTROY( m_data_static );
     908    DESTROY( m_methods_static );
     909    DESTROY( m_methods_instance );
     910  }
     911 
     912  virtual status_t Begin( )
     913  {
     914    SetIterator::Begin( );
     915    m_ptr_item = NULL;
     916    return GetStatus( );
     917  }
     918 
     919  virtual BSyntaxObject *Next()
     920  {
     921    BSyntaxObject *so;
     922   
     923    so = _next();
     924   
     925    if ( so ) {
     926      return so;
     927    }
     928   
     929    if ( m_ptr_item ) {
     930      m_ptr_item = Cdr( m_ptr_item );
     931    } else {
     932      m_ptr_item = m_methods_instance;
     933    }
     934
     935    if ( m_ptr_item ) {
     936      return (BSyntaxObject*)Car( m_ptr_item );
     937    } else {
     938      // si despues de avanzar no encuentro 'obj', lo dejo listo para
     939      // que de la vuelta
     940      Begin( );
     941      return NULL;
     942    }
     943  }
     944
     945private:
     946  BList *m_data_static;
     947  BList *m_methods_static;
     948  BList *m_methods_instance;
     949  BList *m_ptr_item;
     950};
     951
     952ContainerIterator *ContainerIterator::New( BSyntaxObject *obj )
     953{
     954  if ( obj->Grammar( ) == GraSet( ) ) {
     955    return new USetIterator( (BUserSet*)obj );
     956  }
     957  if ( obj->Grammar( ) == GraNameBlock( ) ) {
     958    return new UNameBlockIterator( (BUserNameBlock*)obj );
     959  }
     960  return NULL;
     961}
     962
    808963/*! Implement a foreach proc similar to the one provided in Tcl except
    809964 *  that instead of iterating over the list's items it iterates over
    … …  
    816971                 Tcl_Obj * obj_result)
    817972{
    818   const BSyntaxObject* container;
     973  BSyntaxObject* container;
    819974  Tcl_DString dstr;
    820975  Tcl_Obj * ArgIndexes;
    821976  int tcl_code = TCL_OK;
    822   int i, card ;
     977  int i;
    823978  int n, index_length;
    824979  Tcl_Obj ** items;
    … …  
    8731028    return TCL_ERROR;
    8741029  }
    875   BSet *set = ContainerGetSet( container );
    876   if (!set) {
     1030  ContainerIterator *citer = ContainerIterator::New( container );
     1031 
     1032  if ( !citer ) {
    8771033    Tcl_AppendStringsToObj(obj_result,
    8781034                           "object '",
    … …  
    8801036                           "' is not a valid container ",
    8811037                           NULL);
    882       return TCL_ERROR;
    883   }
    884  
    885   card = set->Card();
     1038    return TCL_ERROR;
     1039  }
    8861040 
    8871041  // is ok to ask for a list
    888   Tcl_ListObjGetElements( interp, objv[ 0 ], &n, &items );
     1042  Tcl_ListObjGetElements( interp, objv[ 1 ], &n, &items );
    8891043
    8901044  // initialize the list of indexes (the common part) for every item
    … …  
    9121066  datav[ OBJ_DESC ]     = Tcl_NewStringObj( "description", -1 );
    9131067  datav[ OBJ_DESCV ]    = Tcl_NewObj( );
    914   Tcl_Obj * last_index  = Tcl_NewIntObj( 0 );
     1068  Tcl_Obj * last_index  = Tcl_NewIntObj( 1 );
    9151069  Tcl_ListObjAppendElement( NULL, ArgIndexes, last_index );
    9161070  datav[ OBJ_INDEXES ]  = Tcl_NewStringObj( "indexes", -1 );
    … …  
    9391093  BText btxt;
    9401094 
    941   for ( i = 1; i <= card; ++i ) {
    942     syn_i = ( *set )[ i ];
    943    
     1095  for ( i = 1; ( syn_i = citer->Next( ) ); ++i ) {
    9441096    /* read the grammar */
     1097   
    9451098    btxt = syn_i->Grammar( )->Name( );
    9461099    Tcl_ExternalToUtfDString( NULL, btxt, -1, &dstr );
    … …  
    9731126    Tcl_DStringFree(&dstr);
    9741127
     1128    /* update last index */
     1129    if ( Tcl_IsShared( last_index ) ) {
     1130      last_index = Tcl_NewIntObj( i );
     1131      Tcl_ListObjReplace( NULL, datav[ OBJ_INDEXESV ], index_length-1,
     1132                          1, 1, &last_index );
     1133    } else {
     1134      Tcl_SetIntObj( last_index, i );
     1135    }
     1136    /* to refresh the string */
     1137    Tcl_InvalidateStringRep( datav[ OBJ_INDEXESV ] );
    9751138    // Este if es para incluir en los items que son Set informacion
    9761139    // que solo ellos llevan como: Subtype, IsFile, etc ...
     1140
    9771141    if ( ( set_i = ContainerGetSet( syn_i ) ) ) {
    978       /* update last index */
    979       if ( Tcl_IsShared( last_index ) ) {
    980         last_index = Tcl_NewIntObj( i );
    981         Tcl_ListObjReplace( NULL, datav[ OBJ_INDEXESV ], index_length-1,
    982                            1, 1, &last_index );
    983       }
    984       /* set the last value index */
    985       Tcl_SetIntObj( last_index, i );
    986       /* to refresh the string */
    987       Tcl_InvalidateStringRep( datav[ OBJ_INDEXESV ] );
    9881142      if ( Tcl_IsShared( datav[ OBJ_ISFILEV ] ) ) {
    9891143        Tcl_DecrRefCount( datav[ OBJ_ISFILEV ] );
    … …  
    10601214    }
    10611215  }
     1216
     1217  delete citer;
    10621218 
    10631219  /* liberar los objetos tcl */
    … …  
    10841240                     Tcl_Obj * obj_result)
    10851241{
    1086   const BSyntaxObject* container;
     1242  BSyntaxObject* container;
    10871243  Tcl_DString dstr;
    10881244  Tcl_Obj * ArgIndexes;
    10891245  int tcl_code;
    1090   int i, card ;
     1246  int i;
    10911247  int n, index_length;
    10921248  Tcl_Obj ** items;
    … …  
    11381294    return TCL_ERROR;
    11391295  }
    1140   BSet *set = ContainerGetSet( container );
    1141   if (!set) {
     1296  ContainerIterator *citer = ContainerIterator::New( container );
     1297 
     1298  if ( !citer ) {
    11421299    Tcl_AppendStringsToObj(obj_result,
    11431300                           "object '",
    … …  
    11471304      return TCL_ERROR;
    11481305  }
    1149  
    1150   card = set->Card();
    11511306 
    11521307  int datac;
    … …  
    11771332  datav[ARG_PATH]    = Tcl_NewObj();
    11781333  datav[ARG_DESC]    = Tcl_NewObj();
    1179   Tcl_Obj * last_index = Tcl_NewIntObj(0);
     1334  Tcl_Obj * last_index = Tcl_NewIntObj(1);
    11801335  Tcl_ListObjAppendElement(NULL,ArgIndexes,last_index);
    11811336  datav[ARG_INDEXES] = ArgIndexes;
    … …  
    11961351  BText btxt;
    11971352 
    1198   for ( i = 1; i <= card; ++i ) {
    1199     syn_i = (*set)[i];
     1353  for ( i = 1; ( syn_i = citer->Next( ) ); ++i ) {
    12001354   
    12011355    /* read the grammar */
    … …  
    12611415        Tcl_ListObjReplace(NULL, datav[ARG_INDEXES], index_length-1,
    12621416                           1, 1, &last_index);
     1417      } else {
     1418        /* set the last value index */
     1419        Tcl_SetIntObj( last_index, i );
    12631420      }
    1264       /* set the last value index */
    1265       Tcl_SetIntObj( last_index, i );
    12661421      /* to refresh the string */
    12671422      Tcl_InvalidateStringRep( datav[ ARG_INDEXES ] );
    … …  
    13321487    Tcl_DecrRefCount( datav[ i ] );
    13331488  }
     1489
     1490  delete citer;
     1491 
    13341492  delete []datav;
    13351493  return tcl_code;

  • toltcl/generic/toltclInt.h

    rdd045c73 r1065545  
    313313 */
    314314extern
    315 const BSyntaxObject * Tol_ResolveObject(Tcl_Interp *interp,
    316                                         Tcl_Obj    *obj_ref,
    317                                         Tcl_Obj    *obj_result/*,
    318                                         BGrammar   *grammar=NULL*/);
     315BSyntaxObject * Tol_ResolveObject(Tcl_Interp *interp,
     316                                  Tcl_Obj    *obj_ref,
     317                                  Tcl_Obj    *obj_result/*,
     318                                                          BGrammar   *grammar=NULL*/);
    319319
    320320extern
Note: See TracChangeset for help on using the changeset viewer.