From 67fc641a8c9e4bbc58eae6f5b1fa464a38638557 Mon Sep 17 00:00:00 2001
From: Eddie Runia <eddie@runia.com>
Date: Fri, 7 May 1999 10:36:52 +0000
Subject: [PATCH] ClassSel method added to classes. Example in debugtst

---
 harbour/source/rtl/classes.c       | 51 +++++++++++++++++++++++++++++-
 harbour/tests/working/debugtst.prg | 10 +++++-
 2 files changed, 59 insertions(+), 2 deletions(-)

diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c
index 709839d99f..b3506fce59 100644
--- a/harbour/source/rtl/classes.c
+++ b/harbour/source/rtl/classes.c
@@ -3,6 +3,7 @@
  */
 
 #include <extend.h>
+#include <itemapi.h>
 
 void Push( PITEM );
 void PushNil( void );
@@ -44,7 +45,7 @@ extern SYMBOL symEval;
 PCLASS  pClasses = 0;
 WORD    wClasses = 0;
 PMETHOD pMethod = 0;
-PDYNSYM msgClassName = 0, msgClassH = 0, msgEval = 0;
+PDYNSYM msgClassName = 0, msgClassH = 0, msgEval = 0, msgClassSel = 0;
 
 HARBOUR CLASSCREATE() /* cClassName, nDatas --> hClass */
 {
@@ -241,6 +242,50 @@ static void DictRealloc( PCLASS pClass )
    }
 }
 
+static HARBOUR ClassSel() /* hClass */
+{
+   WORD    wClass = IS_ARRAY( stack.pBase + 1 ) ?
+        ( ( PBASEARRAY ) ( stack.pBase + 1 )->value.pBaseArray )->wClass: 0;
+                                                /* Get class word           */
+   WORD    wLimit;                              /* Number of Hash keys      */
+   WORD    wAt;
+   WORD    wPos = 0;
+   PCLASS  pClass;
+   PDYNSYM pMessage;
+   PITEM   pReturn = _itemNew( NULL );
+   PITEM   pItem;
+   PITEM   pItemRef;
+
+   /* Variables by reference */
+   if( ( ! wClass ) && IS_BYREF( stack.pBase + 1 ) )
+   {
+      pItemRef = stack.pItems + ( stack.pBase + 1 )->value.wItem;
+      if( IS_ARRAY( pItemRef ) )
+         wClass = ( ( PBASEARRAY ) pItemRef->value.pBaseArray )->wClass;
+   }
+
+   if( wClass && wClass <= wClasses )
+   {
+      pClass   = &pClasses[ wClass - 1 ];
+      wLimit   = pClass->wHashKey * BUCKET;
+      pReturn = _itemArrayNew( pClass->wMethods );
+                                                /* Create a transfer array  */
+      for( wAt = 0; wAt < wLimit ; wAt++ )
+      {
+         pMessage = pClass->pMethods[ wAt ].pMessage;
+         if( pMessage )                         /* Hash Entry used ?        */
+         {
+            pItem  = _itemNew(  NULL );         /* Add to array             */
+            pItem  = _itemPutC( pItem, pMessage->pSymbol->szName );
+            _itemArrayPut( pReturn, ++wPos, pItem );
+            ItemRelease( pItem );
+         }
+      }
+   }
+   _itemReturn( pReturn );
+   _xfree( pReturn );
+}
+
 HARBOUR CLASSADD() /* hClass, cMessage, pFunction, nType */
 {
    WORD wClass = _parnl( 1 );
@@ -359,6 +404,7 @@ HARBOURFUNC GetMethod( PITEM pObject, PSYMBOL pMessage )
    {
       msgClassName = GetDynSym( "CLASSNAME" );
       msgClassH    = GetDynSym( "CLASSH" );
+      msgClassSel  = GetDynSym( "CLASSSEL" );
       msgEval      = GetDynSym( "EVAL" );
    }
 
@@ -387,6 +433,9 @@ HARBOURFUNC GetMethod( PITEM pObject, PSYMBOL pMessage )
    else if( pMsg == msgClassH )
       return ClassH;
 
+   else if( pMsg == msgClassSel )
+      return ClassSel;
+
    else if( pMsg == msgEval )
       return EvalInline;
 
diff --git a/harbour/tests/working/debugtst.prg b/harbour/tests/working/debugtst.prg
index 7818bc19ce..d61f2519f7 100644
--- a/harbour/tests/working/debugtst.prg
+++ b/harbour/tests/working/debugtst.prg
@@ -17,6 +17,10 @@ function Main()
    QOut( "-DEBUG Functions-")
    QOut()
 
+   QOut( "-oForm-" )
+   QOut( ToChar( oForm:ClassSel(), ", ", .T. ))
+   QOut()
+
    QOut( "-Statics-" )
    QOut( ToChar ( __aStatic(), ", ", .T. ) )
    QOut()
@@ -124,7 +128,11 @@ function ToChar( xTxt, cSeparator, lDebug )
          cOut       := ""
          cSeparator := Default( cSeparator, " ")
          if lDebug
-            cOut += if( cValTxt=="A", "{", "Object(" )
+            if cValTxt=="A"
+               cOut += "{"
+            else
+               cOut += "Class#"+ToChar( xTxt:ClassH() )+"("
+            endif
          endif
          nLen := Len( xTxt )
          for n := 1 to nLen                     // For each item : Recurse !