// Use QryExpr.utl  // Expression handling for queries
Use DFScript.utl // DF-Script interpreter
Use vMachine.utl // Virtual machine class (heart of DFScript)
Use Strings.utl  // String manipulation for VDF and 3.2
Use FDX_Attr.nui // FDX compatible attribute functions
Use FdxField.utl // FDX Field things

#IF LNG_DEFAULT=LNG_DUTCH
 define t.QryExpr.Expression    for "Expressie"
 define t.QryExpr.Tables        for "Bestanden"
 define t.QryExpr.Fields        for "Velden"
 define t.QryExpr.Functions     for "Functies"
 define t.QryExpr.LongLabel     for "Lang label"
 define t.QryExpr.ShortLabel    for "Kort label"
 define t.QryExpr.Width         for "Breedte"
 define t.QryExpr._Characters   for " tekens"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Wijzig numerieke expressie"
 define t.QryExpr.EditStrExpr   for "Wijzig string expressie"
 define t.QryExpr.EditDatExpr   for "Wijzig datum expressie"
 define t.QryExpr.CreateCC_1    for "Cre‰er berekende kolom"
 define t.QryExpr.CreateCC_2    for "Wijzig berekende kolom (#"
 define t.QryExpr.Type_Numeric  for "Numeriek"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Tekst"
 define t.QryExpr.Type_Date     for "Datum"
 define t.QryExpr.DecimalPlaces for "Decimale waarden"
#ENDIF
#IF LNG_DEFAULT=LNG_SPANISH  // 03/10/2002 25/01/2004 Pepe GuimarÆes Moose Software  pg@moose-software.com
 define t.QryExpr.Expression    for "Expresi¢n"
 define t.QryExpr.Tables        for "Tablas"
 define t.QryExpr.Fields        for "Campos"
 define t.QryExpr.Functions     for "Funciones"
 define t.QryExpr.LongLabel     for "Etiq.larga"
 define t.QryExpr.ShortLabel    for "Etiq.corta"
 define t.QryExpr.Width         for "Ancho"
 define t.QryExpr._Characters   for " caracteres"
 define t.QryExpr.ReturnType    for "Devolver tipo"
 define t.QryExpr.EditNumExpr   for "Editar expresi¢n num‚rica"
 define t.QryExpr.EditStrExpr   for "Editar expresi¢n alfanum‚rica"
 define t.QryExpr.EditDatExpr   for "Editar expresi¢n tipo fecha"
 define t.QryExpr.CreateCC_1    for "Crear columna calculada"
 define t.QryExpr.CreateCC_2    for "Editar columna calculada (#"
 define t.QryExpr.Type_Numeric  for "Num‚rico"
 define t.QryExpr.Type_String   for "Cadena"
 define t.QryExpr.Type_Text     for "Texto"
 define t.QryExpr.Type_Date     for "Fecha"
 define t.QryExpr.DecimalPlaces for "N£mero decimales"
#ENDIF
#IF LNG_DEFAULT=LNG_ENGLISH
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_DANISH
 define t.QryExpr.Expression    for "Udtryk"
 define t.QryExpr.Tables        for "Tabeller"
 define t.QryExpr.Fields        for "Felter"
 define t.QryExpr.Functions     for "Funktioner"
 define t.QryExpr.LongLabel     for "Langt navn"
 define t.QryExpr.ShortLabel    for "Kort navn"
 define t.QryExpr.Width         for "Bredde"
 define t.QryExpr._Characters   for " karakterer"
 define t.QryExpr.ReturnType    for "Returtype"
 define t.QryExpr.EditNumExpr   for "Ret numerisk udtryk"
 define t.QryExpr.EditStrExpr   for "Ret streng udtryk"
 define t.QryExpr.EditDatExpr   for "Ret dato udtryk"
 define t.QryExpr.CreateCC_1    for "Opret beregnet kolonne"
 define t.QryExpr.CreateCC_2    for "Opret beregnet kolonne (#"
 define t.QryExpr.Type_Numeric  for "Numerisk"
 define t.QryExpr.Type_String   for "Ascii"
 define t.QryExpr.Type_Text     for "Tekst"
 define t.QryExpr.Type_Date     for "Dato"
 define t.QryExpr.DecimalPlaces for "Decimaler"
#ENDIF
#IF LNG_DEFAULT=LNG_SWEDISH
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_NORWEGIAN
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_GERMAN
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_PORTUGUESE
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_FRENCH
 define t.QryExpr.Expression    for "Expression"
 define t.QryExpr.Tables        for "Tables"
 define t.QryExpr.Fields        for "Fields"
 define t.QryExpr.Functions     for "Functions"
 define t.QryExpr.LongLabel     for "Long label"
 define t.QryExpr.ShortLabel    for "Short label"
 define t.QryExpr.Width         for "Width"
 define t.QryExpr._Characters   for " characters"
 define t.QryExpr.ReturnType    for "Return type"
 define t.QryExpr.EditNumExpr   for "Edit numeric expression"
 define t.QryExpr.EditStrExpr   for "Edit string expression"
 define t.QryExpr.EditDatExpr   for "Edit date expression"
 define t.QryExpr.CreateCC_1    for "Create calculated column"
 define t.QryExpr.CreateCC_2    for "Edit calculated column (#"
 define t.QryExpr.Type_Numeric  for "Numeric"
 define t.QryExpr.Type_String   for "String"
 define t.QryExpr.Type_Text     for "Text"
 define t.QryExpr.Type_Date     for "Date"
 define t.QryExpr.DecimalPlaces for "Decimal places"
#ENDIF
#IF LNG_DEFAULT=LNG_ITALIAN
 define t.QryExpr.Expression    for "Campo calcolato"
 define t.QryExpr.Tables        for "Tabelle"
 define t.QryExpr.Fields        for "Campi"
 define t.QryExpr.Functions     for "Funzioni"
 define t.QryExpr.LongLabel     for "Desc. Lunga"
 define t.QryExpr.ShortLabel    for "Desc. Corta"
 define t.QryExpr.Width         for "Larghezza"
 define t.QryExpr._Characters   for " caratteri"
 define t.QryExpr.ReturnType    for "Campo di tipo"
 define t.QryExpr.EditNumExpr   for "Edita espressione numerica"
 define t.QryExpr.EditStrExpr   for "Edita espressione stringa"
 define t.QryExpr.EditDatExpr   for "Edita espressione data"
 define t.QryExpr.CreateCC_1    for "Crea colonna calcolata"
 define t.QryExpr.CreateCC_2    for "Edita colonna calcolata (#"
 define t.QryExpr.Type_Numeric  for "Numerico"
 define t.QryExpr.Type_String   for "Stringa"
 define t.QryExpr.Type_Text     for "Testo"
 define t.QryExpr.Type_Date     for "Data"
 define t.QryExpr.DecimalPlaces for "Numero Decimali"
#ENDIF

// The cVirtualMachine is subclassed in order to
class cQueryExpressionVirtualMachine is a cVirtualMachine
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer pbAllowAllState public DFFALSE
    object oAllowedTables is a cSet NO_IMAGE
    end_object
  end_procedure

  procedure AllowedTables_Reset
    send delete_data to (oAllowedTables(self))
  end_procedure
  procedure AllowedTables_Add integer liFile
    send element_add to (oAllowedTables(self)) liFile
  end_procedure

  function iFileField.s string lsSymbol returns integer
    local string lsFile lsField
    local integer liFile liField lhFdx liRval
    move (uppercase(ExtractWord(lsSymbol,".",1))) to lsFile
    move (uppercase(ExtractWord(lsSymbol,".",2))) to lsField
    get phFDX_Server to lhFdx
    if (lsFile<>"" and lsField<>"") begin
      get FDX_FindLogicalName lhFdx lsFile 0 to liFile
      if (liFile>-1 and (pbAllowAllState(self) or element_find(oAllowedTables(self),liFile)<>-1)) begin
        forward get iFileField.s lsSymbol to liRval
        function_return liRval
      end
    end
    function_return 0
  end_function
end_class // cQueryExpressionVirtualMachine

class cQueryExpression is a cScriptInterpreter
  procedure construct_object integer liImage
    forward send construct_object liImage
    set piListingFileState to DFFALSE
    object oArray is a cArray NO_IMAGE
    end_object
  end_procedure
  function sPrepareExpression.s string lsExpression returns string
    local integer lhArr liPos
    local string lsChar10
    move (oArray(self)) to lhArr
    move (character(10)) to lsChar10
    send delete_data to lhArr
    repeat
      move (pos(lsChar10,lsExpression)) to liPos
      if liPos begin
        set value of lhArr item (item_count(lhArr)) to liPos
        move (replace(lsChar10,lsExpression,"")) to lsExpression
      end
    until (liPos=0)
    function_return lsExpression
  end_function
  function iTheRealErrorPosition integer liErrorPos returns integer
    local integer lhArr liItem liMax liLen liLine
    move (oArray(self)) to lhArr
    get item_count of lhArr to liMax
    move 0 to liItem
    move 1 to liLine
    repeat
      if (liItem<liMax) begin
        get value of lhArr item liItem to liLen
        if (liErrorPos>liLen) begin
          move (liErrorPos-liLen+1) to liErrorPos
          increment liLine
        end
        else function_return (liLine*65536+liErrorPos)
        increment liItem
      end
    until (liItem>=liMax)
    function_return (liLine*65536+liErrorPos)
  end_function
end_class // cQueryExpression

desktop_section
  object Query_ExprEvaluator is a cQueryExpressionVirtualMachine NO_IMAGE
  end_object

  object Query_ExprParser is a cQueryExpression NO_IMAGE
    set pVM_Object to (Query_ExprEvaluator(self))
    procedure AllowedTables_Reset
      send AllowedTables_Reset to (pVM_Object(self))
    end_procedure
    procedure AllowedTables_Add integer liFile
      send AllowedTables_Add to (pVM_Object(self)) liFile
    end_procedure
    procedure set pbAllowAllState integer lbValue
      set pbAllowAllState of (pVM_Object(self)) to lbValue
    end_procedure
  end_object
end_desktop_section

class Query_cExprArrayErrors is a cArray
  item_property_list
    item_property integer piExprRow.i
    item_property string  psError.i
    item_property integer piErrorPos.i
  end_item_property_list Query_cExprArrayErrors
  procedure Show_Errors
    local integer liRow liMax
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      show (piExprRow.i (self,liRow)) " "
      show (psError.i   (self,liRow)) " "
      showln (piErrorPos.i(self,liRow))
    loop
  end_procedure
  procedure AddError integer liExprRow string lsError integer liErrorPos
    local integer liRow
    get row_count to liRow
    set piExprRow.i  liRow to liExprRow
    set psError.i    liRow to lsError
    set piErrorPos.i liRow to liErrorPos
  end_procedure
end_class // Query_cExprArrayErrors

class Query_cExprArray is a cArray NO_IMAGE
  procedure construct_object integer liImage
    forward send construct_object liImage
    object oInterpreterErrors is a Query_cExprArrayErrors
    end_object
  end_procedure
  item_property_list
    item_property string  psLongLabel.i
    item_property string  psLabel.i
    item_property integer piType.i
    item_property integer piWidth.i
    item_property integer piDecimals.i

    item_property string  psExpression.i
    item_property integer piExprId.i       // Temporarily used when compiled
    item_property integer pbCleanupInUse.i        // Temporarily used when cleaning up
    item_property integer pbCleanupNewRow.i
  end_item_property_list Query_cExprArray

  function iInterpretAll returns integer // DFTRUE means OK
    local integer liRow liMax liErrorPos liExprId lbRval liError
    local string lsExpression lsError lsMessage
    move DFTRUE to lbRval
    send delete_data to (oInterpreterErrors(self))
    get row_count to liMax
    send script_begin to (Query_ExprParser(self))
    decrement liMax
    for liRow from 0 to liMax
      set piExprId.i liRow to -1
      get psExpression.i liRow to lsExpression
      // This puts the expression in one line:
      get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression
      if (trim(lsExpression)<>"") begin
        send delete_data to (oScriptErrors(Query_ExprParser(self)))
        get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to liErrorPos
        if (liErrorPos=0) begin
          get piExprID of (Query_ExprParser(self)) to liExprId
          set piExprId.i liRow to liExprId
        end
        else begin
          get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
          get piError.i   of (oScriptErrors(Query_ExprParser(self))) 0 to liError
          get psMessage.i of (oScriptErrors(Query_ExprParser(self))) 0 to lsMessage
          move (ScriptError_Text(liError)) to lsError
          move (lsError+", "+lsMessage) to lsError
          send AddError to (oInterpreterErrors(self)) liRow lsError liErrorPos
          move DFFALSE to lbRval
        end
      end
      else begin
        send AddError to (oInterpreterErrors(self)) liRow "Empty expression" 0
        move DFFALSE to lbRval
      end
    loop
    send script_end to (Query_ExprParser(self))
    function_return lbRval
  end_function

  procedure DisplayErrors
    send Show_Errors to (oInterpreterErrors(self))
    send obs "Errors were found"
  end_procedure

  procedure SEQ_Write integer liChannel
    local integer liRow liMax
    local string lsExpression
    get row_count to liMax
    decrement liMax
    writeln channel liChannel (row_count(self)-1)
    for liRow from 0 to liMax
      writeln (psLongLabel.i(self,liRow))
      writeln (psLabel.i(self,liRow))
      writeln (piType.i(self,liRow))
      writeln (piWidth.i(self,liRow))
      writeln (piDecimals.i(self,liRow))
      get psExpression.i liRow to lsExpression
      writeln (length(lsExpression))
      write lsExpression
    loop
  end_procedure
  procedure SEQ_Read integer liChannel
    local integer liRow liMax liLen
    local string lsExpression
    send delete_data
    readln channel liChannel liMax
    for liRow from 0 to liMax
      set psLongLabel.i liRow to (SEQ_ReadLn(liChannel))
      set psLabel.i     liRow to (SEQ_ReadLn(liChannel))
      set piType.i      liRow to (SEQ_ReadLn(liChannel))
      set piWidth.i     liRow to (SEQ_ReadLn(liChannel))
      set piDecimals.i  liRow to (SEQ_ReadLn(liChannel))
      readln liLen
      read_block lsExpression liLen
      set psExpression.i liRow to lsExpression
    loop
  end_procedure

  procedure CleanUp_Prepare
    local integer liRow liMax
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      set pbCleanupInUse.i  liRow to DFFALSE
      set pbCleanupNewRow.i liRow to -1
    loop
  end_procedure
  procedure CleanUp_MarkAsUsed integer liRow
    set pbCleanupInUse.i liRow to DFTRUE
  end_procedure
  procedure CleanUp_CalcNewRow
    local integer liRow liMax liNewRow
    move 0 to liNewRow
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      if (pbCleanupInUse.i(self,liRow)) begin
        set pbCleanupNewRow.i liRow to liNewRow
        increment liNewRow
      end
    loop
  end_procedure
  procedure CleanUp_Purge
    local integer liRow liMax
    get row_count to liMax
    decrement liMax
    for_ex liRow from liMax down_to 0
      ifnot (pbCleanupInUse.i(self,liRow)) send delete_row liRow
    loop
  end_procedure
end_class // Query_cExprArray


// UI Part

Use Edit.utl     // cEditor class

class cQuery_ExpressionEditorUndoer is a cArray
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer piCurrentUndoPos public 0
  end_procedure
  item_property_list
    item_property integer piCursor.i
    item_property integer piSelectRange.i
    item_property string  psValue.i
    item_property string  psOperation.i
  end_item_property_list cQuery_ExpressionEditorUndoer
  procedure ReadCurrentState string lsOperation
    local integer liRow lhParent liPosition
    local string lsValue
    move (parent(self)) to lhParent
    get piCurrentUndoPos to liRow
    get position of lhParent to liPosition
    get Text_EditObjectValue lhParent to lsValue
    set piCursor.i      liRow to liPosition
//    showln "Snup " liPosition
    set piSelectRange.i liRow to 0
    set psValue.i       liRow to lsValue
    set psOperation.i   liRow to lsOperation
    increment liRow
    set piCurrentUndoPos to liRow
  end_procedure
  procedure DoReset
    send delete_data
    set piCurrentUndoPos to 0
  end_procedure
  procedure SetCurrentState integer liRow
    local integer liPosition lhParent
    local string lsValue
    move (parent(self)) to lhParent
    get piCursor.i liRow to liPosition
    get psValue.i  liRow to lsValue
    send Text_SetEditObjectValue lhParent lsValue
//    showln "Oooog V‘rsgo " liPosition
    send move_absolute to lhParent (hi(liPosition)) (low(liPosition))
  end_procedure
  function iIncrementCurrentUndoPos integer liBy returns integer
    local integer liCurrentUndoPos
    get piCurrentUndoPos to liCurrentUndoPos
    move (liCurrentUndoPos+liBy) to liCurrentUndoPos
    if (liCurrentUndoPos>0 and liCurrentUndoPos<row_count(self)) begin
      set piCurrentUndoPos to liCurrentUndoPos
      function_return DFTRUE
    end
    function_return DFFALSE
  end_function
  procedure ReDo
    if (iIncrementCurrentUndoPos(self,1)) send SetCurrentState (piCurrentUndoPos(self))
    else send bell to desktop
  end_procedure
  procedure UnDo
    if (iIncrementCurrentUndoPos(self,-1)) send SetCurrentState (piCurrentUndoPos(self))
    else send bell to desktop
  end_procedure
end_class // cQuery_ExpressionEditorUndoer


class cQuery_ExpressionEditor is a cEditor
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer piRequiredType public 0
#IFDEF IS$WINDOWS
    set typeface to "Courier New"
#ENDIF
    object oUnDo is a cQuery_ExpressionEditorUndoer NO_IMAGE
    end_object
    on_key KEY_CTRL+KEY_U send undo
    on_key KEY_CTRL+KEY_Z send redo

    property integer piExpressionType // TYPE.UNKNOWN TYPE.UNTYPED TYPE.INTEGER TYPE.DATE TYPE.NUMBER TYPE.STRING
  end_procedure

  procedure DoClear
    send delete_data
  end_procedure

  function bContentsNotOK returns integer
    local integer lbError
    local string lsExpression

    get Text_EditObjectValue self to lsExpression
    get sPrepareExpression.s of (Query_ExprParser(self)) lsExpression to lsExpression

    send script_begin to (Query_ExprParser(self))
    get iParse_Expr.s of (Query_ExprParser(self)) lsExpression to lbError
    set piExpressionType to (piExprType(Query_ExprParser(self)))
    send script_end to (Query_ExprParser(self))
    function_return lbError
  end_function

  procedure GotoErrorPos integer liErrorPos
    if liErrorPos begin
      get iTheRealErrorPosition of (Query_ExprParser(self)) liErrorPos to liErrorPos
      send activate
      send move_absolute (hi(liErrorPos)-1) (low(liErrorPos)-1)
    end
  end_procedure
  procedure UnDo
    send UnDo to (oUndo(self))
  end_procedure
  procedure Redo
    send ReDo to (oUndo(self))
  end_procedure
  procedure Insert string lsValue
    send ReadCurrentState to (oUndo(self)) "Inds‘t"
    forward send Insert lsValue
  end_procedure
end_class // cQuery_ExpressionEditor

#IFDEF IS$WINDOWS
class QryExprTableList is a aps.List
#ELSE
class QryExprTableList is a app.List
#ENDIF
  procedure construct_object integer liImage
    forward send construct_object liImage
    #IFDEF IS$WINDOWS
    #ELSE
     set highlight_row_state to DFTRUE
    #ENDIF
  end_procedure
  procedure fill_list
    local integer lhSet liItem liMax liFile
    set dynamic_update_state to DFFALSE
    send delete_data
    move (oAllowedTables(Query_ExprEvaluator(self))) to lhSet
    get item_count of lhSet to liMax
    decrement liMax
    for liItem from 0 to liMax
      get value of lhSet item liItem to liFile
      send add_item MSG_NONE (FDX_AttrValue_FILELIST(0,DF_FILE_LOGICAL_NAME,liFile))
      set aux_value item (item_count(self)-1) to liFile
    loop
    set dynamic_update_state to DFTRUE
    set current_item to 0
    send OnChange
  end_procedure
  procedure OnChange
    local integer liFile
    get aux_value item (current_item(self)) to liFile
    send DoFillFields liFile
  end_procedure
  procedure item_change integer liItem1 integer liItem2 returns integer
    local integer liRval liFile
    forward get msg_item_change liItem1 liItem2 to liRval
#IFDEF IS$WINDOWS
#ELSE
    if (item_count(self)) begin
      get aux_value item liRval to liFile
      send DoFillFields liFile
    end
#ENDIF
    procedure_return liRval
  end_procedure
end_class // QryExprTableList

#IFDEF IS$WINDOWS
class QryExprFieldList is a aps.List
#ELSE
class QryExprFieldList is a List
#ENDIF
  procedure construct_object integer liImage
    forward send construct_object liImage
    property integer piFile public 0
  end_procedure
  procedure OnFieldSelect string lsName
  end_procedure
  procedure InsertField
    local integer liFile liField liItem
    local string lsName
    get current_item to liItem
    get piFile to liFile
    get aux_value item liItem to liField
    get FDX_FieldName 0 liFile liField DFTRUE to lsName
    send OnFieldSelect lsName
  end_procedure
  procedure HandleField integer liFile integer liField string lsName integer liType integer liLen integer liPrec integer liRelFile integer liRelField integer liIndex integer liOffSet
    if (liType<>DF_OVERLAP and liType<>DF_BINARY) begin
      send add_item MSG_InsertField lsName
      set aux_value item (item_count(self)-1) to liField
    end
  end_procedure
  procedure fill_list.i integer liFile
    local integer lhSet liItem liMax
    if liFile begin
      set piFile to liFile
      set dynamic_update_state to DFFALSE
      send delete_data
      send FDX_FieldCallBack 0 liFile MSG_HandleField self
      set dynamic_update_state to DFTRUE
      set current_item to 0
    end
  end_procedure
//procedure mouse_click integer liItem integer liGrb
//  if ((liItem-1)<item_count(self)) send InsertField
//end_procedure
  procedure mouse_up integer liItem integer liGrb
    if ((liItem-1)<item_count(self)) send InsertField
  end_procedure
end_class // QryExprFieldList

#IFDEF IS$WINDOWS
class QryExprFunctions is a aps.List
#ELSE
class QryExprFunctions is a List
#ENDIF
  procedure InsertFunction
  end_procedure
  procedure Handle_Function string lsName integer liReturnType string lsParamList string lsLongParamList
    local integer liLen liPos
    local string lsValue liChar
    move (lsName+"(") to lsValue
    move (length(lsParamList)) to liLen
    for liPos from 1 to liLen
      move (mid(lsParamList,1,liPos)) to liChar
      if (liChar="S") move (lsValue+"s") to lsValue
      if (liChar="I") move (lsValue+"i") to lsValue
      if (liChar="N") move (lsValue+"n") to lsValue
      if (liChar="D") move (lsValue+"d") to lsValue
      if (liPos<>liLen) move (lsValue+",") to lsValue
    loop
    move (lsValue+")") to lsValue
    send add_item MSG_InsertFunction lsValue
  end_procedure
  procedure fill_list
    local integer lhObj lhSelf
    set dynamic_update_state to DFFALSE
    send delete_data
    move self to lhSelf
    move (oDeclaredFunctions(Query_ExprEvaluator(self))) to lhObj
    send reset to lhObj
    send CallBack_AllFunctions to lhObj MSG_Handle_Function lhSelf
    set dynamic_update_state to DFTRUE
  end_procedure
end_class //

#IFDEF IS$WINDOWS
object Query_EditCriteriaExpression is a aps.ModalPanel label t.QryExpr.Expression // "Expression"
  set locate_mode to CENTER_ON_SCREEN
  on_key ksave_record send close_panel_ok
  on_key kcancel send close_panel
  property integer piResult public DFFALSE
  property string  psExpression public ""
  property integer piExprType   public 0
  object oEdit is a cQuery_ExpressionEditor
    set size to 100 450
  end_object
  send aps_goto_max_row
  object oLbl1 is a aps.TextBox label t.QryExpr.Tables    //"Tabels"
  end_object
  object oLbl2 is a aps.TextBox label t.QryExpr.Fields    //"Fields"
  end_object
  object oLbl3 is a aps.TextBox label t.QryExpr.Functions //"Functions"
  end_object
  send aps_goto_max_row
  object oTables is a QryExprTableList
    set size to 114 80
  end_object
  object oFields is a QryExprFieldList
    set size to 114 120
    procedure OnFieldSelect string lsName
      send Insert to (oEdit(self)) lsName
      send activate to (oEdit(self))
    end_procedure
  end_object
  procedure DoFillFields integer liFile
    send fill_list.i to (oFields(self)) liFile
  end_procedure

  object oFunctions is a QryExprFunctions
    set size to 114 245
    procedure InsertFunction
      local string lsValue
      get value item (current_item(self)) to lsValue
      send Insert to (oEdit(self)) lsValue
      send Activate to (oEdit(self))
    end_procedure
    procedure mouse_up integer liItem integer liGrb
      if ((liItem-1)<item_count(self)) send InsertFunction
    end_procedure
  end_object

  send aps_align_by_moving (oLbl1(self)) (oTables(self)) SL_ALIGN_LEFT
  send aps_align_by_moving (oLbl2(self)) (oFields(self)) SL_ALIGN_LEFT
  send aps_align_by_moving (oLbl3(self)) (oFunctions(self)) SL_ALIGN_LEFT

  object oBtn_Ok is a aps.Multi_Button
    on_item t.btn.ok send close_panel_ok
  end_object
  object oBtn_Clear is a aps.Multi_Button
    on_item t.btn.clear  send DoClear to (oEdit(self))
  end_object
  object oBtn_Cancel is a aps.Multi_Button
    on_item t.btn.cancel send close_panel
  end_object
  send aps_locate_multi_buttons
  procedure close_panel_ok
    integer lbError
    get bContentsNotOK of (oEdit(self)) to lbError
    ifnot lbError begin
      set piResult to DFTRUE
      send close_panel
    end
    else send GotoErrorPos to (oEdit(self)) lbError
  end_procedure

  function iPopup.sis string lsExpression integer liRequiredType string lsCaption returns integer
    integer liType
    set piResult to DFFALSE
    send Text_SetEditObjectValue (oEdit(self)) lsExpression
    set piRequiredType of (oEdit(self)) to liRequiredType
    set label to lsCaption
    send fill_list to (oTables(self))
    send fill_list to (oFunctions(self))
    send popup
    if (piResult(self)) begin
      set psExpression to (Text_EditObjectValue(oEdit(self)))
//      set piExprType

      function_return 1
    end
    function_return -1
  end_function
end_object // Query_EditCriteriaExpression

object Query_ColumnExpression is a aps.ModalPanel
  set locate_mode to CENTER_ON_SCREEN
  on_key ksave_record send close_panel_ok
  on_key kcancel send close_panel
  on_key kuser send testus
  property integer piResult public DFFALSE
  property string psExpression public ""

  object oGrp is a aps.Group
    object oLongLabel is a aps.Form label  (t.QryExpr.LongLabel+":") abstract AFT_ASCII30   //"Long label:"
    end_object
    object oShortLabel is a aps.Form label (t.QryExpr.ShortLabel+":") abstract AFT_ASCII15  // "Short label:"
      procedure OnSetFocus
        if (value(self,0)="") set value to (value(oLongLabel(self),0))
      end_procedure
    end_object
    object oWidth is a aps.form label (t.QryExpr.Width+":") abstract AFT_NUMERIC2.0
    end_object
    object oLabel is a aps.TextBox label t.QryExpr._Characters snap SL_RIGHT
    end_object
    object oExprType is a aps.ComboFormAux label (t.QryExpr.ReturnType+":") abstract AFT_ASCII10
      set entry_state item 0 to DFFALSE
      send combo_add_item t.QryExpr.Type_Numeric DF_BCD
      send combo_add_item t.QryExpr.Type_String  DF_ASCII
      send combo_add_item t.QryExpr.Type_Text    DF_TEXT
      send combo_add_item t.QryExpr.Type_Date    DF_DATE
      register_object oDecimals
      procedure OnChange
        set enabled_state of (oDecimals(self)) to (Combo_Current_Aux_Value(self)=DF_BCD)
      end_procedure
    end_object
    object oDecimals is a aps.Form label (t.QryExpr.DecimalPlaces+":") abstract AFT_NUMERIC1.0 snap SL_RIGHT_SPACE
    end_object
    procedure DoExpression
      integer liType liTranslatedType liRval
      string lsExpression lsCaption
      get Combo_Current_Aux_Value of (oExprType(self)) to liType
      if (liType=DF_BCD  ) move TYPE.NUMBER to liTranslatedType
      if (liType=DF_ASCII) move TYPE.STRING to liTranslatedType
      if (liType=DF_TEXT ) move TYPE.STRING to liTranslatedType
      if (liType=DF_DATE ) move TYPE.DATE   to liTranslatedType
      if (liType=DF_BCD  ) move t.QryExpr.EditNumExpr to lsCaption
      if (liType=DF_ASCII) move t.QryExpr.EditStrExpr to lsCaption
      if (liType=DF_TEXT ) move t.QryExpr.EditStrExpr to lsCaption
      if (liType=DF_DATE ) move t.QryExpr.EditDatExpr to lsCaption
      get psExpression to lsExpression
      get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression liTranslatedType lsCaption to liRval
      if (liRval<>-1) set psExpression to (psExpression(Query_EditCriteriaExpression(self)))
    end_procedure
    send aps_make_row_space 5
    object oBtn is a aps.Button
      on_item t.btn.Edit send DoExpression
    end_object
  end_object
  object oBtn1 is a aps.Multi_Button
    on_item t.btn.ok send close_panel_ok
  end_object
  object oBtn2 is a aps.Multi_Button
    on_item t.btn.cancel send close_panel
  end_object
  send aps_locate_multi_buttons
  procedure aps_beautify
    send aps_align_inside_container_by_moving (oBtn(oGrp(self))) SL_ALIGN_CENTER
  end_procedure
  procedure close_panel_ok
    set piResult to DFTRUE
    send close_panel
  end_procedure

  procedure testus
    integer liTest
    get Combo_Current_Aux_Value of (oExprType(oGrp(self))) item 0 to liTest
    send obs liTest
  end_procedure

  function iPopup.ii integer lhObj integer liRow returns integer
    local integer liType
    if (liRow=-1) begin
      set label to t.QryExpr.CreateCC_1 // "Create calculated column"
      set value of (oLongLabel(oGrp(self))) item 0 to ""
      set value of (oShortLabel(oGrp(self))) item 0 to ""
      set value of (oWidth(oGrp(self))) item 0 to 10
      set value of (oExprType(oGrp(self))) item 0 to t.QryExpr.Type_Numeric
      set value of (oDecimals(oGrp(self))) item 0 to 0
      set psExpression to ""
    end
    else begin
      move (piType.i(lhObj,liRow)) to liType
      set label to (t.QryExpr.CreateCC_2+string(liRow)+")")
      set value of (oLongLabel (oGrp(self))) item 0 to (psLongLabel.i(lhObj,liRow))
      set value of (oShortLabel(oGrp(self))) item 0 to (psLabel.i(lhObj,liRow))
      set value of (oWidth(oGrp(self)))      item 0 to (piWidth.i(lhObj,liRow))
      set Combo_Current_Aux_Value of (oExprType(oGrp(self))) to liType
      set value of (oDecimals(oGrp(self)))   item 0 to (piDecimals.i(lhObj,liRow))
      set psExpression to (psExpression.i(lhObj,liRow))
    end
    set piResult to DFFALSE
    send popup
    if (piResult(self)) begin
      if (liRow=-1) get row_count of lhObj to liRow
      set psLongLabel.i  of lhObj liRow to (value(oLongLabel(oGrp(self)),0))
      set psLabel.i      of lhObj liRow to (value(oShortLabel(oGrp(self)),0))
      set piType.i       of lhObj liRow to (Combo_Current_Aux_Value(oExprType(oGrp(self))))
      set piWidth.i      of lhObj liRow to (value(oWidth(oGrp(self)),0))
      set piDecimals.i   of lhObj liRow to (value(oDecimals(oGrp(self)),0))
      set psExpression.i of lhObj liRow to (psExpression(self))
      function_return liRow
    end
    function_return -1
  end_function
end_object // Query_ColumnExpression
#ELSE
/Query_EditCriteriaExpression.Hdr
ÚÄ________________________________________ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³                                                                       ³
³                                                                       ³
³                                                                       ³
³                                                                       ³
³                                                                       ³
³                                                                       ³
³ Tables       Fields            Functions                              ³
/Query_EditCriteriaExpression.Lst1
³ __________
³ __________
³ __________
³ __________
³ __________
³ __________
³ __________
³ __________
/Query_EditCriteriaExpression.Lst2
  _______________
  _______________
  _______________
  _______________
  _______________
  _______________
  _______________
  _______________
/Query_EditCriteriaExpression.Lst3
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
  ______________________________________ ³
/Query_EditCriteriaExpression.Btn
³                                                                       ³
³                            _____________ _____________ _____________  ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
/*

object Query_EditCriteriaExpression is a app.ModalClient Query_EditCriteriaExpression.Hdr
  set location to 3 3 ABSOLUTE
  on_key ksave_record send close_panel_ok
  on_key kcancel send cancel
  set window_color item 0 to 2
  property string  psExpression public ""
  property integer piExprType   public 0
  object oEdit is a cQuery_ExpressionEditor
    set location to 1 1 RELATIVE
    set size to 5 70
  end_object
  object oTables is a QryExprTableList Query_EditCriteriaExpression.Lst1
    set location to 8 0 RELATIVE
  end_object
  object oFields is a QryExprFieldList Query_EditCriteriaExpression.Lst2
    set location to 8 13 RELATIVE
    procedure OnFieldSelect string lsName
      send Insert to (oEdit(self)) lsName
      send activate to (oEdit(self))
    end_procedure
  end_object
  procedure DoFillFields integer liFile
    send fill_list.i to (oFields(self)) liFile
  end_procedure

  object oFunctions is a QryExprFunctions Query_EditCriteriaExpression.Lst3
    set location to 8 31 RELATIVE
    procedure InsertFunction
      local string lsValue
      get value item (current_item(self)) to lsValue
      send Insert to (oEdit(self)) lsValue
      send Activate to (oEdit(self))
    end_procedure
    procedure mouse_up integer liItem integer liGrb
      send InsertFunction
    end_procedure
  end_object

  object oBtn is a app.Button Query_EditCriteriaExpression.Btn
    set location to 16 0 RELATIVE
    item_list
      on_item T.BTN.OK send close_panel_ok
      on_item T.BTN.CLEAR  send DoClear to (oEdit(self))
      on_item T.BTN.CANCEL send cancel
    end_item_list
  end_object
  procedure close_panel_ok
    integer lbError
    get bContentsNotOK of (oEdit(self)) to lbError
    ifnot lbError procedure_return MSG_OK
    else send GotoErrorPos to (oEdit(self)) lbError
  end_procedure

  function iPopup.sis string lsExpression integer liRequiredType string lsCaption returns integer
    local integer lbRval
    send Text_SetEditObjectValue (oEdit(self)) lsExpression
    set piRequiredType of (oEdit(self)) to liRequiredType
    set value item 0 to (lsCaption+"ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ")
    send fill_list to (oTables(self))
    send fill_list to (oFunctions(self))
    ui_accept self to lbRval
    if (lbRval=MSG_OK) begin
      set psExpression to (Text_EditObjectValue(oEdit(self)))
      function_return 1
    end
    function_return -1
  end_function
end_object

/Query_ColumnExpression.Hdr
ÚÄ______________________________ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
/Query_ColumnExpression.Frm
³                                                ³
³ Long label : ______________________________    ³
³                                                ³
³ Short label: _______________                   ³
³                                                ³
³ Default width: _. characters                   ³
³                                                ³
³ Return type: __________  Decimal places: _    ³
³                                                ³
/Query_ColumnExpression.Btn
³                 _____________                  ³
³                                                ³
³                         __________ __________  ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
/*

format Query_ColumnExpression.Frm.5 {points=0}

object Query_ColumnExpression is a app.ModalClient Query_ColumnExpression.Hdr
  set location to 6 24 ABSOLUTE
  on_key ksave_record send ok
  on_key kcancel send cancel

  set window_color item 0 to 2
  procedure set label string lsValue
    set value item 0 to (lsValue+"ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ")
  end_procedure

  property string psExpression public ""

  object oFrm is a app.Entry_form Query_ColumnExpression.Frm
    set location to 1 0 RELATIVE
    procedure next_and_fill
      if (value(self,1)="") set value item 1 to (value(self,0))
      send next
    end_procedure
    item_list
      on_item "" send next_and_fill
      on_item "" send next
      on_item "" send next
      on_item "" send next
      on_item "" send next
    end_item_list
    send Item_Combo_Add_Item 3 "Numeric" DF_BCD
    send Item_Combo_Add_Item 3 "String"  DF_ASCII
    send Item_Combo_Add_Item 3 "Text"    DF_TEXT
    send Item_Combo_Add_Item 3 "Date"    DF_DATE
    set Item_Combo_Width item 3 to 10
    set entry_state item 3 to false
  end_object

  procedure DoExpression
    local integer liType liTranslatedType liRval
    local string lsExpression lsCaption
    get Item_Combo_Current_Aux_Value of (oFrm(self)) 3 to liType
    if (liType=DF_BCD  ) move TYPE.NUMBER to liTranslatedType
    if (liType=DF_ASCII) move TYPE.STRING to liTranslatedType
    if (liType=DF_TEXT ) move TYPE.STRING to liTranslatedType
    if (liType=DF_DATE ) move TYPE.DATE   to liTranslatedType
    if (liType=DF_BCD  ) move "Edit numeric expression" to lsCaption
    if (liType=DF_ASCII) move "Edit string expression"  to lsCaption
    if (liType=DF_TEXT ) move "Edit string expression"  to lsCaption
    if (liType=DF_DATE ) move "Edit date expression"    to lsCaption
    get psExpression to lsExpression
    get iPopup.sis of (Query_EditCriteriaExpression(self)) lsExpression liTranslatedType lsCaption to liRval
    if (liRval<>-1) set psExpression to (psExpression(Query_EditCriteriaExpression(self)))
  end_procedure

  object oBtn is a app.Button Query_ColumnExpression.Btn
    set location to 10 0 RELATIVE
    item_list
      on_item t.btn.Edit   send DoExpression
      on_item t.btn.ok     send ok
      on_item t.btn.cancel send cancel
    end_item_list
  end_object

  function iPopup.ii integer lhObj integer liRow returns integer
    local integer liRval
    if (liRow=-1) begin
      set label to "Create calculated column"
      set value of (oFrm(self)) item 0 to ""
      set value of (oFrm(self)) item 1 to ""
      set value of (oFrm(self)) item 2 to 10
      set value of (oFrm(self)) item 3 to "Numeric"
      set value of (oFrm(self)) item 4 to 0
      set psExpression to ""
    end
    else begin
      set label to ("Edit calculated column (#"+string(liRow)+")")
      set value of (oFrm(self)) item 0 to (psLongLabel.i(lhObj,liRow))
      set value of (oFrm(self)) item 1 to (psLabel.i(lhObj,liRow))
      set value of (oFrm(self)) item 2 to (piWidth.i(lhObj,liRow))
      set Item_Combo_Current_Aux_Value of (oFrm(self)) item 3 to (piType.i(lhObj,liRow))
      set value of (oFrm(self)) item 4 to (piDecimals.i(lhObj,liRow))
      set psExpression to (psExpression.i(lhObj,liRow))
    end
    set current_item of (oFrm(self)) to 0
    ui_accept self to liRval
    if (liRval=MSG_OK) begin
      if (liRow=-1) get row_count of lhObj to liRow
      set psLongLabel.i  of lhObj liRow to (value(oFrm(self),0))
      set psLabel.i      of lhObj liRow to (value(oFrm(self),1))
      set piWidth.i      of lhObj liRow to (value(oFrm(self),2))
      set piType.i       of lhObj liRow to (Item_Combo_Current_Aux_Value(oFrm(self),3))
      set piDecimals.i   of lhObj liRow to (value(oFrm(self),4))
      set psExpression.i of lhObj liRow to (psExpression(self))
      function_return liRow
    end
    function_return -1
  end_function
end_object // Query_ColumnExpression

#ENDIF