2023-01-31 14:59 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

* include/hbapierr.h
  * src/harbour.def
  * src/rtl/errapi.c
    + added new C function:
         void hb_errReinit( PHB_ITEM pError );
      it allows to replace default error object with user custom one which
      support :Init() method

  * contrib/xhb/xhb.hbp
  + contrib/xhb/xhb.h
  + contrib/xhb/xhberror.prg
    + added code which extends Harbour error objects adding functionality
      known from xHarbour:
         oError:ProcName
         oError:ProcLine
         oError:ProcModule
      Above instance variables are initialized automatically when error
      object is created.
      To enable this functionality it's enough to add to PRG code:
         REQUEST xhb_ErrorNew

  * contrib/xhb/xhberr.prg
    * use error object :Proc*() methods if they are available
    - removed PRG version of xhb_ErrorNew()

  * contrib/xhb/xhbmemo.prg
  * contrib/xhb/xhbtedit.prg
    ! use xhb_ErrorNew() instead of ErrorNew() which does not support
      any parameters

  * include/hbapicls.h
    ; typo in comment

src/harbour.def

@@ -2444,6 +2444,7 @@ hb_errRT_New
 hb_errRT_New_Subst
 hb_errRT_SubstParams
 hb_errRT_TERM
+hb_errReinit
 hb_errRelease
 hb_errorBlock
 hb_errorHandler

src/rtl/errapi.c

@@ -82,8 +82,10 @@ HB_FUNC_EXTERN( ERRORNEW );
 
 
 static PHB_ITEM s_pError = NULL;
+static HB_BOOL s_fErrInit = HB_FALSE;
 
 static HB_SYMB s_symErrorNew = { "ERRORNEW", { HB_FS_PUBLIC | HB_FS_LOCAL }, { HB_FUNCNAME( ERRORNEW ) }, NULL };
+static HB_SYMB s_symmsgInit = { "INIT", { HB_FS_MESSAGE }, { NULL }, NULL };
 
 typedef struct
 {
@@ -478,11 +480,14 @@ void hb_errInit( void )
 
    /* error function */
    hb_dynsymNew( &s_symErrorNew );
+   /* init message */
+   hb_dynsymNew( &s_symmsgInit );
 
    /* Create error class and base object */
    s_pError = hb_itemNew( NULL );
    hb_clsAssociate( hb_errClassCreate() );
    hb_itemMove( s_pError, hb_stackReturnItem() );
+   s_fErrInit = hb_objHasMessage( s_pError, s_symmsgInit.pDynSym );
 }
 
 void hb_errExit( void )
@@ -493,14 +498,42 @@ void hb_errExit( void )
    s_pError = NULL;
 }
 
+void hb_errReinit( PHB_ITEM pError )
+{
+   if( pError && HB_IS_OBJECT( pError ) )
+   {
+      hb_itemRelease( s_pError );
+      s_pError = hb_itemNew( pError );
+   }
+   /* intentionaly outside above if() block so it can be called
+    * with NULL parameter just to refresh :Init() method status
+    * after class modification [druzus]
+    */
+   s_fErrInit = hb_objHasMessage( s_pError, s_symmsgInit.pDynSym );
+}
+
 PHB_ITEM hb_errNew( void )
 {
+   PHB_ITEM pError;
+
    HB_TRACE( HB_TR_DEBUG, ( "hb_errNew()" ) );
 
    if( ! s_pError || ! HB_IS_OBJECT( s_pError ) )
       hb_errInternal( HB_EI_ERRRECFAILURE, NULL, NULL, NULL );
 
-   return hb_arrayClone( s_pError );
+   pError = hb_arrayClone( s_pError );
+   if( s_fErrInit )
+   {
+      if( hb_vmRequestReenter() )
+      {
+         hb_vmPushSymbol( &s_symmsgInit );
+         hb_vmPush( pError );
+         hb_vmSend( 0 );
+         hb_vmRequestRestore();
+      }
+   }
+
+   return pError;
 }
 
 HB_USHORT hb_errLaunch( PHB_ITEM pError )