# forms.tcl

image create bitmap ::img::arrow_left \
    -file [file join $::config::installDir arrow-left.xbm] \
    -foreground #000000
image create bitmap ::img::arrow_right \
    -file [file join $::config::installDir arrow-right.xbm] \
    -foreground #000000
image create bitmap ::img::arrow_home \
    -file [file join $::config::installDir arrow-home.xbm] \
    -foreground #000000
image create bitmap ::img::arrow_end \
    -file [file join $::config::installDir arrow-end.xbm] \
    -foreground #000000


class FormWindow {
    protected common windowList {}
    public variable window {}
    protected variable parent
    public variable formName
    protected variable noteBook
    protected variable formDef
    protected variable attribDef
    protected variable attribList
    protected variable modAttribList
    protected variable tabList {}
    protected variable tabObject

    proc closeAllWindows {} {
        foreach window $windowList {
            destroy $window
        }
        return
    }

    constructor {c_parent c_formName} {
        set parent $c_parent
        set formName $c_formName
        setupWindow
        return
    }

    destructor {
        foreach tab $tabList {
            delete object $tab
        }
        set indexDeleted [lsearch -exact $windowList $window]
        set windowList [lreplace $windowList $indexDeleted $indexDeleted]
        return
    }

    protected method setupWindow {} {
        set window [toplevel [appendToPath $parent [namespace tail $this]]]
        lappend windowList $window
        wm geometry $window [join $::geometry::form {x}]
        set noteBook [ttk::notebook $window.nb -takefocus 0]
        set tabOpen [OpenTab "#auto" $noteBook $this]
        addNotebookTab $noteBook [$tabOpen cget -widget] tabOpen
        lappend tabList $tabOpen
        set tabObject([$tabOpen cget -widget]) $tabOpen
        pack $noteBook -side top -expand 1 -fill both
        pack [ttk::sizegrip ${window}.sg] -side top -anchor e
        ttk::notebook::enableTraversal $noteBook
        bind $noteBook <<NotebookTabChanged>> [list $this onTabChange]
        set tpOnly [bindToplevelOnly $window <Destroy> [list delete object $this]]
        bind $tpOnly <Configure> {set ::geometry::form {%w %h}}
        return
    }

    public method removeTab {removedTab} {
        set indexDeleted [lsearch -exact $tabList $removedTab]
        if {$indexDeleted >= 0} then {
            set tabList [lreplace $tabList $indexDeleted $indexDeleted]
        }
        delete object $removedTab
        if {[llength $tabList] == 0} then {
            destroy $window
        } else {
            [lindex $tabList end] setTabLock 0
        }
        return
    }

    public method deleteTabsAbove {tab} {
        set thisTabIdx [lsearch -exact $tabList $tab]
        foreach tabAbove [lrange $tabList [expr $thisTabIdx + 1] end] {
            delete object $tabAbove
        }
        set tabList [lrange $tabList 0 $thisTabIdx]
        return
    }

    public method newFormTab {newFormName formDefDict history} {
        [lindex $tabList end] setTabLock 1
        set newTab [FormTab "#auto" $noteBook $this $newFormName \
            $formDefDict $history]
        lappend tabList $newTab
        set widget [$newTab cget -widget]
        set tabObject($widget) $newTab
        $noteBook add $widget -text $newFormName
        $noteBook select $widget
        return
    }

    public method getTabList {} {
        return $tabList
    }

    public method onTabChange {} {
        set selectedTab $tabObject([$noteBook select])
        focus [$noteBook select]
        $selectedTab tabSelected
        return
    }

    public method setMenubar {menubar} {
        $window configure -menu $menubar
        return
    }

    public method setTitle {title} {
        wm title $window $title
        return
    }

}

class GenTab {
    public variable widget
    protected variable parent
    protected variable formWindow
    public variable formWinPath
    protected variable formName
    protected variable menubar
    protected variable mnForm
    protected variable title
    protected variable tabLock 0
    protected variable tabStatus
    protected variable btnCloseTab
    protected variable btnUnlockTab
    protected variable tabStatBar

    constructor {c_parent c_formWindow c_formName} {
        set parent $c_parent
        set formWindow $c_formWindow
        set formName $c_formName
        set formWinPath [$formWindow cget -window]
        set widget [ttk::frame [appendToPath $parent [namespace tail $this]] \
            -takefocus 0]
        set tabStatBar [ttk::frame $widget.sb]
        set tabStatus [ttk::label $tabStatBar.lbl -text {} \
            -foreground {red3}]
        set btnCloseTab [defineButton $tabStatBar.btnClose $widget \
            btnCloseTab [list $this closeTab]]
        $btnCloseTab configure -style SButton
        set btnUnlockTab [defineButton $tabStatBar.btnUnlock $widget \
            btnUnlockTab [list $this unlockTab]]
        $btnUnlockTab configure -style SButton
        $btnUnlockTab state {disabled}
        grid $tabStatus -column 0 -row 0
        grid $btnUnlockTab -column 1 -row 0 -pady {5 5}
        grid $btnCloseTab -column 2 -row 0 -pady {5 5}
        grid columnconfigure $tabStatBar 0 -weight 1
        pack $tabStatBar -side top -fill x
        set menubar [menu [appendToPath $formWinPath \
            mb[namespace tail $this]] -tearoff 0]
        set mnForm [menu $menubar.mnForm -tearoff 0]
        addMenuItem $mnForm mnuUnlockTab command [list $this unlockTab]
        $mnForm entryconfigure 0 -state disabled -accelerator {Esc}
        addMenuItem $mnForm mnuCloseTab command [list $this closeTab]
        $mnForm entryconfigure 1 -accelerator {Esc}
        $mnForm add separator
        addMenuItem $mnForm mnuCloseForm command [list destroy $formWinPath]
        addMenuItem $menubar mnuForm cascade $mnForm
        set title "pfm - [$::dbObject cget -dbname]: $formName"
        bind $widget <KeyPress-Escape> [list $this onEscape]
        return
    }

    destructor {
        # $formWindow tabDestroyed [namespace tail $this]
        destroy $widget
        return
    }

    public method tabSelected {} {
        $formWindow setMenubar $menubar
        $formWindow setTitle $title
        return
    }

    public method onEscape {} {
        if {!$tabLock} then {
            closeTab
        } else {
            unlockTab
        }
        return
    }

    public method unlockTab {} {
        $formWindow deleteTabsAbove [namespace tail $this]
        setTabLock 0
        return
    }

    public method closeTab {} {
        $formWindow removeTab [namespace tail $this]
        return
    }

    public method setTabLock {state} {
        set tabLock $state
        if {$state} then {
            $tabStatus configure -text [mc lbTabLocked]
            $btnCloseTab state {disabled}
            $btnUnlockTab state {!disabled}
            $mnForm entryconfigure 0 -state normal
            $mnForm entryconfigure 1 -state disabled
        } else {
            $tabStatus configure -text {}
            $btnCloseTab state {!disabled}
            $btnUnlockTab state {disabled}
            $mnForm entryconfigure 0 -state disabled
            $mnForm entryconfigure 1 -state normal
        }
        $this propagateTabLock $state
        return
    }

}

class OpenTab {
    inherit GenTab
    protected variable formDef
    protected variable attribDef
    protected variable attribList
    protected variable modAttribList
    protected variable whereSelected 1
    protected variable txt
    protected variable btnRun
    protected variable rbWhere
    protected variable rbOrderby
    protected variable pasteValueMenu 0
    protected variable listBoxList {}

    constructor {c_parent c_formWindow} \
        {GenTab::constructor $c_parent $c_formWindow [$c_formWindow cget -formName]} {
        getFormDef $::dbObject $formName $formWinPath formDef
        getAttribDef $::dbObject $formName $formWinPath \
            attribDef attribList modAttribList
        setupWidget
    }

    destructor {
        deleteAllListBoxes
    }

    protected method setupWidget {} {
        # define menus
        set mnPasteName [menu $menubar.mnPasteName -tearoff 0]
        foreach attrib $attribList {
            $mnPasteName add command -label $attrib \
                -command [list $this pasteName $attrib]
        }
        set mnPasteValue [menu $menubar.mnPasteValue -tearoff 0]
        set pasteValueMenu 0
        foreach attrib $attribList {
            if {$attribDef($attrib,typeofget) in {tgLink tgList}} then {
                $mnPasteValue add command -label $attrib \
                    -command [list $this pasteValue $attrib]
                set pasteValueMenu 1
            }
        }
        addMenuItem $menubar mnuPasteName cascade $mnPasteName
        addMenuItem $menubar mnuPasteValue cascade $mnPasteValue
        if {!$pasteValueMenu} then {
            $menubar entryconfigure 2 -state disabled
        }
        set frmQuery [ttk::frame $widget.frmquery]
        foreach field {Query Where Orderby} {
            set txt($field) [text $frmQuery.txt$field -width 1 -height 1 \
                -wrap word]
            set vsb($field) [ttk::scrollbar $frmQuery.vsb$field \
                -orient vertical -command [list $txt($field) yview]]
            $txt($field) configure -yscrollcommand [list $vsb($field) set]
        }
        $txt(Query) configure -takefocus 0
        $txt(Query) insert end "SELECT $formDef(sqlselect)\n"
        $txt(Query) insert end "FROM $formDef(sqlfrom)\n"
        if {$formDef(groupby) ne {}} then {
            $txt(Query) insert end "GROUP BY $formDef(groupby)\n"
        }
        if {$formDef(sqllimit) ne {}} then {
            $txt(Query) insert end "LIMIT $formDef(sqllimit)\n"
        }
        $txt(Query) configure -state disabled \
            -background $::readonlyBackground
        if {$formDef(sqlorderby) ne {}} then {
            $txt(Orderby) insert end $formDef(sqlorderby)
        }
        set rbWhere [ttk::radiobutton $frmQuery.rbWhere \
            -text WHERE -underline 0 -variable [scope whereSelected] \
            -value 1 -command [list focus $txt(Where)] -takefocus 0]
        if {$formDef(groupby) ne {}} then {
            $rbWhere configure -text HAVING
        }
        set rbOrderby [ttk::radiobutton $frmQuery.rbOrderby \
            -text {ORDER BY} -underline 0 -variable [scope whereSelected] \
            -value 0 -command [list focus $txt(Orderby)] -takefocus 0]
        grid $txt(Query) -column 0 -columnspan 2 -row 0 -sticky wens
        grid $vsb(Query) -column 2 -row 0 -sticky ns
        grid $rbWhere -column 0 -row 1 -sticky n
        grid $txt(Where) -column 1 -row 1 -sticky wens
        grid $vsb(Where) -column 2 -row 1 -sticky ns
        grid $rbOrderby -column 0 -row 2 -sticky n
        grid $txt(Orderby) -column 1 -row 2 -sticky wens
        grid $vsb(Orderby) -column 2 -row 2 -sticky ns
        grid columnconfigure $frmQuery 1 -weight 1
        grid rowconfigure $frmQuery 0 -weight 2
        foreach row {1 2} {
            grid rowconfigure $frmQuery $row -weight 1
        }
        bind $txt(Where) <FocusIn> [list set [scope whereSelected] 1]
        bind $txt(Orderby) <FocusIn> [list set [scope whereSelected] 0]
        focus $txt(Where)
        set btnRun [defineButton $frmQuery.btnRun $widget btnRun \
            [list $this onRun]]
        grid $btnRun -column 0 -columnspan 3 -row 3 -sticky e \
            -pady {10 10} -padx {10 10}
        pack $frmQuery -side top -expand 1 -fill both
        # The following makes $widget receive all events that are sent
        # to its children. This makes it possible to bind keyboard
        # shortcuts that apply to the frame of this tab only
        recursiveAppendTag $widget $widget
        if {$formDef(groupby) ne {}} then {
            bind $widget <Alt-KeyPress-h> \
                [list $rbWhere instate {!disabled} [list $rbWhere invoke]]
        } else {
            bind $widget <Alt-KeyPress-w> \
                [list $rbWhere instate {!disabled} [list $rbWhere invoke]]
        }
        bind $widget <Alt-KeyPress-o> \
            [list $rbOrderby instate {!disabled} [list $rbOrderby invoke]]
        return
    }

    public method propagateTabLock {state} {
        if {$state} then {
            $rbWhere state {disabled}
            $rbOrderby state {disabled}
            $txt(Where) configure -state disabled
            $txt(Orderby) configure -state disabled
            $btnRun state {disabled}
            $menubar entryconfigure 1 -state disabled
            $menubar entryconfigure 2 -state disabled
        } else {
            $rbWhere state {!disabled}
            $rbOrderby state {!disabled}
            $txt(Where) configure -state normal
            $txt(Orderby) configure -state normal
            $btnRun state {!disabled}
            $menubar entryconfigure 1 -state normal
            if {$pasteValueMenu} then {
                $menubar entryconfigure 2 -state normal
            }
        }
        return
    }

    public method onRun {} {
        deleteAllListBoxes
        set formDef(sqlwhere) [string trim [$txt(Where) get 1.0 end]]
        set formDef(sqlorderby) [string trim [$txt(Orderby) get 1.0 end]]
        setTabLock 1
        set history [dict create from {} link {} to [mc histOpenForm $formName]]
        $formWindow newFormTab $formName [array get formDef] [list $history]
        return
    }

    public method pasteName {attrib} {
        if {$whereSelected} then {
            $txt(Where) insert insert "\"${attrib}\""
        } else {
            $txt(Orderby) insert insert "\"${attrib}\""
        }
        return
    }

    public method pasteValue {attrib} {
        switch -- $attribDef($attrib,typeofget) {
            tgLink {
                set query $attribDef($attrib,sqlselect)
            }
            tgList {
                set query "SELECT value, description FROM pfm_value "
                append query "WHERE valuelist = '$attribDef($attrib,valuelist)' "
                append query "ORDER BY value"
            }
            default {
                set query {}
            }
        }
        if {[$::dbObject select_query_list $query numTuples headerList valueList errMsg]} then {
            set lsbTitle [mc selectValueFor $attrib]
            set lsb [ListBox "#auto" $formWinPath $lsbTitle $headerList \
                $valueList 0]
            lappend listBoxList [list $lsb $attrib]
            if {[$lsb wait result]} then {
                if {$attribDef($attrib,typeofattrib) eq {taQuoted}} then {
                    set value "'[lindex $result 0]'"
                } else {
                    set value [lindex $result 0]
                }
                if {$whereSelected} then {
                    $txt(Where) insert insert $value
                } else {
                    $txt(Orderby) insert insert $value
                }
            }
            set lsbToRemove [lsearch -exact -index 0 $listBoxList $lsb]
            set listBoxList [lreplace $listBoxList $lsbToRemove $lsbToRemove]
        } else {
            pfm_message $errMsg $formWinPath
        }
        return
    }

    public method deleteAllListBoxes {} {
        foreach lsb $listBoxList {
            [lindex $lsb 0] destroyWindow
        }
        return
    }

}

class FormTab {
    inherit GenTab
    protected variable formDef
    protected variable history
    protected variable attribDef
    protected variable attribList
    protected variable modAttribList
    protected variable linkDef
    protected variable lastLink
    protected variable frmHistory
    protected variable txtHistory
    protected variable canvas
    protected variable frmForm
    protected variable frmButtons
    protected variable btnArray
    protected variable btnSelect
    protected variable txtMessages
    protected variable control
    protected variable formState {browse}
    protected variable statusbar
    protected variable sbNr
    protected variable sbStatus
    protected variable buffer
    protected variable record
    protected variable recordIdx
    protected variable textEditList
    protected variable listBoxList
    protected variable matchCase 0
    protected variable searchPattern
    protected variable searchAttribute
    protected variable searchFrame {}


    constructor {c_parent c_formWindow c_formName formDefDict c_history} \
        {GenTab::constructor $c_parent $c_formWindow $c_formName} {
        array set formDef $formDefDict
        set history $c_history
        set textEditList(0) {}
        set textEditList(1) {}
        set listBoxList {}
        getAttribDef $::dbObject $formName $formWinPath \
            attribDef attribList modAttribList
        getLinkDef $::dbObject $formName $formWinPath linkDef lastLink
        # Bug 1070:
        # "record" is a Tcl array which always contains the current
        # record. Originally, the array elements record($attrib) were
        # bound to the entry widgets of the form and the element names
        # were the attribute names. However, a bug in Itcl caused the
        # attribute value not to be displayed if the attribute name
        # consists of more than one word. Therefore, the following work
        # around is implemented. Instead of record($attrib),
        # record($recordIdx($attrib)) is bound to the form's entry
        # widgets where recordIdx acts as a conversion table which maps
        # the attribute names ($attrib) to integers.
        # recordIdx is initialised here.
        set index 1
        foreach attrib $attribList {
            set recordIdx($attrib) $index
            incr index
        }
        setupWidget
        set buffer [FormBuf "#auto" [array get formDef] [array get attribDef] \
            $this $attribList $modAttribList]
        $buffer getFirstRecord record recNr status
        updateStatusBar $recNr $status
        return
    }

    destructor {
        delete object $buffer
        deleteAllTextEdits 0
        deleteAllTextEdits 1
        deleteAllListBoxes
        return
    }

    public method propagateTabLock {state} {
        if {$state} then {
            if {$formDef(view) eq {f}} then {
                foreach op {Update Add Delete} {
                    $btnArray($op) state {disabled}
                }
            }
            disableBrowseMenus
            for {set link 0} {$link <= $lastLink} {incr link} {
                $btnArray($link) state {disabled}
            }

            bind $widget <KeyPress-Next> {}
            bind $widget <KeyPress-Prior> {}
            bind $widget <KeyPress-Right> {}
            bind $widget <KeyPress-Left> {}
            bind $widget <KeyPress-Home> {}
            bind $widget <KeyPress-End> {}
            foreach btn {Home Prev Next End} {
                $btnArray($btn) state {disabled}
            }
            bind $widget <KeyPress-F3> {}
            if {$searchFrame ne {}} then {
                foreach op {FindNext Hide} {
                    $btnArray($op) state {disabled}
                }
            }
        } else {
            if {$formDef(view) eq {f}} then {
                foreach op {Update Add Delete} {
                    $btnArray($op) state {!disabled}
                }
            }
            for {set link 0} {$link <= $lastLink} {incr link} {
                $btnArray($link) state {!disabled}
            }
            enableBrowseMenus
            bind $widget <KeyPress-Next> [list $this nextRecord]
            bind $widget <KeyPress-Prior> [list $this prevRecord]
            bind $widget <KeyPress-Right> [list $this nextRecord]
            bind $widget <KeyPress-Left> [list $this prevRecord]
            bind $widget <KeyPress-Home> [list $this firstRecord]
            bind $widget <KeyPress-End> [list $this lastRecord]
            foreach btn {Home Prev Next End} {
                $btnArray($btn) state {!disabled}
            }
            bind $widget <KeyPress-F3> [list $this searchForRecord]
            if {$searchFrame ne {}} then {
                foreach op {FindNext Hide} {
                    $btnArray($op) state {!disabled}
                }
            }
        }
        return
    }

    public method mouseWheel {platform arg} {
        switch $platform {
            windows {
                if {$arg < 0} then {
                    set direction 1
                } else {
                    set direction -1
                }
            }
            unix {
                set direction $arg
            }
        }
        set mouse_x [winfo pointerx $formWinPath]
        set mouse_y [winfo pointery $formWinPath]
        set x1 [winfo rootx $frmForm]
        set y1 [winfo rooty $frmForm]
        set x2 [expr $x1 + [winfo width $frmForm]]
        set y2 [expr $y1 + [winfo height $frmForm]]
        if {($x1 <= $mouse_x) && ($mouse_x <= $x2) && \
            ($y1 <= $mouse_y) && ($mouse_y <= $y2)} then {
            $canvas yview scroll $direction unit
        }
        return
    }

    public method scrollForm {i} {

        # Scroll form such that attribute i is visible in the middle
        # of the form.
        #
        # Let: n1 be index of first visible attribute before scrolling
        #      n2 be index of last visible attribute before scrolling
        #      nn1 be index of first visible attribute after scrolling
        #      nn2 be index of last visible attribute after scrolling
        #      f1 = 1st fraction returned by yview before scrolling (known)
        #      f2 = 2nd fraction returned by yview before scrolling (known)
        #      nf1 = 1st fraction to be given to yview for scrolling
        #      nf2 = 2nd fraction returned by yview after scrolling
        #      n = nr of attributes on form (known)
        #      i = index of attribute with input focus (arg of function)
        #      s = number of visible attributes on screen
        # Known data:
        #     n, f1, f2, i
        # To be calculated:
        #     nf1
        # Calculation:
        #     f1 = (y-coord of first visible horizontal line)
        #                                     /(height of canvas)
        #        = (n1 + 1)/(n + 2)
        #     f2 = (y-coord of last visible horizontal line)
        #                                     /(height of canvas)
        #        = (n2 + 1)/(n + 2)
        #     -- to take into account the empty space at top and bottom
        #     -- we assume 2 dummy attributes, one at top (index "-1"),
        #     -- one at bottom (index "n")
        #     n1 = (n + 2) * f1 - 1
        #     n2 = (n + 2) * f2 - 1
        #     s = n2 - n1 + 1
        #       = (n + 2) * (f2 - f1) + 1   (1)
        #     Afters scrolling, same relationship:
        #     nn1 = (n + 2) * nf1 - 1
        #     nn2 = (n + 2) * nf2 - 1
        #     s = (n + 2) * (nf2 - nf1) + 1  (2)
        #     After scrolling we want i to be in the middle between nn1 and nn2
        #     i = (nn1 + nn2)/2
        #       = (nf1 + nf2) * (n + 2)/2 - 1 (3)
        #     s we can calculate with (1)
        #     From (2) and (3) it follows:
        #     nf1 = (2*i - s + 3)/(2 * (n + 2))

        set n [llength $attribList]
        set yviewList [$canvas yview]
        set f1 [lindex $yviewList 0]
        set f2 [lindex $yviewList 1]
        set s [expr ($n + 2) * ($f2 - $f1) + 1.0]
        set nf1 [expr (2.0*$i - $s + 3.0)/(2.0 * ($n + 2.0))]
        if {$nf1 < 0} then {
            set nf1 0
        }
        if {$nf1 > 1} then {
            set nf1 1
        }
        $canvas yview moveto $nf1
        return
    }

    public method showError {message} {
        $txtMessages configure -state normal
        $txtMessages insert end "${message}\n" red
        $txtMessages see end
        $txtMessages configure -state disabled
        bell
        return
    }

    public method showQuery {intro query result resultColor} {
        $txtMessages configure -state normal
        $txtMessages insert end "${intro}\n" blue
        $txtMessages insert end "${query}\n"
        $txtMessages insert end "${result}\n" $resultColor
        $txtMessages see end
        $txtMessages configure -state disabled
        if {$resultColor eq {red}} then {
            bell
        }
        return
    }

    public method firstRecord {} {
        if {(!$tabLock) && ($formState eq {browse})} then {
            $buffer getFirstRecord record recNr status
            updateStatusBar $recNr $status
            updateAllTextEdits 1
        }
        return
    }

    public method lastRecord {} {
        if {(!$tabLock) && ($formState eq {browse})} then {
            $buffer getLastRecord record recNr status
            updateStatusBar $recNr $status
            updateAllTextEdits 1
        }
        return
    }

    public method nextRecord {} {
        if {(!$tabLock) && ($formState eq {browse})} then {
            $buffer getNextRecord record recNr status
            updateStatusBar $recNr $status
            updateAllTextEdits 1
        }
        return
    }

    public method prevRecord {} {
        if {(!$tabLock) && ($formState eq {browse})} then {
            $buffer getPrevRecord record recNr status
            updateStatusBar $recNr $status
            updateAllTextEdits 1
        }
        return
    }

    public method onExpand {attrib} {
        if {$formState eq {browse}} then {
            set readOnly 1
        } else {
            set readOnly 0
        }
        set textEdit [TextEdit "#auto" $formWinPath $attrib \
            $record($recordIdx($attrib)) $readOnly]
        lappend textEditList($readOnly) [list $textEdit $attrib]
        $textEdit defineCallBack \
            [list $this textEditCallBack $textEdit $attrib $readOnly]
        return
    }

    public method textEditCallBack {textEdit attrib readOnly} {
        $textEdit getText record($recordIdx($attrib))
        set itemToRemove [lsearch -exact -index 0 \
            $textEditList($readOnly) $textEdit]
        set textEditList($readOnly) [lreplace $textEditList($readOnly) \
            $itemToRemove $itemToRemove]
        return
    }

    public method onUpdate {} {
        if {[$buffer getStatus] ni {statAfterLast statNotAdded statDeleted}} then {
            # deleteAllTextEdits 1
            set reloaded [$buffer reloadRecord record recNr status]
            updateStatusBar $recNr $status
            updateAllTextEdits 1
            if {$reloaded} then {
                setFormState update
            } else {
                pfm_message [mc reloadFailed] $formWinPath
            }
        }
        return
    }

    public method onAdd {} {
        # deleteAllTextEdits 1
        foreach attrib $modAttribList {
            if {$attribDef($attrib,default) ne {}} then {
                if {[string index $attribDef($attrib,default) 0] eq {=}} then {
                    set query [string range $attribDef($attrib,default) 1 end]
                    if {[$::dbObject select_query_list $query numTuples \
                            namesList tuples errMsg]} then {
                        showQuery [mc getDefaultValue $attrib] \
                            $query [mc queryOK] green
                        if {$numTuples == 1} then {
                            set record($recordIdx($attrib)) [lindex $tuples 0 0]
                        } else {
                            showError [mc defaultNumTuplesErr $attrib $numTuples]
                        }
                    } else {
                        showQuery [mc getDefaultValue $attrib] \
                            $query $errMsg red
                    }
                } else {
                    set record($recordIdx($attrib)) $attribDef($attrib,default)
                }
            }
        }
        setFormState add
        return
    }

    public method onDelete {} {
        if {[$buffer getStatus] ni {statAfterLast statNotAdded statDeleted}} then {
            # deleteAllTextEdits 1
            set reloaded [$buffer reloadRecord record recNr status]
            updateStatusBar $recNr $status
            if {$status ni {statAfterLast statNotAdded statDeleted}} then {
                set arg [dict create \
                    parent $formWinPath \
                    title [mc questionDeleteTitle] \
                    message [mc questionDeleteMessage] \
                    msgWidth 400 \
                    defaultButton btnNo \
                    buttonList {btnYes btnNo}]
                set dlg [GenDialog "#auto" $arg]
                if {[$dlg wait] eq {btnYes}} then {
                    $buffer deleteRecord record recNr status
                    updateStatusBar $recNr $status
                    updateAllTextEdits 1
                }
            }
        }
        return
    }

    public method onOK {} {
        if {[llength $textEditList(0)] > 0} then {
            set attributes {}
            foreach item $textEditList(0) {
                append attributes "[lindex $item 1]\n"
            }
            pfm_message [mc editWindowsOpen $attributes] $formWinPath
        } else {
            if {[llength $listBoxList] > 0} then {
                set attributes {}
                foreach item $listBoxList {
                    append attributes "[lindex $item 1]\n"
                }
                pfm_message [mc listBoxOpen $attributes] $formWinPath
            } else {
                switch -- $formState {
                    "update" {
                        $buffer updateRecord record
                        $buffer reloadRecord record recNr status
                        updateStatusBar $recNr $status
                        updateAllTextEdits 1
                    }
                    "add" {
                        if {[$buffer addRecord record]} then {
                            $buffer reloadRecord record recNr status
                            updateStatusBar $recNr $status
                            updateAllTextEdits 1
                        } else {
                            updateStatusBar {} statNotAdded
                            updateAllTextEdits 1
                        }
                    }
                }
                setFormState browse
            }
        }
        return
    }

    public method onCancel {} {
        deleteAllListBoxes
        deleteAllTextEdits 0
        setFormState browse
        $buffer getCurRecord record recNr status
        updateStatusBar $recNr $status
        return
    }

    public method onSelect {attrib} {
        switch -- $attribDef($attrib,typeofget) {
            tgLink {
                set query $attribDef($attrib,sqlselect)
            }
            tgList {
                set query "SELECT value, description FROM pfm_value "
                append query "WHERE valuelist = '$attribDef($attrib,valuelist)' "
                append query "ORDER BY value"
            }
            default {
                set query {}
            }
        }
        if {[$::dbObject select_query_list $query numTuples headerList valueList errMsg]} then {
            set lsbTitle [mc selectValueFor $attrib]
            set selected [lsearch -exact -index 0 $valueList $record($recordIdx($attrib))]
            if {$selected < 0} then {
                set selected 0
            }
            set lsb [ListBox "#auto" $formWinPath $lsbTitle $headerList \
                $valueList $selected]
            lappend listBoxList [list $lsb $attrib]
            if {[$lsb wait result]} then {
                set record($recordIdx($attrib)) [lindex $result 0]
            }
            set lsbToRemove [lsearch -exact -index 0 $listBoxList $lsb]
            set listBoxList [lreplace $listBoxList $lsbToRemove $lsbToRemove]
        } else {
            pfm_message $errMsg $formWinPath
        }
        return
    }

    public method followLink {link} {
        if {!$tabLock && \
            ([$buffer getStatus] ni {statDeleted statAfterLast statNotAdded})} then {
            set from $formName
            set displayValues {}
            foreach attrib $linkDef($link,displayattrib) {
                lappend displayValues $record($recordIdx($attrib))
            }
            set displayValues [join $displayValues {, }]
            append from " (${displayValues})"
            set to "$linkDef($link,toform)"
            set newEntry [dict create from $from link \
                $linkDef($link,linkname) to $linkDef($link,toform)]
            set newhistory $history
            lappend newhistory $newEntry
            array unset toformDef
            if {[getFormDef $::dbObject $linkDef($link,toform) \
                    $formWinPath toformDef]} then {
                set toformDef(sqlwhere) [expandSqlWhere $link]
                # Next statement added for bug 1072
                set toformDef(sqlorderby) $linkDef($link,orderby)
                $formWindow newFormTab $linkDef($link,toform) \
                    [array get toformDef] $newhistory
            }
        }
        return
    }

    public method onSearch {attrib} {
        if {$searchFrame eq {}} then {
            set searchFrame [setupsearchbar $frmHistory $attrib]
            pack $searchFrame -side top -fill x
        } else {
            set searchAttribute $attrib
        }
        return
    }

    public method onSearchHide {} {
        if {$searchFrame ne {}} then {
            destroy $searchFrame
            set searchFrame {}
            focus [tk_focusNext [focus]]
        }
        return
    }

    public method searchForRecord {} {
        if {($formState eq {browse}) && ($searchFrame ne {}) && !$tabLock} then {
            $buffer searchRecord $searchAttribute \
                "*${searchPattern}*" $matchCase
            $buffer getCurRecord record recNr status
            updateStatusBar $recNr $status
            updateAllTextEdits 1
        }
        return
    }

    public method onHelp {} {
        set query "SELECT help FROM pfm_form WHERE name = '${formName}'"
        if {[$::dbObject select_query_list $query numTuples \
                names tuples errMsg]} then {
            if {$numTuples == 1} then {
                set txtEdit [TextEdit "#auto" $formWinPath \
                    [mc formHelp $formName] [lindex $tuples 0 0] 1]
            }
        } else {
            pfm_message $errMsg $formWinPath
        }
        return
    }

    protected method setupWidget {} {
        setupMenus
        set vpanes [ttk::panedwindow $widget.vpanes -orient vertical]
        set frmHistory [historyPane $vpanes]
        set hpanes [ttk::panedwindow $vpanes.hpanes -orient horizontal]
        set frmForm [formPane $hpanes]
        set frmLink [linkPane $hpanes]
        $hpanes add $frmForm -weight 6
        $hpanes add $frmLink -weight 1
        set frmMessages [messagePane $vpanes]
        $vpanes add $frmHistory -weight 1
        $vpanes add $hpanes -weight 3
        $vpanes add $frmMessages -weight 1
        pack $vpanes -side top -expand 1 -fill both
        recursiveAppendTag $widget $widget
        update
        set bbox [$canvas bbox all]
        set rightEdge [expr [lindex $bbox 2] + 20]
        set bottomEdge [expr [lindex $bbox 3] + 20]
        $canvas configure -scrollregion [list 0 0 $rightEdge $bottomEdge]
        bind $widget <KeyPress-Next> [list $this nextRecord]
        bind $widget <KeyPress-Prior> [list $this prevRecord]
        bind $widget <KeyPress-Right> [list $this nextRecord]
        bind $widget <KeyPress-Left> [list $this prevRecord]
        bind $widget <KeyPress-Home> [list $this firstRecord]
        bind $widget <KeyPress-End> [list $this lastRecord]
        bind $widget <KeyPress-Up> {focus [tk_focusPrev [focus]]}
        bind $widget <KeyPress-Down> {focus [tk_focusNext [focus]]}
        showHistory
        return
    }

    protected method setupMenus {} {
        set mnRecord [menu $menubar.record -tearoff 0]
        foreach op {Update Add Delete} {
            addMenuItem $mnRecord mnu${op}Record command [list $this on$op]
        }
        set mnGoTo [menu $menubar.goto -tearoff 0]
        foreach dir {next prev first last} {
            addMenuItem $mnGoTo mnuGoTo$dir command [list $this ${dir}Record]
        }
        $mnGoTo entryconfigure 0 -accelerator {PgDn}
        $mnGoTo entryconfigure 1 -accelerator {PgUp}
        $mnGoTo entryconfigure 2 -accelerator {Home}
        $mnGoTo entryconfigure 3 -accelerator {End}
        set mnSearch [menu $menubar.search -tearoff 0]
        foreach attrib $attribList {
            $mnSearch add command -label $attrib \
                -command [list $this onSearch $attrib]
        }
        $mnSearch add separator
        $mnSearch add checkbutton \
            -label [lindex [mcunderline mnuSearchCase] 0] \
            -underline [lindex [mcunderline mnuSearchCase] 1] \
            -variable [scope matchCase] -onvalue 1 -offvalue 0 \
            -indicatoron 1 -selectcolor black
        $mnSearch add separator
        addMenuItem $mnSearch mnuSearchHide command [list $this onSearchHide]
        addMenuItem $menubar mnuRecordMenu cascade $mnRecord
        addMenuItem $menubar mnuGoToMenu cascade $mnGoTo
        addMenuItem $menubar mnuSearchMenu cascade $mnSearch
        addMenuItem $menubar mnuFormHelp command [list $this onHelp]
        if {$formDef(view) eq {t}} then {
            $menubar entryconfigure 1 -state disabled
        }
        return
    }

    protected method enableBrowseMenus {} {
        if {$formDef(view) eq {f}} then {
            $menubar entryconfigure 1 -state normal
        }
        foreach item {2 3} {
            $menubar entryconfigure $item -state normal
        }
        return
    }

   protected method disableBrowseMenus {} {
        foreach item {1 2 3} {
            $menubar entryconfigure $item -state disabled
        }
        return
    }

    protected method historyPane {parent} {
        set frm [ttk::frame $parent.frmhistory]
        set frm2 [ttk::frame $frm.frm2]
        set txtHistory [text $frm2.txt -width 1 -height 1 \
            -takefocus 0 -state disabled]
        set vsbHistory [ttk::scrollbar $frm2.vsb -orient vertical \
            -command [list $txtHistory yview]]
        $txtHistory configure -yscrollcommand [list $vsbHistory set]
        $txtHistory tag configure blue -foreground {medium blue}
        $txtHistory tag configure red -foreground {red3}
        $txtHistory tag configure green -foreground {green4}
        pack $txtHistory -side left -expand 1 -fill both
        pack $vsbHistory -side left -fill y
        pack $frm2 -side top -expand 1 -fill both
        return $frm
    }

    protected method formPane {parent} {
        global tcl_platform
        set frmForm [ttk::frame $parent.frmform -borderwidth 1 -relief raised]
        # relief modified
        set statusbar [ttk::frame $frmForm.sb]
        set frmRecNr [ttk::frame $statusbar.frmRecNr]
        set btnArray(Home) [ttk::button $frmRecNr.btnHome -image ::img::arrow_home \
            -command [list $this firstRecord] -style SButton -takefocus 0]
        set btnArray(Prev) [ttk::button $frmRecNr.btnPrev -image ::img::arrow_left \
            -command [list $this prevRecord] -style SButton -takefocus 0]
        set sbNr [ttk::label $frmRecNr.sbnr -text {0/0} \
            -background white]
        set btnArray(Next) [ttk::button $frmRecNr.btnNext -image ::img::arrow_right \
            -command [list $this nextRecord] -style SButton -takefocus 0]
        set btnArray(End) [ttk::button $frmRecNr.btnEnd -image ::img::arrow_end \
            -command [list $this lastRecord] -style SButton -takefocus 0]
        pack $btnArray(Home) -side left
        pack $btnArray(Prev) -side left
        pack $sbNr -side left -padx {8 8}
        pack $btnArray(Next) -side left
        pack $btnArray(End) -side left
        set sbForm [ttk::label $statusbar.sbform -text $formName \
            -foreground {medium blue}]
        set sbStatus [ttk::label $statusbar.sbStatus -text {state}]
        grid $frmRecNr -column 0 -row 0 -sticky w
        grid $sbForm -column 1 -row 0
        grid $sbStatus -column 2 -row 0 -sticky e
        grid columnconfigure $statusbar 0 -weight 1
        grid columnconfigure $statusbar 1 -weight 1
        grid columnconfigure $statusbar 2 -weight 1
        set frmBody [ttk::frame $frmForm.frmbody -borderwidth 2 \
            -relief sunken]
        set canvas [canvas $frmBody.canvas -width 100 -height 100]
        set canvsb [ttk::scrollbar $frmBody.vsb -orient vertical \
            -command [list $canvas yview]]
        $canvas configure -yscrollcommand [list $canvsb set]
        set embWindow [formControls $canvas]
        $canvas create window 20 20 -window $embWindow -anchor nw
        pack $canvas -side left -expand 1 -fill both
        pack $canvsb -side left -fill y
        pack $statusbar -side top -fill x
        pack $frmBody -side top -expand 1 -fill both
        if {$formDef(view) eq {f}} then {
            set frmButtons [ttk::frame $frmForm.frmbtns]
            foreach op {Update Add Delete OK Cancel} {
                set btnArray($op) [defineButton $frmButtons.btn$op $widget btn$op \
                    [list $this on$op]]
                $btnArray($op) configure -style SButton
            }
            set col 0
            foreach op {Update Add Delete} {
                grid $btnArray($op) -column $col -row 0 -pady {5 5}
                incr col
            }
            foreach op {OK Cancel} {
                $btnArray($op) state {disabled}
            }
            grid anchor $frmButtons center
            pack $frmButtons -side top -fill x
        }
        switch -- $tcl_platform(platform) {
            "windows" {
                bind $widget <MouseWheel> [list $this mouseWheel windows %D]
            }
            "unix" -
            default {
                # On X Window system, mouse wheel sends <4> and <5> events.
                bind $widget <4> [list $this mouseWheel unix -1]
                bind $widget <5> [list $this mouseWheel unix 1]
            }
        }
        return $frmForm
    }

    protected method formControls {parent} {
        set frame [ttk::frame $parent.controls]
        set row 0
        foreach attrib $attribList {
            set lbl [ttk::label $frame.lbl$row -text $attrib -takefocus 0]
            set record($recordIdx($attrib)) {}
            set control($attrib) [entry $frame.ent$row -width 35 \
                -textvariable [scope record($recordIdx($attrib))]]
            $control($attrib) configure -state {readonly}
            bind $control($attrib) <FocusIn> [list $this scrollForm $row]
            set btn [defineButton $frame.btn$row $control($attrib) \
                btnExpand [list $this onExpand $attrib]]
            $btn configure -style SButton
            if {$attribDef($attrib,typeofget) in {tgList tgLink}} then {
                set btnSelect($attrib) [defineButton $frame.sel$row \
                    $control($attrib) btnSelect \
                    [list $this onSelect $attrib]]
                $btnSelect($attrib) state {disabled}
                $btnSelect($attrib) configure -style SButton
                bind $control($attrib) <KeyPress-Return> \
                    [list $btnSelect($attrib) instate {!disabled} \
                        [list $btnSelect($attrib) invoke]]
                grid $lbl -column 0 -row $row -sticky w
                grid $control($attrib) -column 1 -row $row -sticky wens
                grid $btnSelect($attrib) -column 2 -row $row -sticky we
                grid $btn -column 3 -row $row
            } else {
                grid $lbl -column 0 -row $row -sticky w
                grid $control($attrib) -column 1 -columnspan 2 \
                    -row $row -sticky wens
                grid $btn -column 3 -row $row
            }
            incr row
        }
        focus $control([lindex $attribList 0])
        return $frame
    }

    protected method linkPane {parent} {
        set frmLink [ttk::frame $parent.frmlink -borderwidth 1 -relief raised]
        # relief modified
        set frmTitle [ttk::frame $frmLink.frmtitle]
        set lbTitle [ttk::label $frmTitle.lbl -text [mc lbLinks]]
        pack $lbTitle -side top
        set linksBody [ttk::frame $frmLink.body -borderwidth 2 \
            -relief sunken]
        for {set link 0} {$link<= $lastLink} {incr link} {
            set btnNr [expr $link + 1]
            set btnArray($link) [ttk::button $linksBody.btn$btnNr \
                -text "${btnNr}: $linkDef($link,linkname)" \
                -takefocus 0 -style LButton -underline 0 \
                -command [list $this followLink $link]]
            grid $btnArray($link) -column 0 -row $link -sticky we
            if {$btnNr < 10} then {
                bind $widget <Alt-KeyPress-$btnNr> \
                    [list after 200 [list $btnArray($link) instate {!disabled} \
                        [list $btnArray($link) invoke]]]
            }
        }
        grid anchor $linksBody center
        pack $frmTitle -side top -fill x
        pack $linksBody -side top -expand 1 -fill both
        return $frmLink
    }

    protected method messagePane {parent} {
        set frmMessages [ttk::frame $parent.frmmsg]
        set txtMessages [text $frmMessages.txt -width 1 -height 1 -takefocus 0]
        set vsb [ttk::scrollbar $frmMessages.vsb -orient vertical \
            -command [list $txtMessages yview]]
        $txtMessages configure -yscrollcommand [list $vsb set]
        $txtMessages tag configure blue -foreground {medium blue}
        $txtMessages tag configure red -foreground {red3}
        $txtMessages tag configure green -foreground {green4}
        pack $txtMessages -side left -expand 1 -fill both
        pack $vsb -side left -fill y
        return $frmMessages
    }

    protected method setupsearchbar {parent attrib} {
        set searchAttribute $attrib
        set frm [ttk::frame $parent.frmsearch]
        set searchFor [ttk::label $frm.lb1 -text [mc lbSearchFor]]
        set searchEntry [entry $frm.entry \
            -textvariable [scope searchPattern]]
        set searchIn [ttk::label $frm.lb2 -text [mc lbSearchIn]]
        set searchCombo [ttk::combobox $frm.combo -values $attribList \
            -textvariable [scope searchAttribute] -takefocus 0]
        set btnArray(FindNext) [defineButton $frm.btnFindNext $widget \
            btnFindNext [list $this searchForRecord]]
        $btnArray(FindNext) configure -style SButton
        bind $widget <KeyPress-F3> [list $this searchForRecord]
        set btnCase [defineCheckbutton $frm.btncase $widget \
            btnMatchCase {} [scope matchCase] 1 0]
        set btnArray(Hide) [defineButton $frm.btnHide $widget \
            btnHide [list $this onSearchHide]]
        $btnArray(Hide) configure -style SButton
        recursiveAppendTag $frm $widget
        grid $searchIn -column 0 -row 0 -sticky w
        grid $searchCombo -column 1 -row 0 -sticky we
        grid $searchFor -column 2 -row 0 -sticky w
        grid $searchEntry -column 3 -row 0 -sticky we
        grid $btnArray(FindNext) -column 4 -row 0 -sticky e
        grid $btnCase -column 5 -row 0 -sticky w
        grid $btnArray(Hide) -column 6 -row 0 -sticky w
        grid columnconfigure $frm {1 3} -weight 1
        bind $searchEntry <KeyPress-Return> [list $this searchForRecord]
        focus $searchEntry
        return $frm
    }

    protected method updateStatusBar {recNr status} {
        $sbNr configure -text $recNr
        setRecordStatus $status
        return
    }

    protected method setRecordStatus {status} {
        switch -- $status {
            "statUpdated" -
            "statAdded" -
            "statDeleted" {
                set colour {green4}
            }
            "statUpdating" -
            "statAdding" {
                set colour {red3}
            }
            "statNotAdded" -
            "statAfterLast" {
                set colour {medium blue}
            }
            "statNotModified" -
            default {
                set colour {black}
            }
        }
        $sbStatus configure -text [mc $status] -foreground $colour
        return
    }

    protected method expandSqlWhere {link} {
        set expandWhere $linkDef($link,sqlwhere)
        set first [string first "\$(" $expandWhere]
        while {$first >= 0} {
            set last [string first ")" $expandWhere $first]
            set parName [string range $expandWhere [expr $first + 2] [expr $last -1]]
            if {[info exists record($recordIdx($parName))]} then {
                set parameter [string map {' ''} $record($recordIdx($parName))]
                set expandWhere [string replace $expandWhere $first $last $parameter]
            } else {
                pfm_message \
                    [mc expandSqlWhereErr $linkDef($link,linkname) $parName $formName] \
                     $formWinPath
            }
            set first [string first "\$(" $expandWhere $last]
        }
        return $expandWhere
    }

    protected method showHistory {} {
        $txtHistory configure -state normal
        $txtHistory delete 1.0 end
        set indent {}
        # first entry doesn't have 'from' and 'link'. Therefore, next loop
        # starts from 2nd entry
        foreach entry [lrange $history 1 end] {
            set from [dict get $entry from]
            $txtHistory insert end "${indent}${from}\n" blue
            set link [dict get $entry link]
            $txtHistory insert end \
                "${indent}    | ${link}\n${indent}    v\n" green
            append indent {    }
        }
        # The 'to' only has to be printed for the last entry. Therefoe,
        # it is outside the previous loop
        set lastEntry [lindex $history end]
        $txtHistory insert end "${indent}[dict get $lastEntry to]" blue
        $txtHistory see end
        $txtHistory configure -state disabled
        return
    }

    protected method setFormState {newstate} {
        set formState $newstate
        switch -- $newstate {
            "browse" {
                disableEditButtons
                disableEditControls
                enableLinkButtons
                enableBrowseMenus
            }
            "update" {
                setRecordStatus statUpdating
                disableLinkButtons
                enableEditButtons
                enableEditControls
                disableBrowseMenus
            }
            "add" {
                setRecordStatus statAdding
                disableLinkButtons
                enableEditButtons
                enableEditControls
                disableBrowseMenus
            }
        }
        return
    }

    protected method disableLinkButtons {} {
        for {set link 0} {$link <= $lastLink} {incr link} {
            $btnArray($link) state {disabled}
        }
        return
    }

   protected method enableLinkButtons {} {
        for {set link 0} {$link <= $lastLink} {incr link} {
            $btnArray($link) state {!disabled}
        }
        return
    }

    protected method disableEditButtons {} {
        foreach op {OK Cancel} {
            $btnArray($op) state {disabled}
            if {$btnArray($op) in [grid slaves $frmButtons]} then {
                grid forget $btnArray($op)
            }
        }
        bind $widget <KeyPress-Escape> [list $this onEscape]
        set col 0
        foreach op {Update Add Delete} {
            $btnArray($op) state {!disabled}
            if {$btnArray($op) ni [grid slaves $frmButtons]} then {
                grid $btnArray($op) -column $col -row 0 -pady {5 5}
                incr col
            }
        }
        for {set link 0} {$link <= $lastLink} {incr link} {
            $btnArray($link) state {!disabled}
        }
        return
    }

   protected method enableEditButtons {} {
        foreach op {Update Add Delete} {
            $btnArray($op) state {disabled}
            if {$btnArray($op) in [grid slaves $frmButtons]} then {
                grid forget $btnArray($op)
            }
        }
        set col 0
        foreach op {OK Cancel} {
            $btnArray($op) state {!disabled}
            if {$btnArray($op) ni [grid slaves $frmButtons]} then {
                grid $btnArray($op) -column $col -row 0 -pady {5 5}
            }
            incr col
        }
        bind $widget <KeyPress-Escape> [list $this onCancel]
        for {set link 0} {$link <= $lastLink} {incr link} {
            $btnArray($link) state {disabled}
        }
        return
    }

    protected method enableEditControls {} {
        foreach attrib $modAttribList {
            if {$attribDef($attrib,typeofget) ni {tgList tgLink tgReadOnly}} {
                $control($attrib) configure -state normal
            } else {
                if {$attribDef($attrib,typeofget) ne {tgReadOnly}} then {
                    $btnSelect($attrib) state {!disabled}
                }
            }
        }
        return
    }

    protected method disableEditControls {} {
       foreach attrib $modAttribList {
            if {$attribDef($attrib,typeofget) ni {tgList tgLink tgReadOnly}} {
                $control($attrib) configure -state readonly
            } else {
                if {$attribDef($attrib,typeofget) ne {tgReadOnly}} then {
                    $btnSelect($attrib) state {disabled}
                }
            }
        }
        return
    }

    protected method updateAllTextEdits {readonly} {
        foreach item $textEditList($readonly) {
            [lindex $item 0] setText record($recordIdx([lindex $item 1]))
        }
        return
    }

    protected method deleteAllTextEdits {readOnly} {
        foreach item $textEditList($readOnly) {
            [lindex $item 0] destroyWindow
        }
        set textEditList($readOnly) {}
        return
    }

    protected method deleteAllListBoxes {} {
        foreach item $listBoxList {
            [lindex $item 0] destroyWindow
        }
        set listBoxList {}
        return
    }

}

class FormBuf {
    protected variable formDef
    protected variable attribDef
    protected variable attribList
    protected variable modAttribList
    protected variable formTab
    protected variable buffer
    protected variable status
    protected variable bufferFilled 0
    protected variable curRecord
    protected variable lastRecord
    protected variable lastChunk
    protected variable offset
    protected variable recordIdx

    constructor {c_formDef c_attribDef c_formTab c_attribList c_modAttribList} {
        array set formDef $c_formDef
        array set attribDef $c_attribDef
        set attribList $c_attribList
        set modAttribList $c_modAttribList
        set formTab $c_formTab
        # Bug 1070:
        # The same calculation is done in the constructor of class FormTab.
        # See there for more information.
        set index 1
        foreach attrib $attribList {
            set recordIdx($attrib) $index
            incr index
        }
        return
    }

    destructor {
        return
    }

    proc quoteIfNecessary {tablename} {
        # Procedure added for bug 1071
        set double "\""
        if {[string first $double $tablename] >= 0} then {
            # If tablename already contains double quotes, just leave it
            # alone
            set result $tablename
        } else {
            # replace . with "." and enclose everything in double quotes
            set dot "."
            set quotedDot "\".\""
            set result [string map [list $dot $quotedDot] $tablename]
            set result "${double}${result}${double}"
        }
        # puts stdout $result
        return $result
    }
    
    public method getFirstRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        if {(!$bufferFilled) || ($offset != 0)} then {
            loadDataChunk 0
        }
        set curRecord 0
        getCurRecord record recNr recordStatus
        return
    }

    public method getNextRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        if {$curRecord <= [expr $lastRecord - 2]} then {
            incr curRecord
        } else {
            if {!$lastChunk} then {
                loadDataChunk 1
                set curRecord 0
            } else {
                set curRecord $lastRecord
            }
        }
        getCurRecord record recNr recordStatus
        return
    }

    public method getPrevRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        if {$curRecord >= 1} then {
            incr curRecord -1
        } else {
            if {$offset > 0} then {
                loadDataChunk -1
                set curRecord [expr $lastRecord - 1]
            }
        }
        getCurRecord record recNr recordStatus
        return
    }

    public method getLastRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        while {!$lastChunk} {
            loadDataChunk 1
        }
        set curRecord [expr $lastRecord - 1]
        if {$curRecord < 0} then {
            set curRecord 0
        }
        getCurRecord record recNr recordStatus
        return
    }

    public method getCurRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        array unset record
        foreach attrib $attribList {
                set record($recordIdx($attrib)) $buffer($curRecord,$attrib)
        }
        set recordStatus $status($curRecord)
        # set recNr [expr $curRecord + $offset + 1]
        if {$lastChunk} then {
            set recNr "[expr $curRecord + $offset + 1]/[expr $lastRecord + $offset]"
        } else {
            set recNr "[expr $curRecord + $offset + 1]/?"
        }
        return
    }

    public method searchRecord {attribute pattern matchCase} {
        if {($curRecord == $lastRecord) && $lastChunk} then {
            loadDataChunk 0
            set startSearch 0
        } else {
            set startSearch [expr $curRecord + 1]
        }
        set searching 1
        while {$searching} {
            set found 0
            for {set tuple $startSearch} {$tuple < $lastRecord} {incr tuple} {
                if {$matchCase} then {
                    set found [string match $pattern \
                        $buffer($tuple,$attribute)]
                } else {
                    set found [string match -nocase $pattern \
                        $buffer($tuple,$attribute)]
                }
                if {$found} then {
                    set curRecord $tuple
                    break
                }
            }
            if {$found} then {
                set searching 0
            } else {
                if {!$lastChunk} then {
                    loadDataChunk 1
                    set startSearch 0
                } else {
                    set searching 0
                    set curRecord $lastRecord
                }
            }
        }
        return $found
    }

    public method getStatus {} {
        return $status($curRecord)
    }

    public method deleteRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        set command "DELETE FROM [quoteIfNecessary $formDef(tablename)]"
        append command "\nWHERE [identCurRecord 0]"
        if {[$::dbObject send_command $command errMsg]} then {
            foreach attrib $attribList {
                set buffer($curRecord,$attrib) {}
                set status($curRecord) statDeleted
            }
            $formTab showQuery [mc deleteRecord] $command [mc commandOK] green
        } else {
            $formTab showQuery [mc deleteRecord] $command $errMsg red
        }
        getCurRecord record recNr recordStatus
        return
    }

    public method addRecord {recordName} {
        upvar $recordName record
        set query "INSERT INTO [quoteIfNecessary $formDef(tablename)]"
        set attribSpec {}
        set valueList {}
        foreach attrib $modAttribList {
            lappend attribSpec "\"${attrib}\""
            set value $record($recordIdx($attrib))
            if {$attribDef($attrib,typeofget) eq {tgExpression}} then {
                    set value [expr $value]
            }
            if {$attribDef($attrib,typeofattrib) eq {taQuoted}} then {
                    set value "'[string map {{'} {''}} ${value}]'"
            }
            lappend valueList $value
        }
        append query " ([join $attribSpec {, }])"
        append query "\nVALUES ([join $valueList {, }])"
        if {[$::dbObject send_command $query errMsg]} then {
            set result 1
            $formTab showQuery [mc addRecord] $query [mc commandOK] green
            set curRecord $lastRecord
            incr lastRecord
            foreach attrib $modAttribList {
                set buffer($curRecord,$attrib) $record($recordIdx($attrib))
            }
            set status($curRecord) statAdded
            foreach attrib $attribList {
                set buffer($lastRecord,$attrib) {}
            }
            set status($lastRecord) statAfterLast
        } else {
            $formTab showQuery [mc addRecord] $query $errMsg red
            set result 0
        }
        return $result
    }

    public method updateRecord {recordName} {
        upvar $recordName record
        if {[transactionCommand [mc startTransaction] {START TRANSACTION}]} then {
            if {[selectForUpdate]} then {
                if {[basicUpdateRecord record]} then {
                    if {[transactionCommand [mc commitTransaction] {COMMIT}]} then {
                        set result 1
                        foreach attrib $modAttribList {
                            set buffer($curRecord,$attrib) $record($recordIdx($attrib))
                        }
                        set status($curRecord) statUpdated
                    } else {
                        set result 0
                    }
                } else {
                    set result 0
                    transactionCommand [mc rollBack] {ROLLBACK}
                }
            } else {
                set result 0
                transactionCommand [mc rollBack] {ROLLBACK}
            }
        } else {
            set result 0
        }
        return $result
    }

    protected method basicUpdateRecord {recordName} {
        upvar $recordName record
        set updateList {}
        foreach attrib $modAttribList {
            if {$record($recordIdx($attrib)) ne $buffer($curRecord,$attrib)} then {
                set value $record($recordIdx($attrib))
                if {$attribDef($attrib,typeofget) eq {tgExpression}} then {
                    set value [expr $value]
                }
                if {$attribDef($attrib,typeofattrib) eq {taQuoted}} then {
                    set value "'[string map {{'} {''}} ${value}]'"
                }
                lappend updateList "\"${attrib}\" = $value"
            }
        }
        if {[llength $updateList] > 0} then {
            set command "UPDATE [quoteIfNecessary $formDef(tablename)]"
            append command "\nSET [join $updateList {, }]"
            append command "\nWHERE [identCurRecord 0]"
            if {[$::dbObject send_command $command errMsg]} then {
                set result 1
                $formTab showQuery [mc updateRecord] $command \
                    [mc commandOK] green
            } else {
                set result 0
                $formTab showQuery [mc updateRecord] $command \
                    $errMsg red
            }
        } else {
            set result 0
            $formTab showError [mc noUpdates]
        }
        return $result
    }

    protected method selectForUpdate {} {
        set sqlattrib {}
        foreach attrib $modAttribList {
            lappend sqlattrib "\"${attrib}\""
        }
        set sqlattrib [join $sqlattrib {, }]
        set query "SELECT $sqlattrib"
        append query "\nFROM [quoteIfNecessary $formDef(tablename)]"
        append query "\nWHERE [identCurRecord 0] FOR UPDATE"
        if {[$::dbObject select_query_list $query numTuples namesList \
                resultList errMsg]} then {
            switch -- $numTuples {
                1 {
                    set idx 0
                    set result 1
                    foreach attrib $namesList {
                        if {$buffer($curRecord,$attrib) ne [lindex $resultList 0 $idx]} then {
                            set result 0
                            break
                        }
                        incr idx
                    }
                    if {$result} then {
                        $formTab showQuery [mc selectForUpdate] $query [mc queryOK] green
                    } else {
                        set idx 0
                        foreach attrib $namesList {
                            set buffer($curRecord,$attrib) [lindex $resultList 0 $idx]
                            set status($curRecord) statNotModified
                            incr idx
                        }
                        $formTab showQuery [mc selectForUpdate] $query \
                            [mc recordModified] red
                        pfm_message [mc recordModified] [$formTab cget -formWinPath]
                    }
                }
                0 {
                    set result 0
                    $formTab showQuery [mc selectForUpdate] $query \
                        [mc recordDeleted] red
                    pfm_message [mc recordDeleted] [$formTab cget -formWinPath]
                }
                default {
                    set result 0
                    $formTab showQuery [mc selectForUpdate] $query \
                        [mc wrongNumTuples $numTuples] red
                    pfm_message [mc wrongNumTuples $numTuples] \
                        [$formTab cget -formWinPath]
                }
            }
        } else {
            set result 0
            $formTab showQuery [mc selectForUpdate] $query $errMsg red
            pfm_message $errMsg [$formTab cget -formWinPath]
        }
        return $result
    }

    protected method transactionCommand {intro command} {
        if {[$::dbObject send_command $command errMsg]} then {
            $formTab showQuery $intro $command [mc commandOK] green
            set result 1
        } else {
            $formTab showQuery $intro $command $errMsg red
            set result 0
        }
        return $result
    }

    public method reloadRecord {recordName recNrName statusName} {
        upvar $recordName record
        upvar $recNrName recNr
        upvar $statusName recordStatus
        set query "SELECT $formDef(sqlselect)"
        append query "\nFROM $formDef(sqlfrom) "
        if {$formDef(groupby) eq {}} then {
            append query "\nWHERE [identCurRecord 1]"
        } else {
            append query "\nGROUP BY $formDef(groupby) "
            append query "\nHAVING [identCurRecord 1]"
        }
        if {[$::dbObject select_query_list $query numTuples namesList \
                resultList errMsg]} then {
            switch -- $numTuples {
                1 {
                    set idx 0
                    foreach attrib $namesList {
                        set buffer($curRecord,$attrib) [lindex $resultList 0 $idx]
                        incr idx
                    }
                    $formTab showQuery [mc reloadRecord] $query [mc queryOK] green
                    set result 1
                }
                0 {
                    $formTab showQuery [mc reloadRecord] $query \
                        [mc recordDeleted] red
                    foreach attrib $attribList {
                        set buffer($curRecord,$attrib) {}
                    }
                    set status($curRecord) statDeleted
                    set result 0
                }
                default {
                $formTab showQuery [mc reloadRecord] $query \
                    [mc wrongNumTuples $numTuples] red
                    set result 0
                }
            }
        } else {
            $formTab showQuery [mc reloadRecord] $query $errMsg red
            set result 0
        }
        getCurRecord record recNr recordStatus
        return $result
    }

    protected method identCurRecord {withTable} {
        set whereClause {}
        set table [quoteIfNecessary $formDef(tablename)]
        foreach pkey $formDef(pkey) {
            if {$attribDef($pkey,typeofattrib) eq {taQuoted}} then {
                set value "'[string map {{'} {''}} $buffer($curRecord,$pkey)]'"
            } else {
                set value $buffer($curRecord,$pkey)
            }
            if {$withTable} then {
                lappend whereClause "(${table}.\"${pkey}\" = $value)"
            } else {
                lappend whereClause "(\"${pkey}\" = $value)"
            }
        }
        return [join $whereClause { AND }]
    }

    protected method loadDataChunk {arg} {
        switch -- $arg {
            0 {
                set offset 0
            }
            1 {
                if {$formDef(sqllimit) ne {}} then {
                    incr offset $formDef(sqllimit)
                }
            }
            -1 {
                if {$formDef(sqllimit) ne {}} then {
                    incr offset -$formDef(sqllimit)
                    if {$offset < 0} then {
                        set offset 0
                    }
                }
            }
        }
        set query "SELECT $formDef(sqlselect)"
        append query "\nFROM $formDef(sqlfrom)"
        if {$formDef(groupby) ne {}} then {
            append query "\nGROUP BY $formDef(groupby)"
            if {$formDef(sqlwhere) ne {}} then {
                append query "\nHAVING $formDef(sqlwhere)"
            }
        } else {
            if {$formDef(sqlwhere) ne {}} then {
                append query "\nWHERE $formDef(sqlwhere)"
            }
        }
        if {$formDef(sqlorderby) ne {}} then {
            append query "\nORDER BY $formDef(sqlorderby)"
        }
        if {$formDef(sqllimit) ne {}} then {
            append query "\nLIMIT $formDef(sqllimit) OFFSET $offset"
        }
        array unset buffer
        array unset status
        if {[$::dbObject select_query $query lastRecord buffer errMsg]} then {
            if {$formDef(sqllimit) ne {}} then {
                set lastChunk [expr $lastRecord < $formDef(sqllimit)]
            } else {
                set lastChunk 1
            }
            if {[checkResult errMsg]} then {
                $formTab showQuery [mc loadDataChunk] $query [mc queryOK] green
            } else {
                $formTab showQuery [mc loadDataChunk] $query $errMsg red
            }
            set bufferFilled 1
        } else {
            set lastRecord 0
            set lastChunk 1
            $formTab showQuery [mc loadDataChunk] $query $errMsg red
            set bufferFilled 0
        }
        for {set tuple 0} {$tuple < $lastRecord} {incr tuple} {
            set status($tuple) statNotModified
        }
        foreach attrib $attribList {
            set buffer($lastRecord,$attrib) {}
        }
        set status($lastRecord) statAfterLast
        return
    }

    protected method checkResult {errMsgName} {
        upvar $errMsgName errMsg
        set result 1
        set errMsg {}
        if {$lastRecord > 0} then {
            foreach attrib $attribList {
                if {![info exists buffer(0,$attrib)]} then {
                    set result 0
                    append errMsg "[mc attribMissing $attrib]\n"
                    for {set tuple 0} {$tuple < $lastRecord} {incr tuple} {
                        set buffer($tuple,$attrib) {}
                    }
                }
            }
            foreach attrib $formDef(pkey) {
                if {![info exists buffer(0,$attrib)]} then {
                    set result 0
                    append errMsg "[mc pkeyMissing $attrib]\n"
                    for {set tuple 0} {$tuple < $lastRecord} {incr tuple} {
                        set buffer($tuple,$attrib) {}
                    }
                }
                if {$attrib ni $attribList} then {
                    append errMsg "[mc attribDefPkeyMissing $attrib]\n"
                    set attribDef($attrib,typeofattrib) taQuoted
                    set attribbDef($attrib,typeofget) tgDirect
                }
            }
        }
        return $result
    }
}