#!/bin/sh
# the next line calls 
#     tclsh "$0" "$@"
# where - "$0" is the filename of the script being executed, i.e.  pfm.tcl
#       - "$@" stands for all arguments with which the script was called
# The backslash at the end of this comment makes the next line a continuation
# of the comment for tclsh, but not for sh. So, the next line is only
# executed in 'sh', not in 'tclsh' \
exec tclsh "$0" "$@"
#############################################################################
#
# This is Postgres Forms (pfm), a client application for PostgreSQL.
#
# Copyright (C) 2004 Willem Herremans
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# 
# Please send bug reports and feature requests via the corresponding
# facilities on the home page of Postgres Forms (pfm):
# 
# http://gborg.postgresql.org/project/pfm/
# 
# Please send all other comments or questions to the mailing list:
# 
# pfm-comments@gborg.postgresql.org
#
# or directly to me
#
# willem.herremans@tiscali.be
#############################################################################

package require Tk

########################################################################
# Begin namespace options                                              #
########################################################################

# pfmOptions is an array with all the options for Postgres Forms.
# Up to now, the options are:
#
#     - dblist : a list of data base names from which the user
#       can choose one at Open data base.
#
#     - host, port, user and dbname: the default values for the
#       connection parameters proposed by Open data base.
#
#     - printcmd : UNIX command which accepts data on stdin and sends
#       them to the printer.
#
#     - printencoding: character encoding used by pfm to send text to print command.
#
# pfmOptions are stored in file ~/.pfmrc. This file is read by proc initOptions.
#
# On Windows platforms the options are stored in %APPDATA%\pfm\pfm.conf
#
# pfmOptions can be modified by menu Tools -> Options.
#


namespace eval options {
    variable pfmOptions
    variable newOptions
    variable font
    variable optionList
	
    proc getDefault {option} {
	global env
	global tcl_platform

	switch -- $option {
	    "browser" {
		switch -- $tcl_platform(platform) {
		    "unix" {
			set value {mozilla -remote "openurl(%s)"}
		    }
		    "windows" {
			if {[info exists env(ProgramFiles)]} then {
			    set iexplorer \
				[file normalize [file join $env(ProgramFiles) \
						     {Internet Explorer} \
						     {iexplore.exe}]]
			    set value [list $iexplorer %s]
			} else {
			    set value {iexplore.exe %s}
			}
		    }
		    default {
			set value {}
		    }
		}
	    }
	    "dblist" {
		set value [list $tcl_platform(user)]
	    }
	    "dbname" {
		set value $tcl_platform(user)
	    }
	    "fontmonospace" {
		set value [list courier -12]
	    }
	    "fontproportional" {
		set value [list helvetica -12]
	    }
	    "host" {
		set value {}
	    }
	    "port" {
		set value {5432}
	    }
	    "printcmd" {
		switch -- $tcl_platform(platform) {
		    "unix" {
			set value {a2ps --printer=display --$(portrait_or_landscape=portrait) --rows=$(nr-of-rows=1) --columns=$(nr-of-columns=1) --major=rows --chars-per-line=$(nr_of_chars_per_line=90) --center-title=$(title=Report)}
		    }
		    "windows" {
			if {[info exists env(ProgramFiles)]} then {
			    set wordpad \
				[file normalize [file join $env(ProgramFiles) \
						     {Windows NT} \
						     {Bureau-accessoires} \
						     {wordpad.exe}]]
			    set value [list $wordpad %s]
			} else {
			    set value {wordpad.exe %s}
			}
		    }
		}
	    }
	    "printencoding" {
		set value [encoding system]
	    }
	    "psql" {
		switch -- $tcl_platform(platform) {
		    "unix" {
			set value {psql}
		    }
		    "windows" {
			set value {psql.exe}
		    }
		    default {
			set value {}
		    }
		}
	    }
	    "tmpdir" {
		switch -- $tcl_platform(platform) {
		    "unix" {
			set value {/tmp}
		    }
		    "windows" {
			if {[info exists env(TEMP)]} then {
			    set value [file normalize $env(TEMP)]
			} else {
			    set value [file normalize "~/tmp"]
			}
		    }
		    default {
			set value {}
		    }
		}
	    }
	    "usePGPASSWORD" {
		set value {yes}
	    }
	    "user" {
		set value $tcl_platform(user)
	    }
	    default {
		set value {}
	    }
	}
	return $value
    }

    proc setDefaultOptions {OptionsName erase} {
	# If $erase, all options are set to their default.
	# Else, only the options that are not defined yet are set to
	# their defaults.
	# This makes it possible to add new options in new versions of pfm
	# without having to convert the .pfmrc file.
	# From version 1.0.4. on, this procedure does not call
	# pg_conndefaults anymore.

	upvar $OptionsName Options
	variable optionList

	foreach option $optionList {
	    if {![info exists Options($option)] || $erase} then {
		set Options($option) [getDefault $option]
	    }
	}
	return
    }

    proc saveOptions {} {

	variable pfmOptions
	variable optionList
	variable font
	global tcl_platform
	global env

	if {$tcl_platform(platform) eq {windows}} then {
	    set filename [file join $env(APPDATA) pfm pfm.conf]
	    set dirname [file join $env(APPDATA) pfm]
	    if {![file exists $dirname]} then {
		file mkdir $dirname
	    }
	} else {
	    set filename "~/.pfmrc"
	}
	set rcFile [open $filename w]
	foreach option $optionList {
	    puts $rcFile [list $option $pfmOptions($option)]
	}
	close $rcFile
	set font(fixed) "$pfmOptions(fontmonospace)"
	set font(fixbold) "$pfmOptions(fontmonospace) bold"
	set font(prop) "$pfmOptions(fontproportional)"
	set font(propbold) "$pfmOptions(fontproportional) bold"
	if {$tcl_platform(platform) eq {unix}} then {
	    set font(propsys) $font(propbold)
	    set font(fixsys) $font(fixbold)
	} else {
	    set font(propsys) $font(prop)
	    set font(fixsys) $font(fixed)
	}
	return
    }

    proc initOptions { } {

	variable pfmOptions
	variable font
	variable optionList
	global tcl_platform
	global env

	set optionList \
	    [list browser dblist dbname fontmonospace fontproportional host \
		 port printcmd printencoding psql tmpdir usePGPASSWORD user]
	if {$tcl_platform(platform) eq {windows}} then {
	    set filename [file join $env(APPDATA) pfm pfm.conf]
	} else {
	    set filename "~/.pfmrc"
	}
	if { [file exists $filename]} then {
	    set rcFile [open $filename r]
	    while {![eof $rcFile]} {
		set line [gets $rcFile]
		if {[string length $line] != 0} then {
		    set pfmOptions([lindex $line 0]) [lindex $line 1]
		}
	    }
	    close $rcFile
	    # Next lines make it possible to add new options in new versions of
	    # pfm without having to convert the .pfmrc file: all options not
	    # present in .pfmrc, are set to their default values.
	    setDefaultOptions pfmOptions 0
	    saveOptions
	} else {
	    setDefaultOptions pfmOptions 1
	    saveOptions
	}
	return
    }

    proc getOptionHelp {option} {
	variable ::pfm::installDir
	
	set fileName [file join $installDir doc help_${option}.txt]
	if {[catch {open $fileName r} helpChannel]} then {
	    set help {No help available}
	} else {
	    set help [read $helpChannel]
	    close $helpChannel
	}
	switch -- $option {
	    "fontmonospace" -
	    "fontproportional" {
		append help \
		    "\nThe following font families are available on your system:\n"
		foreach font [lsort [font families]] {
		    append help "\n$font"
		}
	    }
	    "printencoding" {
		append help \
		    "\nThe following character encodings are available on you system:\n"
		foreach charEncoding [lsort [encoding names]] {
		    append help "\n$charEncoding"
		}
	    }
	}
	return $help
    }

    proc cmdOptions {} {

	variable pfmOptions
	variable newOptions
	variable font
	variable optionList

	destroy .options
	toplevel .options -class Toplevel
	wm transient .options .
	set x [winfo pointerx .]
	set y [winfo pointery .]
	wm geometry .options +$x+$y
	wm minsize .options 1 1
	wm overrideredirect .options 0
	wm resizable .options 1 1
	wm title .options "pfm - Options"
	set rowidx 0
	foreach option $optionList {
	    set newOptions($option) $pfmOptions($option)
	    label .options.lb$option -text $option -font $font(propsys)
	    entry .options.ent$option -textvar ::options::newOptions($option) \
		-width 40 -background white -font $font(prop)
	    button .options.bn$option -text "? >>" -pady 0 -font $font(propsys) \
		-command "::options::cmdExpand $option .options.ent$option"
	    grid .options.lb$option -in .options -column 0 -row $rowidx \
		    -columnspan 1 -rowspan 1
	    grid .options.ent$option -in .options -column 1 -row $rowidx \
		    -columnspan 3 -rowspan 1
	    grid .options.bn$option -in .options -column 4 -row $rowidx \
		    -columnspan 1 -rowspan 1
	    incr rowidx
	}
	button .options.btnOK -text {OK} -font $font(propsys) \
	    -command [namespace code cmdOptionOK]
	button .options.btnCancel -text {Cancel} -font $font(propsys) \
	    -command [namespace code cmdOptionCancel]
	button .options.btnDefault -text {Defaults} -font $font(propsys) \
	    -command [namespace code \
			  {setDefaultOptions newOptions 1}]
	grid .options.btnOK -column 1 -row $rowidx -sticky we
	grid .options.btnDefault -column 2 -row $rowidx -sticky we
	grid .options.btnCancel -column 3 -row $rowidx -sticky we
	return
    }


    proc cmdExpand {option optionWidget} {
	variable wrapOn
	variable ::options::font

	set wrapOn 1
	destroy .options.expand
	toplevel .options.expand -class Toplevel
	wm transient .options.expand .options
	set x [expr [winfo pointerx .options] - 400]
	set y [expr [winfo pointery .options] - 100]
	wm geometry .options.expand 600x400+$x+$y
	wm title .options.expand "pfm - Option: $option"
	text .options.expand.text -background white -wrap word \
	    -font $font(fixed) \
	    -yscrollcommand {.options.expand.vsb set} \
	    -xscrollcommand {.options.expand.hsb set}
	scrollbar .options.expand.vsb -orient vertical -width 15 -command \
	    {.options.expand.text yview}
	scrollbar .options.expand.hsb -orient horizontal -width 15 -command \
	    {.options.expand.text xview}
	text .options.expand.help -background LightYellow2 -wrap word \
	    -font $font(fixed) \
	    -yscrollcommand {.options.expand.helpscroll set}
	.options.expand.help insert end "Help for option '$option':\n\n"
	set endIdx [.options.expand.help index "end -1 chars"]
	.options.expand.help tag add helpTitle 1.0 $endIdx
	.options.expand.help tag configure helpTitle -foreground {medium blue}
	.options.expand.help insert end [getOptionHelp $option]
	.options.expand.help configure -state disabled
	scrollbar .options.expand.helpscroll -orient vertical -width 15 \
	    -command {.options.expand.help yview}
	frame .options.expand.buttons
	button .options.expand.buttons.bnBrowse -text {Paste filename} \
	    -font $font(propsys) \
	    -command {
		.options.expand.text insert insert \
		    [file normalize \
			 [tk_getOpenFile -title {Paste filename} \
			      -parent .options.expand]]
	    }
	button .options.expand.buttons.bnDefault -text {Default} \
	    -font $font(propsys) \
	    -command "::options::cmdOneDefault $option"
	button .options.expand.buttons.bnOK -text {OK} -font $font(propsys) \
	    -command "::options::cmdExpandOK $optionWidget"
	radiobutton .options.expand.buttons.rbWrap -text {Wrap} -value 1 \
	    -variable ::options::wrapOn -font $font(propsys) \
	    -command {.options.expand.text configure -wrap word}
	radiobutton .options.expand.buttons.rbTruncate -text {Truncate} \
	    -value 0 \
	    -variable ::options::wrapOn -font $font(propsys) \
	    -command {.options.expand.text configure -wrap none}
	button .options.expand.buttons.bnCancel -text {Cancel} \
	    -font $font(propsys) \
	    -command {destroy .options.expand}
	place .options.expand.help -x 0 -y 0 -width -15 \
	    -relwidth 1 -relheight 0.4 -anchor nw
	place .options.expand.helpscroll -x 0 -y 0 \
	    -relheight 0.4 -relx 1 -anchor ne
	place .options.expand.text -x 0 -y 0 -width -15 -height -45 \
	    -rely 0.4 -relwidth 1 -relheight 0.6 -anchor nw
	place .options.expand.vsb -x 0 -y 0 -relx 1 -height -50 \
	    -rely 0.4 -relheight 0.6 -anchor ne
	place .options.expand.hsb -x 0 -y -30 -rely 1 -width -20 \
	    -relwidth 1 -anchor sw 
	place .options.expand.buttons -x 0 -y 0 -rely 1 -relwidth 1 \
	    -height 30 -anchor sw
	pack .options.expand.buttons.bnCancel -side right
	pack .options.expand.buttons.bnOK -side right
	pack .options.expand.buttons.bnBrowse -side right
	pack .options.expand.buttons.bnDefault -side right
	pack .options.expand.buttons.rbWrap -side left
	pack .options.expand.buttons.rbTruncate -side left
	.options.expand.text insert end [$optionWidget get]
	return
    }

    proc cmdOneDefault {option} {

	.options.expand.text delete 1.0 end
	.options.expand.text insert end [getDefault $option]
	return
    }

    proc cmdExpandOK { optionWidget} {

	$optionWidget delete 0 end
	$optionWidget insert 0 [.options.expand.text get 1.0 "end -1 chars"]
	destroy .options.expand
	return
    }

    proc cmdOptionOK {} {

	variable pfmOptions
	variable newOptions
	variable ::pfm::currentDB
	variable optionList
	destroy .options
	foreach option $optionList {
	    set pfmOptions($option) $newOptions($option)
	}
	saveOptions
	if {[info exists currentDB]} {
	    ::pfm::refreshFormsList
	}
	return
    }

    proc cmdOptionCancel {} {

	destroy .options
	return
    }

    proc addToDBlist {dbName} {
	variable pfmOptions

	if { [lsearch $pfmOptions(dblist) $dbName] == -1 } then {
	    lappend pfmOptions(dblist) $dbName
	    set pfmOptions(dblist) [lsort $pfmOptions(dblist)]
	}
	set pfmOptions(dbname) $dbName
	saveOptions
	return
    }


    ###############################################################
    # Main of namespace options                                   #
    ###############################################################

    initOptions


}

###############################################################
# End of namespace options                                    #
###############################################################


################################################################
#                                                              #
# Begin of namespace pfm                                       #
#                                                              #
################################################################

# widget is an associative array containing aliases for widget path names
#
# dbName is the name of the currently open data base. It is filled out
# by proc cmdOpenOK.
#
# passMatrix an associative array which is filled by readPgPass with the 
# contents of the ~/.pgpass file:
#      passMatrix($i,hostname) = hostname of $i-th entry in pgpass
#      passMatrix($i,port) = port of $i-th entry in pgpass
#      passMatrix($i,database) = database name of $i-th entry in pgpass
#      passMatrix($i,username) = username of $i-th entry in pgpass
#      passMatrix($i,password) = password of $i-th entry in pgpass
#
# psqlChannel the channel linked to the psql command pipeline. It is set
# in cmdOpenOK and unset in cmdCloseDataBase.
#
# currentDB contains the postgres data base handle for the open data base
# It is filled in by proc cmdOpenDataBase, and it is used throughout this
# application.
#
# formsArray contains all the tuples of pfm_form, where
# formsArray($name,$attribute) contains the value of attribute '$attribute'
# in the tuple of pfm_form for which name=$name. It is also filled by 
# refreshFormsList.
#
# formsIndex is an array for which formsIndex($n) contains the
# name of the form in the n-th form in the forms listbox. It is
# filled by refreshFormsList.
#
# connInfoList: the list of parameters for the conninfo in pg_connect.
#
# pfmMode can be either:
#
#    -  "normal": only the forms with showform = true are displayed;  or
#
#    -  "design": only the forms with showform = false are displayed.
#

namespace eval pfm {

    variable pfmVersion {1.2.1}
    variable API
    variable installDir
    variable currentDB
    variable psqlChannel
    variable errChannel
    variable formsArray
    variable formsIndex
    variable widget
    variable dbName
    variable pfmMode {normal}
    variable connInfoList
    variable passMatrix

    proc initRootWindow { } {

	variable widget
	variable ::options::font

	wm title . "pfm - No data base opened"
	wm geometry . 350x300

	# Cleanup by calling cmdExit no matter how user exits pfm.
	bind . <Destroy> ::pfm::cmdExit

	# Main menu
	menu .mainMenu -type menubar -tearoff 0 -font $font(propsys)
	.mainMenu add cascade -menu .mainMenu.database -label {Database}
	.mainMenu add cascade -menu .mainMenu.reports -label {Reports/Queries}
	.mainMenu add cascade -menu .mainMenu.tools -label {Tools}
	.mainMenu add cascade -menu .mainMenu.help -label {Help}

	# Database pull down menu
	menu .mainMenu.database -tearoff 0 -font $font(propsys)
	.mainMenu.database add command \
	    -command [namespace code {cmdOpenDataBase}] -label "Open ..."
	.mainMenu.database add command \
		-command [namespace code cmdCloseDataBase] -label Close 
	.mainMenu.database add command \
		-command [namespace code cmdExit] -label Exit

	# Reports/Queries pull down menu
	menu .mainMenu.reports -tearoff 0 -font $font(propsys)
	.mainMenu.reports add command \
	    -command {::report::cmdReportSQL sql} -label "Run SQL"
	.mainMenu.reports add command \
	    -command {::report::cmdReportSQL report} -label "Run report"

	# Tools pull down menu
	menu .mainMenu.tools -tearoff 0 -font $font(propsys)
	.mainMenu.tools add command \
		-command ::options::cmdOptions -label "Options"

	# Help menu
	menu .mainMenu.help -tearoff 0 -font $font(propsys)
	.mainMenu.help add command \
		-command ::help::cmdDisplayManual -label {Help file} 
	.mainMenu.help add command \
	    -command ::help::cmdLicense -label {License} 
	.mainMenu.help add command \
		-command [namespace code cmdAbout] -label About 
	. configure -menu .mainMenu

	radiobutton .rbNormal -text {Normal mode} -value {normal} \
	    -variable ::pfm::pfmMode -command ::pfm::refreshFormsList \
	    -state disabled -font $font(propsys)
	radiobutton .rbDesign -text {Design mode} -value {design} \
	    -variable ::pfm::pfmMode -command ::pfm::refreshFormsList \
	    -state disabled -font $font(propsys)
	label .lbList -text "List of forms" -font $font(propsys)
	listbox .lsbForms -width 50 -height 12 -font $font(propsys) \
	    -yscrollcommand {.vsb set} -background white
	scrollbar .vsb -orient vertical -width 15 \
	    -command {.lsbForms yview}
	set widget(lsbForms) .lsbForms
	button .btnOpen -font $font(propsys) \
		-command {::pfm::cmdOpenQuery} -padx 0 -text {Open form} -state disabled
	###################
	# SETTING GEOMETRY
	###################
 	place .rbNormal -x 0 -y 0 -relx 0.25 -anchor n
 	place .rbDesign -x 0 -y 0 -relx 0.75 -anchor n
 	place .lbList -x 0 -y 20 -relx 0.5 -anchor n
 	place .lsbForms -x 0 -y 40 -width -15 -relwidth 1 -height -70 \
 	    -relheight 1 -anchor nw
 	place .vsb -x 0 -y 40 -relx 1 -height -70 -relheight 1 -anchor ne
 	place .btnOpen -x 0 -y 0 -relx 0.5 -rely 1 -relwidth 1 -anchor s
	return
    }

    proc cmdAbout {} {
	variable ::pfm::installDir
	variable API
	variable pfmVersion

	set aboutMsg \
	    "Postgres Forms (pfm) Version $pfmVersion. Copyright (C)"
	append aboutMsg \
	    " Willem Herremans 2004\n\nPostgres Forms comes with ABSOLUTELY NO WARRANTY;"
	append aboutMsg \
	    " see 'Help -> License' for details."
	append aboutMsg \
	    "\n\nThis is free software, and you are welcome to redistribute it under"
	append aboutMsg " certain conditions; see 'Help -> License' for details."
        append aboutMsg "\n\n$API"
	append aboutMsg "\n\npfm is installed in $installDir"
	::pfm::pfmDialog .about "pfm - About" $aboutMsg 400 0 "OK"
	return
    }


    proc cmdOpenDataBase { } {
	# Let the user specify a data base to open

	variable ::options::pfmOptions
	variable ::options::font
	variable connInfoList
	variable currentDB
	variable dbName
	if { [string equal -nocase -length 1 $pfmOptions(usePGPASSWORD) y] } then {
	    set connInfoList {host port user password}
	    # The password will be prompted for and stored in PGPASSWORD.
	} else {
	    set connInfoList {host port user}
	    # The password will not be prompted for. A properly configured
	    # ~/.pgpass file is required.
	}
	if { ![info exists currentDB]} then {
	    set dbName $pfmOptions(dbname)
	    destroy .opendb
	    toplevel .opendb -class Toplevel
	    wm transient .opendb .
	    set x [winfo pointerx .]
	    set y [winfo pointery .]
	    # wm geometry .opendb 350x210+$x+$y
	    wm geometry .opendb +$x+$y
	    wm title .opendb "pfm - Open data base"
	    set rowidx 0
	    foreach connItem $connInfoList {
		if { [info exists pfmOptions($connItem)] } then {
		    set connInfo $pfmOptions($connItem)
		} else {
		    set connInfo {}
		}
		label .opendb.lbl$connItem -text $connItem -font $font(propsys)
		entry .opendb.val$connItem -width 30 -background white \
		    -font $font(prop)
		if { [string equal $connItem {password}] } then {
		    .opendb.val$connItem configure -show *
		}
		grid .opendb.lbl$connItem -in .opendb -row $rowidx -column 0 \
			-rowspan 1 -columnspan 1
		grid .opendb.val$connItem -in .opendb -row $rowidx -column 1 \
			-rowspan 1 -columnspan 3 -sticky {we}
		.opendb.val$connItem insert end $connInfo
		incr rowidx
	    }
	    label .opendb.lbldbname -text {dbname} -font $font(propsys)
	    grid .opendb.lbldbname -in .opendb -row $rowidx -column 0 \
		-rowspan 1 -columnspan 1
	    entry .opendb.valdbname -width 30 -background white \
		-textvariable ::pfm::dbName -font $font(prop)
	    button .opendb.btndbname -image ::img::down \
		-command ::pfm::cmdSelectDB
	    grid .opendb.valdbname -in .opendb -row $rowidx -column 1 \
		-rowspan 1 -columnspan 2
	    grid .opendb.btndbname -in .opendb -row $rowidx -column 3 \
		-rowspan 1 -columnspan 1
	    button .opendb.btnOK -text OK -font $font(propsys) \
		-command {::pfm::cmdOpenOK}
	    button .opendb.btnCancel -text Cancel -font $font(propsys) \
		-command {::pfm::cmdOpenCancel}
	    incr rowidx
	    grid .opendb.btnOK -column 1 -row $rowidx -sticky we
	    grid .opendb.btnCancel -column 2 -row $rowidx -sticky we
	    # place .opendb.btnOK -relx 0.3 -rely 1 -y {-5} -anchor s
	    # place .opendb.btnCancel -relx 0.6 -rely 1 -y {-5} -anchor s
	} else {
	    tk_messageBox -message "First close data base $dbName" -type ok \
		-icon info -parent .
	}
	return
    }

    proc cmdSelectDB {} {
	variable ::options::pfmOptions
	variable dbName
	variable ::options::font

	destroy .opendb.selectDB
	toplevel .opendb.selectDB -class Toplevel
	wm transient .opendb.selectDB .opendb
	set x [expr [winfo pointerx .opendb] - 200]
	set y [winfo pointery .opendb]
	wm geometry .opendb.selectDB 250x200+$x+$y
	wm title .opendb "pfm - Select database"
	listbox .opendb.selectDB.lsb -font $font(propsys) -background white \
	    -yscrollcommand {.opendb.selectDB.vsb set}
	scrollbar .opendb.selectDB.vsb -orient vertical -width 15 \
	    -command {.opendb.selectDB.lsb yview}
	place .opendb.selectDB.lsb -x 0 -y 0 -width -15 -relwidth 1 -relheight 1
	place .opendb.selectDB.vsb -x 0 -y 0 -relheight 1 -relx 1 -anchor ne
	foreach item $pfmOptions(dblist) {
	    .opendb.selectDB.lsb insert end $item
	}
	bind .opendb.selectDB.lsb <<ListboxSelect>> {
	    set ::pfm::dbName [lindex $::options::pfmOptions(dblist) \
			    [.opendb.selectDB.lsb curselection]]
	    destroy .opendb.selectDB
	}
	return
    }

    proc cmdOpenOK {} {
	global env
	variable connInfoList
	variable currentDB
	variable dbName
	variable ::options::pfmOptions

	set env(PGCLIENTENCODING) "UNICODE"
	set connInfo {}
	lappend connInfo "dbname = '$dbName'"
	set dbHost {}
	set dbPort {}
	set dbUser {}
	set dbPassword {}
	foreach connItem $connInfoList {
	    set connItemValue [.opendb.val$connItem get]
	    if { ![string equal $connItemValue {}] } then {
		lappend connInfo "$connItem = $connItemValue"
	    }
	    switch $connItem {
		host {
		    set dbHost $connItemValue
		}
		port {
		    set dbPort $connItemValue
		}
		user {
		    set dbUser $connItemValue
		}
		password {
		    set dbPassword $connItemValue
		}
	    }
	}
	if { [string equal -nocase -length 1 $pfmOptions(usePGPASSWORD) n] } then {
	    # Get password from ~/.pgpass
	    # Pgtcl is able to read the .pgpass file, but pgin.tcl is not.
	    # That is why pfm reads it.
	    set dbPassword [findPassword $dbHost $dbPort $dbName $dbUser]
	    if { $dbPassword ne {} } then {
		lappend connInfo "password = $dbPassword"
	    }
	}
	set connInfo [join $connInfo]
	if { [catch {set currentDB [pg_connect -conninfo $connInfo]} errorMsg]} then {
	    # Database could not be opened for some reason.
	    tk_messageBox -message $errorMsg -type ok -icon error -parent .opendb
	} else {
	    openPsql $dbName $dbHost $dbPort $dbUser $dbPassword
	    destroy .opendb
	    wm title . "pfm - Database : $dbName"
	    if { [pfmInstalled] } then {
		refreshFormsList
	    }
	    .btnOpen configure -state normal
	    .rbNormal configure -state normal
	    .rbDesign configure -state normal
	    ::options::addToDBlist $dbName
	}
	return
    }

    proc openPsql {dbName dbHost dbPort dbUser dbPassword} {
	variable psqlChannel
	variable errChannel
	global env
	variable ::options::pfmOptions

	if { [info exists psqlChannel] } then {
	    close $psqlChannel
	    unset psqlChannel
	}
	set openCommand "|"
	lappend openCommand $pfmOptions(psql)
	lappend openCommand {--echo-queries}
	if { ![string equal $dbName {}] } then {
	    lappend openCommand "--dbname"
	    lappend openCommand $dbName
	}
	if { ![string equal $dbHost {}] } then {
	    lappend openCommand "--host"
	    lappend openCommand $dbHost
	}
	if { ![string equal $dbPort {}] } then {
	    lappend openCommand "--port"
	    lappend openCommand $dbPort
	}
	if { ![string equal $dbUser {}] } then {
	    lappend openCommand "--username"
	    lappend openCommand $dbUser
	}
	if { [string equal -nocase -length 1 $pfmOptions(usePGPASSWORD) y] } then {
	    set env(PGPASSWORD) $dbPassword
	}
	lappend openCommand "2>@$errChannel"
	# Connecting to psql.
	if { [catch { open $openCommand RDWR } psqlChannel] } then {
	    # For security reasons, the PGPASSWORD environment variable is cleared.
	    if { [string equal -nocase -length 1 $pfmOptions(usePGPASSWORD) y] } then {
		unset env(PGPASSWORD)
	    }
	    tk_messageBox -message $psqlChannel -type ok -icon error -parent .opendb
	    unset psqlChannel
	} else {
	    # For security reasons, the PGPASSWORD environment variable is cleared.
	    if { [string equal -nocase -length 1 $pfmOptions(usePGPASSWORD) y] } then {
		unset env(PGPASSWORD)
	    }
	    # When openeing a database, pfm puts the environment variable 
	    # PGCLIENTENCODING UNICODE, which means in fact utf-8 (see
	    # chapter '20.2 Character set support' of PostgreSQL documentation.
	    # The next statement puts the command pipeline to utf-8 as well.
	    fconfigure $psqlChannel -encoding utf-8
	    fileevent $psqlChannel readable ::report::showResult
	}
	return
    }

    proc readPgPass { } {
	variable passMatrix
	global tcl_platform
	global env

	# This procedure reads the ~/.pgpass file if it exists and if it
	# has the right permissions (00600, i.e. rw for owner only).
	# It parses this file and stores the result in passMatrix.
	# This procedure supports the backslash escape for : and backslash.
	# backslash backslash is read as backslash
	# backslash ':' is read as ':' and not interpreted as entry separator
	# backslash 'anything else' is read as 'anything else'
	#                                      (i.e. backslash is dropped)
	# ':' is interpreted as entry separator

	# On Windows platforms, the pgpass file is
	# %APPDATA%\postgresql\pgpass.conf

	set seqnr 0
	if {$tcl_platform(platform) eq {windows}} then {
	    set filename [file join $env(APPDATA) postgresql pgpass.conf]
	} else {
	    set filename "~/.pgpass"
	}
	if { [file exists $filename] } then {
	    if {$tcl_platform(platform) eq {unix}} then {
	        set filePermission [file attributes $filename -permissions]
	        set first [expr [string length $filePermission] - 3]
	        set filePermission [string range $filePermission $first end]
	    } else {
	        set filePermission "600"
	    }
	    if { $filePermission ne "600" } then {
		set map {0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx}
		set filePermission [string map $map $filePermission]
		set errMsg "The permissions on ~/.pgpass are '$filePermission'."
		set errMsg "$errMsg\nThey should be 'rw-------'"
		tk_messageBox -type ok -icon error -message $errMsg -parent .opendb
	    } else {
		if { [catch {open $filename r} pgPass ] } then {
		    tk_messageBox -type ok -icon error -message $pgPass \
			-parent .opendb
		} else {
		    set argList {hostname port database username password}
		    while { ![eof $pgPass] } {
			if {[gets $pgPass current_line] > 0} then {
			    incr seqnr
			    foreach name $argList {
				set passMatrix($seqnr,$name) {}
			    }
			    set arg {}
			    set argNr 0
			    set last [expr [string length $current_line] - 1]
			    for {set i 0} {$i <= $last} {incr i} {
				set curChar [string index $current_line $i]
				switch -- $curChar {
				    "\\" {
					# This is the way to write 1 backslash:
					# NOT with curly braces.
					# Skip the backslash and copy the next character
					incr i
					append arg [string index $current_line $i]
				    }
				    ":" {
					# end of an arg
					set name [lindex $argList $argNr]
					if {$name ne {}} then {
					    set passMatrix($seqnr,$name) $arg
					}
					# puts "$seqnr, $name : $arg"
					set arg {}
					incr argNr
				    }
				    default {
					# just copy the character
					append arg $curChar
				    }
				}
			    }
			    # We are at end of line. Just copy the last arg.
			    set name [lindex $argList $argNr]
			    if {$name ne {}} then {
				set passMatrix($seqnr,$name) $arg
			    }
			    # puts "$seqnr, $name : $arg"
			    set arg {}
			    incr argNr
			}
		    }
		    close $pgPass
		}
	    }
	}
	return $seqnr
    }

    proc findPassword {hostname port database username} {
	variable passMatrix

	# This procedure tries to get the password from ~/.pgpass
	# It returns the found password. If it does not find
	# a password, it returns the empty string.

	set nr_of_lines [readPgPass]
	set found 0
	set password {}
	for {set seqnr 1} {($seqnr <= $nr_of_lines) && (!$found)} {incr seqnr} {
	    if { ([string equal $hostname $passMatrix($seqnr,hostname)] || \
		      [string equal {*} $passMatrix($seqnr,hostname)]) && \
		     ([string equal $port $passMatrix($seqnr,port)] || \
			  [string equal {*} $passMatrix($seqnr,port)]) && \
		     ([string equal $database $passMatrix($seqnr,database)] || \
			  [string equal {*} $passMatrix($seqnr,database)]) && \
		     ([string equal $username $passMatrix($seqnr,username)] || \
			  [string equal {*} $passMatrix($seqnr,username)]) } then {
		set found 1
		set password $passMatrix($seqnr,password)
	    }
	}
	array unset passMatrix
	return $password
    }



    proc cmdOpenCancel {} {

	destroy .opendb
	return
    }

    proc cmdCloseDataBase {} {
	#Close data base that is currently open

	variable currentDB
	variable dbName
	variable formsArray
	variable widget
	variable psqlChannel

	if { [info exists currentDB] } then {
	    pg_disconnect $currentDB
	    unset currentDB
	}
	if { [info exists psqlChannel] } then {
	    if { [catch {close $psqlChannel} errMsg] } then {
		tk_messageBox -message $errMsg -type ok -icon error -parent .
	    }
	    unset psqlChannel
	}
	array unset formsArray
	$widget(lsbForms) delete 0 end
	$widget(lsbForms) see 0
	wm title . "pfm - No data base opened"
	.btnOpen configure -state disabled
	.rbNormal configure -state disabled
	.rbDesign configure -state disabled
	destroy .form
	destroy .query
	destroy .report
	return
    }

    proc cmdExit {} {

	variable currentDB
	variable ::options::pfmOptions

	if {[info exists currentDB]} {
	    cmdCloseDataBase
	}
	# remove temporary files of this session
	set tmpFile [file join $pfmOptions(tmpdir) "pfm_$pfmOptions(user)_[pid].sql"]
	if {[file exists $tmpFile]} then {
	    catch {file delete $tmpFile}
	}
	set tmpFile [file join $pfmOptions(tmpdir) "pfm_$pfmOptions(user)_[pid].txt"]
	if {[file exists $tmpFile]} then {
	    catch {file delete $tmpFile}
	}
	exit
    }

    proc refreshFormsList {} {

	variable currentDB
	variable ::options::pfmOptions
	variable formsArray
	variable formsIndex
	variable widget
	variable pfmMode

	array unset formsArray
	array unset formsIndex
	switch $pfmMode {
	    design {
		set sqlwhere "WHERE showform='f'"
	    }
	    normal -
	    default {
		set sqlwhere "WHERE showform='t'"
	    }
	}
	set formQuery "SELECT name,tablename,pkey,showform,view,sqlselect,sqlfrom,groupby"
	append formQuery " FROM pfm_form $sqlwhere ORDER BY name"
	set resQuery [pg_exec $currentDB $formQuery]
	pg_result $resQuery -assignbyidx formsArray
	set lastTuple [expr [pg_result $resQuery -numTuples] -1]
	$widget(lsbForms) delete 0 end
	set listIndex 0
	for {set tupleNr 0} {$tupleNr <= $lastTuple} {incr tupleNr} {
	    set tuple [pg_result $resQuery -getTuple $tupleNr]
	    $widget(lsbForms) insert end [lindex $tuple 0]
	    set formsIndex($listIndex) [lindex $tuple 0]
	    incr listIndex
	}
	foreach index [array names formsIndex] {
	    set form $formsIndex($index)
	    if {$formsArray($form,pkey) eq {}} then {
		set formsArray($form,view) {t}
	    }
	}
	pg_result $resQuery -clear
	$widget(lsbForms) selection clear 0 end
	$widget(lsbForms) selection set 0 0
	$widget(lsbForms) see 0
	return
    }


    proc installPfm {} {

	variable installDir
	variable currentDB

	set proceed [tk_messageBox -message "Install pfm-* tables?" -type yesno \
			-icon question -parent .]
	if { [string equal $proceed "yes"] } then {
	    ::report::cmdReportSQL {sql}
	    set fileName [file join $installDir install_pfm.sql]
	    if { ![file exists $fileName] } then {
		set errMsg "$fileName does not exist!"
		tk_messageBox -message $errMsg -icon error -type ok -parent .report
		set installed 0
	    } else {
		.report.fmSQL.text delete 1.0 end
		set convertedFile [::report::ConvertToUTF-8 $fileName]
		if {$convertedFile ne {}} then {
		    .report.fmSQL.text insert end "\\i '$convertedFile'"
		    set msgInfo "The pfm_* tables will be installed."
		    append msgInfo "\nPlease, check the output that will be generated."
		    append msgInfo "\nThen close window \"Reports and Queries\"."
		    tk_messageBox -message $msgInfo -type ok -icon info -parent .report
		    ::report::cmdRunSQL
		    tkwait window .report
		    set installed 1
		} else {
		    set installed 0
		}
	    }
	} else {
	    set installed 0
	}
	return $installed
    }


    proc pfmInstalled {} {

	variable currentDB
	variable pfmVersion

	set queryDef {
	    SELECT COUNT(*) AS pfm_exists FROM pg_tables WHERE
	    tablename IN ('pfm_form','pfm_attribute','pfm_value','pfm_value_list',
			  'pfm_link','pfm_report','pfm_section')
	}
	set queryRes [pg_exec $currentDB $queryDef]
	set nrInstalled [lindex [pg_result $queryRes -getTuple 0] 0]
	pg_result $queryRes -clear
	if { $nrInstalled == 0} then {
	    set installed [installPfm]
	} else {
	    set installed 1
	}
	if { $installed } then {
	    set queryDef {SELECT version FROM pfm_version ORDER BY seqnr DESC}
	    set queryRes [pg_exec $currentDB $queryDef]
	    set status [pg_result $queryRes -status]
	    if { [string equal $status "PGRES_TUPLES_OK"] } then {
		set numTuples [pg_result $queryRes -numTuples]
		if { $numTuples > 0 } then {
		    pg_result $queryRes -assign versionArray
		    set DBversion $versionArray(0,version)
		} else {
		    set msgWarn "pfm_version exists, but contains no data."
		    append msgWarn "\npfm allows you to open this database,"
		    append msgWarn "\nbut it is an indication that the pfm_* tables"
		    append msgWarn "\nare not properly installed."
		    tk_messageBox -message $msgWarn -type ok -icon warning -parent .
		    # We assume that no conversion is needed.
		    set DBversion $pfmVersion
		}
	    } else {
		# Older versions of pfm did not record version in the database.
		set DBversion "1.0.4"
	    }
	    pg_result $queryRes -clear
	    switch -- [versionCompare $pfmVersion $DBversion] {
		1 {
		    # pfm version is newer than database version
		    set installed [convertDB $DBversion]
		}
		0 {
		    # pfm version = database version, no action required
		}
		-1 {
		    # pfm version is older than database version
		    set msgWarn "This database was made with version $DBversion of pfm."
		    append msgWarn "\nThis version of pfm ($pfmVersion) may not be able"
		    append msgWarn " to read the pfm_* tables."
		    tk_messageBox -type ok -icon warning -message $msgWarn -parent .
		}
	    }
	}
	return $installed
    }

    proc versionCompare {v1 v2} {

	set v1List [split $v1 "."]
	set v2List [split $v2 "."]
	set result 0
	for {set i 0} {($i <= 2) && ($result == 0)} {incr i} {
	    if {[lindex $v1List $i] < [lindex $v2List $i]} then {
		set result -1
	    } else {
		if {[lindex $v1List $i] > [lindex $v2List $i]} then {
		    set result 1
		}
	    }
	}
	return $result
    }

    proc convertDB { DBversion } {
       	variable installDir
	variable pfmVersion
	variable currentDB

	set proceed [tk_messageBox \
		-message "Convert pfm-* tables to format of version $pfmVersion?" \
		-type yesno -icon question -parent .]
	if { [string equal $proceed "yes"] } then {
	    switch $DBversion {
		{1.0.4} {
		    set converted [specialConversion {1.0.4} {1.1.0}]
		    set converted [specialConversion {1.1.0} {1.2.1}]
		}
		{1.1.0} -
		{1.1.1} {
		    set converted [specialConversion {1.1.0} {1.2.1}]
		}
		default {
		    # Normally only a new record is inserted in pfm_version.
		    set queryDef \
			"INSERT INTO pfm_version (version, \"date\", comment)"
		    append queryDef \
			"\nVALUES ('$pfmVersion', CURRENT_DATE, 'no conversion')"
		    set queryRes [pg_exec $currentDB $queryDef]
		    if { [pg_result $queryRes -status] == "PGRES_COMMAND_OK" } then {
			set converted 1
		    } else {
			set converted 0
			set infoMsg "$queryDef\n[pg_result $queryRes -error]"
			tk_messageBox -message $infoMsg -type ok -icon error \
			    -parent .
		    }
		    pg_result $queryRes -clear
		}
	    }
	} else {
	    set converted 0
	}
	return $converted
    }

    proc specialConversion {DBversion toVersion} {
       	variable installDir
	variable pfmVersion
	variable currentDB

	# When this procedure is called, the file 
	# '$installDir/convert_from_$DBversion.sql' should exist.

	::report::cmdReportSQL {sql}
	set fileName [file join $installDir convert_from_$DBversion.sql]
	if {![file exists $fileName]} then {
	    set errMsg "$fileName does not exist!"
	    tk_messageBox -message $errMsg -icon error -type ok -parent .report
	    set converted 0
	} else {
	    .report.fmSQL.text delete 1.0 end
	    set convertedFile [::report::ConvertToUTF-8 $fileName]
	    if {$convertedFile ne {}} then {
		.report.fmSQL.text insert end "\\i '$convertedFile'"
		set msgInfo "The database will be converted to $toVersion."
		append msgInfo "\nPlease, check the output that will be generated."
		append msgInfo "\nThen close window \"Reports and Queries\"."
		tk_messageBox -message $msgInfo -type ok -icon info -parent .report
		::report::cmdRunSQL
		tkwait window .report
		set converted 1
	    } else {
		set converted 0
	    }
	}
	return $converted
    }
    

    proc cmdOpenQuery {} {
	variable formsIndex
	variable widget
	set formNr [$widget(lsbForms) curselection]
        if { $formNr == {} } then {
            set formNr 0
        }
        set formName $formsIndex($formNr)
	::form::OpenQuery $formName 1
	return
    }

    proc defineEditMenu {} {
	variable ::options::font
	
	menu .mnEdit -tearoff 0 -font $font(propsys)
	.mnEdit add command \
	    -command {::pfm::cmdEditCopy} -label Copy
	.mnEdit add command \
	    -command {::pfm::cmdEditCut} -label Cut
	.mnEdit add command \
	    -command {::pfm::cmdEditPaste} -label Paste
	# Entry and Text are class names. They refer to all entry and text widgets.
	bind Entry <ButtonPress-3> ::pfm::popUpEditMenu
	bind Text <ButtonPress-3> ::pfm::popUpEditMenu
    }

    proc popUpEditMenu {} {

	# Set focus to the widget on which button 3 (right button) is pressed.
	set x [winfo pointerx .]
	set y [winfo pointery .]
	set widget [winfo containing -displayof . $x $y]
	focus $widget
	if {[selection own -displayof . -selection PRIMARY] ne $widget ||
	    [catch {selection get -displayof . -selection PRIMARY \
			-type STRING}]} then {
	    # The widget does not own the selection or there is no selection
	    # in the widget
	    .mnEdit entryconfigure 0 -state disabled
	    .mnEdit entryconfigure 1 -state disabled
	} else {
	    .mnEdit entryconfigure 0 -state normal
	    if {[$widget cget -state] eq {normal}} then {
		.mnEdit entryconfigure 1 -state normal
	    } else {
		.mnEdit entryconfigure 1 -state disabled
	    }
	}
	if {[catch {clipboard get -displayof . -type STRING}]} then {
	    .mnEdit entryconfigure 2 -state disabled
	} else {
	    if {[$widget cget -state] eq {normal}} then {
		.mnEdit entryconfigure 2 -state normal
	    } else {
		.mnEdit entryconfigure 2 -state disabled
	    }
	}
	tk_popup .mnEdit $x $y
	return
    }

    proc cmdEditCopy {} {

	clipboard clear -displayof .
	clipboard append -displayof . -format STRING -type STRING -- \
	    [selection get -displayof . -selection PRIMARY -type STRING]
	selection clear -displayof . -selection PRIMARY
	return
    }
 
    proc cmdEditCut {} {

	# selection own -selection PRIMARY $widget
	clipboard clear -displayof .
	clipboard append -displayof . -format STRING -type STRING -- \
	    [selection get -displayof . -selection PRIMARY -type STRING]
	set widget [focus -displayof .]
	$widget delete sel.first sel.last
	selection clear -displayof . -selection PRIMARY
	return
    }
    
    proc cmdEditPaste {} {
	set widget [focus -displayof .]
	$widget insert insert [clipboard get -displayof . -type STRING]
	return
    }

    proc pfmDialog {widget title message msgWidth defaultButton buttonList} {
	variable ::options::font
	variable ::pfm::dialogChoice

	destroy $widget
	toplevel $widget
	set x [winfo pointerx [winfo parent $widget]]
	set y [winfo pointery [winfo parent $widget]]
	wm transient $widget [winfo parent $widget]
	wm geometry $widget +$x+$y
	wm title $widget $title
	message $widget.message -font $font(propsys) -width $msgWidth -justify left \
	    -text $message
	set lastButton [expr [llength $buttonList] - 1]
	grid ${widget}.message -row 0 -column 0 -columnspan [expr $lastButton + 1]
	for {set button 0} {$button <= $lastButton} {incr button} {
	    button ${widget}.button${button} -font $font(propsys) \
		-text [lindex $buttonList $button] \
		-command "set ::pfm::dialogChoice $button
                          destroy $widget"
	    grid ${widget}.button${button} -row 1 -column $button
	}
	focus ${widget}.button${defaultButton}
	tkwait window $widget
	return $dialogChoice
    }

    #########################################################
    # Main of namespace pfm                                 #
    #########################################################

    if { $argc == 0 } then {
	set installDir [file normalize [pwd]]
    } else {
	set installDir [lindex $argv 0]
    }
    initRootWindow
    defineEditMenu

    # Init errChannel. This the channel to which stderr of psql is redirected.

    switch -- $tcl_platform(platform) {
	"unix" {
	    set tclkit [file join $installDir tclkit tclkit]
	}
	"windows" {
	    # Cat does not require Tk. Hence it is better to use tclkitsh
	    # for faster start up.
	    set tclkit [file join $installDir tclkit tclkitsh.exe]
	}
    }
    set cat [file join $installDir "cat.kit"]
    set openCommand "|"
    lappend openCommand $tclkit
    lappend openCommand $cat
    if {[catch {open $openCommand RDWR} errChannel]} then {
	tk_messageBox -type ok -icon error -message $errChannel
    } else {
	fconfigure $errChannel -encoding utf-8
	fileevent $errChannel readable ::report::showError
    }

}

#############################################################################
# end of namespace pfm                                                      #
#############################################################################

#############################################################################
# begin of namespace help                                                   #
#############################################################################
#

namespace eval help {

    proc cmdDisplayManual {} {

	variable ::pfm::installDir
	variable ::options::pfmOptions
	global tcl_platform
	
	set url "file://$installDir/doc/help.html"
	set command {exec}
	set map {%s}
	lappend map $url
	foreach arg $pfmOptions(browser) {
		lappend command [string map $map $arg]
	}
	if {$tcl_platform(platform) eq {windows}} then {
	    lappend command {&}
	}
	# puts $command
	if { [catch $command errMsg]} then {
	    tk_messageBox -type ok -icon error -parent . \
		-message "$command failed\n$errMsg"
	}
	return
    }


    proc cmdLicense {} {

	variable ::pfm::installDir
	variable ::options::font

	if { [catch { open $installDir/doc/gpl.txt } license_ch] } then {
	    fileNotFound {license} $license_ch
	} else {
	    toplevel .license -class Toplevel
	    wm geometry .license 600x600
	    wm title .license "pfm - License"
	    label .license.lbl \
		-text {GNU GENERAL PUBLIC LICENSE - Version 2, June 1991} \
		-font $font(propsys)
	    text .license.txt -background white -font $font(fixed) \
		-yscrollcommand {.license.vsb set}
	    scrollbar .license.vsb -orient vertical -width 15 \
		-command {.license.txt yview}
	    button .license.bnOK -command {destroy .license} -text {OK} \
		-font $font(propsys)
	    place .license.lbl -x 0 -y 0 -relx 0.5 -anchor n
	    place .license.txt -x 0 -y 20 -width -15 -anchor nw \
		-relwidth 1 -relheight 1 -height {-50}
	    place .license.vsb -x 0 -y 20 -relx 1 -height -50 -relheight 1 -anchor ne
	    place .license.bnOK -x 0 -y 0 -relx 0.5 -rely 1 -anchor s
	    set license_ch [open $installDir/doc/gpl.txt]
	    set license_text [read $license_ch]
	    close $license_ch
	    .license.txt insert end $license_text
	}
	return
    }

    proc fileNotFound {what reason} {

	switch $what {
	    help {
		set msgText "Normally you should see the help file now, but $reason"
	    }
	    license {
		set msgText "Normally you should see the GNU General Public License now, but $reason"
	    }
	    default {
		set msgText $reason
	    }
	}
	tk_messageBox -message $msgText -type ok -icon error
	return
    }

}
######################################################################
# End of namespace help                                              #
######################################################################

######################################################################
# Begin of namespace form                                            #
######################################################################

# activeForm contains the name of the currently opened form.
# It is filled by several procedures:
#     1. OpenQuery
#     2. cmdFollowLink
#     3. cmdBack
#
# formAttribList contains the list of attributes of the active form,
# as defined in data base table pfm_attributes.
#
# attributeArray contains the complete attributes defintion of the
# active form as defined by pfm_attributes.
#
# tableAttribList contains only the attributes that are not "tgReadOnly".
# The purpose is to include only the attributes of the table referred
# to by pfm_form.tablename.
#
# formAttribList, tableAttribList and attributeArray are filled by 
# proc getAttributes.
#
# getAttributes is called by:
#     1. OpenQuery
#     2. cmdFollowLink
#     3. cmdBack
#
# WhereSelected is a boolean which indicates whether the user is
# pasting into the "where" or into the "order by" text entry
# of the query. Its value is controlled by the radio buttons
# on the query window.
#
# recordArray contains all the records selected by the query defined
# by the user in the query window. recordArray($tupleNr,$attribute)
# indicates the value of $attribute of $tupleNr. It is filled
# by proc OpenForm. It is the so called "internal buffer".
# On top of the attribute values, recordArray also contains
# a status for each record: recordArray($tupleNr,23status47)
# contains the status the record indicated by $tupleNr. The
# status can be : "Not modified", "Updated", "Deleted", "Added",
# "After last", "Not added", "Updating", "Adding". 
# The attribute name "23status47" has been chosen
# to avoid name conflicts with real table attributes.
#
# lastRecord is the tupleNr of the last tuple in recordArray. This
# is in fact a dummy, empty record, functioning as a sentinel.
#
# curRecord is the tupleNr of the record that is currently displayed
# on the screen.
#
# txtRecord is the textvar linked to the attribute labels,
# entries or buttons on the form. When the current record
# is displayed, the values of recordArray($curRecord,$attribute)
# are copied to txtRecord($attribute).
#
# formStack contains the subsequent queries issued by the user
# as a result of following links. lastFormOnStack is a stack
# pointer on this stack. The first query is pushed on the stack
# by proc cmdExecuteQuery. If the user clicks on a link button
# another query is pushed on the stack by proc cmdFollowLink.
# Any time the user presses back, a query defintion is popped
# of the stack. The elements that are kept on the stack are:
#     formId
#     queryDef
#     intro (the information displayed on top of the form)
#     displayKey (the list of pkey attribute values of the record 
#                 that was displayed at
#                 the time a link button was pressed and which
#                 is displayed again when the user presses "Back")
#
# linksArray is loaded with all the links originating from the
# active form. It is filled by proc displayLinks, which is called
# from OpenForm. Its structure is linksArray($link,$attribute)
# where $link is an index for the link (starting from 0) and
# where $attribute is any attribute of pfm_link.
#
# widget is an array containing aliases for some widget
# path names
#

namespace eval form {
    variable activeForm
    variable formState
    variable formAttribList
    variable tableAttribList
    variable attributeArray
    variable WhereSelected
    variable queryWhere
    variable queryOrderBy
    variable lastRecord
    variable recordArray
    variable curRecord
    variable txtRecord
    variable formStack
    variable lastFormOnStack
    variable linksArray
    variable widget
    variable windowSize

    #############################################################
    # Procedures that are called from the corresponding cmdXXX  #
    # procedures in namespace pfm                               #    
    #############################################################


    proc OpenQuery {formName clear} {

	variable ::pfm::formsArray
	variable activeForm
	variable WhereSelected
	variable queryWhere
	variable queryOrderBy
	variable formAttribList
	variable attributeArray
	variable widget

	set WhereSelected true
	if {$clear} then {
	    set queryWhere {}
	    set queryOrderBy {}
	}
	set activeForm $formName
	showQueryWindow
	wm title .query "pfm - Query : $formName"
	$widget(lbSelect) insert end \
	    "SELECT $formsArray($activeForm,sqlselect)\nFROM $formsArray($activeForm,sqlfrom)"
	if { ![string equal $formsArray($activeForm,groupby) {}] } then {
	    $widget(lbSelect) insert end \
		"\nGROUP BY $formsArray($activeForm,groupby)"
	}
	getAttributes $activeForm
	displayAttribButtons
	return
    }

    proc displayAttribButtons {} {
	variable ::pfm::formsArray
	variable formAttribList
	variable attributeArray
	variable widget
	variable ::options::font

	destroy .query.canvas
	destroy .query.vscroll
	canvas .query.canvas -yscrollcommand {.query.vscroll set} \
	    -relief sunken -borderwidth 2
	scrollbar .query.vscroll -orient vertical -width 15 \
	    -command {.query.canvas yview}
	frame .query.canvas.frmAttributes
	set widget(attributes) .query.canvas.frmAttributes
	place .query.canvas  -x 105 -y 164 -width {-127} -relwidth 1 \
	    -height {-194} -relheight 1 -anchor nw
	place .query.vscroll -x 0 -y 164 -relx 1 -height {-194} -relheight 1 \
	    -anchor ne
	.query.canvas create window 20 20 -window .query.canvas.frmAttributes \
	    -anchor nw
	label $widget(attributes).lblAttributes -text {Attributes} -relief flat \
	    -font $font(propsys)
	label $widget(attributes).lblValues -text {Values} -relief flat \
	    -font $font(propsys)
	grid $widget(attributes).lblAttributes -column 0 \
	    -row 0 -columnspan 1 -rowspan 1
	grid $widget(attributes).lblValues -column 1 \
	    -row 0 -columnspan 1 -rowspan 1
	set rowidx 1
	foreach attribute $formAttribList {
	    button $widget(attributes).btn$attribute -text $attribute -pady 0 \
		-anchor w -font $font(propsys) \
		-command "::form::cmdPasteAttribute $attribute"
	    grid $widget(attributes).btn$attribute -column 0 \
		-row $rowidx -columnspan 1 -rowspan 1 -sticky we
	    switch $attributeArray($attribute,typeofget) {
		"tgDirect" -
		"tgReadOnly" -
		"tgExpression" { }
		"tgList" -
		"tgLink" {
		    button $widget(attributes).ent$attribute -pady 0 \
			-font $font(propsys) \
			-text {Select and paste value} -relief raised -command \
			"::form::cmdSelectFromList $attribute .query paste"
		    grid $widget(attributes).ent$attribute -column 1 \
			-row $rowidx -columnspan 1 -rowspan 1
		}
	    }
	    incr rowidx
	}
	set attribute [lindex $formAttribList 0]
	set rowHeight [winfo reqheight $widget(attributes).btn$attribute]
	.query.canvas configure -scrollregion "0 0 200 [expr $rowidx * $rowHeight + 40]"
	return
    }


    ################################################################
    #                                                              #
    # Procedures for query window                                  #
    #                                                              #
    ################################################################

    proc showQueryWindow { } {

	variable widget
	variable ::options::font
	variable windowSize

	destroy .query
	destroy .form
	toplevel .query -class Toplevel
	bind .query <Destroy> {
	    set ::form::windowSize(.query) \
		[string map {{+0+0} {}} [wm geometry .query]]
	}
	wm focusmodel .query passive
	wm geometry .query $windowSize(.query)
	# wm maxsize .query 785 570
	wm minsize .query 1 1
	wm overrideredirect .query 0
	wm resizable .query 1 1
	text .query.lbSelect -wrap word -font $font(fixed) -background white \
	    -yscrollcommand {.query.vsbSelect set}
	scrollbar .query.vsbSelect -orient vertical -width 15 \
	    -command {.query.vsbSelect yview}
	set widget(lbSelect) .query.lbSelect
	radiobutton .query.rabWhere -font $font(propsys) \
		-text WHERE -value true  -variable ::form::WhereSelected 
	entry .query.entWhere -background white -font $font(prop) \
	    -textvariable ::form::queryWhere
	radiobutton .query.rabOrderBy -font $font(propsys) \
		-text {ORDER BY} -value false  -variable ::form::WhereSelected 
	entry .query.entOrderBy -background white -font $font(prop) \
	    -textvariable ::form::queryOrderBy
	label .query.lbAttributes  -borderwidth 1 -text {Paste buttons} \
	    -font $font(propsys)
	frame .query.buttons -borderwidth 2 -relief groove
	button .query.buttons.execute -font $font(propsys) -command \
	    {::form::cmdExecuteQuery $::form::queryWhere $::form::queryOrderBy \
		 "User defined query:"} -text Execute 
	button .query.buttons.quit -command ::form::cmdQuitQuery -text Quit \
	    -font $font(propsys)
	###################
	# SETTING GEOMETRY
	###################
	place .query.lbSelect  -x 0 -y 0 -relwidth 1 -height 120 \
	    -anchor nw -width -15
	place .query.vsbSelect -x 0 -y 0 -relx 1 -height 120 \
	    -anchor ne
	place .query.rabWhere  -x 0 -y 120 -anchor nw
	place .query.entWhere  -x 105 -y 120 -width {-105} -relwidth 1 \
	    -height 22 -anchor nw
	place .query.rabOrderBy  -x 0 -y 142 -anchor nw
	place .query.entOrderBy  -x 105 -y 142 -width {-105} -relwidth 1 \
	    -height 22 -anchor nw
	place .query.lbAttributes  -x 0 -y 200 -anchor w
	place .query.buttons -x 0 -y 0 -rely 1 -relwidth 1 -height 30 \
	    -anchor sw
	pack .query.buttons.quit -side right
	pack .query.buttons.execute -side right
	return
    }


    proc cmdExecuteQuery {sqlWhere sqlOrderBy intro} {
	# This procedure prepares the SQL SELECT statement of the
	# query to be made, it initialises the formStack and
	# it calls OpenForm. It is called when the user presses
	# the Execute button on the query window.

	variable ::pfm::formsArray
	variable activeForm
	variable formStack
	variable lastFormOnStack
	variable windowSize

	set sqlAttrib $formsArray($activeForm,sqlselect)
	if { !$formsArray($activeForm,view) && \
		 ([lsearch $formsArray($activeForm,pkey) {oid}] >= 0) && \
		 ([regexp {\moid\M} $sqlAttrib] == 0)} then {
	    set sqlAttrib \
		"\"$formsArray($activeForm,tablename)\".oid, $sqlAttrib"
	}
	set sqlFrom $formsArray($activeForm,sqlfrom)
	set groupby $formsArray($activeForm,groupby)
	set queryDef "SELECT $sqlAttrib\nFROM $sqlFrom"
	if { ![string equal $groupby {}] } then {
	    append queryDef "\nGROUP BY $groupby"
	    if { ![string equal $sqlWhere {}] } then {
		# If there is a GROUP BY clause, the sqlWhere must become
		# a HAVING clause.
		append queryDef "\nHAVING $sqlWhere"
	    }
	} else {
	    if { ![string equal $sqlWhere {}] } then {
		append queryDef "\nWHERE $sqlWhere"
	    }
	}
	if { ![string equal $sqlOrderBy {}] } then {
	    append queryDef "\nORDER BY $sqlOrderBy"
	}
	array unset formStack
	set lastFormOnStack 0
	set formStack($lastFormOnStack,formId) $activeForm
	set formStack($lastFormOnStack,queryDef) $queryDef
	set formStack($lastFormOnStack,intro) $intro
	set formStack($lastFormOnStack,displayKey) {}
	destroy .query
	OpenForm $queryDef $intro {}
	return
    }

    proc cmdPasteAttribute {attribute} {
	# The user pastes an attribute name into either the "where" or
	# "order by" text entries, depending on WhereSelect, the value
	# of which is determined by the radio buttons .query.rabWhere
	# and .query.rabOrderBy

	variable WhereSelected
	if {$WhereSelected} then {
	    .query.entWhere insert insert \"$attribute\"
	} else {
	    .query.entOrderBy insert insert \"$attribute\"
	}
	return
    }


    proc cmdQuitQuery {} {
	variable windowSize
	
	destroy .query
	::pfm::refreshFormsList
	return
    }



    ################################################################
    #                                                              #
    # Procedures for form window                                   #
    #                                                              #
    ################################################################

    proc showFormWindow { } {

	variable widget
	variable ::options::font
	variable windowSize

	destroy .query
	if { [winfo exists .form] } then {
	    displayRecordFrame
	    destroy .form.frmLinkBtn
	    frame .form.frmLinkBtn \
		    -borderwidth 2 -relief sunken
	    place .form.frmLinkBtn \
		-x 0 -relx 0.8 -y 30 -rely 0.2 -relwidth 0.2 -height -30 \
		-relheight 0.6 -anchor nw	
	    .form.txtQuery delete 1.0 end
	    .form.txtResult delete 1.0 end
	} else {
	    toplevel .form -class Toplevel
	    bind .form <Destroy> {
		set ::form::windowSize(.form) \
		    [string map {{+0+0} {}} [wm geometry .form]]
	    }
	    wm focusmodel .form passive
	    wm geometry .form $windowSize(.form)
	    wm minsize .form 1 1
	    wm overrideredirect .form 0
	    wm resizable .form 1 1
	    text .form.txtQuery -font $font(fixed) -background white \
		-wrap word -yscrollcommand {.form.scrollQuery set}
	    .form.txtQuery tag configure blueTag -foreground {medium blue}
	    .form.txtQuery tag configure greenTag -foreground {green4}
	    .form.txtQuery tag configure redTag -foreground {red3}
	    scrollbar .form.scrollQuery -width 15 -orient vertical \
		-command {.form.txtQuery yview}
	    text .form.txtResult -font $font(fixed) -background white \
		-wrap word -yscrollcommand {.form.scrollResult set}
	    .form.txtResult tag configure blueTag -foreground {medium blue}
	    .form.txtResult tag configure greenTag -foreground {green4}
	    .form.txtResult tag configure redTag -foreground {red3}
	    scrollbar .form.scrollResult -width 15 -orient vertical \
		-command {.form.txtResult yview}
	    displayRecordFrame
	    frame .form.frmStatus \
		    -borderwidth 2 -height 75 -relief groove -width 125 
	    label .form.frmStatus.lblRecord -font $font(propsys) \
		    -borderwidth 1 -textvar ::form::txtRecord(23nr47) 
	    label .form.frmStatus.lblFormName -font $font(propsys) \
		    -borderwidth 1 -textvar ::form::activeForm
	    label .form.frmStatus.lblStatus -font $font(propsys) \
		    -borderwidth 1 -textvar ::form::txtRecord(23status47)
	    frame .form.frmButtons \
		    -borderwidth 2 -relief groove
	    button .form.frmButtons.btnHelp -font $font(propsys) \
		-text Help -command ::form::cmdHelp
	    label .form.frmButtons.left
	    button .form.frmButtons.btnPrev -font $font(propsys) \
		-text Prev -command ::form::cmdPrev
	    button .form.frmButtons.btnNext -font $font(propsys) \
		-text Next -command ::form::cmdNext
	    button .form.frmButtons.btnUpdate -font $font(propsys) \
		-text Update -command ::form::cmdUpdate
	    button .form.frmButtons.btnAdd -font $font(propsys) \
		-text Add -command ::form::cmdAdd
	    button .form.frmButtons.btnDelete -font $font(propsys) \
		-text Delete -command ::form::cmdDelete
	    label .form.frmButtons.right
	    button .form.frmButtons.btnQuit -font $font(propsys) \
		-command {::form::cmdQuitForm} -text Quit
	    button .form.frmButtons.btnOK -font $font(propsys) \
		-text OK -command ::form::cmdOK
	    button .form.frmButtons.btnCancel -font $font(propsys) \
		-text Cancel -command ::form::cmdCancel
	    frame .form.frmLink1 \
		-borderwidth 2 -relief groove
	    label .form.frmLink1.lblLinks -font $font(propsys) \
		-borderwidth 1 -text Links 
	    frame .form.frmLinkBtn -borderwidth 2 -relief sunken
	    ###################
	    # SETTING GEOMETRY
	    ###################
	    place .form.txtQuery \
		    -x 0 -y 0 -width -15 -relwidth 1 -relheight 0.2 -anchor nw
	    place .form.scrollQuery -x 0 -y 0 -relx 1 -relheight 0.2 -anchor ne
	    place .form.txtResult \
		    -x 0 -y 0 -rely 1 -width -15 -relwidth 1 -relheight 0.2 -anchor sw
	    place .form.scrollResult -x 0 -y 0 -relx 1 -rely 1 -relheight 0.2 -anchor se
	    place .form.frmStatus \
		    -x 0 -y 0 -rely 0.2 -relwidth 0.8 -height 30 -anchor nw
	    place .form.frmLink1 \
		    -x 0 -relx 0.8 -y 0 -rely 0.2 -relwidth 0.2 -height 30 -anchor nw
	    place .form.frmLinkBtn \
		-x 0 -relx 0.8 -y 30 -rely 0.2 -relwidth 0.2 \
		-height -30 -relheight 0.6 -anchor nw
	    place .form.frmButtons \
		    -x 0 -y 0 -rely 0.8 -relwidth 0.8 -height 30 -anchor sw
	    place .form.frmStatus.lblRecord \
		    -x 10 -y 0 -rely 0.5 -anchor w
	    place .form.frmStatus.lblFormName \
		    -x 0 -y 0 -rely 0.5 -relx 0.5 -anchor center
	    place .form.frmStatus.lblStatus \
		    -x -10 -relx 1 -y 0 -rely 0.5 -anchor e
	    place .form.frmLink1.lblLinks \
		    -x 0 -relx 0.5 -y 0 -rely 0.5 -anchor center
	}
	return
    }

    proc displayRecordFrame {} {
	variable widget

	destroy .form.canvas
	destroy .form.vscroll
	canvas .form.canvas -yscrollcommand {.form.vscroll set} \
	    -borderwidth 2 -relief sunken
	scrollbar .form.vscroll -orient vertical -width 15 \
	    -command {.form.canvas yview}
	frame .form.canvas.frmRecord -borderwidth 2 -relief raised
	.form.canvas create window 20 20 -window .form.canvas.frmRecord -anchor nw
	set widget(record) .form.canvas.frmRecord
	place .form.canvas \
	    -x 0 -y 30 -rely 0.2 -width -15 -relwidth 0.8 -height -60 -relheight 0.6 \
	    -anchor nw
	place .form.vscroll -x 0 -y 30 -rely 0.2 -relx 0.8 -height -60 \
	    -relheight 0.6 -anchor ne
	return
    }

    ################################################################
    # Commands for browse, update, add and quit buttons            #
    ################################################################

    proc identCurRecord {withTable} {
	variable ::pfm::formsArray
	variable activeForm
	variable recordArray
	variable curRecord
	variable attributeArray

	set whereClause {}
	foreach pkey $formsArray($activeForm,pkey) {
	    if {[info exists recordArray($curRecord,$pkey)]} then {
		if {$whereClause ne {}} then {
		    set whereClause "$whereClause AND"
		}
		if {$withTable} then {
		    set attribute "\"$formsArray($activeForm,tablename)\".\"$pkey\""
		} else {
		    set attribute "\"$pkey\""
		}
		if {[info exists attributeArray($pkey,typeofattrib)] } then {
		    if {$attributeArray($pkey,typeofattrib) eq {taQuoted}} then {
			set value [string map {' ''} $recordArray($curRecord,$pkey)]
			set whereClause \
			    "$whereClause ($attribute = '$value')"
		    } else {
			set whereClause \
			    "$whereClause ($attribute = $recordArray($curRecord,$pkey))"
		    }
		} else {
		    set whereClause \
			"$whereClause ($attribute = $recordArray($curRecord,$pkey))"
		}
	    } else {
		set whereClause FALSE
		set errMsg "The pkey attribute '$pkey' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!"
		tk_messageBox -type ok -icon error -message $errMsg -parent .form
		break
	    }
	}
	return $whereClause
    }

    proc cmdHelp {} {

	variable wrapOn
	variable ::pfm::currentDB
	variable activeForm
	variable ::options::font
	variable windowSize

	set queryDef "SELECT help FROM pfm_form WHERE name='$activeForm'"
	set queryRes [pg_exec $currentDB $queryDef]
	set helpText [lindex [pg_result $queryRes -getTuple 0] 0]
	if { [string length $helpText] == 0 } then {
	    set helpText "No help available for $activeForm."
	}
	pg_result $queryRes -clear
	set wrapOn 1
	destroy .form.help
	toplevel .form.help -class Toplevel
	bind .form.help <Destroy> {
	    set ::form::windowSize(.form.help) \
		[string map {{+0+0} {}} [wm geometry .form.help]]
	}
	wm transient .form.help .form
	wm geometry .form.help $windowSize(.form.help)
	wm title .form.help "Help for $activeForm"
	text .form.help.text -wrap word -font $font(fixed) -background white \
	    -yscrollcommand {.form.help.vscroll set} \
	    -xscrollcommand {.form.help.hscroll set}
	scrollbar .form.help.vscroll -orient vertical -width 15 \
	    -command {.form.help.text yview}
	scrollbar .form.help.hscroll -orient horizontal -width 15 \
	    -command {.form.help.text xview}
	frame .form.help.buttons
	radiobutton .form.help.buttons.rbWrap -text {Wrap} -value 1 \
	    -font $font(propsys) -variable ::form::wrapOn \
	    -command {.form.help.text configure -wrap word}
	radiobutton .form.help.buttons.rbTruncate -text {Truncate} \
	    -font $font(propsys) -value 0 -variable ::form::wrapOn \
	    -command {.form.help.text configure -wrap none}
	button .form.help.buttons.bnCancel -text {Cancel} -font $font(propsys) \
	    -command {destroy .form.help}
	place .form.help.text -x 0 -y 0 -height -45 -relwidth 1 -relheight 1 \
	    -width -15 -anchor nw
	place .form.help.vscroll -x 0 -y 0 -height -45 -relx 1 \
	    -relheight 1 -anchor ne
	place .form.help.hscroll -x 0 -y -30 -width -15 -relwidth 1 \
	    -rely 1 -anchor sw
	place .form.help.buttons -x 0 -y 0 -rely 1 -relwidth 1 -height 30 \
	    -anchor sw
	pack .form.help.buttons.bnCancel -side right
	pack .form.help.buttons.rbWrap -side left
	pack .form.help.buttons.rbTruncate -side left
	.form.help.text insert end $helpText
	.form.help.text configure -state disabled
	return
    }

    proc cmdAdd {} {
	variable attributeArray
	variable tableAttribList
	variable txtRecord
	variable ::pfm::currentDB
	variable activeForm
	variable windowSize

	if {[winfo exists .form.search]} then {
	    destroy .form.search
	}
	.form.txtResult delete 1.0 end
	foreach attribute $tableAttribList {
	    set defVal $attributeArray($attribute,default)
	    if {$defVal ne {}} then {
		if { [string index $defVal 0] eq {=}} then {
		    set queryDef [string range $defVal 1 end]
		    set queryRes [pg_exec $currentDB $queryDef]
		    if { [pg_result $queryRes -status] eq {PGRES_TUPLES_OK}} then {
			if {[pg_result $queryRes -numTuples] == 1} then {
			    set txtRecord($attribute) \
				[lindex [pg_result $queryRes -getTuple 0] 0]
			} else {
			    set errMsg "$queryDef\nhas returned [pg_result $queryRes -numTuples] records."
			    set errMsg "$errMsg\nCheck the definition of the default value for $attribute of $activeForm in pfm_attribute.\n"
			    bell
			    displayOnForm .form.txtResult $errMsg {red}
			}
		    } else {
			set errMsg "$queryDef\n[pg_result $queryRes -error]"
			set errMsg "$errMsg\nCheck the definition of the default value for $attribute of $activeForm in pfm_attribute.\n"
			bell
			displayOnForm .form.txtResult $errMsg {red}
		    }
		    pg_result $queryRes -clear
		} else {
		    set txtRecord($attribute) $defVal
		}
	    }
	}
	newFormState add
	return
    }

    proc cmdUpdate {} {

	# variable ::pfm::currentDB
	# variable ::pfm::formsArray
	variable txtRecord
	variable windowSize
	# variable recordArray
	# variable curRecord
	# variable tableAttribList
	# variable activeForm
	# Bug 679 : The start of the transaction is postponed until
	# the user presses [OK]. Instead a 'reload record' is executed
	# to minimize the time window during which another user can
	# modify or delete the current record.

	if { ![string equal $txtRecord(23status47) {After last}] && \
		![string equal $txtRecord(23status47) {Deleted}] && \
		![string equal $txtRecord(23status47) {Not added}] } then {
	    .form.txtResult delete 1.0 end
	    if {[winfo exists .form.search]} then {
		destroy .form.search
	    }
	    if { [reloadRecord] } then {
		newFormState update   
	    }	
	}
	return
    }


    proc cmdDelete {} {

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable curRecord
	variable activeForm
	variable txtRecord
	variable recordArray
	variable formAttribList
	if { ![string equal $txtRecord(23status47) {After last}] && \
		![string equal $txtRecord(23status47) {Deleted}] && \
		![string equal $txtRecord(23status47) {Not added}] } then {
	    set queryDef "DELETE FROM \"$formsArray($activeForm,tablename)\""
	    set queryDef "$queryDef WHERE [identCurRecord 0]"
	    .form.txtResult delete 1.0 end
	    displayOnForm .form.txtResult "$queryDef\n" {black}
	    set queryRes [pg_exec $currentDB $queryDef]
	    set status [pg_result $queryRes -status]
	    if { [string equal $status {PGRES_COMMAND_OK}] } then {
		set recordArray($curRecord,23status47) "Deleted"
		set txtRecord(23status47) "Deleted"
		foreach attribute $formAttribList {
		    set recordArray($curRecord,$attribute) ""
		    set txtRecord($attribute) ""
		}
		displayOnForm .form.txtResult $status {green}
	    } else {
		set status $status\n[pg_result $queryRes -error]
		bell
		displayOnForm .form.txtResult $status {red}
	    }
	    pg_result $queryRes -clear
	}
	return
    }

    proc cmdNext {} {

	variable curRecord
	variable lastRecord
	if {$curRecord < $lastRecord} then {
	    incr curRecord
	    filltxtRecord $curRecord
	    .form.txtResult delete 1.0 end
	}
	return
    }

    proc cmdPrev {} {

	variable curRecord
	if {$curRecord > 0} then {
	    incr curRecord -1
	    filltxtRecord $curRecord
	    .form.txtResult delete 1.0 end
	}
	return
    }

    proc cmdQuitForm {} {
	variable windowSize
	variable formStack
	
	destroy .form
	::pfm::refreshFormsList
	OpenQuery $formStack(0,formId) 0
	return
    }



    ################################################################
    # Commands for OK and Cancel buttons                           #
    ################################################################

    proc cmdOK {} {

	variable ::pfm::currentDB
	variable formState

	# reworked because of bug 679
	.form.txtResult delete 1.0 end
	switch $formState {
	    "update" {
		set success [updateRecord]
		reloadRecord
	    }
	    "add" {
		if {[addRecord]} then {
		    reloadRecord
		}
	    }
	}
	newFormState browse
	return
    }

    proc cmdCancel {} {

	variable ::pfm::currentDB
	variable curRecord
	variable formState

	# reworked because of bug 679
	filltxtRecord $curRecord
	if { [string equal $formState {update}] } then {
	    set rollbackStatus "Update cancelled."
	} else {
	    set rollbackStatus "No record inserted."
	}
	.form.txtResult delete 1.0 end
	displayOnForm .form.txtResult $rollbackStatus {blue}
	newFormState browse
	return
    }

    ################################################################
    # Commands for selecting a value from a list                   #
    ################################################################

    
    proc cmdSelectFromList {attribute base action} {

	variable ::pfm::currentDB
	variable activeForm
	variable attributeArray
	variable displayList
	variable searchString
	variable ::options::font

	set searchString {}
	set xy [winfo pointerxy $base]
	set x [lindex $xy 0]
	set y [lindex $xy 1]
	set window $base.select
	destroy $window
	toplevel $window -class Toplevel
	wm transient $window $base
	wm geometry $window 300x300+$x+$y
	wm minsize $window 1 1
	wm overrideredirect $window 0
	wm resizable $window 1 1
	wm title $window "pfm - Select value for $attribute"
	listbox $window.lsb -yscrollcommand "$window.scroll set" \
	    -font $font(propsys) -background white
	scrollbar $window.scroll -orient vertical -width 15 \
	    -command "$window.lsb yview"
	switch $attributeArray($attribute,typeofget) {
	    "tgList" {
		set queryDef "SELECT value,description FROM pfm_value "
		append queryDef \
		    "WHERE valuelist='$attributeArray($attribute,valuelist)'"
	    }
	    "tgLink" {
		set queryDef $attributeArray($attribute,sqlselect)
	    }
	}
	set queryRes [pg_exec $currentDB $queryDef]
	set lastItem [expr [pg_result $queryRes -numTuples] - 1]
	set valueList {}
	set displayList {}
	for {set item 0} {$item <= $lastItem} {incr item } {
	    set listItem [pg_result $queryRes -getTuple $item]
	    lappend valueList [lindex $listItem 0]
	    set displayItem {}
	    set itemNr 0
	    foreach subItem $listItem {
		set displayItem "$displayItem $subItem"
		if {$itemNr == 0} then {
		    set displayItem "$displayItem :"
		}
		incr itemNr
	    }
	    lappend displayList $displayItem
	    $window.lsb insert end $displayItem
	}
	pg_result $queryRes -clear
	bind $window.lsb <<ListboxSelect>> \
		"::form::cmdValueSelected \{$valueList\} $attribute $window $action"
	$window.lsb selection set 0 0
	label $window.lblSearch -text {Search for:} -font $font(propsys)
	entry $window.entSearch -textvariable ::form::searchString -background white \
	     -font $font(prop)
	bind $window.entSearch <KeyPress-Return> "::form::cmdSearchInList $window"
	button $window.btnSearch -text {Go} -font $font(propsys) -command \
	    "::form::cmdSearchInList $window"
	button $window.btnOK -text {OK}  -font $font(propsys) -command \
	    "::form::cmdValueSelected \{$valueList\} $attribute $window $action"
	button $window.btnCancel -text {Cancel} -font $font(propsys)  \
	    -command "destroy $window"
	place $window.lblSearch -x 0 -y 0 -height 30 -width 75
	place $window.entSearch -x 75 -y 0 -height 30 -width {-115} -relwidth 1
	place $window.btnSearch -x {-40} -y 0 -relx 1 -height 30 -width 40
	place $window.lsb -x 0 -y 30 -height {-60} -relheight 1 -relwidth 1
	place $window.scroll -x 0 -y 30 -height -60 -relheight 1 -relx 1 -anchor ne
	place $window.btnOK -x 0 -y 0 -rely 1 -relwidth 0.5 -anchor sw
	place $window.btnCancel -x 0 -y 0 -rely 1 -relx 0.5 -relwidth 0.5 -anchor sw
	return
    }

    proc cmdValueSelected {valueList attribute base action} {

	variable txtRecord
	variable WhereSelected
	set item [$base.lsb curselection]
	switch $action {
	    "fillout" {
		set txtRecord($attribute) [lindex $valueList $item]
	    }
	    "paste" {
		if {$WhereSelected} then {
		    .query.entWhere insert insert [lindex $valueList $item]
		} else {
		    .query.entOrderBy insert insert [lindex $valueList $item]
		}
	    }
	}
	destroy $base
	return
    }

    proc cmdSearchInList {window} {
	variable displayList
	variable searchString
	
	set lastIndex [expr [llength $displayList] - 1]
	set startPosition [expr [lindex [$window.lsb curselection] 0] + 1]
	if {$startPosition > $lastIndex} then {
	    $window.lsb selection clear 0 end
	    $window.lsb selection set 0 0
	    $window.lsb see 0
	} else {
	    set newPosition -1
	    for {set index $startPosition} {$index <= $lastIndex} {incr index} {
		if {[string match -nocase "*$searchString*" \
			 [lindex $displayList $index]]} then {
		    set newPosition $index
		    break
		}
	    }
	    if { $newPosition >= 0 } then {
		$window.lsb selection clear 0 end
		$window.lsb selection set $newPosition $newPosition
		$window.lsb see $newPosition
	    } else {
		$window.lsb selection clear 0 end
		$window.lsb selection set 0 0
		$window.lsb see 0
	    }
	}
	return
    }

    ###############################################################################
    # Procedures for opening the active form with a defined query                 #
    ###############################################################################

    proc OpenForm {queryDef intro displayKey} {

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable activeForm
	variable lastRecord
	variable recordArray
	variable curRecord
	variable formAttribList
	variable formState
	variable txtRecord
	variable ::options::font

	showFormWindow
	wm title .form "pfm - Form : $activeForm"
	displayOnForm .form.txtQuery "$intro\n" {blue}
	displayOnForm .form.txtQuery "$queryDef\n" {black}
	array unset recordArray
	array unset txtRecord
	set queryRes [pg_exec $currentDB $queryDef]
	set status [pg_result $queryRes -status]
	if { [string equal $status {PGRES_TUPLES_OK}] } then {
	    displayOnForm .form.txtQuery "$status\n" {green}
	    # lastRecord is a dummy empty record.
	    set lastRecord [pg_result $queryRes -numTuples]
	    pg_result $queryRes -assign recordArray
	} else {
	    set lastRecord 0
	    set status $status\n[pg_result $queryRes -error]
	    bell
	    displayOnForm .form.txtQuery "$status\n" {red}
	}
	pg_result $queryRes -clear
	for {set recordNr 0} {$recordNr < $lastRecord} {incr recordNr} {
	    set recordArray($recordNr,23status47) "Not modified"
	}
	foreach attribute $formAttribList {
	    set recordArray($lastRecord,$attribute) {}
	}
	set recordArray($lastRecord,23status47) "After last"
	if {$displayKey eq {}} then {
	    set curRecord 0
	} else {
	    set curRecord 0
	    for {set recordNr 0} {$recordNr < $lastRecord} {incr recordNr} {
		set match 1
		set i 0
		foreach pkey $formsArray($activeForm,pkey) {
		    if {[info exist recordArray($recordNr,$pkey)]} then {
			if {[lindex $displayKey $i] ne $recordArray($recordNr,$pkey)} then {
			    set match 0
			    break
			}
			incr i
		    } else {
			set errMsg "The pkey attribute '$pkey' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!"
			tk_messageBox -type ok -icon error -message $errMsg \
			    -parent .form
			break
		    }
		}
		if {$match} then {
		    set curRecord $recordNr
		    break
		}
	    }
	}
	set formState "browse"
	hideBrowseButtons
	hideEditButtons
	displayBrowseButtons
	displayAttribNames
	filltxtRecord $curRecord
	displayAttribLabels
	displayLinks
	return
    }

    proc displayAttribNames {} {
	variable formAttribList
	variable widget
	variable ::options::font

	set rowidx 0
	foreach attribute $formAttribList {
	    button $widget(record).lb1$attribute -borderwidth 2 -relief raised \
		-text $attribute -anchor w -pady 0 -padx 0 \
		-command "::form::cmdOpenSearch $attribute" \
		-font $font(propsys) 
	    grid $widget(record).lb1$attribute \
		-column 0 -row $rowidx \
		-columnspan 1 -rowspan 1 -sticky we
	    incr rowidx
	}
	return
    }

    proc cmdOpenSearch {attribute} {
	variable formState
	variable ::options::font
	variable windowSize

	if {($formState ne {update}) && ($formState ne {add})} then {
	    if {[winfo exists .form.search]} then {
		destroy .form.search
	    }
	    toplevel .form.search
	    bind .form.search <Destroy> {
		set ::form::windowSize(.form.search) \
		    [string map {{+0+0} {}} [wm geometry .form.search]]
	    }
	    wm transient .form.search .form
	    if {$windowSize(.form.search) eq {}} then {
		set x [expr [winfo pointerx .] + 50]
		set y [expr [winfo pointery .] - 300]
		if {$y < 0} then {
		    set y 0
		}
		wm geometry .form.search "+$x+$y"
	    } else {
		wm geometry .form.search $windowSize(.form.search)
	    }
	    wm title .form.search "pfm - Form: Search $attribute"
	    label .form.search.lb1 -text "Search for next record in buffer with" \
		 -font $font(propsys)
	    label .form.search.lb2 -text "$attribute =" -font $font(propsys)
	    entry .form.search.ent -background white -width 50 -font $font(prop)
	    bind .form.search.ent <KeyPress-Return> \
		"::form::searchInBuffer $attribute \[.form.search.ent get\] \$bnCase"
	    button .form.search.bnSearch -text Search -font $font(propsys) -command \
		"::form::searchInBuffer $attribute \[.form.search.ent get\] \$bnCase"
	    button .form.search.bnCancel -text Cancel -font $font(propsys) \
		-command {destroy .form.search}
	    checkbutton .form.search.bnCase -text {Match case} -font $font(propsys)
	    set help "*     matches any sequence of characters;"
	    set help "$help\n?     matches any single character."
	    message .form.search.msgHelp -width 500 -text $help -borderwidth 2 \
		-relief groove -font $font(propsys)
	    grid .form.search.lb1 -column 0 -row 0 -columnspan 3
	    grid .form.search.lb2 -column 0 -row 1 -columnspan 1
	    grid .form.search.ent -column 1 -row 1 -columnspan 1
	    grid .form.search.bnSearch -column 2 -row 1 -columnspan 1 -sticky we
	    grid .form.search.bnCase -column 0 -row 2 -columnspan 1
	    grid .form.search.msgHelp -column 1 -row 2 -columnspan 1
	    grid .form.search.bnCancel -column 2 -row 2 -columnspan 1 -sticky we
	}
	return
    }

    proc searchInBuffer {attribute pattern matchcase} {
	variable curRecord
	variable lastRecord
	variable recordArray

	set searching 1
	set startSearch [expr $curRecord + 1]
	while {$searching} {
	    set found 0
	    for {set tuple $startSearch} {$tuple <= $lastRecord} {incr tuple} {
		if {$matchcase} then {
		    set found [string match $pattern $recordArray($tuple,$attribute)]
		} else {
		    set found \
			[string match -nocase $pattern $recordArray($tuple,$attribute)]
		}
		if {$found} then {
		    set curRecord $tuple
		    filltxtRecord $curRecord
		    .form.txtResult delete 1.0 end
		    break
		}
	    }
	    if {$found} then {
		set searching 0
	    } else {
		set searching \
		    [tk_messageBox -type yesno -icon question -parent .form.search \
			 -message "End of buffer reached. Wrap around?"]
		set startSearch 0
	    }
	}
	return
    }

    proc displayAttribLabels {} {

	variable formAttribList
	variable txtRecord
	variable attributeArray
	variable widget
	variable ::options::font

	set rowidx 0
	foreach attribute $formAttribList {
	    entry $widget(record).lb2$attribute -state readonly -width 45 \
		-textvar ::form::txtRecord($attribute) -font $font(prop)
	    grid $widget(record).lb2$attribute -column 1 -row $rowidx \
		-columnspan 1 -rowspan 1
	    button $widget(record).bn$attribute -text {>>} -pady 0 \
		-command "::form::cmdExpand $attribute 1" \
		-font $font(propsys) 
	    grid $widget(record).bn$attribute -column 2 -row $rowidx \
		-columnspan 1 -rowspan 1
	    incr rowidx
	}
	set attribute [lindex $formAttribList 0]
	set rowHeight [winfo reqheight $widget(record).bn$attribute]
	.form.canvas configure -scrollregion "0 0 200 [expr $rowidx * $rowHeight + 40]"
	return
    }

    proc hideAttribLabels {} {

	variable formAttribList
	variable widget
	foreach attribute $formAttribList {
	    destroy $widget(record).lb2$attribute
	    destroy $widget(record).bn$attribute
	}
	return
    }

    proc displayAttribEntries {} {

	variable formAttribList
	variable txtRecord
	variable attributeArray
	variable widget
	variable ::options::font

	set rowidx 0
	foreach attribute $formAttribList {
	    switch $attributeArray($attribute,typeofget) {
		"tgDirect" -
		"tgExpression" {
		    entry $widget(record).ent$attribute -borderwidth 1 -textvar \
			::form::txtRecord($attribute) -relief sunken -width 45 \
			-background white -font $font(prop)
		    button $widget(record).bn$attribute -text {>>} -pady 0 \
			-command "::form::cmdExpand $attribute 0" \
			-font $font(propsys) 
		    grid $widget(record).bn$attribute -column 2 \
			-row $rowidx -columnspan 1 -rowspan 1
		}
		"tgReadOnly" {
		    entry $widget(record).ent$attribute -borderwidth 1 -textvar \
			::form::txtRecord($attribute) -relief sunken -width 45 \
			-state readonly -font $font(prop)
		    button $widget(record).bn$attribute -text {>>} -pady 0 \
			-command "::form::cmdExpand $attribute 1" \
			-font $font(propsys) 
		    grid $widget(record).bn$attribute -column 2 \
			-row $rowidx -columnspan 1 -rowspan 1
		}
		"tgList" -
		"tgLink" {
		    button $widget(record).ent$attribute -pady 0 -padx 0 \
			-anchor w -textvar ::form::txtRecord($attribute) \
			-relief raised -width 45 -command \
			"::form::cmdSelectFromList $attribute .form fillout" \
			-font $font(propsys) 
		    button $widget(record).bn$attribute -text {>>} -pady 0 \
			-command "::form::cmdExpand $attribute 0" \
			-font $font(propsys) 
		    grid $widget(record).bn$attribute -column 2 \
			-row $rowidx -columnspan 1 -rowspan 1
		}
	    }
	    grid $widget(record).ent$attribute -column 1 -row $rowidx \
		-columnspan 1 -rowspan 1
	    incr rowidx
	}
	set attribute [lindex $formAttribList 0]
	set rowHeight [winfo reqheight $widget(record).bn$attribute]
	.form.canvas configure -scrollregion "0 0 200 [expr $rowidx * $rowHeight + 40]"
	return
    }

    proc cmdExpand {attribute readonly} {
	variable wrapOn
	variable txtRecord
	variable ::options::font
	variable windowSize

	set wrapOn 1
	destroy .form.expand
	toplevel .form.expand -class Toplevel
	bind .form.expand <Destroy> {
	    set ::form::windowSize(.form.expand) \
		[string map {{+0+0} {}} [wm geometry .form.expand]]
	}
	wm transient .form.expand .form
	wm geometry .form.expand $windowSize(.form.expand)
	wm title .form.expand "$attribute"
	frame .form.expand.buttons
	place .form.expand.buttons -x 0 -y 0 -rely 1 -relwidth 1 -height 30 \
	    -anchor sw
	button .form.expand.buttons.bnCancel -text {Cancel} \
	    -font $font(propsys) \
	    -command {destroy .form.expand}
	pack .form.expand.buttons.bnCancel -side right
	if { $readonly } then {
	    text .form.expand.text -wrap word -font $font(fixed) -background white \
		-xscrollcommand {.form.expand.hscroll set} \
		-yscrollcommand {.form.expand.vscroll set}
	} else {
	    text .form.expand.text -background white -wrap word -font $font(fixed) \
		-xscrollcommand {.form.expand.hscroll set} \
		-yscrollcommand {.form.expand.vscroll set}
	    button .form.expand.buttons.bnOK -text {OK} -font $font(propsys) \
		-command "::form::cmdExpandOK $attribute"
	    pack .form.expand.buttons.bnOK -side right
	}
	scrollbar .form.expand.hscroll -orient horizontal -width 15 \
	    -command {.form.expand.text xview}
	scrollbar .form.expand.vscroll -orient vertical -width 15 \
	    -command {.form.expand.text yview}
	place .form.expand.text -x 0 -y 0 -height -45 -width -15 -relwidth 1 \
	    -relheight 1 -anchor nw
	place .form.expand.hscroll -x 0 -y -30 -rely 1 -width -15 \
	    -relwidth 1 -anchor sw
	place .form.expand.vscroll -x 0 -y 0 -height -45 -relheight 1 \
	    -relx 1 -anchor ne
	radiobutton .form.expand.buttons.rbWrap -text {Wrap} -value 1 \
	    -font $font(propsys) \
	    -variable ::form::wrapOn \
	    -command {.form.expand.text configure -wrap word}
	radiobutton .form.expand.buttons.rbTruncate -text {Truncate} -value 0 \
	    -variable ::form::wrapOn -font $font(propsys) \
	    -command {.form.expand.text configure -wrap none}
	pack .form.expand.buttons.rbWrap -side left
	pack .form.expand.buttons.rbTruncate -side left
	.form.expand.text insert end $txtRecord($attribute)
	if { $readonly } then {
	    .form.expand.text configure -state disabled
	}
	return
    }

    proc cmdExpandOK { attribute} {
	variable txtRecord
	variable windowSize

	set txtRecord($attribute) [.form.expand.text get 1.0 "end -1 chars"]
	destroy .form.expand
	return
    }

    proc hideAttribEntries {} {

	variable formAttribList
	variable widget
	foreach attribute $formAttribList {
	    destroy $widget(record).ent$attribute
	    destroy $widget(record).bn$attribute
	}
	return
    }

    proc displayBrowseButtons {} {

	variable activeForm
	variable ::pfm::formsArray
	set view $formsArray($activeForm,view)
	pack .form.frmButtons.btnHelp -side left
	pack .form.frmButtons.left -side left -expand 1
	pack .form.frmButtons.btnPrev -side left
	pack .form.frmButtons.btnNext -side left
	if { [string equal $view {f}] } then {
	    pack .form.frmButtons.btnUpdate -side left
	    pack .form.frmButtons.btnAdd -side left
	    pack .form.frmButtons.btnDelete -side left
	}
	pack .form.frmButtons.right -side left -expand 1
	pack .form.frmButtons.btnQuit -side left
	# also bind PgUp, PgDn, Up and Dn
	bind .form <KeyPress-Next> ::form::cmdNext
	bind .form <KeyPress-Down> ::form::cmdNext
	bind .form <KeyPress-Prior> ::form::cmdPrev
	bind .form <KeyPress-Up> ::form::cmdPrev
	return
    }

    proc hideBrowseButtons {} {

	foreach widget [pack slaves .form.frmButtons] {
	    pack forget $widget
	}
	# also unbind PgUp, PgDn, Up and Dn
	bind .form <KeyPress-Next> {}
	bind .form <KeyPress-Down> {}
	bind .form <KeyPress-Prior> {}
	bind .form <KeyPress-Up> {}
	return
    }

    proc displayEditButtons {} {

	pack .form.frmButtons.btnHelp -side left
	pack .form.frmButtons.left -side left -expand 1
	pack .form.frmButtons.btnOK -side left
	pack .form.frmButtons.btnCancel -side left
	pack .form.frmButtons.right -side left -expand 1
	return
    }

    proc hideEditButtons {} {

	foreach widget [pack slaves .form.frmButtons] {
	    pack forget $widget
	}
	return
    }

    proc newFormState {newState} {

	variable formState
	variable txtRecord

	set formState $newState
	displayRecordFrame
	displayAttribNames
	switch $newState {
	    "update" {
		hideAttribLabels
		displayAttribEntries
		hideBrowseButtons
		displayEditButtons
		newLinkState disabled
		set txtRecord(23status47) "Updating"
	    }
	    "add" {
		hideAttribLabels
		displayAttribEntries
		hideBrowseButtons
		displayEditButtons
		newLinkState disabled
		set txtRecord(23status47) "Adding"
	    }
	    "browse" {
		hideAttribEntries
		displayAttribLabels
		hideEditButtons
		displayBrowseButtons
		newLinkState normal
	    }
	}
	return
    }

    proc filltxtRecord {recordNr} {

	variable recordArray
	variable txtRecord
	variable formAttribList
	variable lastRecord
	variable widget
	variable activeForm
	foreach attribute $formAttribList {
	    if {[info exists recordArray($recordNr,$attribute)]} then {
		set txtRecord($attribute) $recordArray($recordNr,$attribute)
	    } else {
		set txtRecord($attribute) "Undefined"
		set errMsg "The attribute '$attribute' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!"
		tk_messageBox -type ok -icon error -message $errMsg -parent .form
	    }
	}
	set txtRecord(23nr47) "Record [expr $recordNr + 1]/$lastRecord"
	set txtRecord(23status47) $recordArray($recordNr,23status47)
	return
    }

    proc getAttributes {formName} {

	variable ::pfm::currentDB
	variable attributeArray
	variable formAttribList
	variable tableAttribList
	array unset attributeArray
	set fields "attribute,typeofattrib,typeofget,valuelist,sqlselect,\"default\""
	set queryDef \
	    "SELECT $fields FROM pfm_attribute WHERE form = '$formName' ORDER BY nr"
	set queryRes [pg_exec $currentDB $queryDef]
	set formAttribList [list]
	set tableAttribList [list]
	set lastAttribute [expr [pg_result $queryRes -numTuples] - 1]
	pg_result $queryRes -assign attribRecords
	for {set attribNr 0} {$attribNr <= $lastAttribute} {incr attribNr} {
	    set attribute [string trim $attribRecords($attribNr,attribute)]
	    lappend formAttribList $attribute
	    set typeofattrib [string trim $attribRecords($attribNr,typeofattrib)]
	    set attributeArray($attribute,typeofattrib) $typeofattrib
	    set typeofget [string trim $attribRecords($attribNr,typeofget)]
	    set attributeArray($attribute,typeofget) $typeofget
	    set valuelist [string trim $attribRecords($attribNr,valuelist)]
	    set attributeArray($attribute,valuelist) $valuelist
	    set sqlselect [string trim $attribRecords($attribNr,sqlselect)]
	    set attributeArray($attribute,sqlselect) $sqlselect
	    set defVal [string trim $attribRecords($attribNr,default)]
	    set attributeArray($attribute,default) $defVal
	    if { ![string equal $typeofget {tgReadOnly}] } then {
		lappend tableAttribList $attribute
	    }
	}
	pg_result $queryRes -clear
	array unset attribRecords
	return
    }

    ########################################################################
    # Procedures that modify the data base                                 #
    ########################################################################

    proc addRecord {} {
	# insert txtRecord to data base and to recordArray

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable recordArray
	variable txtRecord
	variable curRecord
	variable activeForm
	variable lastRecord
	variable attributeArray
	variable tableAttribList
	variable formAttribList

	set success 1
	set colDef "("
	set valueDef "("
	foreach attribute $tableAttribList {
	    set colDef "$colDef \"$attribute\","
	    if { [string equal $attributeArray($attribute,typeofget) {tgExpression}] } then {
		set txtRecord($attribute) [expr $txtRecord($attribute)]
	    }
	    switch $attributeArray($attribute,typeofattrib) {
		"taQuoted" {
		    set convertedValue [string map {' ''} $txtRecord($attribute)]
		    append valueDef " '$convertedValue',"
		}
		"taNotQuoted" {
		    append valueDef " $txtRecord($attribute),"
		}
	    }
	}
	set colDef "[string trimright $colDef ","])"
	set valueDef "[string trimright $valueDef ","])"
	set queryDef "INSERT INTO \"$formsArray($activeForm,tablename)\" $colDef\nVALUES $valueDef"
	displayOnForm .form.txtResult "$queryDef\n" {black}
	set queryRes [pg_exec $currentDB $queryDef]
	set status [pg_result $queryRes -status]
	if { [string equal $status {PGRES_COMMAND_OK}] } then {
	    displayOnForm .form.txtResult "$status\n" {green}
	    set curRecord $lastRecord
	    incr lastRecord
	    set recordArray($curRecord,23status47) "Added"
	    set recordArray($lastRecord,23status47) "After last"
	    set txtRecord(23status47) "Added"
	    set txtRecord(23nr47) "Record [expr $curRecord + 1]/$lastRecord"
	    if {[lsearch $formsArray($activeForm,pkey) {oid}] >= 0} then {
		set oid [pg_result $queryRes -oid]
		set recordArray($curRecord,oid) $oid
	    }
	    foreach attribute $tableAttribList {
		set recordArray($curRecord,$attribute) $txtRecord($attribute)
	    }
	    foreach attribute $formAttribList {
		set recordArray($lastRecord,$attribute) {}
	    }
	} else {
	    set status $status\n[pg_result $queryRes -error]
	    set success 0
	    displayOnForm .form.txtResult "$status\n" {red}
	    set curRecord $lastRecord
	    set txtRecord(23nr47) "Record [expr $lastRecord + 1]/$lastRecord"
	    set txtRecord(23status47) "Not added"
	}
	pg_result $queryRes -clear
	if {!$success} then {
	    bell
	    tk_messageBox -type ok -icon warning -message "Add record has failed" \
		-parent .form
	}
	return $success
    }


    proc updateRecord {} {
	# copy txtRecord to data base and to recordArray

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable recordArray
	variable txtRecord
	variable curRecord
	variable activeForm
	variable attributeArray
	variable tableAttribList

	# Reworked because of bugs 679 and 680.
	# selectForUpdate starts a transaction and checks that the record
	# still exists and has not been modified by another user. If that check
	# fails, selectForUpdate returns 'false' and the update operation is
	# canceled.
	set success 1
	if { [selectForUpdate] } then {
	    set queryDef {}
	    foreach attribute $tableAttribList {
		if {[info exists recordArray($curRecord,$attribute)]} then {
		    if { $txtRecord($attribute) ne \
			     $recordArray($curRecord,$attribute)} then {
			if { $attributeArray($attribute,typeofget) eq \
				 {tgExpression}} then {
			    set txtRecord($attribute) [expr $txtRecord($attribute)]
			}
			switch $attributeArray($attribute,typeofattrib) {
			    "taQuoted" {
				set quotesDoubled [string map {' ''} $txtRecord($attribute)]
				append queryDef " \"$attribute\"='$quotesDoubled',"
			    }
			    "taNotQuoted" {
				append queryDef " \"$attribute\"=$txtRecord($attribute),"
			    }
			}
		    }
		} else {
		    set success 0
		    set errMsg "The attribute '$attribute' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!\n"
		    displayOnForm .form.txtResult $errMsg {red}
		}
	    }
	    if { ![string equal $queryDef {}] && $success } then {
		set queryDef [string trimright $queryDef ","]
		set queryDef "UPDATE \"$formsArray($activeForm,tablename)\"\nSET $queryDef"
		append queryDef "\nWHERE [identCurRecord 0]"
		displayOnForm .form.txtResult "$queryDef\n" {black}
		set queryRes [pg_exec $currentDB $queryDef]
		set status [pg_result $queryRes -status]
		if { [string equal $status {PGRES_COMMAND_OK}] } then {
		    set recordArray($curRecord,23status47) "Updated"
		    set txtRecord(23status47) "Updated"
		    foreach attribute $tableAttribList {
			set recordArray($curRecord,$attribute) $txtRecord($attribute)
		    }
		    displayOnForm .form.txtResult "$status\n" {green}
		    set endTransaction {COMMIT WORK}
		    displayOnForm .form.txtResult "$endTransaction\n" {black}
		} else {
		    set status $status\n[pg_result $queryRes -error]
		    set success 0
		    displayOnForm .form.txtResult "$status\n" {red}
		    set endTransaction {ROLLBACK WORK}
		    displayOnForm .form.txtResult "$endTransaction\n" {black}
		}
		pg_result $queryRes -clear
		filltxtRecord $curRecord
	    } else {
		set status {No updates.}
		set success 0
		displayOnForm .form.txtResult "$status\n" {blue}
		set endTransaction {ROLLBACK WORK}
		displayOnForm .form.txtResult "$endTransaction\n" {black}
		set txtRecord(23status47) $recordArray($curRecord,23status47)
	    }
	} else {
	    set status {Your update is cancelled.}
	    set success 0
	    displayOnForm .form.txtResult "$status\n" {blue}
	    set endTransaction {ROLLBACK WORK}
	    displayOnForm .form.txtResult "$endTransaction\n" {black}
	    set txtRecord(23status47) $recordArray($curRecord,23status47)
	}
	set commitResult [pg_exec $currentDB $endTransaction]
	set commitStatus [pg_result $commitResult -status]
	if { ![string equal $commitStatus {PGRES_COMMAND_OK}] } then {
	    set commitStatus "$commitStatus\n[pg_result $commitResult -error]"
	    displayOnForm .form.txtResult "$commitStatus\n" {red}
	    set success 0
	    set txtRecord(23status47) $recordArray($curRecord,23status47)
	} else {
	    displayOnForm .form.txtResult "$commitStatus\n" {green}
	}
	pg_result $commitResult -clear
	if {!$success} then {
	    bell
	    tk_messageBox -type ok -icon warning -message "No updates done" \
		-parent .form
	}
	return $success
    }

#########################################################################
# selectForUpdate and reloadRecord                                      #
#########################################################################

    proc selectForUpdate { } {

	# Introduced because of bugs 679 and 680.
	# selectForUpdate starts a transaction and checks that the record
	# still exists and has not been modified by another user. If that check
	# fails, selectForUpdate returns 'false'.

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable txtRecord
	variable recordArray
	variable curRecord
	variable tableAttribList
	variable activeForm
	set success 1
	set status {}
	set queryDef {}
	set sqlAttrib \"[join $tableAttribList "\", \""]\"
	# Probably not required anymore:
	# if {([lsearch -exact $tableAttribList oid] == -1) && \
	# 	([lsearch $formsArray($activeForm,pkey) {oid}] >= 0)} then {
	#     set sqlAttrib "\"oid\", $sqlAttrib"
	# }
	set beginWork [pg_exec $currentDB "BEGIN WORK"]
	displayOnForm .form.txtResult "BEGIN WORK\n" {black}
	set beginStatus [pg_result $beginWork -status]
	if { [string equal $beginStatus {PGRES_COMMAND_OK}] } then {
	    displayOnForm .form.txtResult "$beginStatus\n" {green}
	    set queryDef "SELECT $sqlAttrib FROM \"$formsArray($activeForm,tablename)\""
	    set queryDef "$queryDef\nWHERE [identCurRecord 0] FOR UPDATE"
	    displayOnForm .form.txtResult "$queryDef\n" {black}
	    set queryRes [pg_exec $currentDB $queryDef]
	    set status [pg_result $queryRes -status]
	    if { [string equal $status {PGRES_TUPLES_OK}] } then {
		displayOnForm .form.txtResult "$status\n" {green}
		switch -- [pg_result $queryRes -numTuples] {
		    1 {
			pg_result $queryRes -assign recordForUpdate
			foreach attribute $tableAttribList {
			    if {[info exists recordArray($curRecord,$attribute)]} then {
				if { ![string equal $recordArray($curRecord,$attribute) \
					   $recordForUpdate(0,$attribute)] } then {
				    set success 0
				    set status \
					"Record was modified by another user after you pressed the \[Update\] button.\nReconsider your input."
				    displayOnForm .form.txtResult "$status\n" {red}
				    break
				}
			    } else {
				set success 0
				set status \
				    "Attribute '$attribute' of form '$activeForm' was not returned by the form's SQL statement.\nCheck the form's definition!"
				displayOnForm .form.txtResult "$status\n" {red}
				break
			    }
			}
		    }
		    0 {
			set success 0
			# Bug 680 : selectForUpdate has to take into account that the the
			# current record may have been deleted by another user.
			set status \
			    "Record was deleted by another user after you pressed \[Update\]."
			displayOnForm .form.txtResult "$status\n" {red}
		    }
		    default {
			set success 0
			set status "Error in definition of form '$activeForm'."
			set status "$status\npkey '$formsArray($activeForm,pkey)' does not uniquely define a record."
			set status "$status\n[pg_result $queryRes -numTuples] records where returned by the query."
			displayOnForm .form.txtResult "$status\n" {red}
		    }
		}
	    } else {
		set success 0
		set status $status\n[pg_result $queryRes -error]
		displayOnForm .form.txtResult "$status\n" {red}
	    }
	    pg_result $queryRes -clear
	} else {
	    set success 0
	    set beginStatus "$beginStatus\n[pg_result $beginWork -error]"
	    displayOnForm .form.txtResult "$beginStatus\n" {red}
	}
	pg_result $beginWork -clear
	if {!$success} then {
	    bell
	    tk_messageBox -type ok -icon warning -parent .form \
		-message "Select for update failed"
	}
	return $success
    }

    proc reloadRecord { } {

	variable ::pfm::currentDB
	variable ::pfm::formsArray
	variable txtRecord
	variable recordArray
	variable curRecord
	variable formAttribList
	variable activeForm
	set success 1
	if { ![string equal $txtRecord(23status47) {After last}] && \
		![string equal $txtRecord(23status47) {Deleted}] && \
		![string equal $txtRecord(23status47) {Not added}] } then {
	    set sqlAttrib $formsArray($activeForm,sqlselect)
	    set sqlFrom $formsArray($activeForm,sqlfrom)
	    set groupby $formsArray($activeForm,groupby)
	    set tableName $formsArray($activeForm,tablename)
	    set queryDef "SELECT $sqlAttrib\nFROM $sqlFrom"
	    if { [string length $groupby] != 0 } then {
		set queryDef "$queryDef\nGROUP BY $groupby"
		# If there is a GROUP BY clause, the WHERE clause must become a
		# HAVING clause
		set queryDef "$queryDef\nHAVING [identCurRecord 1]"
	    } else {
		set queryDef "$queryDef\nWHERE [identCurRecord 1]"
	    }
	    displayOnForm .form.txtResult "Reload record:\n" {blue}
	    displayOnForm .form.txtResult "$queryDef\n" {black}
	    set queryRes [pg_exec $currentDB $queryDef]
	    set status [pg_result $queryRes -status]
	    if { [string equal $status {PGRES_TUPLES_OK}]} then {
		displayOnForm .form.txtResult "$status\n" {green}
		switch -- [pg_result $queryRes -numTuples] {
		    1 {
			pg_result $queryRes -assign reloadedRecord
			foreach attribute $formAttribList {
			    if {[info exists reloadedRecord(0,$attribute)]} then {
				set recordArray($curRecord,$attribute) $reloadedRecord(0,$attribute)
				set txtRecord($attribute) $recordArray($curRecord,$attribute)
			    } else {
				set errMsg "The attribute '$attribute' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!"
				displayOnForm .form.txtResult "$errMsg\n" {red}
				set succes 0
			    }
			}
		    }
		    0 {
			set success 0
			set status "The query did not return any tuples."
			displayOnForm .form.txtResult "$status\n" {red}
			set status "The record is deleted from the internal buffer,"
			append status " but the database is not modified."
			displayOnForm .form.txtResult "$status\n" {blue}
			set recordArray($curRecord,23status47) "Deleted"
			set txtRecord(23status47) "Deleted"
			foreach attribute $formAttribList {
			    set recordArray($curRecord,$attribute) ""
			    set txtRecord($attribute) ""
			}
		    }
		    default {
			set success 0
			set status "Error in definition of form $activeForm."
			set status "$status\npkey '$formsArray($activeForm,pkey)' does not uniquely define a record."
			set status "$status\n[pg_result $queryRes -numTuples] records where returned by the query."
			displayOnForm .form.txtResult "$status\n" {red}
		    }
		}
	    } else {
		set success 0
		set status "$status\n[pg_result $queryRes -error]"
		displayOnForm .form.txtResult "$status\n" {red}
	    }
	    pg_result $queryRes -clear
	} else {
	    set success 0
	    set status {Record not reloaded}
	    displayOnForm .form.txtResult "$status\n" {blue}
	}
	if {!$success} then {
	    bell
	    tk_messageBox -type ok -icon warning -parent .form -message \
		"Reload record has failed"
	}
	return $success
    }

    ###########################################################################
    #                                                                         #
    # Procedure for writing text on the text windows txtQuery and txtResult   #
    #                                                                         #
    ###########################################################################

    proc displayOnForm {txtWidget text colour} {

	if {$colour ne {black}} then {
	    set begin [$txtWidget index "end - 1 chars"]
	    $txtWidget insert end $text
	    set end [$txtWidget index "end -1 chars"]
	    $txtWidget tag add ${colour}Tag $begin $end
	} else {
	    $txtWidget insert end $text
	}
	return
    }

    #############################################################################
    #                                                                           #
    #  Procedures treating the links                                            #
    #                                                                           #
    #############################################################################

    proc displayLinks {} {

	variable ::pfm::currentDB
	variable activeForm
	variable linksArray
	variable lastFormOnStack
	variable ::options::font

	if {$lastFormOnStack != 0} then {
	    button .form.frmLinkBtn.btnBack -text "Back" -pady 0 -anchor w \
		-command ::form::cmdBack -font $font(propsys)
	    grid .form.frmLinkBtn.btnBack -row 0 \
		    -column 0 -rowspan 1 -columnspan 1 -sticky we
	}
	array unset linksArray
	set queryDef "SELECT * from pfm_link WHERE fromform = '$activeForm'"
	set queryRes [pg_exec $currentDB $queryDef]
	pg_result $queryRes -assign linksArray
	set lastLink [expr [pg_result $queryRes -numTuples] -1]
	pg_result $queryRes -clear
	set rowidx 1
	for {set link 0} {$link <= $lastLink} {incr link} {
	    set linkName $linksArray($link,linkname)
	    button .form.frmLinkBtn.btn$link -text $linkName -pady 0 -anchor w \
		-command "::form::cmdFollowLink $link" -font $font(propsys)
	    grid .form.frmLinkBtn.btn$link -row $rowidx \
		    -column 0 -rowspan 1 -columnspan 1 -sticky we
	    incr rowidx
	}
	return
    }

    proc newLinkState {newState} {

	if { [winfo exists .form.frmLinkBtn.btnBack] } then {
	    .form.frmLinkBtn.btnBack configure -state $newState
	}
	set link 0
	while { [winfo exists .form.frmLinkBtn.btn$link] } {
	    .form.frmLinkBtn.btn$link configure -state $newState
	    incr link
	}
	return
    }

    proc cmdFollowLink {link} {

	variable ::pfm::formsArray
	variable linksArray
	variable txtRecord
	variable attributeArray
	variable activeForm
	variable recordArray
	variable curRecord
	variable lastFormOnStack
	variable formStack
	variable windowSize

	if { ![string equal $txtRecord(23status47) {After last}] && \
		![string equal $txtRecord(23status47) {Deleted}] && \
		![string equal $txtRecord(23status47) {Not added}] } then {
	    if {[winfo exists .form.search]} then {
		destroy .form.search
	    }
	    set whereDef [expandSqlWhere $linksArray($link,sqlwhere) $link]
	    set orderDef $linksArray($link,orderby)
	    set dispAttribList $linksArray($link,displayattrib)
	    set displayDef " "
	    foreach attribute $dispAttribList {
		if {[info exists txtRecord($attribute)]} then {
		    set displayDef "$displayDef$txtRecord($attribute) "
		} else {
		    set errMsg "Wrong definition of 'displayattrib' for link '$linksArray($link,linkname)'."
		    set errMsg "$errMsg\n'$attribute' is not an attribute of form '$activeForm'"
		    tk_messageBox -type ok -icon error -parent .form -message $errMsg
		}
	    }
	    set From "$activeForm \($displayDef\)"
	    set To "$linksArray($link,toform)"
	    # remember view attribute of 'fromform'
	    set view $formsArray($activeForm,view)
	    # remember active form
	    set fromForm $activeForm
	    # prepare form pointed to by the link
	    set activeForm $linksArray($link,toform)
	    getAttributes $activeForm
	    set sqlAttrib $formsArray($activeForm,sqlselect)
	    if {!$formsArray($activeForm,view) && \
		     ([lsearch $formsArray($activeForm,pkey) {oid}] >= 0) && \
		     ([regexp {\moid\M} $sqlAttrib] == 0)} then {
		set sqlAttrib \
		    "\"$formsArray($activeForm,tablename)\".oid, $sqlAttrib"
	    }
	    set sqlFrom $formsArray($activeForm,sqlfrom)
	    set groupby $formsArray($activeForm,groupby)
	    set queryDef "SELECT $sqlAttrib\nFROM $sqlFrom"
	    set intro "Link \'$linksArray($link,linkname) : $From -> $To\'"
	    if { [string length $groupby] != 0 } then {
		append queryDef "\nGROUP BY $groupby"
		# If there is a GROUP BY clause, the whereDef must become a
		# HAVING clause.
		append queryDef "\nHAVING $whereDef"
	    } else {
		append queryDef "\nWHERE $whereDef"
	    }
	    if { [string length $orderDef] != 0 } then {
		append queryDef "\nORDER BY $orderDef"
	    }
	    set displayKey {}
	    foreach pkey $formsArray($fromForm,pkey) {
		if {[info exists recordArray($curRecord,$pkey)]} then {
		    lappend displayKey $recordArray($curRecord,$pkey)
		} else {
		    set errMsg "The pkey attribute '$pkey' of form '$activeForm' is not returned by the form's SQL statement. Check the form's definition!"
		    tk_messageBox -type ok -icon error -parent .form \
			-message $errMsg
		}
	    }
	    set formStack($lastFormOnStack,displayKey) $displayKey
	    incr lastFormOnStack
	    set formStack($lastFormOnStack,formId) $activeForm
	    set formStack($lastFormOnStack,queryDef) $queryDef
	    set formStack($lastFormOnStack,intro) $intro
	    OpenForm $queryDef $intro {}
	}
	return
    }

    proc cmdBack {} {

	variable activeForm
	variable lastFormOnStack
	variable formStack
	if {$lastFormOnStack >= 1} then {
	    incr lastFormOnStack -1
	    set activeForm $formStack($lastFormOnStack,formId)
	    getAttributes $activeForm
	    set queryDef $formStack($lastFormOnStack,queryDef)
	    set intro $formStack($lastFormOnStack,intro)
	    set displayKey $formStack($lastFormOnStack,displayKey)
	    OpenForm $queryDef $intro $displayKey
	}
	return
    }

    proc expandSqlWhere {sqlWhere link} {
	# This procedure finds the $(name) variables,
	# and replaces them with $txtRecord(name)
	# and also doubles all single quotes

	variable txtRecord
	variable linksArray

	set expandWhere $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 txtRecord($parName)]} then {
		set parameter [string map {' ''} $txtRecord($parName)]
		set expandWhere [string replace $expandWhere $first $last $parameter]
	    } else {
		set errMsg \
		    "Error in 'sqlwhere' of link '$linksArray($link,linkname)' "
		append errMsg \
		    "from '$linksArray($link,fromform)' to '$linksArray($link,toform)': "
		append errMsg \
		    "No attribute '$parName' in form '$linksArray($link,fromform)'"
		tk_messageBox -type ok -icon error -parent .form -message $errMsg
	    }
	    set first [string first "\$(" $expandWhere $last]
	}
	return $expandWhere
    }

    ############################################################
    # init namespace form                                      #
    ############################################################

    set windowSize(.query) {700x500}
    set windowSize(.form) {700x500}
    set windowSize(.form.help) {600x400}
    set windowSize(.form.expand) {600x400}
    set windowSize(.form.search) {}

}


##################################################################
# End of namespace form                                          #
##################################################################

##################################################################
# Begin namespace report                                         #
##################################################################

# commandHistory is an associative array where
#
#     - commandHistory(top) is the index in the history where
#           the next command will be stored, i.e. it points
#           to the first free element in the command history array.
#
#     - commandHistory(cursor) is the index in the history of
#               the command that is currently displayed
#
#     - commandHistory($n) is the $n-th command in the history
#
# reportDef is an array which contains the data stored in table
#           pfm_report. It is filled out by cmdDisplayReportList.
#
# layout is an array where layout($level) = row, column or table
#         - "row" means that the labels and values are printed on 1 row
#         - "column" means that the labels are printed in the
#            first column and the values in the second column
#         - "table" means that the values are printed in a
#            table with the labels as table header
#               
#           It is filled out by collectReportLayout.
#
# fieldNamesList($level) contains, for each level, the list
# of field names to be displayed in that level.
#
# printInfo($name,label) contains the label to be used for the
# field "$name". It is filled out by collectReportLayout
#
# printInfo($name,alignment) contains the alignment info:
#    l: left
#    r: right
#
# printInfo($name,width) contains the maximum width for the
# field $name. It is filled out by cmdRunReport.
#
# printInfo($name,columnWidth) contains the maximum of
# the length of the field's label and printInfo($name,width).
# It is the optimum width for a table column displaying the field data.
#
# maxLabelWidth($level,section) contains, for each level, the maximum label width
# for the section $level. It is filled out by collectReportLayout.
#
# maxLabelWidth($level,summary) contains, for each level, the maximum label width
# for the summary $level. It is filled out by collectReportLayout.
#
# targetFields($level) contains the list of summary fields defined in section $level,
# i.e. summary fields meant to be printed at the end of each $level section
#
# sourceFields($level) contains the list of summary fields that are defined as
# normal field in section $level.
#
# summaryDef($level,$seqnr,field), summaryDef($level,$seqnr,aggregate) and
# summaryDef($level,$seqnr,format)
# contain the field, the aggregate operator and the format of the summary field
# $seqnr defined in section $level. The $seqnr is assigned automatically by pfm
# to provide a unique identification of a summary field within a section and to allow
# e.g. both SUM and AVG of the same field in a section.
#
# summaryList($level) the list of seqnr of summary fields for section $level.
#
# sectionBegin($tuple,$level) is a boolean which indicates whether or not $tuple
# is the begin of a section $level.
#
# sectionEnd($tuple,$level) is a boolean which indicates whether or not $tuple
# is the end of a section $level.
#
# reportData contains the result of the query associated with the
# report. It is filled out by cmdRunReport.
#
# summary($field,$targetLevel) contains a list of all the values to be used for
# the aggregate functions operating on $field for $targetLevel.


namespace eval report {

    variable ::pfm::currentDB
    variable ::pfm::dbName
    variable ::pfm::psqlChannel
    variable commandHistory
    variable reportDef
    variable layout
    variable fieldNamesList
    variable printInfo
    variable maxLabelWidth
    variable targetFields
    variable sourceFields
    variable summaryList
    variable summaryDef
    variable sectionBegin
    variable sectionEnd
    variable summary
    variable reportData
    variable reportMode {sql}
    variable printCommand
    variable parmlist
    variable windowSize

########################################################################
#  This is the entry point for this namespace                          #
########################################################################

    proc cmdReportSQL {requestedMode} {
	variable ::pfm::currentDB
	variable ::pfm::dbName
	variable reportMode
	variable wrapOn
	variable ::options::font
	variable windowSize

	set wrapOn 0
	set reportMode $requestedMode
	if { [info exists currentDB] } then {
	    if {[winfo exists .report]} {
		destroy .report
	    }
	    toplevel .report -class Toplevel
	    bind .report <Destroy> {
		set ::report::windowSize(.report) \
		    [string map {{+0+0} {}} [wm geometry .report]]
	    }
	    initCommandHistory
	    wm focusmodel .report passive
	    wm geometry .report $windowSize(.report)
	    wm minsize .report 1 1
	    wm overrideredirect .report 0
	    wm resizable .report 1 1
	    wm deiconify .report
	    wm title .report "pfm - Reports and Queries : $dbName"
	    
	    # define widgets

	    # define upper frame for radiobuttons
	    
	    frame .report.fmUpper -borderwidth 2 -relief groove
	    place .report.fmUpper -x 0 -y 0 -relwidth 1 -height 30 -anchor nw
	    radiobutton .report.fmUpper.rbSQL -text {SQL} -value {sql} \
		-variable ::report::reportMode -command ::report::cmdEnterSQLmode \
		-font $font(propsys)
	    radiobutton .report.fmUpper.rbReport -text {report} -value {report} \
		-variable ::report::reportMode -font $font(propsys) \
		-command ::report::cmdEnterReportMode
	    grid .report.fmUpper.rbSQL -column 0 -row 0
	    grid .report.fmUpper.rbReport -column 1 -row 0

	    # define middle frame and buttons for SQL command

	    frame .report.fmMiddle -borderwidth 2 -relief groove
	    place .report.fmMiddle -x 0 -y -30 -rely 0.4 -height 30 -relwidth 1
	    button .report.fmMiddle.bnRun -text {Run} -command {::report::cmdRun} \
		-underline 0 -font $font(propsys)
	    button .report.fmMiddle.bnSave -text {Save SQL} -font $font(propsys) \
		-command {::report::cmdSaveFile .report.fmSQL.text "Save SQL as" "sql"}
	    button .report.fmMiddle.bnImport -text {Import SQL} -font $font(propsys) \
		-command {::report::cmdImportFile .report.fmSQL.text "Open SQL-file" "sql"}
	    button .report.fmMiddle.bnClear -text {Clear} -underline 0 \
		-command ::report::cmdClear -font $font(propsys)
	    button .report.fmMiddle.bnForward -text {Forward} -underline 0 \
		-command ::report::cmdForward -font $font(propsys)
	    button .report.fmMiddle.bnBack -text {Back} -underline 0 \
		-command ::report::cmdBack -font $font(propsys)
	    button .report.fmMiddle.bnHelp -text {Help} -command ::report::cmdHelp \
		-font $font(propsys)
	    pack .report.fmMiddle.bnRun -side right
	    pack .report.fmMiddle.bnSave -side right
	    pack .report.fmMiddle.bnImport -side right
	    pack .report.fmMiddle.bnClear -side right
	    pack .report.fmMiddle.bnForward -side right
	    pack .report.fmMiddle.bnBack -side right
	    pack .report.fmMiddle.bnHelp -side right

	    # define scrolled text widget for displaying results

	    label .report.lblResult -text {Result} -font $font(propsys)
	    text .report.txtResult -wrap none -background white -font $font(fixed) \
		-xscrollcommand {.report.hscrollResult set} \
		-yscrollcommand {.report.vscrollResult set}
	    # Tag errTag which will be used to highlight error messages from psql.
	    .report.txtResult tag configure errTag -foreground red3
	    scrollbar .report.hscrollResult -orient horizontal -width 15 \
		-command {.report.txtResult xview}
	    scrollbar .report.vscrollResult -orient vertical -width 15 \
		-command {.report.txtResult yview}
	    place .report.lblResult -x 0 -y 0 -relx 0.5 -rely 0.4 -height 15 \
		-anchor n
	    place .report.txtResult -x 0 -y 15 -rely 0.4 -height -60 \
		-relheight 0.6 -width -15 -relwidth 1
	    place .report.hscrollResult -x 0 -y -30 -rely 1 -width -15 -relwidth 1 \
		-anchor sw
	    place .report.vscrollResult -x 0 -y 15 -relx 1 -rely 0.4 -height -60 \
		-relheight 0.6 -anchor ne

	    # define lower frame and buttons

	    frame .report.fmLower -borderwidth 2 -relief groove
	    place .report.fmLower -x 0 -y -30 -rely 1 -height 30 -relwidth 1
	    button .report.fmLower.bnQuit -text {Quit} -font $font(propsys) \
		-command ::report::cmdQuitReport
	    button .report.fmLower.bnSave -text {Save result} -font $font(propsys) \
		-command {::report::cmdSaveFile .report.txtResult "Save result as" "text"}
	    button .report.fmLower.bnPrint -text {Print result} -font $font(propsys) \
		-command {::report::cmdPrint .report.txtResult}
	    button .report.fmLower.bnClear -text {Clear} -font $font(propsys) \
		-command {.report.txtResult delete 1.0 end}
	    radiobutton .report.fmLower.rbWrap -text {Wrap} -value 1 \
		-font $font(propsys) -variable ::report::wrapOn \
		-command {.report.txtResult configure -wrap char}
	    radiobutton .report.fmLower.rbTruncate -text {Truncate} -value 0 \
		-variable ::report::wrapOn -font $font(propsys) \
		-command {.report.txtResult configure -wrap none}

	    pack .report.fmLower.bnQuit -side right
	    pack .report.fmLower.bnSave -side right
	    pack .report.fmLower.bnPrint -side right
	    pack .report.fmLower.bnClear -side right
	    pack .report.fmLower.rbTruncate -side left
	    pack .report.fmLower.rbWrap -side left

	    # Initially enter mode according to $reportMode

	    switch $reportMode {
		sql {
		    cmdEnterSQLmode
		}
		report {
		    cmdEnterReportMode
		}
	    }
	} else {
	    tk_messageBox -message "There is no data base open!" -type ok \
		-icon error -parent .
	}
	return
    }

###########################################################################
# Common procedures, i.e. for both SQL and report mode                    #
###########################################################################

    proc cmdSaveFile {txtWidget title type} {
	
	set textToSave [$txtWidget get 1.0 end]
	switch $type {
	    "sql" {
		set fileTypes {
		    {{SQL statements} {.sql} }
		    {{All files} *}
		}
		set defaultExt ".sql"
	    }
	    "text" {
		set fileTypes {
		    {{Text files} {.txt} }
		    {{All files} *}
		}
		set defaultExt ".txt"
	    }
	}
	set fileName [tk_getSaveFile -title $title -filetypes $fileTypes \
			  -defaultextension $defaultExt -parent .report]
	if { $fileName !=  "" } then {
	    set file_ch [open $fileName w]
	    puts $file_ch $textToSave
	    close $file_ch
	}
	return
    }


    proc cmdImportFile {txtWidget title type} {
	
	switch $type {
	    "sql" {
		set fileTypes {
		    {{SQL statements} {.sql} }
		    {{All files} *}
		}
		set defaultExt ".sql"
	    }
	    "text" {
		set fileTypes {
		    {{Text files} {.txt} }
		    {{All files} *}
		}
		set defaultExt ".txt"
	    }
	}
	set fileName [tk_getOpenFile -title $title -filetypes $fileTypes \
			  -defaultextension $defaultExt -parent .report]
	if { $fileName !=  "" } then {
	    set title "Import SQL"
	    set message "Offer file to psql using \\i (recommended for large files),"
	    append message "\nor import directly in SQL window?"
	    set buttonList {}
	    lappend buttonList {Offer file to psql}
	    lappend buttonList {Import file in SQL window}
	    lappend buttonList {Cancel}
	    switch -- \
		[::pfm::pfmDialog .report.dialog $title $message 400 0 $buttonList] {
		    0 {
			$txtWidget insert end "\\i '[ConvertToUTF-8 $fileName]'"
		    }
		    1 {
			set file_ch [open $fileName r]
			$txtWidget insert end [read $file_ch]
			close $file_ch
		    }
		    default {
		    }
		}
	}
	return
    }

    proc ConvertToUTF-8 {fileName} {
	# This procedures converts $fileName from system encoding to UTF-8.
	# It writes the converted file in pfmOptions(tmpdir) and returns
	# the name of the converted file.
	variable ::options::pfmOptions

	set outFileName {}
	if {![file exists $pfmOptions(tmpdir)]} then {
	    if {[catch {file mkdir $pfmOptions(tmpdir)} errMsg]} then {
		tk_messageBox -type ok -icon error -message $errMsg
	    }
	}
	if {[catch {open $fileName r} inFile]} then {
	    tk_messageBox -type ok -icon error -message $inFile
	} else {
	    set tmpName \
		"pfm_$pfmOptions(user)_[pid].sql"
	    set outFileName [file join $pfmOptions(tmpdir) $tmpName]
	    if {[catch {open $outFileName w} outFile]} then {
		tk_messageBox -type ok -icon error -message $outFile
		set outFileName {}
	    } else {
		fconfigure $outFile -encoding utf-8
		while {![eof $inFile]} {
		    puts $outFile [gets $inFile]
		}
		close $inFile
		close $outFile
	    }
	}
	return $outFileName
    }

    proc cmdPrint {txtWidget} {
	variable ::options::pfmOptions
	variable printCommand
	variable parmlist
	variable ::options::font

	set x [expr [winfo pointerx .report] -500]
	set y [expr [winfo pointery .report] -300]
	toplevel .report.tpPrint -class Toplevel
	wm transient .report.tpPrint .report
	wm geometry .report.tpPrint +$x+$y
	wm title .report.tpPrint "pfm - Print result"
	set printCommand $pfmOptions(printcmd)
	message .report.tpPrint.msgPrintcmd -width 500 -justify center -text \
	    "$printCommand\n\nLongest line is: [longestLine .report.txtResult]" \
	     -font $font(propsys)
	grid .report.tpPrint.msgPrintcmd -column 0 -row 0 -columnspan 3
	set n 1
	# Get the parameters for the printcommand
	set parmlist {}
	set startOfParm [string first "\$(" $printCommand 0]
	if { $startOfParm >= 0 } then {
	    set n 1
	    while { $startOfParm >= 0 } {
		set endOfParm [string first ")" $printCommand $startOfParm]
		if { $endOfParm >= 0 } then {
		    set parm [string range $printCommand $startOfParm $endOfParm]
		    set equalSign [string first "=" $parm 0]
		    if { $equalSign >= 0 } then {
			set defVal [string range $parm [expr $equalSign + 1] "end-1"]
			set parmName [string range $parm 2 [expr $equalSign - 1]]
		    } else {
			set defVal {}
			set parmName [string range $parm 2 "end-1"]
		    }
		    label .report.tpPrint.lb$n -text $parmName -font $font(propsys)
		    grid .report.tpPrint.lb$n -column 0 -row $n
		    entry .report.tpPrint.en$n -width 40 -background white \
			 -font $font(prop)
		    .report.tpPrint.en$n insert end $defVal
		    grid .report.tpPrint.en$n -column 1 -columnspan 2 -row $n
		    lappend parmlist $parm
		    set startOfParm \
			[string first "\$(" $printCommand [expr $endOfParm + 1]]
		    incr n
		} else {
		    set startOfParm -1
		}
	    }
	}
	button .report.tpPrint.bnOK -text OK -font $font(propsys) \
	    -command "::report::cmdPrintOK $txtWidget"
	button .report.tpPrint.bnCancel -text Cancel -font $font(propsys) \
	    -command {destroy .report.tpPrint}
	grid .report.tpPrint.bnOK -column 1 -row $n -sticky we
	grid .report.tpPrint.bnCancel -column 2 -row $n -sticky we
	return
    }

    proc cmdPrintOK {txtWidget} {
	variable printCommand
	variable parmlist
	variable ::options::pfmOptions

	# This part was completely rewritten.
	# The lappend function ensures that the arguments of the openCommand
	# are properly delimited with { and } where necessary.
	# Also possibility to use temp file was added: %s in printCommand
	# represents the temporary file.

	if {[string first {%s} $printCommand] <= 0} then {
	    # input via stdin
	    set tempFile 0
	} else {
	    # input via temporary file
	    if {![file exists $pfmOptions(tmpdir)]} then {
		if {[catch {file mkdir $pfmOptions(tmpdir)} errMsg]} then {
		    tk_messageBox -type ok -icon error -message $errMsg
		}
	    }
	    set tempFile 1
	    set tmpName "pfm_$pfmOptions(user)_[pid].txt"
	    set fileName [file normalize [file join $pfmOptions(tmpdir) $tmpName]]
	    set map {}
	    lappend mapTemp {%s}
	    lappend mapTemp $fileName
	}
	set execCommand {}
	foreach arg $printCommand {
	    set n 1
	    foreach parm $parmlist {
		set value [.report.tpPrint.en$n get]
		set map $parm
		lappend map $value
		set arg [string map $map $arg]
		incr n
	    }
	    if {$tempFile} then {
		set arg [string map $mapTemp $arg]
	    }
	    lappend execCommand $arg
	}
	destroy .report.tpPrint
	if {$tempFile} then {
	    set openCommand $fileName
	} else {
	    set openCommand [linsert $execCommand 0 {|}]
	}
	# puts $openCommand
	if { [catch {open $openCommand w} printch] } then {
	    tk_messageBox -type ok -icon error -message $printch
	} else {
	    # Next line added because of feature request 693.
	    fconfigure $printch -encoding $pfmOptions(printencoding)
	    puts $printch [$txtWidget get 1.0 end]
	    if { [catch {close $printch} errMsg] } then {
		tk_messageBox -message $errMsg -type ok -icon info
	    }
	    if {$tempFile} then {
		set execCommand [linsert $execCommand 0 {exec}]
		lappend execCommand {&}
		# puts $execCommand
		if {[catch $execCommand errMsg]} then {
		    tk_messageBox -type ok -icon error -message $errMsg
		}
	    }
	}
	return
    }

    proc longestLine {txtWidget} {

	set longest 0
	set lastIndex [$txtWidget index end]
	set index [$txtWidget index 1.0]
	while { $index < $lastIndex } {
	    set thisLineLength [string length [$txtWidget get $index "$index lineend"]]
	    if { $longest < $thisLineLength } then {
		set longest $thisLineLength
	    }
	    set index [$txtWidget index "$index +1 lines"]
	}
	return $longest
    }

    proc cmdRun {} {
	variable reportMode

	switch $reportMode {
	    sql {
		cmdRunSQL
	    }
	    report {
		cmdRunReport [.report.fmReport.lsb curselection]
	    }
	}
	return
    }


    proc {cmdQuitReport} {} {
	variable commandHistory
	variable windowSize

	destroy .report
	array unset commandHistory
    }

###########################################################################
#  Procedures for queries (SQL mode)                                      #
###########################################################################

    proc cmdEnterSQLmode { } {
	variable ::pfm::dbName
	variable reportMode
	variable ::options::font

	destroy .report.fmReport
	frame .report.fmSQL
	label .report.fmSQL.title -text {SQL statement} -font $font(propsys)
	text .report.fmSQL.text -wrap none -font $font(fixed) -background white \
	    -xscrollcommand {.report.fmSQL.hscroll set} \
	    -yscrollcommand {.report.fmSQL.vscroll set}
	scrollbar .report.fmSQL.hscroll -orient horizontal -width 15 \
	    -command {.report.fmSQL.text xview}
	scrollbar .report.fmSQL.vscroll -orient vertical -width 15 \
	    -command {.report.fmSQL.text yview}
	place .report.fmSQL -x 0 -y 30 -relwidth 1 -height -60 -relheight 0.4
	place .report.fmSQL.title -x 0 -y 0 -relx 0.5 -anchor n -height 15
	place .report.fmSQL.text -x 0 -y 15 -width -15 -relwidth 1 \
	    -height -30 -relheight 1
	place .report.fmSQL.hscroll -x 0 -y 0 -rely 1 -width -15 -relwidth 1 \
	    -anchor sw
	place .report.fmSQL.vscroll -x 0 -y 15 -relx 1 -height -30 -relheight 1 \
	    -anchor ne
	.report.fmMiddle.bnSave configure -state normal
	.report.fmMiddle.bnImport configure -state normal
	.report.fmMiddle.bnClear configure -state normal
	.report.fmMiddle.bnHelp configure -state normal
	bind .report <Alt-KeyPress-r> ::report::cmdRun
	bind .report <Alt-KeyPress-b> ::report::cmdBack
	bind .report <Alt-KeyPress-f> ::report::cmdForward
	bind .report <Alt-KeyPress-Return> ::report::cmdRun
	bind .report <Alt-KeyPress-p> ::report::cmdBack
	bind .report <Alt-KeyPress-n> ::report::cmdForward
	bind .report <Alt-KeyPress-c> ::report::cmdClear
	bind .report <Alt-KeyPress-h> {::report::cmdShortCut {\h}}
	bind .report <Alt-KeyPress-question> {::report::cmdShortCut {\?}}
	bind .report <Alt-KeyPress-d> {::report::cmdShortCut {\d}}
	bind .report <Alt-KeyPress-l> {::report::cmdShortCut {\l}}
	cmdClear
	return
    }

    proc showResult { } {
	variable ::pfm::psqlChannel

	if { ![winfo exists .report.txtResult] } then {
	    # If psql sends output when the .report window is not existing,
	    # we create the .report window.
	    ::report::cmdReportSQL {sql}
	}
	if { ![eof $psqlChannel] } then {
	    .report.txtResult insert end "[gets $psqlChannel]\n"
	    .report.txtResult see end
	} else {
	    # Bug 690: pfm hangs when psql exits.
	    # This branch is necessary to avoid endless loops when the user types '\q',
	    # or in the unlikely event that psql dies.
	    fileevent $psqlChannel readable {}
	    unset psqlChannel
	    puts [info exists psqlChannel]
	    .report.txtResult insert end "Connection with psql is closed.\n"
	    .report.txtResult see end
	}
	return
    }

    proc showError { } {
	variable ::pfm::errChannel

	if { ![winfo exists .report.txtResult] } then {
	    # If psql sends output when the .report window is not existing,
	    # we create the .report window.
	    ::report::cmdReportSQL {sql}
	}
	if { ![eof $errChannel] } then {
	    set begin [.report.txtResult index "end - 1 chars"]
	    .report.txtResult insert end "[gets $errChannel]\n"
	    .report.txtResult see end
	    set end [.report.txtResult index "end - 1 chars"]
	    .report.txtResult tag add errTag $begin $end
	} else {
	    fileevent $errChannel readable {}
	    unset errChannel
	    .report.txtResult insert end "Error channel has died.\n"
	    .report.txtResult see end
	}
	return
    }

    proc cmdClear {} {
	variable commandHistory

	.report.fmSQL.text delete 1.0 end
	set commandHistory($commandHistory(top)) {}
	# Added because of bug 691. If user presses [Clear], cursor must
	# be reset to top of command history.
	set commandHistory(cursor) $commandHistory(top)
	if { $commandHistory(top) > 0 } then {
	    .report.fmMiddle.bnBack configure -state normal
	} else {
	    .report.fmMiddle.bnBack configure -state disabled
	}
	.report.fmMiddle.bnForward configure -state disabled
	return
    }

    proc initCommandHistory {} {
	variable commandHistory

	set commandHistory(top) 0
	set commandHistory(cursor) 0
	set commandHistory(0) {}
	return
    }

    proc storeCommand {} {
	variable commandHistory

	# Store command in first free element of commandHistory array
	# Do not store \i commands
	set commandStart [.report.fmSQL.text get 1.0 1.2]
	if {$commandStart ne {\i}} then {
	    set commandHistory($commandHistory(top)) [.report.fmSQL.text get 1.0 "end -1 chars"]
	    # Increment top to first free element.
	    incr commandHistory(top)
	    set commandHistory($commandHistory(top)) {}
	    set commandHistory(cursor) $commandHistory(top)
	    .report.fmMiddle.bnBack configure -state normal
	    .report.fmMiddle.bnForward configure -state disabled
	}
	return
    }

    proc cmdBack {} {
	variable commandHistory

	if { $commandHistory(cursor) == $commandHistory(top) } then {
	    set commandHistory($commandHistory(top)) [.report.fmSQL.text get 1.0 "end -1 chars"]
	}
	# Reworked because of bug 691.
	
	if { $commandHistory(cursor) > 0 } then {
	    incr commandHistory(cursor) -1
	    .report.fmSQL.text delete 1.0 end
	    .report.fmSQL.text insert end $commandHistory($commandHistory(cursor))
	    .report.fmMiddle.bnForward configure -state normal
	    if { $commandHistory(cursor) == 0} then {
		.report.fmMiddle.bnBack configure -state disabled
	    }
	} else {
	    bell
	}
	return
    }

    proc cmdForward {} {
	variable commandHistory

	# Reworked because of bug 691.
	if { $commandHistory(cursor) < $commandHistory(top) } then {
	    incr commandHistory(cursor)
	    .report.fmSQL.text delete 1.0 end
	    .report.fmSQL.text insert end $commandHistory($commandHistory(cursor))	    
	    if { $commandHistory(cursor) == $commandHistory(top) } then {
		.report.fmMiddle.bnForward configure -state disabled
	    }
	    .report.fmMiddle.bnBack configure -state normal
	} else {
	    bell
	}
	return
    }

    proc cmdRunSQL {} {
	variable ::pfm::psqlChannel
	variable ::pfm::errChannel

	storeCommand
        set sqlCmd [.report.fmSQL.text get 1.0 end]
	if { [info exists psqlChannel] } then {
	    if { [catch {
		puts $psqlChannel $sqlCmd
		flush $psqlChannel
	    } errMsg] } then {
		tk_messageBox -message $errMsg -type ok -icon error
	    }
	} else {
	    puts $errChannel \
		"No connection with psql.\nTry to close and reopen the database.\n"
	    flush $errChannel
	}
	.report.fmSQL.text delete 1.0 end
	return
    }

    proc cmdHelp {} {

	set helpTxt "This feature allows you to run SQL commands in 'psql'.\n"
	append helpTxt "\nAvailable shortcuts:\n"
	append helpTxt "\nAlt-r or Alt-Return : Run"
	append helpTxt "\nAlt-b or Alt-p      : Back (previous)"
	append helpTxt "\nAlt-f or Alt-n      : Forward (next)"
	append helpTxt "\nAlt-c               : Clear"
	append helpTxt "\nAlt-?               : Help about psql '\\' commands (\\? Run)"
	append helpTxt "\nAlt-h               : Help about SQL (\\h Run)"
	append helpTxt "\nAlt-d               : List of relations (\\d Run)"
	append helpTxt "\nAlt-l               : List of databases (\\l Run)\n\n"
	.report.txtResult insert end $helpTxt
	.report.txtResult see end
    }

    proc cmdShortCut {command} {

	.report.fmSQL.text insert end $command
	cmdRunSQL
	return
    }

###################################################################
#  Procedures for report mode                                     #
###################################################################

    proc cmdEnterReportMode { } {
	variable reportMode

	destroy .report.fmSQL
	.report.fmMiddle.bnSave configure -state disabled
	.report.fmMiddle.bnImport configure -state disabled
	.report.fmMiddle.bnClear configure -state disabled
	.report.fmMiddle.bnForward configure -state disabled
	.report.fmMiddle.bnBack configure -state disabled
	.report.fmMiddle.bnHelp configure -state disabled
	bind .report <Alt-KeyPress-r> ::report::cmdRun
	bind .report <Alt-KeyPress-b> {}
	bind .report <Alt-KeyPress-f> {}
	bind .report <Alt-KeyPress-Return> ::report::cmdRun
	bind .report <Alt-KeyPress-p> {}
	bind .report <Alt-KeyPress-n> {}
	bind .report <Alt-KeyPress-c> {}
	bind .report <Alt-KeyPress-h> {}
	bind .report <Alt-KeyPress-question> {}
	bind .report <Alt-KeyPress-d> {}
	bind .report <Alt-KeyPress-l> {}
	cmdDisplayReportList
	return
    }


    proc cmdDisplayReportList {} {
	variable ::pfm::currentDB
	variable reportDef
	variable ::options::font
	variable ::options::pfmOptions

	if { ![info exists currentDB] } then {
	    tk_messageBox -message "There is no data base open!" -type ok \
		-icon error
	} else {
	    set queryDef "SELECT * FROM pfm_report ORDER BY name"
	    set queryRes [pg_exec $currentDB $queryDef]
	    set lastTuple [expr [pg_result $queryRes -numTuples] - 1]
	    pg_result $queryRes -assign reportDef
	    pg_result $queryRes -clear
	    if { $lastTuple < 0} then {
		tk_messageBox -message "There are no reports defined!" \
		    -type ok -icon info
	    } else {
		set maxNameWidth 0
		for {set tuple 0} {$tuple <= $lastTuple} {incr tuple } {
		    set nameLength [string length $reportDef($tuple,name)]
		    if { $nameLength > $maxNameWidth } then {
			set maxNameWidth $nameLength
		    }
		}
		set reportList {}
		for {set tuple 0} {$tuple <= $lastTuple} {incr tuple } {
		    set name [format "%-$maxNameWidth\s" $reportDef($tuple,name)]
		    lappend reportList \
			    "$name : $reportDef($tuple,description)"
		}
		destroy .report.fmReport
		frame .report.fmReport
		label .report.fmReport.title -text "List of reports" \
		    -font $font(propsys)
		listbox .report.fmReport.lsb \
		    -font $font(fixsys) -background white \
		    -yscrollcommand {.report.fmReport.vscroll set}
		scrollbar .report.fmReport.vscroll -orient vertical -width 15 \
		    -command {.report.fmReport.lsb yview}
		foreach report $reportList {
		    .report.fmReport.lsb insert end $report
		}
		.report.fmReport.lsb selection clear 0 end
		.report.fmReport.lsb selection set 0 0
		place .report.fmReport -x 0 -y 30 -relwidth 1 -height -60 -relheight 0.4
       		place .report.fmReport.title -x 0 -y 0 -relx 0.5 -height 15 -anchor n
		place .report.fmReport.lsb -x 0 -y 15 -width -15 -relwidth 1 \
		    -height -15 -relheight 1
		place .report.fmReport.vscroll -x 0 -y 15 -relx 1 \
		    -height -15 -relheight 1 -anchor ne
	    }
	}
	return
    }

    proc cmdRunReport {selectedReport} {
	variable reportDef
	variable ::pfm::currentDB
	variable parmlist
	variable ::options::font

	# Get the parameters necessary to execute the query
	set sqlselect $reportDef($selectedReport,sqlselect)
	set startOfParm [string first "\$(" $sqlselect 0]
	if { $startOfParm >= 0 } then {
	    set parmlist {}
	    set x [expr [winfo pointerx .report] - 600]
	    set y [expr [winfo pointery .report] -100]
	    toplevel .report.getparm -class Toplevel
	    wm transient .report.getparm .report
	    wm geometry .report.getparm 600x400+$x+$y
	    wm title .report.getparm "pfm - Get report parameters"
	    text .report.getparm.txtselect -wrap word -font $font(fixed) \
		-yscrollcommand {.report.getparm.vscroll set} -background white
	    scrollbar .report.getparm.vscroll -orient vertical -width 15 \
		-command {.report.getparm.txtselect yview}
	    place .report.getparm.txtselect -x 0 -y 0 -anchor nw \
		-width -15 -relwidth 1 -height 150
	    place .report.getparm.vscroll -x 0 -y 0 -relx 1 -height 150 \
		-anchor ne
	    .report.getparm.txtselect insert end $reportDef($selectedReport,sqlselect)
	    frame .report.getparm.frmparm -relief sunken -borderwidth 2
	    set frmparm .report.getparm.frmparm
	    place .report.getparm.frmparm -x 0 -y 150 -relwidth 1 \
		-height -180 -relheight 1 -anchor nw
	    set n 0
	    while { $startOfParm >= 0 } {
		set endOfParm [string first ")" $sqlselect $startOfParm]
		if { $endOfParm >= 0 } then {
		    set parm [string range $sqlselect $startOfParm $endOfParm]
		    if { [lsearch -exact $parmlist $parm] == -1} then {
			# It is a new parameter. If the parameter is already
			# in parmlist, there is no need to prompt the user again.
			set labelText [string range $sqlselect \
					   [expr $startOfParm +2] [expr $endOfParm - 1]]
			label .report.getparm.frmparm.lb$n -text $labelText \
			     -font $font(propsys)
			grid .report.getparm.frmparm.lb$n -column 0 -row $n
			entry .report.getparm.frmparm.en$n -width 40 \
			    -background white -font $font(prop)
			grid .report.getparm.frmparm.en$n -column 1 -row $n
			lappend parmlist $parm
			incr n
		    }
		    set startOfParm [string first "\$(" $sqlselect [expr $endOfParm + 1]]
		} else {
		    set startOfParm -1
		}
	    }
	    button .report.getparm.bnOK -text OK -font $font(propsys) \
		-command "::report::completeSqlselect $selectedReport"
	    place .report.getparm.bnOK -x -30 -y 0 -relx 0.5 -rely 1 -anchor s
	    button .report.getparm.bnCancel -text Cancel -font $font(propsys) \
		-command {destroy .report.getparm}
	    place .report.getparm.bnCancel -x 30 -y 0 -relx 0.5 -rely 1 -anchor s
	} else {
	    executeQuery $selectedReport $sqlselect
	}
	return
    }

    proc completeSqlselect { selectedReport } {
	variable parmlist
	variable reportDef

	set sqlselect $reportDef($selectedReport,sqlselect)
	set n 0
	foreach parm $parmlist {
	    set value [.report.getparm.frmparm.en$n get]
	    set sqlselect [string map "$parm \"$value\"" $sqlselect]
	    incr n
	}
	destroy .report.getparm
	executeQuery $selectedReport $sqlselect
	return
    }

    proc executeQuery {selectedReport sqlselect } {
	variable reportDef
	variable ::pfm::currentDB
	variable ::pfm::errChannel
	variable reportData

	# Execute the query for the report and store the result in reportData

	set queryRes [pg_exec $currentDB $sqlselect]
	set queryStatus [pg_result $queryRes -status]
	if { [string equal $queryStatus "PGRES_TUPLES_OK"] } then {
	    pg_result $queryRes -assign reportData
	    set lastTuple [expr [pg_result $queryRes -numTuples] - 1]
	    printReport $selectedReport $lastTuple $sqlselect
	} else {
	    set errmsg "$sqlselect failed\n"
	    set errmsg "$errmsg [pg_result $queryRes -error]\n"
	    puts $errChannel $errmsg
	    flush $errChannel
	}
	pg_result $queryRes -clear
	return
    }

    proc printReport {selectedReport lastTuple sqlselect} {
	variable reportDef
	variable fieldNamesList
	variable printInfo
	variable reportData
	variable layout
	variable maxLabelWidth
	variable targetFields
	variable sourceFields
	variable summaryList
	variable summaryDef
	variable sectionBegin
	variable sectionEnd
	variable summary	

	set lastLevel [collectReportLayout $selectedReport]

	if {[checkReportDef $lastLevel $lastTuple]} then {

	    delimitSections $lastTuple $lastLevel

	    # Calculate maximum field width and the optimum columwidth
	    # for a table layout. Store result in printInfo.

	    for { set level 1 } { $level <= $lastLevel} { incr level} {
		foreach field $fieldNamesList($level) {
		    set printInfo($field,width) 0
		    for {set tuple 0} { $tuple <= $lastTuple } { incr tuple } {
			set width [string length $reportData($tuple,$field)]
			if { $printInfo($field,width) < $width } then {
			    set printInfo($field,width) $width
			}
		    }
		    set labelLength [string length $printInfo($field,label)]
		    if { $printInfo($field,width) < $labelLength } then {
			set printInfo($field,columnWidth) $labelLength
		    } else {
			set printInfo($field,columnWidth) $printInfo($field,width)
		    }
		}
	    }

	    # Print report title

	    .report.txtResult insert end "$reportDef($selectedReport,name)\n"
	    .report.txtResult insert end \
		"[string repeat - [string length $reportDef($selectedReport,name)]]\n\n"

	    .report.txtResult insert end \
		"Description: $reportDef($selectedReport,description)\n"
	    set formattedSQL [string map {\n "\n             "} $sqlselect]
	    .report.txtResult insert end "SQL        : $formattedSQL\n"
	    .report.txtResult insert end \
		"Date       : [clock format [clock seconds] -format {%d-%b-%Y}]\n\n"

	    # print the reportData

	    for {set tuple 0} {$tuple <= $lastTuple} {incr tuple} {
		for {set level 1} {$level <= $lastLevel} {incr level} {
		    if {$sectionBegin($tuple,$level)} then {
			initSummary $level
		    }
		}
		for {set level 1} {$level <= $lastLevel} {incr level} {
		    if {$level != $lastLevel} then {
			if {[newValues $level $tuple]} then {
			    updateSummary $level $tuple
			    .report.txtResult insert end \
				[printLevel 1 $level $tuple]
			}
		    } else {
			updateSummary $level $tuple
			.report.txtResult insert end \
			    [printLevel $sectionBegin($tuple,$level) $level $tuple]
		    }
		}
		for {set level $lastLevel} {$level >= 1} {incr level -1} {
		    if {$sectionEnd($tuple,$level)} then {
			printSummary $level
		    }
		}
	    }
	    .report.txtResult insert end "\n\n"
	    .report.txtResult see end
	}
	unset fieldNamesList
	array unset printInfo
	array unset reportData
	array unset layout
	array unset maxLabelWidth
	unset targetFields
	unset sourceFields
	unset summaryList
	array unset summaryDef
	array unset sectionBegin
	array unset sectionEnd
	array unset summary
	return
    }

    proc collectReportLayout {selectedReport} {
	variable ::pfm::currentDB
	variable layout
	variable fieldNamesList
	variable printInfo
	variable reportDef
	variable maxLabelWidth
	variable targetFields
	variable sourceFields
	variable summaryDef
	variable summaryList
	variable ::pfm::errChannel

	# Get data from pfm_section and store them in sectionArray

	set queryDef "SELECT * FROM pfm_section WHERE report='$reportDef($selectedReport,name)'"
	set queryDef "$queryDef ORDER BY level"
	set queryRes [pg_exec $currentDB $queryDef]
	set lastTuple [expr [pg_result $queryRes -numTuples] - 1]
	pg_result $queryRes -assign sectionArray
	pg_result $queryRes -clear
	set lastLevel 0
	set shouldBeLevel 1

	# Store data in layout, fieldNamesList and printInfo

	for {set tuple 0} {$tuple <= $lastTuple} {incr tuple } {
	    if {$sectionArray($tuple,level) != $shouldBeLevel} then {
		set errMsg "\nWARNING: The levels of pfm_section should be numbered consecutively, starting from 1! "
		append errMsg "\nLevel '$sectionArray($tuple,level)' should become level '$shouldBeLevel'!\n"
		puts $errChannel $errMsg
		flush $errChannel
		set sectionArray($tuple,level) $shouldBeLevel
	    }
	    if { $sectionArray($tuple,level) > $lastLevel} then {
		set lastLevel $sectionArray($tuple,level)
	    }
	    set layout($shouldBeLevel) $sectionArray($tuple,layout)
	    set fieldDefList $sectionArray($tuple,fieldlist)
	    set fieldNamesList($shouldBeLevel) {}
	    foreach item $fieldDefList {
		set attribName [lindex $item 0]
		lappend fieldNamesList($shouldBeLevel) $attribName
		set printInfo($attribName,label) [lindex $item 1]
		set printInfo($attribName,alignment) [lindex $item 2]
	    }
	    incr shouldBeLevel
	}

	# Calculate maxLabelWidth per level

	for { set level 1 } { $level <= $lastLevel } { incr level } {
	    set maxLabelWidth($level,section) 0
	    foreach field $fieldNamesList($level) {
		set width [string length $printInfo($field,label)]
		if { $width > $maxLabelWidth($level,section) } then {
		    set maxLabelWidth($level,section) $width
		}
	    }
	}

	# Read summary definitions

	for {set tuple 0} {$tuple <= $lastTuple} {incr tuple} {
	    set level $sectionArray($tuple,level)
	    set targetFields($level) {}
	    set summaryList($level) {}
	    set seqnr 1
	    foreach summaryItem $sectionArray($tuple,summary) {
		set field [lindex $summaryItem 0]
		set summaryDef($level,$seqnr,field) $field
		if {[lsearch $targetFields($level) $field] == -1} then {
		    lappend targetFields($level) $field
		}
		set summaryDef($level,$seqnr,aggregate) [lindex $summaryItem 1]
		set summaryDef($level,$seqnr,format) [lindex $summaryItem 2]
		lappend summaryList($level) $seqnr
		incr seqnr
	    }
	}
	
	# Check summary definitions and calculate sourceFields($level) and
	# maxLabelWidth($level,summary)

	for {set level 1} {$level <= $lastLevel} {incr level} {
	    set sourceFields($level) {}
	}
	for {set level 1} {$level <= $lastLevel} {incr level} {
	    set maxLabelWidth($level,summary) 0
	    foreach seqnr $summaryList($level) {
		set sourceLevel 0
		set field $summaryDef($level,$seqnr,field)
		for {set searchLevel $level} {$searchLevel <= $lastLevel} \
		    {incr searchLevel} {
			if {[lsearch $fieldNamesList($searchLevel) $field] >= 0} then {
			    set sourceLevel $searchLevel
			    break
			}
		}
		if {$sourceLevel == 0} then {
		    set errMsg "\nERROR: Summary field '$field' in section '$level'"
		    append errMsg \
			"\neither is not defined as a normal field in any section,"
		    append errMsg \
			"\nor it is defined in a section with level lower than $level."
		    append errMsg \
			"\nSummary field '$field' has been discarded.\n"
		    puts $errChannel $errMsg
		    flush $errChannel
		    set fieldIndex [lsearch $targetFields($level) $field]
		    if {$fieldIndex >= 0} then {
			set targetFields($level) \
			    [lreplace $targetFields($level) $fieldIndex $fieldIndex]
		    }
		    unset summaryDef($level,$seqnr,aggregate)
		    unset summaryDef($level,$seqnr,format)
		    unset summaryDef($level,$seqnr,field)
		    set seqIndex [lsearch $summaryList($level) $seqnr]
		    if {$seqIndex >= 0} then {
			set summaryList($level) \
			    [lreplace $summaryList($level) $seqIndex $seqIndex]
		    }
		} else {
		    if {[lsearch $sourceFields($sourceLevel) $field] == -1} then {
			lappend sourceFields($sourceLevel) $field
		    }
		    set labelWidth \
			[expr [string length $printInfo($field,label)] + \
			     [string length $summaryDef($level,$seqnr,aggregate)] + 2]
		    if { $maxLabelWidth($level,summary) < $labelWidth} then {
			set maxLabelWidth($level,summary) $labelWidth
		    }
		}
	    }
	}
	array unset sectionArray
	return $lastLevel
    }

    proc delimitSections {lastTuple lastLevel} {
	variable reportData
	variable sectionBegin
	variable sectionEnd

	for {set tuple 0} {$tuple <= $lastTuple} {incr tuple} {
	    for {set level 1} {$level <= $lastLevel} {incr level} {
		set sectionBegin($tuple,$level) 0
		set sectionEnd($tuple,$level) 0
	    }
	}
	for {set level 1} {$level <= $lastLevel} {incr level} {
	    set sectionBegin(0,$level) 1
	    set sectionEnd($lastTuple,$level) 1
	}
	for {set tuple 0} {$tuple <= $lastTuple} {incr tuple} {
	    for {set level 1} {$level <= [expr $lastLevel - 1]} {incr level} {
		if {[newValues $level $tuple]} then {
		    set sectionEnd([expr $tuple - 1],[expr $level + 1]) 1
		    set sectionBegin($tuple,[expr $level + 1]) 1
		}
	    }
	}
	return
    }

    proc checkReportDef {lastLevel lastTuple} {
	variable fieldNamesList
	variable reportData
	variable ::pfm::errChannel

	set result 1
	if {$lastTuple == -1} then {
	    set errMsg "\nWARNING: The report's SQL SELECT statement did not return any data.\n"
	    puts $errChannel $errMsg
	    flush $errChannel
	} else {
	    for {set level 1} {$level <= $lastLevel} {incr level} {
		foreach field $fieldNamesList($level) {
		    if {![info exists reportData(0,$field)]} then {
			set result 0
			set errMsg \
			    "\nERROR: The report's SQL SELECT statement does not return data"
			append errMsg \
			    "\nfor field '$field' defined in section '$level' of the report."
			append errMsg \
			    "\nCheck the report definition!\n"
			puts $errChannel $errMsg
			flush $errChannel
		    }
		}
	    }
	}
	return $result
    }

    proc newValues {level tuple} {
	variable fieldNamesList
	variable reportData

	if { $tuple == 0 } then {
	    set returnValue 1
	} else {
	    set returnValue 0
	    foreach field $fieldNamesList($level) {
		if { $reportData($tuple,$field) != $reportData([expr $tuple - 1],$field) } then {
		    set returnValue 1
		}
	    }
	}
	return $returnValue
    }

    proc initSummary {targetLevel} {
	# procedure to be called at the begin of each $targetLevel section
	# it inits all lists
	# targetLevel is the level for which the summary is calculated.
	variable targetFields
	variable summary

	# .report.txtResult insert end "initSummary $targetLevel\n"
	foreach field $targetFields($targetLevel) {
	    set summary($field,$targetLevel) {}
	}
	return
    }

    proc updateSummary {sourceLevel tuple} {
	# procedure to be called every time a new value for $sourecLevel section
	# is being printed.
	# sourceLevel is the level/section in which a field is defined as an
	# ordinary field.
	variable reportData
	variable summary
	variable sourceFields
	variable targetFields

	foreach field $sourceFields($sourceLevel) {
	    for {set targetLevel 1} {$targetLevel <= $sourceLevel} {incr targetLevel} {
		if {([lsearch $targetFields($targetLevel) $field] >= 0) && \
			($reportData($tuple,$field) ne {})} then {
		    # Null fields are discarded. Else most aggregate functions
		    # will not give the right result when a LEFT JOIN does not
		    # yield a record in the right table.
		    lappend summary($field,$targetLevel) $reportData($tuple,$field)
		}
	    }
	}
	return
    }
    
    proc printSummary {targetLevel} {
	variable summary
	variable summaryDef
	variable targetFields
	variable summaryList
	variable ::pfm::errChannel

	set firstLine 1
	if {$summaryList($targetLevel) ne {}} then {
	    .report.txtResult insert end "\n"
	}
	foreach seqnr $summaryList($targetLevel) {
	    if {[info commands \
		     ::aggregate::$summaryDef($targetLevel,$seqnr,aggregate)] \
		    ne {}} then {
		set field $summaryDef($targetLevel,$seqnr,field)
		set value [::aggregate::$summaryDef($targetLevel,$seqnr,aggregate) \
			       $summary($field,$targetLevel)]
		printSummaryLine $targetLevel $seqnr $value $firstLine
		set firstLine 0
	    } else {
		set errMsg "ERROR: Aggregate function '$summaryDef($targetLevel,$seqnr,aggregate)' is not defined."
		puts $errChannel "$errMsg\n"
		flush $errChannel
	    }
	}
	return
    }

    proc printSummaryLine {level seqnr value firstLine} {
	variable summaryDef
	variable printInfo
	variable maxLabelWidth

	set offset [string repeat " " [expr 4 * ($level - 1)]]
	if {$firstLine} then {
	    set textToPrint "$offset\Summary: "
	} else {
	    set textToPrint "$offset         "
	}
	set field $summaryDef($level,$seqnr,field)
	set label $printInfo($field,label)
	set label "$summaryDef($level,$seqnr,aggregate)($label)"
	set formatLabel "%-$maxLabelWidth($level,summary)\s"
	set formatString $summaryDef($level,$seqnr,format)
	set textToPrint "$textToPrint[format $formatLabel $label] = "
	if {$formatString ne {}} then {
	    set textToPrint "$textToPrint[format $formatString $value]\n"
	} else {
	    set textToPrint "$textToPrint$value\n"
	}
	.report.txtResult insert end $textToPrint
	.report.txtResult see end
	return
    }

    proc printLevel {firstRecordOfTable level tuple} {
	variable layout

	switch $layout($level) {
	    row {
		set lineToPrint [printRow $level $tuple]
	    }
	    column {
		set lineToPrint [printColumn $firstRecordOfTable $level $tuple]
	    }
	    table {
		set lineToPrint [printTable $firstRecordOfTable $level $tuple]
	    }
	}
  	if { $firstRecordOfTable } then {
  	    set lineToPrint "\n$lineToPrint"
  	}
	return $lineToPrint
    }



    proc printRow {level tuple} {
	variable reportData
	variable fieldNamesList
	variable printInfo

	set offset [string repeat " " [expr 4 * ($level - 1)]]
	set lineToPrint $offset
	foreach field $fieldNamesList($level) {
	    append lineToPrint "$printInfo($field,label):"
	    append lineToPrint "$reportData($tuple,$field); "
	}
	append lineToPrint "\n"
	return $lineToPrint
    }


    proc printColumn {firstRecordOfTable level tuple} {
	variable reportData
	variable fieldNamesList
	variable printInfo
	variable maxLabelWidth

	set offset [string repeat " " [expr 4 * ($level - 1)]]
	if {$firstRecordOfTable} then {
	    # printColumn normally prints an empty line before each record,
	    # except for the first record because printLevel has already
	    # printed it.
	    set textToPrint {}
	} else {
	    set textToPrint "\n"
	}
	foreach field $fieldNamesList($level) {
	    set formatString "%-$maxLabelWidth($level,section)\s"
	    set labelToPrint \
		"$offset[format $formatString $printInfo($field,label)] : "
	    append textToPrint $labelToPrint
	    set nextLineOffset [string repeat { } [string length $labelToPrint]]
	    set startIdx 0
	    set nlIdx [string first "\n" $reportData($tuple,$field) $startIdx]
	    while { $nlIdx >= 0 } {
		append textToPrint \
		    [string range $reportData($tuple,$field) $startIdx $nlIdx]
		append textToPrint $nextLineOffset
		set startIdx [expr $nlIdx + 1]
		set nlIdx [string first "\n" $reportData($tuple,$field) $startIdx]
	    }
	    append textToPrint \
		"[string range $reportData($tuple,$field) $startIdx end]\n"
	}
	return $textToPrint
    }


    proc printHeader {level} {
	variable reportData
	variable fieldNamesList
	variable printInfo

	set offset [string repeat " " [expr 4 * ($level - 1)]]
	set header ""
	set underline ""
	foreach field $fieldNamesList($level) {
	    switch $printInfo($field,alignment) {
		r {
		    set formatString "%$printInfo($field,columnWidth)\s"
		}
		l -
		default {
		    set formatString "%-$printInfo($field,columnWidth)\s"
		}
	    }
	    set header "$header| [format $formatString $printInfo($field,label)] "
	    set underline "$underline\+-[string repeat - $printInfo($field,columnWidth)]-"
	}
	set header [string replace $header 0 0 ""]
	set underline [string replace $underline 0 0 ""]
	return "$offset$header\n$offset$underline\n"
    }

    proc printTable {firstRecordOfTable level tuple} {
	variable reportData
	variable fieldNamesList
	variable printInfo


	if { $firstRecordOfTable } then {
	    set header [printHeader $level]
	} else {
	    set header ""
	}
	set offset [string repeat " " [expr 4 * ($level - 1)]]
	set lineToPrint ""
	foreach field $fieldNamesList($level) {
	    switch $printInfo($field,alignment) {
		r {
		    set formatString "%$printInfo($field,columnWidth)\s"
		}
		l -
		default {
		    set formatString "%-$printInfo($field,columnWidth)\s"
		}
	    }
	    append lineToPrint \
		"| [format $formatString $reportData($tuple,$field)] "
	}
	set lineToPrint [string replace $lineToPrint 0 0 ""]
	return "$header$offset$lineToPrint\n"
    }

    ##################################################################
    # Init namespace report                                          #
    ##################################################################

    set windowSize(.report) {750x550}

}

########################################################################
# End of namespace report                                              #
########################################################################

########################################################################
# Begin of namespace aggregate                                         #
########################################################################

namespace eval aggregate {

    proc SUM {List} {

	set sum 0.0
	foreach item $List {
	    set sum [expr $sum + $item]
	}
	return $sum
    }

    proc COUNT {List} {

	# puts $List
	set count 0
	foreach item $List {
	    incr count
	}
	return $count
    }

    proc AVG {List} {

	set sum 0.0
	set count 0
	foreach item $List {
	    set sum [expr $sum + $item]
	    incr count
	}
	set avg [expr $sum / $count]
	return $avg
    }

    proc STDDEV {List} {

	set sum 0.0
	set count 0
	foreach item $List {
	    set sum [expr $sum + $item]
	    incr count
	}
	set avg [expr $sum / $count]
	set squareDev 0
	foreach item $List {
	    set squareDev [expr $squareDev + pow(($item - $avg),2)]
	}
	set stddev [expr sqrt($squareDev/$count)]
	return $stddev
    }

    proc MIN {List} {

	set min [lindex $List 0]
	foreach item $List {
	    if {$item < $min} then {
		set min $item
	    }
	}
	return $min
    }

    proc MAX {List} {

	set max [lindex $List 0]
	foreach item $List {
	    if {$item > $max} then {
		set max $item
	    }
	}
	return $max
    }

}

########################################################################
# End of namespace aggregate                                           #
########################################################################


###################################################################
# Intialisation of the application programmers  interface (API)   #
###################################################################

if { [catch {source [file join $::pfm::installDir pgin.tcl]} errMsg1 ] } then {
    if { [catch {package require Pgtcl} PgtclVersion] } then {
	set errMsg "$errMsg1\n$PgtclVersion."
	set errMsg "$errMsg\nNeither Pgtcl, nor pgintcl were found."
	set errMsg "$errMsg\npfm cannot connect to postgreSQL."
	tk_messageBox -message $errMsg -type ok -icon error
	set ::pfm::API "pfm cannot communicate with postgreSQL. "
	append ::pfm::API "Neither Pgtcl nor pgintcl are present."
    } else {
	set ::pfm::API "pfm is using Pgtcl $PgtclVersion "
	append ::pfm::API "to communicate with postgreSQL."
    }
} else {
    if { [catch { set pgintclVersion $::pgtcl::version } errMsg] } then {
	set pgintclVersion "???"
    }
    set ::pfm::API "pfm is using pgintcl $pgintclVersion "
    append ::pfm::API "to communicate with postgreSQL."
}


# Define arrow images

image create bitmap ::img::down \
    -file [file join $::pfm::installDir arrow_down.xbm] \
    -maskfile [file join $::pfm::installDir arrow_down_mask.xbm]

package provide pfm $::pfm::pfmVersion
