#---------------------------------------------------------- -*- 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
}