#!/usr/bin/tclsh

# From version 2.0.0 on, pfm.tcl is called without arguments

#######################################################################
# This is Postgres Forms (pfm), a client application for PostgreSQL.
#
# Copyright (C) 2004-2013 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
#
# The home page for the pfm project is at
#
# http://pgfoundry.org/projects/pfm/
#
# There you can report bugs, request new features and get support.
#
#######################################################################

package require Tcl
package require msgcat
namespace import ::msgcat::mc
package require Itcl
namespace import itcl::class itcl::code itcl::delete itcl::scope
package require Tk

# config.tcl
source [file join [file dirname [file normalize [info script]]] config.tcl]

# options.tcl
source [file join $config::installDir options.tcl]

# misc.tcl
source [file join $config::installDir misc.tcl]

# postgresql.tcl
source [file join $config::installDir postgresql.tcl]

# database.tcl
source [file join $config::installDir database.tcl]

# sql.tcl
source [file join $config::installDir sql.tcl]

# forms.tcl
source [file join $config::installDir forms.tcl]

# reports.tcl
source [file join $config::installDir report.tcl]

class MainWin {
    public variable state
    protected variable noteBook
    public variable fForms
    public variable fDesign
    public variable fReports
    protected variable mnDatabase
    protected variable menubar
    protected variable mnTools
    protected variable mnHelp
    protected variable sqlObject {}

    constructor {} {
        wm title . [mc pfm_no_database]
        wm geometry {.} [join $::geometry::main {x}]
        set db {}
        initWindow
        setState closed
        set tpOnly [bindToplevelOnly {.} <Destroy> [list delete object $this]]
        bind $tpOnly <Configure> {set ::geometry::main {%w %h}}
        return
    }

    destructor {
        # Cleanup before closing down application
        if {$state ne {closed}} then {
            $::dbObject closedb
        }
        $::pfmOptions setOption geometry main $::geometry::main
        $::pfmOptions setOption geometry sql $::geometry::sql
        $::pfmOptions setOption geometry form $::geometry::form
        $::pfmOptions setOption geometry text $::geometry::text
        $::pfmOptions saveOptions
        foreach file $::tmpFiles {
            file delete $file
        }
        # puts "on exit: [::itcl::find objects]"
        return
    }

    protected method setState {newstate} {
        set state $newstate
        switch $state {
            "open" {
                wm title . "pfm - [$::dbObject cget -dbname]"
                $menubar entryconfigure 1 -state normal
                $mnDatabase entryconfigure 0 -state disabled
                $mnDatabase entryconfigure 1 -state normal
                $mnTools entryconfigure 0 -state disabled
                $mnTools entryconfigure 1 -state disabled
            }
            "notables" {
                wm title . "pfm - [$::dbObject cget -dbname]"
                $menubar entryconfigure 1 -state normal
                $mnDatabase entryconfigure 0 -state disabled
                $mnDatabase entryconfigure 1 -state normal
                $mnTools entryconfigure 0 -state normal
                $mnTools entryconfigure 1 -state normal
            }
            default {
                wm title . [mc pfm_no_database]
                $menubar entryconfigure 1 -state disabled
                $mnDatabase entryconfigure 0 -state normal
                $mnDatabase entryconfigure 1 -state disabled
                $mnTools entryconfigure 0 -state disabled
                $mnTools entryconfigure 1 -state disabled
            }
        }
        return
    }

    public method openDatabase {} {
        if {$state eq {closed}} then {
            if {[$::dbObject opendb]} then {
                check_pfm_tables nrOfTables dbversion
                if {$nrOfTables > 0} then {
                    switch -- [versionCompare $::config::dbversion $dbversion] {
                        -1 {
                            # pfm_tables are newer than required
                            pfm_message [mc pfm_tables_newer \
                                $::config::dbversion $dbversion] {.}
                            set newstate open
                        }
                        0 {
                            # pfm_tables have required version
                            set newstate open
                        }
                        1 {
                            # pfm_tables are older than required
                            set arg [dict create \
                                parent {.} \
                                title [mc convertDB] \
                                message [mc questionConvertDB \
                                    $::config::dbversion $dbversion] \
                                msgWidth 400 \
                                defaultButton btnNo \
                                buttonList {btnYes btnNo}]
                            set dlg [GenDialog "#auto" $arg]
                            if {[$dlg wait] eq {btnYes}} then {
                                if {[convertDB $dbversion]} then {
                                    set newstate open
                                } else {
                                    set newstate open
                                    pfm_message [mc oldVersion \
                                        $::config::dbversion $dbversion] {.}
                                }
                            } else {
                                set newstate open
                                pfm_message [mc oldVersion \
                                    $::config::dbversion $dbversion] {.}
                            }
                        }
                    }
                } else {
                    set newstate notables
                    pfm_message [mc noTables] {.}
                }
                setState $newstate
                $fForms setState $newstate
                $fDesign setState $newstate
                $fReports setState $newstate
            }
        }
        return
    }

    public method closeDatabase {} {
        FormWindow::closeAllWindows
        if {$sqlObject ne {}} then {
            $sqlObject destroyWindow
            delete object $sqlObject
            set sqlObject {}
        }
        if {$state ne {closed}} then {
            $::dbObject closedb
            setState closed
            $fForms setState closed
            $fDesign setState closed
            $fReports setState closed
        }
        # puts "on close: [::itcl::find objects]"
        return
    }

    public method openSql {} {
        if {$sqlObject eq {}} then {
            set sqlObject [Sql "#auto" {.}]
        } else {
            $sqlObject showWindow
        }
        return
    }

    public method displayHelp {} {
        set helpFolder [file join $::config::docDir en]
        foreach locale [lrange [::msgcat::mcpreferences] 0 end-1] {
            set translatedFolder [file join $::config::docDir $locale]
            if {[file exists $translatedFolder] && \
                [file isdirectory $translatedFolder]} then {
                set helpFolder $translatedFolder
                break
            }
        }
        set url "file://${helpFolder}/index.html"
        set command {exec}
        set map {%s}
        lappend map $url
        foreach arg [$::pfmOptions getOption general browser] {
            lappend command [string map $map $arg]
        }
            lappend command {&}
        if { [catch $command errMsg]} then {
            pfm_message [mc browser_failed $command $errMsg] {.}
        }
        return
    }

    public method displayLicense {} {
        set filename [file join $::config::licenseDir gpl.txt]
        foreach locale [lrange [::msgcat::mcpreferences] 0 end-1] {
            set translatedFile [file join $::config::licenseDir $locale \
                gpl.txt]
            if {[file exists $translatedFile]} then {
                set filename $translatedFile
                break
            }
        }
        if {[catch {open $filename r} chan]} then {
            set textEdit [TextEdit "#auto" {.} License $chan 1]
        } else {
            set textEdit [TextEdit "#auto" {.} License [chan read $chan] 1]
            chan close $chan
        }
        return
    }

    public method displayAbout {} {
        variable ::config::version
        variable ::config::installDir

        set arg [dict create \
            parent {.} \
            title pfm \
            message [mc about_pfm $version $installDir $::config::API \
                [info nameofexecutable] [info patchlevel]] \
            msgWidth 500 \
            defaultButton btnOK \
            buttonList btnOK]
        set dlg [GenDialog "#auto" $arg]
        return
    }

    public method installPfmTables {} {
        if {$sqlObject eq {}} then {
            set sqlObject [Sql "#auto" {.}]
        } else {
            $sqlObject showWindow
        }
        set sqlWindow [$sqlObject cget -window]
        update
        set filename [file join $::config::installDir install_pfm.sql]
        if {[file exists $filename]} then {
            set message [mc watchScript install_pfm.sql]
            pfm_message $message $sqlWindow
            $sqlObject executeScript $filename {iso8859-1}
            set message [mc pressOkWhenFinished]
            pfm_message $message $sqlWindow
            setState open
            $fForms setState open
            $fDesign setState open
            $fReports setState open
        } else {
            pfm_message [mc scriptNotFound $filename] {.}
        }
        return
    }

    public method installExample {} {
        set initialDir $::config::exampleDir
        set title [mc selectExampleDB]
        set fromEncoding {iso8859-1}
        set fileTypes {
            {{SQL statements} {.sql} }
            {{All files} *}
        }
        set defaultExt ".sql"
        set filename [tk_getOpenFile -title $title -filetypes $fileTypes \
                -defaultextension $defaultExt -parent {.} \
                -initialdir $initialDir]
        if {($filename ne {}) && [file exists $filename]} then {
            if {$sqlObject eq {}} then {
                set sqlObject [Sql "#auto" {.}]
            } else {
                $sqlObject showWindow
            }
            set sqlWindow [$sqlObject cget -window]
            update
            set message [mc watchScript [file tail $filename]]
            pfm_message $message $sqlWindow
            $sqlObject executeScript $filename {iso8859-1}
            set message [mc pressOkWhenFinished]
            pfm_message $message $sqlWindow
            setState open
            $fForms setState open
            $fDesign setState open
            $fReports setState open
        }
        return
    }

    public method onTabChange {} {
        if {$state eq {open}} then {
            $fForms refreshList
            $fReports refreshList
            $fDesign refreshList
        }
        return
    }

    protected method initWindow {} {

        . configure -background $::themeBackground
        # Define menus
        set menubar [menu .mb -tearoff 0]

        # Database menu
        set mnDatabase [menu $menubar.db -tearoff 0]
        addMenuItem $mnDatabase mnuOpen command [list $this openDatabase]
        addMenuItem $mnDatabase mnuClose command [list $this closeDatabase]
        $mnDatabase add separator
        addMenuItem $mnDatabase mnuQuit command [list destroy .]
        # accelerators for Database menu
        $mnDatabase entryconfigure 0 -accelerator {Cntrl-o}
        bind . <Control-KeyPress-o> [list $this openDatabase]
        $mnDatabase entryconfigure 1 -accelerator {Cntrl-w}
        bind . <Control-KeyPress-w> [list $this closeDatabase]
        $mnDatabase entryconfigure 3 -accelerator {Cntrl-q}
        bind . <Control-KeyPress-q> [list destroy .]

        # Tools menu
        set mnTools [menu $menubar.tools -tearoff 0]
        addMenuItem $mnTools mnuInstallTables command [list $this installPfmTables]
        addMenuItem $mnTools mnuInstallExample command [list $this installExample]
        addMenuItem $mnTools mnuOptions command [list $::pfmOptions editOptions]
        $mnTools add separator
        addMenuItem $mnTools mnuIncrFont command [list $this changeFontSize 1]
        addMenuItem $mnTools mnuDecrFont command [list $this changeFontSize -1]
        $mnTools entryconfigure 4 -accelerator {Cntrl +}
        $mnTools entryconfigure 5 -accelerator {Cntrl -}
        bind all <Control-KeyPress-plus> [list $this changeFontSize 1]
        bind all <Control-KeyPress-minus> [list $this changeFontSize -1]

        # Help menu
        set mnHelp [menu $menubar.help -tearoff 0]
        addMenuItem $mnHelp mnuHelpFile command [list $this displayHelp]
        addMenuItem $mnHelp mnuLicense command [list $this displayLicense]
        addMenuItem $mnHelp mnuAbout command [list $this displayAbout]
        # Accelerators for Help menu
        $mnHelp entryconfigure 0 -accelerator {F1}
        bind . <KeyPress-F1> [list $this displayHelp]

        # connect submenus to menubar
        addMenuItem $menubar mnuDatabase cascade $mnDatabase
        addMenuItem $menubar mnuSQL command [list $this openSql]
        addMenuItem $menubar mnuTools cascade $mnTools
        addMenuItem $menubar mnuHelp cascade $mnHelp
        . configure -menu $menubar

        # Define notebook
        set noteBook [ttk::notebook .nb -takefocus 0]
        set fForms [ListTab "#auto" $noteBook forms]
        set fDesign [ListTab "#auto" $noteBook design]
        set fReports [ListTab "#auto" $noteBook reports]
        addNotebookTab $noteBook [$fForms cget -widget] tabForms
        addNotebookTab $noteBook [$fReports cget -widget] tabReports
        addNotebookTab $noteBook [$fDesign cget -widget] tabDesign
        ttk::notebook::enableTraversal $noteBook
        pack $noteBook -fill both -expand 1
        pack [ttk::sizegrip .sg] -side top -anchor e
        bind $noteBook <<NotebookTabChanged>> [list $this onTabChange]
        return
    }

    public method changeFontSize {increment} {

        foreach font {TkDefaultFont TkTextFont TkFixedFont TkMenuFont TkHeadingFont} {
            set size [font configure $font -size]
            if {$size > 0} then {
                font configure $font -size [expr $size + $increment]
            } else {
                font configure $font -size [expr $size - $increment]
            }
        }
        return
    }

    protected method convertDB {fromVersion} {
        if {$sqlObject eq {}} then {
            set sqlObject [Sql "#auto" {.}]
        } else {
            $sqlObject showWindow
        }
        set sqlWindow [$sqlObject cget -window]
        update
        switch -- $fromVersion {
            {1.0.4} {
                set scriptList {{1.0.4} {1.1.0} {1.2.0}}
            }
            {1.1.0} -
            {1.1.1} {
                set scriptList {{1.1.0} {1.2.0}}
            }
            {1.2.0} -
            {1.2.1} -
            {1.2.3} -
            {1.2.4} -
            {1.2.5} {
                set scriptList {1.2.0}
            }
            default {
                set scriptList {}
            }
        }
        foreach script $scriptList {
            set filename [file join $::config::installDir \
                convert_from_${script}.sql]
            if {[file exists $filename]} then {
                set message [mc watchScript convert_from_${script}.sql]
                pfm_message $message $sqlWindow
                $sqlObject executeScript $filename {iso8859-1}
            } else {
                pfm_message [mc scriptNotFound $filename] {.}
            }
        }
        set message [mc pressOkWhenFinished]
        pfm_message $message $sqlWindow
        check_pfm_tables nrOfTables dbversion
        set converted [string equal $::config::dbversion $dbversion]
        return $converted
    }
}

class ListTab {
    public variable tabType
    public variable widget
    protected variable parent
    public variable treeview
    protected variable btn
    protected variable state
    protected variable itemList

    constructor {c_parent c_type} {
        set parent $c_parent
        set tabType $c_type
        set widget [ttk::frame $parent.[namespace tail $this] -takefocus 0]
        set frm1 [ttk::frame $widget.frm1 -takefocus 0]
        set frm2 [ttk::frame $widget.frm2 -takefocus 0]
        switch $tabType {
            forms {
                set treeview [ttk::treeview $frm1.tv -columns forms \
                    -show {headings} -selectmode browse -height 1]
                $treeview heading forms -text [mc lblForms]
                set btn [defineButton $frm2.btn $widget btnOpen \
                    [list $this onOpen]]
                pack $btn -side right
            }
            design {
                set treeview [ttk::treeview $frm1.tv -columns forms \
                    -show {headings} -selectmode browse -height 1]
                $treeview heading forms -text [mc lblDesign]
                set btn [defineButton $frm2.btn $widget btnOpen \
                    [list $this onOpen]]
                pack $btn -side right
            }
            reports {
                set treeview [ttk::treeview $frm1.tv \
                    -columns {reports description} \
                    -show {headings} -selectmode browse -height 1]
                $treeview heading reports -text [mc lblReports]
                $treeview heading description -text [mc lblDescription]
                $treeview column reports -stretch 0 -width 150
                set btn [defineButton $frm2.btn $widget btnRun \
                    [list $this onRun]]
                pack $btn -side right
            }
        }
        set vsb [ttk::scrollbar $frm1.vsb -orient vertical \
            -command [list $treeview yview]]
        $treeview configure -yscrollcommand [list $vsb set]
        grid $treeview -row 0 -column 0 -sticky wens
        grid $vsb -row 0 -column 1 -sticky ns
        grid rowconfigure $frm1 0 -weight 1
        grid columnconfigure $frm1 0 -weight 1
        pack $frm1 -side top -expand 1 -fill both
        pack $frm2 -side top -fill x -pady {10 10} -padx {10 10}
        setState closed
        focus $treeview
        recursiveAppendTag $widget $widget
        bind $widget <KeyPress-Return> \
            [list $btn instate {!disabled} [list $btn invoke]]
        return
    }

    destructor {
        return
    }

    public method setState {newstate} {
        set state $newstate
        switch $newstate {
            "open" {
                $btn state {!disabled}
                $treeview state {!disabled}
                refreshList
            }
            "closed" {
                $btn state {disabled}
                $treeview delete [$treeview children {}]
                $treeview state {disabled}
            }
            "notables" {
                $btn state {disabled}
                $treeview state {disabled}
            }
        }
        return
    }

    public method refreshList {} {
        set itemList {}
        $treeview delete [$treeview children {}]
        foreach item [getFormsReports $::dbObject $tabType] {
            lappend itemList [$treeview insert {} end -values $item]
        }
        if {[llength $itemList]} then {
            $btn state {!disabled}
            $treeview state {!disabled}
            $treeview focus [lindex $itemList 0]
            $treeview selection set [lindex $itemList 0]
        } else {
            $btn state {disabled}
            $treeview state {disabled}
        }
        return
    }

    public method onOpen {} {
        set formName [lindex [$treeview item [$treeview selection] -values] 0]
        set form [FormWindow "#auto" {.} $formName]
        return
    }

    public method onRun {} {
        set reportName [lindex [$treeview item [$treeview selection] -values] 0]
        set reportObject [Report "#auto" {.} $reportName]
        return
    }

}

# Main

# create and init options object
set pfmOptions [PfmOptions "#auto"]
$pfmOptions initOptions
set tmpFiles {}

namespace eval geometry {

    foreach window {main sql form text} {
        variable $window
        set $window [$::pfmOptions getOption geometry $window]
    }

}

# Style issues

proc installTheme {theme} {
    global readonlyBackground
    global themeBackground
    global tcl_platform
    set readonlyBackground {#F3F0EB}
    if {[catch {ttk::style theme use $theme} errMsg]} then {
        ttk::style theme use default
        $::pfmOptions setOption general theme default
    }
    # smaller button
    ttk::style layout SButton [ttk::style layout TButton]
    ttk::style configure SButton {*}[ttk::style configure TButton]
    ttk::style configure SButton -width -6 -padding {4 1}
    # Left aligned smaller button
    ttk::style layout LButton [ttk::style layout TButton]
    ttk::style configure LButton {*}[ttk::style configure TButton]
    ttk::style configure LButton -anchor w -width -6 -padding {4 1}
    ttk::style map TCombobox -fieldbackground [list readonly $readonlyBackground]
    set themeBackground [ttk::style lookup TFrame -background]
    option clear
    option add *Canvas.background $themeBackground
    option add *Canvas.highlightThickness 0
    option add *Toplevel.background $themeBackground
    option add *Message.background $themeBackground
    option add *Entry.highlightThickness 1
    option add *Entry.highlightColor {SteelBlue4}
    option add *Entry.readonlyBackground $readonlyBackground
    option add *Entry.background {White}
    option add *Text.background {White}
    if {$tcl_platform(platform) eq {unix}} then {
        set activeBackground [ttk::style lookup TButton -background active]
        set activeForeground [ttk::style lookup TButton -foreground active]
        option add *Menu.background $themeBackground
        option add *Menu.activeBackground $activeBackground
        option add *Menu.activeForeground $activeForeground
    }
    return
}

installTheme [$::pfmOptions getOption general theme]

bind TButton <KeyPress-Return> {event generate %W <KeyPress-space>}
bind TCheckbutton <KeyPress-Return> {event generate %W <KeyPress-space>}
bind TRadiobutton <KeyPress-Return> {event generate %W <KeyPress-space>}
bind Button <KeyPress-Return> {event generate %W <KeyPress-space>}
bind Checkbutton <KeyPress-Return> {event generate %W <KeyPress-space>}
bind Radiobutton <KeyPress-Return> {event generate %W <KeyPress-space>}

# Load user interface strings
::msgcat::mcload $::config::languageDir

set dbObject [PostgresqlApi "#auto"]

set pfmObject [MainWin "#auto"]

::ContextMenu::setup


