fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2010-05-17 20:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* include/hbextern.ch
  * src/rtl/Makefile
  + src/rtl/memvarhb.prg
    + Added:
        HB_MVSAVE( <cFileName>, [<cMask>], [<lIncludeMask>] )
        HB_MVRESTORE( <cFileName>, [<lAdditive>], [<cMask>], [<lIncludeMask>] )

      They serve the same purpose with same interface
      and similar behavior to __MVSAVE()/__MVRESTORE()
      (and __MSAVE()/__MRESTORE(), and 'SAVE TO' command),
      only that they support longer than 10 char variable names.
      It is not possible to add such support in Clipper-style
      .mem files, so these functions will create an incompatible
      file format with default '.hbv' extension.

    ; TOFIX: __MVRESTORE() restores variables as PRIVATEs
             while HB_MVRESTORE() as PUBLIC.
    ; NOTE: GETLIST exclusion is solved with simple trick,
            as I couldn't find how it's solved in __MVSAVE().
    ; Consider this experimental solution to the problem.

  * contrib/hbmysql/tmysql.prg
    % STOD( "" ) -> STOD()

  * contrib/hbide/ideprojmanager.prg
    ! -hbexec -> -hbexe

  * src/rtl/typefile.prg
    ! __TYPEFILE(): Fixed both RTEs to be Clipper compatible.
This commit is contained in:
Viktor Szakats
2010-05-17 18:49:23 +00:00
parent 7eded4f427
commit e4196785d1
7 changed files with 333 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
harbour/ChangeLog
View File

@@ -17,12 +17,43 @@
past entries belonging to author(s): Viktor Szakats.
*/
2010-05-17 20:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* include/hbextern.ch
* src/rtl/Makefile
+ src/rtl/memvarhb.prg
+ Added:
HB_MVSAVE( <cFileName>, [<cMask>], [<lIncludeMask>] )
HB_MVRESTORE( <cFileName>, [<lAdditive>], [<cMask>], [<lIncludeMask>] )
They serve the same purpose with same interface
and similar behavior to __MVSAVE()/__MVRESTORE()
(and __MSAVE()/__MRESTORE(), and 'SAVE TO' command),
only that they support longer than 10 char variable names.
It is not possible to add such support in Clipper-style
.mem files, so these functions will create an incompatible
file format with default '.hbv' extension.
; TOFIX: __MVRESTORE() restores variables as PRIVATEs
while HB_MVRESTORE() as PUBLIC.
; NOTE: GETLIST exclusion is solved with simple trick,
as I couldn't find how it's solved in __MVSAVE().
; Consider this experimental solution to the problem.
* contrib/hbmysql/tmysql.prg
% STOD( "" ) -> STOD()
* contrib/hbide/ideprojmanager.prg
! -hbexec -> -hbexe
* src/rtl/typefile.prg
! __TYPEFILE(): Fixed both RTEs to be Clipper compatible.
2010-15-17 07:33 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com)
* contrib/hbqt/hbqt_hbqplaintextedit.cpp
! Fixed: misbehavior of "Del" key.
* contrib/hbide/ideeditor.prg
% Changed: hb_fGetAttr( cFile, nAttr) tested agains
% Changed: hb_fGetAttr( cFile, nAttr) tested agains
hb_bitAnd( nAttr, FC_READONLY ) == FC_READONLY
* contrib/hbide/ideshortcuts.prg
@@ -45,8 +76,8 @@
* contrib/hbide/idesources.prg
+ Implemented: "new" source opens a file save dialog to provide
a valid name with extention. Syntax highlighting will be based on that.
+ Implemented: "new" project opens a Select Path dialog to
designate the project location. The path obtained as such is
+ Implemented: "new" project opens a Select Path dialog to
designate the project location. The path obtained as such is
posted in the "Project Location field of "Project Properties".
2010-15-16 21:05 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com)
@@ -55,19 +86,19 @@
* contrib/hbide/ideedit.prg
* contrib/hbide/ideeditor.prg
+ Implemented: <MainMenu><Edit><Switch ReadOnly Mode> plus
+ Implemented: <MainMenu><Edit><Switch ReadOnly Mode> plus
file's "readonly" attribute obtained by hb_fGetAttr() == 33
( please correct me if it is not OK on all systems ).
"Switch ReadOnly Mode" toggles the readonly status of the
"Switch ReadOnly Mode" toggles the readonly status of the
current source in focus only if on disk attribute is normal.
ReadOnly status is permanent if disk attribute equals 33 and
ReadOnly status is permanent if disk attribute equals 33 and
cannot be toggled.
While in readonly mode, cut/paste/alter operation are suspened,
only copy operation is supported. Copy can be performed with
mouse and keyboard both and all three modes are available.
2010-05-17 00:59 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/sddfb/sddfb.hbi
! Sync with recent fix in contrib/hbfbird/hbfbird.hbi.

2
harbour/contrib/hbide/ideprojmanager.prg
View File

@@ -443,7 +443,7 @@ METHOD IdeProjManager:pullHbpData( cHbp )
s := hbide_stripRoot( cHome, s )
NEXT
IF ( n := ascan( aOptns, {|e| lower( e ) $ "-hbexec,-hblib,-hbdyn" } ) ) > 0
IF ( n := ascan( aOptns, {|e| lower( e ) $ "-hbexe,-hblib,-hbdyn" } ) ) > 0
cType := lower( aOptns[ n ] )
cType := iif( cType == "-hblib", "Lib", iif( cType == "-hbdyn", "Dll", "Executable" ) )
ELSE

4
harbour/contrib/hbmysql/tmysql.prg
View File

@@ -542,7 +542,7 @@ METHOD GetRow( nRow ) CLASS TMySQLQuery
CASE MYSQL_TYPE_DATE
IF Empty( ::aRow[ i ] )
::aRow[ i ] := hb_SToD( "" )
::aRow[ i ] := hb_SToD()
ELSE
// Date format YYYY-MM-DD
::aRow[ i ] := hb_SToD( Left( ::aRow[ i ], 4 ) + SubStr( ::aRow[ i ], 6, 2 ) + Right( ::aRow[ i ], 2 ) )
@@ -1167,7 +1167,7 @@ METHOD GetBlankRow( lSetValues ) CLASS TMySQLTable
EXIT
CASE MYSQL_TYPE_DATE
aRow[ i ] := hb_SToD( "" )
aRow[ i ] := hb_SToD()
EXIT
OTHERWISE

2
harbour/include/hbextern.ch
View File

@@ -845,6 +845,8 @@ EXTERNAL HB_ISSYMBOL
EXTERNAL HB_ISDATETIME
EXTERNAL HB_ISTIMESTAMP
EXTERNAL HB_GET
EXTERNAL HB_MVSAVE
EXTERNAL HB_MVRESTORE
EXTERNAL HB_DATETIME
EXTERNAL HB_CTOD

1
harbour/src/rtl/Makefile
View File

@@ -224,6 +224,7 @@ PRG_SOURCES := \
listbox.prg \
memoedit.prg \
memvarbl.prg \
memvarhb.prg \
menuto.prg \
menusys.prg \
objfunc.prg \

285
harbour/src/rtl/memvarhb.prg Normal file
View File

@@ -0,0 +1,285 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MEMVAR save/restore functions with >10 variable name support.
*
* Copyright 2010 Viktor Szakats (harbour.01 syenar.hu)
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/* TOFIX: PUBLICs are created on restore, instead of PRIVATEs */
#include "hbmemvar.ch"
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
#define _HBMEM_EXT ".hbv"
PROCEDURE HB_MVSAVE( cFileName, cMask, lIncludeMask )
LOCAL nCount
LOCAL xValue
LOCAL cName
LOCAL nScope
LOCAL lMatch
LOCAL cExt
LOCAL aVars
LOCAL fhnd
LOCAL tmp
LOCAL oError
LOCAL xRecover
LOCAL nRetries
#ifdef HB_CLP_STRICT
IF PCount() == 3 .AND. ;
ISCHARACTER( cFileName ) .AND. ;
ISCHARACTER( cMask ) .AND. ;
ISLOGICAL( lIncludeMask )
#else
IF ISCHARACTER( cFileName )
#endif
IF Set( _SET_DEFEXTENSIONS )
hb_FNameSplit( cFileName, NIL, NIL, @cExt )
IF Empty( cExt )
cFileName += _HBMEM_EXT
ENDIF
ENDIF
IF ! ISCHARACTER( cMask ) .OR. ;
Empty( cMask ) .OR. Left( cMask, 1 ) == "*"
cMask := "*"
ENDIF
IF ! ISLOGICAL( lIncludeMask )
lIncludeMask := .T.
ENDIF
aVars := {}
FOR EACH nScope IN { HB_MV_PUBLIC, HB_MV_PRIVATE }
nCount := __mvDbgInfo( nScope )
FOR tmp := 1 TO nCount
xValue := __mvDbgInfo( nScope, tmp, @cName )
IF !( cName == "GETLIST" )
lMatch := hb_WildMatchI( cMask, cName )
IF iif( lIncludeMask, lMatch, ! lMatch )
AAdd( aVars, { Upper( cName ), xValue } )
ENDIF
ENDIF
NEXT
NEXT
nRetries := 0
DO WHILE .T.
fhnd := hb_FCreate( cFileName, FC_NORMAL, FO_CREAT + FO_TRUNC + FO_READWRITE + FO_EXCLUSIVE )
IF fhnd == F_ERROR
oError := ErrorNew()
oError:severity := ES_ERROR
oError:genCode := EG_OPEN
oError:subSystem := "BASE"
oError:subCode := 2006
oError:canRetry := .T.
oError:canDefault := .T.
oError:fileName := cFileName
oError:osCode := FError()
oError:tries := ++nRetries
xRecover := Eval( ErrorBlock(), oError )
IF ISLOGICAL( xRecover ) .AND. xRecover
LOOP
ENDIF
ENDIF
EXIT
ENDDO
IF fhnd != F_ERROR
FWrite( fhnd, hb_serialize( aVars ) )
FClose( fhnd )
ENDIF
ELSE
oError := ErrorNew()
oError:severity := ES_ERROR
oError:genCode := EG_ARG
oError:subSystem := "BASE"
oError:subCode := 2008
oError:canRetry := .F.
oError:canDefault := .F.
oError:Args := hb_AParams()
oError:operation := ProcName()
Eval( ErrorBlock(), oError )
ENDIF
RETURN NIL
FUNCTION HB_MVRESTORE( cFileName, lAdditive, cMask, lIncludeMask )
LOCAL item
LOCAL cName
LOCAL lMatch
LOCAL cExt
LOCAL aVars
LOCAL cBuffer
LOCAL xValue
LOCAL fhnd
LOCAL oError
LOCAL xRecover
LOCAL nRetries
#ifdef HB_CLP_STRICT
IF ISCHARACTER( cFileName ) .AND. ;
ISLOGICAL( lAdditive )
#else
IF ISCHARACTER( cFileName )
#endif
IF ! ISLOGICAL( lAdditive )
lAdditive := .T.
ENDIF
IF ! lAdditive
__MVClear()
ENDIF
IF Set( _SET_DEFEXTENSIONS )
hb_FNameSplit( cFileName, NIL, NIL, @cExt )
IF Empty( cExt )
cFileName += _HBMEM_EXT
ENDIF
ENDIF
IF ! ISCHARACTER( cFileName ) .OR. ;
Empty( cMask ) .OR. Left( cMask, 1 ) == "*"
cMask := "*"
ENDIF
IF ! ISLOGICAL( lIncludeMask )
lIncludeMask := .T.
ENDIF
nRetries := 0
DO WHILE .T.
fhnd := FOpen( cFileName, FO_READ )
IF fhnd == F_ERROR
oError := ErrorNew()
oError:severity := ES_ERROR
oError:genCode := EG_OPEN
oError:subSystem := "BASE"
oError:subCode := 2005
oError:canRetry := .T.
oError:canDefault := .T.
oError:fileName := cFileName
oError:osCode := FError()
oError:tries := ++nRetries
xRecover := Eval( ErrorBlock(), oError )
IF ISLOGICAL( xRecover ) .AND. xRecover
LOOP
ENDIF
ENDIF
EXIT
ENDDO
IF fhnd == F_ERROR
RETURN .F.
ENDIF
cBuffer := Space( FSeek( fhnd, 0, FS_END ) )
FSeek( fhnd, 0, FS_SET )
FRead( fhnd, @cBuffer, Len( cBuffer ) )
FClose( fhnd )
aVars := hb_deserialize( cBuffer )
cBuffer := NIL
IF ISARRAY( aVars )
FOR EACH item IN aVars
IF ISARRAY( item ) .AND. Len( item ) == 2 .AND. ;
ISCHARACTER( item[ 1 ] ) .AND. ;
! Empty( item[ 1 ] )
cName := item[ 1 ]
lMatch := hb_WildMatchI( cMask, cName )
IF iif( lIncludeMask, lMatch, ! lMatch )
IF xValue == NIL
xValue := item[ 2 ]
ENDIF
IF __MVExist( cName )
&cName := item[ 2 ]
ELSE
PUBLIC &cName := item[ 2 ]
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
RETURN xValue
ELSE
oError := ErrorNew()
oError:severity := ES_ERROR
oError:genCode := EG_ARG
oError:subSystem := "BASE"
oError:subCode := 2007
oError:canRetry := .F.
oError:canDefault := .F.
oError:Args := hb_AParams()
oError:operation := ProcName()
Eval( ErrorBlock(), oError )
ENDIF
RETURN NIL

6
harbour/src/rtl/typefile.prg
View File

@@ -80,10 +80,10 @@ PROCEDURE __TypeFile( cFile, lPrint )
IF ! ISCHARACTER( cFile )
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_OPEN
oErr:genCode := EG_ARG
oErr:subSystem := "BASE"
oErr:SubCode := 2009
oErr:Description := "Argument error: __TYPEFILE"
oErr:Description := ProcName()
Eval( ErrorBlock(), oErr )
ENDIF
@@ -113,9 +113,9 @@ PROCEDURE __TypeFile( cFile, lPrint )
oErr:genCode := EG_OPEN
oErr:subSystem := "BASE"
oErr:SubCode := 2011
oErr:Description := "Open Error: " + cFile
oErr:canDefault := .T.
oErr:canRetry := .T.
oErr:fileName := cFile
oErr:OsCode := FError()
oErr:tries := ++nRetries
xRecover := Eval( ErrorBlock(), oErr )