#==========================================================
# Scripts --
#
#   allows for inclusion of lots of Tcl code into small apps
#
#==========================================================
#
namespace eval Scripts {}


#----------------------------------------------------------
# ::Scripts::new --
#
#   A new script will open a window to design a nameless script.
#
# Arguments:
#   none
#
# Results:
#   none returned
#----------------------------------------------------------
#
proc ::Scripts::new {} {
    design {}
}; # end proc ::Scripts::new


#----------------------------------------------------------
# ::Scripts::open --
#
#   Evaluates the script commands.
#   Scripts are only retrieved from the database once.
#
# Arguments:
#   scriptname_     The name of the script
#
# Results:
#   none returned
#----------------------------------------------------------
#
proc ::Scripts::open {scriptname_} {
global CurrentDB PgAcVar

    set ss {}

    # check if script has already been cached
    if {[info exists PgAcVar(script,cache,$scriptname_)]} {
        set ss $PgAcVar(script,cache,$scriptname_)

    } else {
        wpg_select $CurrentDB "
            SELECT *
              FROM pga_scripts
             WHERE scriptname='$scriptname_'" \
        rec {
            set ss $rec(scriptsource)
            # cache the script
            set PgAcVar(script,cache,$scriptname_) $ss
        }
    }

    # evaluated either the new script or the cached version
    if {[string length $ss] > 0} {
        eval $ss
    }

}; # end proc ::Scripts::open


#----------------------------------------------------------
# ::Scripts::design --
#
#   The selected script will be opened for editing.
#
# Arguments:
#   scriptname_     The name of the script
#
# Results:
#   none returned
#----------------------------------------------------------
#
proc ::Scripts::design {scriptname_} {
global PgAcVar CurrentDB

    Window show .pgaw:Scripts
    set PgAcVar(script,name) $scriptname_
    .pgaw:Scripts.src delete 1.0 end

    if {[string length $scriptname_]==0} return;

    wpg_select $CurrentDB "
        SELECT oid,*
          FROM pga_scripts
         WHERE scriptname='$scriptname_'" \
    rec {
        set PgAcVar(script,oid) $rec(oid)
        .pgaw:Scripts.src insert end $rec(scriptsource)
        ::Syntax::highlight .pgaw:Scripts.src tcl
    }

}; # end proc ::Scripts::design


#----------------------------------------------------------
# ::Scripts::execute --
#
#   A wrapper, passes execution to the open command.
#
# Arguments:
#   scriptname_     The name of the script
#
# Results:
#   none returned
#----------------------------------------------------------
#
proc ::Scripts::execute {scriptname_} {
    # a wrap for execute command
    open $scriptname_
}; # end proc ::Scripts::execute


#----------------------------------------------------------
# ::Scripts::save --
#
#   Save checks if the script has a name
#   and if it is valid Tcl code.
#
# Arguments:
#   badtcl_         yes if Tcl code should be validated
#
# Resutls:
#   none returned
#----------------------------------------------------------
#
proc ::Scripts::save {{badtcl_ {no}} {copy_ 0}} {
global PgAcVar CurrentDB

    if {$PgAcVar(script,name)==""} {
        tk_messageBox \
            -title [intlmsg Warning] \
            -parent .pgaw:Scripts \
            -message [intlmsg "The script must have a name!"]

    } elseif {![info complete [.pgaw:Scripts.src get 1.0 end]] \
    && $badtcl_=="no"} {

        set badtcl_ [tk_messageBox -title [intlmsg {Warning}] \
        -parent .pgaw:Scripts -type yesno \
        -message [intlmsg "There appears to be invalid Tcl code in the Script.  Are you sure you want to save it?"]]

        if {$badtcl_=="yes"} {::Scripts::save $badtcl_ $copy_}

    } else {

        if {$copy_ == 0 && [info exists PgAcVar(script,oid)]} {
            sql_exec noquiet "
                DELETE FROM pga_scripts
                      WHERE oid=$PgAcVar(script,oid)"
        }

        regsub -all {\\} [.pgaw:Scripts.src get 1.0 end] {\\\\} \
            PgAcVar(script,body)
        regsub -all ' $PgAcVar(script,body)  \\' PgAcVar(script,body)

        sql_exec noquiet "
            INSERT INTO pga_scripts
                 VALUES ('$PgAcVar(script,name)','$PgAcVar(script,body)')"

        # refresh the OID
        set res [wpg_exec $CurrentDB "
            SELECT oid
              FROM pga_scripts
             WHERE scriptname='$PgAcVar(script,name)'
             "]
        set PgAcVar(script,oid) [lindex [pg_result $res -getTuple 0] 0]
        pg_result $res -clear

        # highlight the tcl code
        ::Syntax::highlight .pgaw:Scripts.src tcl

        # refresh the list in the window
        ::Mainlib::cmd_Scripts

        # refresh the cache
        set PgAcVar(script,cache,$PgAcVar(script,name)) $PgAcVar(script,body)

    }

}; # end proc ::Scripts::save



########################## END OF NAMESPACE SCRIPTS ##################



proc vTclWindow.pgaw:Scripts {base} {
global PgAcVar
    if {$base == ""} {
        set base .pgaw:Scripts
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 650x440+192+152
    wm maxsize $base 1009 738
    wm minsize $base 300 300
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base [intlmsg "Design script"]

    frame $base.ftop \
        -height 55 \
        -relief groove \
        -width 125
    label $base.ftop.lscriptname \
        -borderwidth 0 \
        -text [intlmsg {Script name}]
    entry $base.ftop.escriptname \
        -background #fefefe \
        -borderwidth 1 \
        -highlightthickness 0 \
        -textvariable PgAcVar(script,name) \
        -width 64
    Button $base.ftop.bclose \
        -borderwidth 1 \
        -padx 1 \
        -pady 1 \
        -command {Window destroy .pgaw:Scripts} \
        -helptext [intlmsg {Close}] \
        -image ::icon::exit-22
    Button $base.ftop.bsave \
        -borderwidth 1 \
        -padx 1 \
        -pady 1 \
        -command {::Scripts::save {no} 0} \
        -helptext [intlmsg {Save}] \
        -image ::icon::filesave-22
    Button $base.ftop.bsaveas \
        -borderwidth 1 \
        -padx 1 \
        -pady 1 \
        -command {::Scripts::save {no} 1} \
        -helptext [intlmsg {Save As}] \
        -image ::icon::filesaveas-22

    text $base.src  \
        -background #ffffff \
        -foreground #000000 \
        -font $PgAcVar(pref,font_normal) \
        -height 2 \
        -width 2 \
        -wrap none \
        -highlightthickness 1 \
        -selectborderwidth 0 \
        -xscrollcommand "$base.hscroll set" \
        -yscrollcommand "$base.vscroll set"
    scrollbar $base.hscroll \
        -orient horiz \
        -command "$base.src xview"
    scrollbar $base.vscroll \
        -command "$base.src yview"

    bind $base <Escape> {
        Window destroy .pgaw:Scripts
    }
    bind $base.src <Control-Key-s> {
        ::Scripts::save
    }

    # add Ctrl-x|c|v for cut, copy, paste
    bind $base.src <Control-Key-x> {
        set PgAcVar(shared,curseltext) [%W get sel.first sel.last]
        %W delete sel.first sel.last
    }
    bind $base.src <Control-Key-c> {
        set PgAcVar(shared,curseltext) [%W get sel.first sel.last]
    }
    bind $base.src <Control-Key-v> {
        if {[info exists PgAcVar(shared,curseltext)]} {
            %W insert insert $PgAcVar(shared,curseltext)
            %W see current
        }
    }

    pack $base.ftop \
        -in .pgaw:Scripts \
        -anchor center \
        -expand 0 \
        -fill x \
        -pady 2 \
        -side top
    pack $base.ftop.lscriptname \
        -in .pgaw:Scripts.ftop \
        -anchor center \
        -expand 0 \
        -fill none \
        -ipadx 2 \
        -side left
    pack $base.ftop.escriptname \
        -in .pgaw:Scripts.ftop \
        -anchor center \
        -expand 0 \
        -fill none \
        -side left
    pack $base.ftop.bclose \
        -in .pgaw:Scripts.ftop \
        -anchor center \
        -expand 0 \
        -fill none \
        -side right
    pack $base.ftop.bsaveas \
        -in .pgaw:Scripts.ftop \
        -anchor center \
        -expand 0 \
        -fill none \
        -side right
    pack $base.ftop.bsave \
        -in .pgaw:Scripts.ftop \
        -anchor center \
        -expand 0 \
        -fill none \
        -side right
    pack $base.hscroll \
        -in .pgaw:Scripts \
        -anchor center \
        -expand 0 \
        -fill both \
        -padx 2 \
        -side bottom
    pack $base.vscroll \
        -in .pgaw:Scripts \
        -anchor center \
        -expand 0 \
        -fill both \
        -padx 2 \
        -side right
    pack $base.src \
        -in .pgaw:Scripts \
        -anchor center \
        -expand 1 \
        -fill both \
        -padx 2 \
        -side left
}
