#---------------------------------------------------------- -*- tcl -*-
#  Eskil, Preprocess dialog
#
#  Copyright (c) 2004-2017, Peter Spjuth  (peter.spjuth@gmail.com)
#
#  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; see the file COPYING.  If not, write to
#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
#
# The format of the ::Pref(preprocessn) is:
# Flat list of stride 2, (name data)
# Data dict elements: preprocess active save
# Preprocess element is a flat list of stride 3 (RE sub side)
# If side is a special word, it is a special shortcut format.
#
# There used to be a ::Pref(preprocess) with a different format, the new
# was named a bit different for compatibilty with saved preferences.

# Return active preprocess items as a flat list with stride 3
proc getActivePreprocess {top} {
    set res {}
    set count 0
    foreach {name data} $::Pref(preprocessn) {
        if {[dict get $data active]} {
            foreach {RE sub side} [dict get $data preprocess] {
                if {$side eq "Subst"} {
                    # Translate to Regexps
                    # Unique substitution
                    set pattern __$count[clock clicks -microseconds]__
                    incr count
                    lappend res $RE  $pattern left
                    lappend res $sub $pattern right
                } elseif {$side eq "Prefix"} {
                    # Translate to Regexp
                    set RE2 [string map [list % $RE] {^.*?\m(%\w+).*$}]
                    lappend res $RE2 {\1} ""
                } else {
                    # Generic
                    lappend res $RE $sub $side
                }
            }
        }
    }
    return $res
}

# Entry for adding preprocess from command line
proc addPreprocess {name RE sub side} {
    set data {}
    dict set data preprocess [list $RE $sub $side]
    dict set data active 1
    dict set data save 0
    lappend ::Pref(preprocessn) $name $data
}

# Get the value used when saving preferences
proc getPreprocessSave {} {
    set res {}
    foreach {name data} $::Pref(preprocessn) {
        if {[dict get $data save]} {
            # Always save with active 0 for now.
            # A user can edit the save file to have it by default.
            dict set data active 0
            lappend res $name $data
        }
    }
    return $res
}

# This is called when Ok or Apply is pressed.
# Update preference from dialog contents.
proc EditPrefRegsubOk {top w item {keep 0}} {
    set exa $::eskil($top,prefregexa)

    set result {}
    for {set t 1} {[info exists ::eskil($top,prefregexp$t)]} {incr t} {
        set RE $::eskil($top,prefregexp$t)
        set Sub $::eskil($top,prefregsub$t)
        set l $::eskil($top,prefregleft$t)
        set r $::eskil($top,prefregright$t)
        if {$RE eq ""} continue
        switch $::eskil($top,prefregtype$t) {
            Subst {
                lappend result $RE $Sub Subst
            }
            Prefix {
                lappend result $RE "" Prefix
            }
            default {
                set side ""
                if {$l && !$r} { set side left }
                if {!$l && $r} { set side right }
                if {!$l && !$r} { continue }

                if {[catch {regsub -all -- $RE $exa $Sub _} err]} {
                    return
                }
                lappend result $RE $Sub $side
            }
        }
    }

    set ::TmpPref(preprocess,re,$item) $result
    set ::TmpPref(preprocess,active,$item) 1

    if {$keep} {
        # Apply was pressed, also apply main dialog
        # TODO: Get widgets right. Right now it does not matter
        EditPrefPrepOk . $top 1
        return
    }
    destroy $w

    array unset ::eskil $top,prefregexp*
    array unset ::eskil $top,prefregsub*
    array unset ::eskil $top,prefregleft*
    array unset ::eskil $top,prefregright*
    array unset ::eskil $top,prefregtype*
}

# Update the example in the preprocess dialog
proc EditPrefRegsubUpdate {top args} {
    set exal $::eskil($top,prefregexa)
    set exar $::eskil($top,prefregexa)
    set exal2 $::eskil($top,prefregexa2)
    set exar2 $::eskil($top,prefregexa2)
    set ok $::widgets($top,prefRegsubOk)
    set app $::widgets($top,prefRegsubApply)

    set pp {}
    for {set t 1} {[info exists ::eskil($top,prefregexp$t)]} {incr t} {
        set RE $::eskil($top,prefregexp$t)
        set Sub $::eskil($top,prefregsub$t)
        set l $::eskil($top,prefregleft$t)
        set r $::eskil($top,prefregright$t)

        if {$RE eq ""} continue

        switch $::eskil($top,prefregtype$t) {
            Subst {
                set pattern __$t[clock clicks -microseconds]__
                lappend pp $RE  $pattern 1 0
                lappend pp $Sub $pattern 0 1
            }
            Prefix {
                set RE2 [string map [list % $RE] {^.*?\m(%\w+).*$}]
                lappend pp $RE2 {\1} 1 1
            }
            default {
                lappend pp $RE $Sub $l $r
            }
        }
    }
    foreach {RE Sub l r} $pp {
        if {$l} {
            if {[catch {regsub -all -- $RE $exal $Sub result} err]} {
                set ::eskil($top,prefregresultl) "$t ERROR: $err"
                $ok configure -state disabled
                $app configure -state disabled
                return
            } else {
                set exal $result
            }
            if {[catch {regsub -all -- $RE $exal2 $Sub result} err]} {
                set ::eskil($top,prefregresultl2) "$t ERROR: $err"
                $ok configure -state disabled
                $app configure -state disabled
                return
            } else {
                set exal2 $result
            }
        }
        if {$r} {
            if {[catch {regsub -all -- $RE $exar $Sub result} err]} {
                set ::eskil($top,prefregresultr) "$t ERROR: $err"
                $ok configure -state disabled
                $app configure -state disabled
                return
            } else {
                set exar $result
            }
            if {[catch {regsub -all -- $RE $exar2 $Sub result} err]} {
                set ::eskil($top,prefregresultr2) "$t ERROR: $err"
                $ok configure -state disabled
                $app configure -state disabled
                return
            } else {
                set exar2 $result
            }
        }
    }
    set ::eskil($top,prefregresultl2) $exal2
    set ::eskil($top,prefregresultr2) $exar2
    set ::eskil($top,prefregresultl) $exal
    set ::eskil($top,prefregresultr) $exar
    $ok configure -state normal
    $app configure -state normal
}

# Add a new entry in the preprocess dialog
proc AddPrefRegsub {top parent {type {}}} {
    # Figure out next number to use
    for {set t 1} {[winfo exists $parent.fr$t]} {incr t} {
        #Empty
    }
    # Default values
    if {![info exists ::eskil($top,prefregexp$t)]} {
        set ::eskil($top,prefregtype$t) Generic
        set ::eskil($top,prefregexp$t) ""
        set ::eskil($top,prefregexp$t) ""
        set ::eskil($top,prefregsub$t) ""
        set ::eskil($top,prefregleft$t) 1
        set ::eskil($top,prefregright$t) 1
    }
    # Override type if given
    if {$type ne ""} {
        set ::eskil($top,prefregtype$t) $type
    }

    set w [ttk::frame $parent.fr$t -borderwidth 2 -relief groove -padding 3]
    pack $w -side "top" -fill x -padx 3 -pady 3

    switch $::eskil($top,prefregtype$t) {
        Subst {
            ttk::label $w.l1 -text "Left:" -anchor "w"
            ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 20
            ttk::label $w.l2 -text "Right:" -anchor "w"
            ttk::entryX $w.e2 -textvariable ::eskil($top,prefregsub$t)
            grid $w.l1 $w.e1 $w.l2 $w.e2 -sticky we -padx 3 -pady 3
            grid columnconfigure $w {0 2} -uniform a
            grid columnconfigure $w {1 3} -weight 1 -uniform b

            addBalloon $w.l1 -fmt {
                Each pattern is applied to its side and substituted
                for a common unique string.
            }
        }
        Prefix {
            ttk::label $w.l1 -text "Prefix:" -anchor "w"
            ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 20
            grid $w.l1 $w.e1 -sticky we -padx 3 -pady 3
            grid columnconfigure $w 1 -weight 1
            addBalloon $w.l1 -fmt {
                Only one word that start with prefix is valid for line
                comparison.
            }
        }
        default {
            ttk::label $w.l1 -text "Regexp:" -anchor "w"
            ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 60
            ttk::label $w.l2 -text "Subst:" -anchor "w"
            ttk::entryX $w.e2 -textvariable ::eskil($top,prefregsub$t)
            ttk::checkbutton $w.cb1 -text "Left"  -variable ::eskil($top,prefregleft$t)
            ttk::checkbutton $w.cb2 -text "Right" -variable ::eskil($top,prefregright$t)
            addBalloon $w.cb1 "Apply to left file"
            addBalloon $w.cb2 "Apply to right file"

            grid $w.l1 $w.e1 $w.cb1 -sticky we -padx 3 -pady 3
            grid $w.l2 $w.e2 $w.cb2 -sticky we -padx 3 -pady 3
            grid columnconfigure $w 1 -weight 1
        }
    }

    trace add variable ::eskil($top,prefregexp$t) write \
            [list EditPrefRegsubUpdate $top]
    trace add variable ::eskil($top,prefregsub$t) write \
            [list EditPrefRegsubUpdate $top]
    trace add variable ::eskil($top,prefregleft$t) write \
            [list EditPrefRegsubUpdate $top]
    trace add variable ::eskil($top,prefregright$t) write \
            [list EditPrefRegsubUpdate $top]
}

# Editor for one item in ::Pref(preprocessn)
proc EditPrefRegsub {top item} {
    set w $top.prefregsub

    ToplevelForce $w "Preferences: Preprocess group"

    # Buttons
    ttk::frame $w.fb1 -padding 3
    ttk::button $w.fb1.b1 -text "Add" -command [list AddPrefRegsub $top $w Generic]
    addBalloon $w.fb1.b1 "Add generic pattern"
    ttk::button $w.fb1.b2 -text "Add Subst" -command [list AddPrefRegsub $top $w Subst]
    addBalloon $w.fb1.b2 "Add using substitution shortcut"
    ttk::button $w.fb1.b3 -text "Add Prefix" -command [list AddPrefRegsub $top $w Prefix]
    addBalloon $w.fb1.b3 "Add using prefix shortcut"
    grid $w.fb1.b1 $w.fb1.b2 $w.fb1.b3 -sticky we -ipadx 5 -padx 3 -pady 3
    grid columnconfigure $w.fb1 all -uniform a
    grid anchor $w.fb1 w

    # Result example part
    if {![info exists ::eskil($top,prefregexa)]} {
        set ::eskil($top,prefregexa) \
                "An example TextString FOR_REGSUB /* Comment */"
        set ::eskil($top,prefregexa2) \
                "An example TextString FOR_REGSUB /* Comment */"
    }
    ttk::labelframe $w.res -text "Preprocessing result" -padding 3
    ttk::label $w.res.l3 -text "Example 1:" -anchor "w"
    ttk::entryX $w.res.e3 -textvariable ::eskil($top,prefregexa) -width 60
    ttk::label $w.res.l4l -text "Result 1 L:" -anchor "w"
    ttk::label $w.res.l4r -text "Result 1 R:" -anchor "w"
    ttk::label $w.res.e4l -textvariable ::eskil($top,prefregresultl) \
            -anchor "w" -width 10
    ttk::label $w.res.e4r -textvariable ::eskil($top,prefregresultr) \
            -anchor "w" -width 10
    ttk::label $w.res.l5 -text "Example 2:" -anchor "w"
    ttk::entryX $w.res.e5 -textvariable ::eskil($top,prefregexa2)
    ttk::label $w.res.l6l -text "Result 2 L:" -anchor "w"
    ttk::label $w.res.l6r -text "Result 2 R:" -anchor "w"
    ttk::label $w.res.e6l -textvariable ::eskil($top,prefregresultl2) \
            -anchor "w" -width 10
    ttk::label $w.res.e6r -textvariable ::eskil($top,prefregresultr2) \
            -anchor "w" -width 10

    grid $w.res.l3  $w.res.e3  -sticky we -padx 3 -pady 3
    grid $w.res.l4l $w.res.e4l -sticky we -padx 3 -pady 3
    grid $w.res.l4r $w.res.e4r -sticky we -padx 3 -pady 3
    grid $w.res.l5  $w.res.e5  -sticky we -padx 3 -pady 3
    grid $w.res.l6l $w.res.e6l -sticky we -padx 3 -pady 3
    grid $w.res.l6r $w.res.e6r -sticky we -padx 3 -pady 3
    grid columnconfigure $w.res 1 -weight 1

    # Buttons
    ttk::frame $w.fb -padding 3
    ttk::button $w.fb.b1 -text "Ok"     -command [list EditPrefRegsubOk $top $w $item]
    ttk::button $w.fb.b2 -text "Apply"  -command [list EditPrefRegsubOk $top $w $item 1]
    ttk::button $w.fb.b3 -text "Cancel" -command [list destroy $w]
    set ::widgets($top,prefRegsubOk) $w.fb.b1
    set ::widgets($top,prefRegsubApply) $w.fb.b2

    grid $w.fb.b1 x $w.fb.b2 x $w.fb.b3 -sticky we
    grid columnconfigure $w.fb {0 2 4} -uniform a
    grid columnconfigure $w.fb {1 3} -weight 1

    # Top layout
    pack $w.fb1 -side "top" -fill x -padx 3 -pady 3
    pack $w.fb $w.res -side bottom -fill x -padx 3 -pady 3

    # Fill in existing or an empty line
    set preprocess $::TmpPref(preprocess,re,$item)

    if {[llength $preprocess] == 0} {
        AddPrefRegsub $top $w Generic
    } else {
        set t 1
        foreach {RE Sub side} $preprocess {
            set ::eskil($top,prefregexp$t) $RE
            set ::eskil($top,prefregsub$t) $Sub
            set ::eskil($top,prefregleft$t) 0
            set ::eskil($top,prefregright$t) 0
            set ::eskil($top,prefregtype$t) Generic
            if {$side in {Subst Prefix}} {
                set ::eskil($top,prefregtype$t) $side
            } else {
                if {$side eq "" || $side eq "left"} {
                    set ::eskil($top,prefregleft$t) 1
                }
                if {$side eq "" || $side eq "right"} {
                    set ::eskil($top,prefregright$t) 1
                }
            }
            AddPrefRegsub $top $w
            incr t
        }
    }

    trace add variable ::eskil($top,prefregexa) write \
            [list EditPrefRegsubUpdate $top]
    trace add variable ::eskil($top,prefregexa2) write \
            [list EditPrefRegsubUpdate $top]
    EditPrefRegsubUpdate $top
}


# This is called when Ok or Apply is pressed.
proc EditPrefPrepOk {top w {keep 0}} {
    # Update preference from dialog contents.
    set new {}
    for {set r 1} {$r <= $::TmpPref(preprocess,n)} {incr r} {
        set name $::TmpPref(preprocess,name,$r)
        set act $::TmpPref(preprocess,active,$r)
        set save $::TmpPref(preprocess,save,$r)
        set re $::TmpPref(preprocess,re,$r)
        lappend new $name
        lappend new [dict create active $act "save" $save preprocess $re]
    }
    set ::Pref(preprocessn) $new
    
    if {$keep} return
    destroy $w
}

# Create a toplevel, even if it exists
proc ToplevelForce {w title} {
    destroy $w
    ttk::toplevel $w -padx 3 -pady 3
    wm title $w $title
}

# Move an item one step up
proc EditPrefPreUp {r} {
    puts EditPrefPreUp$r
    # Sanity check
    if {$r <= 1 || $r > $::TmpPref(preprocess,n)} {
        return
    }
    set p [expr {$r - 1}]
    foreach item {name active save re} {
        set tmp $::TmpPref(preprocess,$item,$r)
        set ::TmpPref(preprocess,$item,$r) $::TmpPref(preprocess,$item,$p)
        set ::TmpPref(preprocess,$item,$p) $tmp
    }
}

proc EditPrefPreprocessAddItem {w} {
    set r $::TmpPref(preprocess,n)
    incr r
    if {![info exists ::TmpPref(preprocess,name,$r)]} {
        set ::TmpPref(preprocess,name,$r) ""
        set ::TmpPref(preprocess,active,$r) 0
        set ::TmpPref(preprocess,save,$r) 0
        set ::TmpPref(preprocess,re,$r) ""
    }
    ttk::entry $w.fp.ne$r -textvariable ::TmpPref(preprocess,name,$r)
    addBalloon $w.fp.ne$r "Name of preprocess group (optional)"
    ttk::checkbutton $w.fp.cba$r -text "Active" \
            -variable ::TmpPref(preprocess,active,$r)
    addBalloon $w.fp.cba$r "Activate group for this session"
    ttk::checkbutton $w.fp.cbs$r -text "Save" \
            -variable ::TmpPref(preprocess,save,$r)
    addBalloon $w.fp.cbs$r "Save group when preferences are saved"
    ttk::button $w.fp.be$r -text "Edit" \
            -command [list EditPrefRegsub $w $r]
    addBalloon $w.fp.be$r "Edit the associated list of regexps"
    ttk::button $w.fp.bu$r -image $::img(up) \
            -command [list EditPrefPreUp $r]
    addBalloon $w.fp.bu$r "Move group up in list"
    grid $w.fp.ne$r $w.fp.cba$r $w.fp.cbs$r $w.fp.be$r $w.fp.bu$r -sticky we \
            -padx 3 -pady 3
    # Make buttons symmetric
    grid  $w.fp.be$r $w.fp.bu$r -sticky news

    set ::TmpPref(preprocess,n) $r
}

proc EditPrefPreprocess {top} {
    set w $top.prefpreprocess

    # Make a working copy more suitable for GUI connection
    set r 0
    foreach {name data} $::Pref(preprocessn) {
        incr r
        set ::TmpPref(preprocess,name,$r) $name
        set ::TmpPref(preprocess,active,$r) [dict get $data active]
        set ::TmpPref(preprocess,save,$r) [dict get $data save]
        set ::TmpPref(preprocess,re,$r) [dict get $data preprocess]
    }
    # Create one if there is none, to simplify GUI usage
    if {$r == 0} {
        incr r
    }
    set ::TmpPref(preprocess,n) 0
    set nItems $r

    ToplevelForce $w "Preferences: Preprocess"

    # Frame for List of preprocessing
    ttk::frame $w.fp -padding 3
    grid columnconfigure $w.fp 0 -weight 1
    
    for {set r 1} {$r <= $nItems} {incr r} {
        EditPrefPreprocessAddItem $w
    }

    # Frame for action buttons
    ttk::frame $w.fa -padding 3
    ttk::button $w.fa.b1 -text "Add" \
            -command [list EditPrefPreprocessAddItem $w]
    addBalloon $w.fa.b1 "Add a preprocess group"

    grid $w.fa.b1 -sticky we
    grid columnconfigure $w.fa {0 2 4} -uniform a
    grid columnconfigure $w.fa {1 3} -weight 1

    
    # Frame for dialog Buttons
    ttk::frame $w.fb -padding 3
    ttk::button $w.fb.b1 -text "Ok"     -command [list EditPrefPrepOk $top $w]
    ttk::button $w.fb.b2 -text "Apply"  -command [list EditPrefPrepOk $top $w 1]
    ttk::button $w.fb.b3 -text "Cancel" -command [list destroy $w]

    grid $w.fb.b1 x $w.fb.b2 x $w.fb.b3 -sticky we
    grid columnconfigure $w.fb {0 2 4} -uniform a
    grid columnconfigure $w.fb {1 3} -weight 1

    # Top layout
    pack $w.fb -side bottom -fill x
    pack $w.fa -side bottom -fill x
    pack $w.fp -side "top" -fill both -expand 1
}
