#!/bin/sh  
#-*-tcl-*-  
# the next line restarts using wish \
exec wish "$0" -- ${1+"$@"}


set version 3.0

###############################################################################################
#
# VisualREGEXP -- A graphical front-end to wirte/debug regular expression
# (c) 2000-2002 Laurent Riesterer
#
# VisualREGEXP Home Page: http://laurent.riesterer.free.fr/regexp
#
#----------------------------------------------------------------------------------------------
#
# Usage: tkregexp <sampleFile>
#
#----------------------------------------------------------------------------------------------
#
# 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  
#
###############################################################################################



#----------------------------------------------------------------------------------------------
# SOME CUSTOMIZATION CAN BE DONE BY MODIFYING VARIABLES BELOW
#----------------------------------------------------------------------------------------------

# default geometry
set geometry            800x600+0+0
# main font used to display the text
if {$tcl_platform(platform) == "windows"} {
        set font_regexp     {Courier 10}
        set font_replace    {Courier 10}
        set font_sample     {Courier 10}
} else {
        set font_regexp                9x15
        set font_replace        9x15
        set font_sample                9x15
}
# the font used in the popup menu (use ---- to get a separator, else format is {font size ?bold?}
set fonts                                 {{Courier 8} {Courier 9} {Courier 10} {Courier 11} {Courier 12}
                                                 ----
                                             {Arial 8} {Arial 9} {Arial 10} {Arial 11} {Arial 12}
                                             ----
                                             8x13 8x13bold 9x15 9x15bold 10x20}
# the colors for the different matching groups
set colors              {#ff0000 #0000ff darkgreen violetred #ff9000 #537db9 #e4c500     firebrick darkgoldenrod hotpink}
set bgcolors            {#ffe6e6 #e6e6ff #e6ffe6   #efd5e1   #fef3e5 #d6dce5 lightyellow white    white        white}
# use background color in sample by default ? (1 use, 0 do not use)
set background                        0
# background color to visualize the non-reporting group (?:...)
set color_noreport      #fffdc4
# background color to visualize the lookhead group (?=...) and (?!...)
set color_lookahead     wheat
# show/hide help about control characters in regexp
set show_help                        0
# show/hide history windows on startup
set history                                0
# mode to use on startup (select/concat = raw, select/insert new lines = nl, replace = replace)
set mode                                replace
# database of some regexp to appear in the "Insert regexp" menu
set regexp_db {
        "URL"                        {(?:^|")(http|ftp|mailto):(?://)?(\w+(?:[\.:@]\w+)*?)(?:/|@)([^"\?]*?)(?:\?([^\?"]*?))?(?:$|")}
        "IP numbers"         {[12]?[0-9]?[0-9](\.[12]?[0-9]?[0-9]){3}}
        "HTML tags"                {<[^<>]+>}
        "HTML tag content" {<(\w+)[^>]*?>(.*?)</\1>}
        "vars and arrays (PHP)" {\$[^0-9 ]{1}[a-zA-Z0-9_]*((?:\[[a-zA-Z0-9_'\"]+\])*)}
        "dd/mm/yyyy"        {(0[1-9]|[12][0-9]|3[01])(/|-)(0[1-9]|1[12])(/|-)[12][0-9]{3}}
        "mm/dd/yyyy"        {(0[1-9]|1[12])(/|-)(0[1-9]|[12][0-9]|3[01])(/|-)[12][0-9]{3}}
        "hh:mm"                        {([01][0-9]|2[0-3]):[0-5][0-9]}
        "user@domain.net" {[A-Za-z0-9_.-]+@([A-Za-z0-9_]+\.)+[A-Za-z]{2,4}}
}


#----------------------------------------------------------------------------------------------
# DO NOT MODIFY BELOW THIS POINT
#----------------------------------------------------------------------------------------------

namespace eval regexp {} {
        set data(v:undo:index) 0
        set data(v:undo:sample) ""
        set data(v:dir) "."
        set data(v:file) "untitled.txt"
}

#----------------------------------------------------------------------------------------------
#        Main GUI
#----------------------------------------------------------------------------------------------

proc regexp::gui {} {
variable data
global colors bgcolors color_noreport color_lookahead geometry show_help regexp_db history
global tcl_platform


        set top ""

        # frame for regexp
        set w [frame $top.regexp -bd 2 -relief groove]
                # options
                set fo [frame $w.options]
                set sep 0
                foreach option {nocase all - line lineanchor linestop - inline} \
                                label {nocase all - line "lineanchor (k)" "linestop (m)" - inline} \
                                underline {0 0 - 0 12 10 - 0} {
                        if {$option != "-"} {
                                checkbutton $fo.$option -text $label -bd 1 -underline $underline \
                                                        -variable regexp::data(v:$option) \
                                                        -offvalue "" -onvalue "-$option"
                                set data(v:$option) ""
                                pack $fo.$option -side left
                        } else {
                                pack [frame $fo.[incr sep] -width 40] -side left
                        }
                }
                # text for regexp entry
                set data(w:regexp) [text $w.regexp -wrap char -bg white -font $::font_regexp \
                                                                        -selectbackground lightblue -selectborderwidth 0 \
                                                                        -width 1 -height 3 -bd 1]
                if {$tcl_platform(platform) == "windows"} {
                        set sfont {Courier 8}
                        set sbfont {Courier 8 bold}
                } else {
                        set sfont 6x13
                        set sbfont 6x13bold
                }
                set data(w:help) [text $w.help -font $sfont -bd 0 -height 9 -wrap none -bg [$w cget -bg]]
                $w.help insert 1.0 "\n\n\n\n\n\n\n\n"
                $w.help insert 1.0 {\a  alert              \n     newline     \0    char 0       \d [[:digit:]]    \A beginning of the string }
                $w.help insert 2.0 {\b  backspace          \r     carriage    \xyz  octal code   \D [^[:digit:]]   \Z end of string }
                $w.help insert 3.0 {\B  synomyn for \      \t     tab                            \s [[:space:]]    \m beginning of a word}
                $w.help insert 4.0 {\cX same as X & 0x1F   \uwxyz unicode     \x    backref      \S [^[:space:]]   \M end of a word}
                $w.help insert 5.0 {\e  ESC                \v     vert tab                       \w [[:alnum:]_]   \y beginning or end of a word}
                $w.help insert 6.0 {\f  form feed          \xhhh  hexa code                      \W [^[:alnum:]_]  \Y not beginning or end of a word}
                $w.help insert 7.0 {----------------------------------------------------------------------------------------------------------------}
                $w.help insert 8.0 {    ungreedy:          ?? single optional *? zero-many       +? at least one   {n,m}? ungreedy quantifiers}
                $w.help insert 9.0 {(?:) ghost group       (?=) lookahead     (?!) neg. lookahead}
                $w.help tag configure bold -font $sbfont
                foreach line {1 2 3 4 5 6} {
                        foreach {min max} {0 2 23 25 42 44 61 63 79 82} {
                                $w.help tag add bold $line.$min $line.$max
                        }
                }
                $w.help tag remove bold 2.43 2.44 4.43 4.44
                # buttons & selection of match
                set fb [frame $w.b]
                button $fb.go -text "Go" -underline 0 -command "regexp::go" -bd 1 -width 5
                button $fb.clear -text "Clear (z)" -underline 7 -command "regexp::clear" -bd 1 -width 5
                pack $fb.go [frame $fb.00 -width 10] $fb.clear -side left -pady 5

                # selection - buttons for match level
                label $fb.sep
                label $fb.l -text "Select:"
                pack $fb.sep -side left -fill x -expand true
                pack $fb.l -side left -padx 5 -pady 5
                set i 0
                foreach c $colors t {match 1 2 3 4 5 6 7 8 9} {
                        button $fb.$i -text $t -fg $c -bd 1 -padx 0 -width 6 -command "regexp::select $i"
                        pack $fb.$i -side left -fill y -pady 5
                        incr i
                }
                # text for replace
                set f [frame $w.replace]
                        set data(w:replace) [text $f.replace -wrap char -bg white -font $::font_replace \
                                                                                -selectbackground lightblue -selectborderwidth 0 \
                                                                                -width 1 -height 2 -bd 1]
                        button $f.do -text "Replace" -underline 0 -bd 1 -width 9 -command "regexp::replace"
                        label $f.nb -textvariable regexp::data(v:nbreplace) -width 12 -anchor e
                        pack $data(w:replace) -side left -expand true -fill both -pady 5 -padx 5
                        pack $f.do -side left -pady 5
                        pack $f.nb -side left -pady 5 -padx 5
                # layout
                pack [frame $w.0 -height 5] $data(w:regexp) -side top -anchor w -padx 5 -expand true -fill both
                pack $fo $fb -side top -anchor w -padx 5 -expand true -fill both
                pack $fb -side top -anchor w -padx 5 -expand true -fill both
                set data(w:allreplace) $f

        # frame for sample
        set w [frame $top.sample -bd 2 -relief groove]
                set w [frame $w.inner]
                pack $top.sample.inner -padx 5 -pady 5 -fill both -expand true
                # text for sample highlighting
                set data(w:sample) [text $w.sample  -bg white -font $::font_sample -bd 1 -width 1 -height 1 \
                                                                        -selectbackground lightblue -selectborderwidth 0 \
                                                                        -yscrollcommand "$w.sy set" -xscrollcommand "$w.sx set"]
                scrollbar $w.sy -command "$w.sample yview" -orient vertical -bd 1
                scrollbar $w.sx -command "$w.sample xview" -orient horizontal -bd 1
                # set tags for colors & special
                set data(v:levels) {e0 e1 e2 e3 e4 e5 e6 e7 e8 e9}
                foreach level $data(v:levels) \
                                color $colors {
                        $data(w:regexp) tag configure $level -foreground $color
                        $data(w:history) tag configure $level -foreground $color
                        $data(w:sample) tag configure $level -foreground $color
                }
                $data(w:regexp) tag configure lookahead -background $color_lookahead
                $data(w:regexp) tag configure noreport -background $color_noreport
                $data(w:history) tag configure lookahead -background $color_lookahead
                $data(w:history) tag configure noreport -background $color_noreport
                # options
                set f [frame $w.matches]
                        label $f.nb -textvariable regexp::data(v:nbmatches) -anchor w
                        set regexp::data(v:nbmatches) "0 matches"
                        # button for navigation
                        button $f.p -text "Previous" -bd 1 -pady 2 -width 8 -command "regexp::sample:move -1"
                        button $f.n -text "Next" -bd 1 -pady 2 -width 8 -command "regexp::sample:move +1"
                        set data(v:positions) [list ]
                        set data(v:position) 0
                        # layout
                        pack $f.nb [frame $f.0 -width 15] $f.p $f.n -padx 5 -side left
                
                # layout
                grid $w.sample        $w.sy        -sticky news
                grid $w.sx                x                -sticky news
                grid $w.matches        -                -sticky news
                grid rowconfigure $w {0} -weight 1
                grid columnconfigure $w {0} -weight 1

        # main layout
        pack $top.regexp -side top -anchor w -padx 5 -pady 5 -fill x
        pack $top.sample -side top -anchor w -padx 5 -pady 5 -expand true -fill both
        wm geometry . $geometry
        wm title . "Visual REGEXP $::version"
        focus $data(w:regexp)

        # main menu
        . configure -menu .menubar
        set m [menu .menubar -tearoff 0 -bd 1 -activeborderwidth 1]
          # file
          $m add cascade -menu $m.file -label "File" -underline 0
          set mm [menu $m.file -tearoff 0 -bd 1 -activeborderwidth 1]
                $mm add command -label "Load regexp ..." -command "regexp::regexp:load"
                $mm add command -label "Load sample ..." -command "regexp::sample:load" -accelerator "Alt-O"
                $mm add separator
                $mm add command -label "Save sample (auto) ..." -command "regexp::sample:save auto" -accelerator "Alt-S"
                $mm add command -label "Save sample Unix (lf) ..." -command "regexp::sample:save lf"
                $mm add command -label "Save sample Windows (crlf) ..." -command "regexp::sample:save crlf"
                $mm add command -label "Save sample Mac (cr) ..." -command "regexp::sample:save cr"
                $mm add separator
                $mm add command -label "Quit" -underline 0 -command "exit" -accelerator "Alt-Q"
          # edit
          $m add cascade -menu $m.edit -label "Edit" -underline 0
          set mm [menu $m.edit -tearoff 0 -bd 1 -activeborderwidth 1]
                $mm add command -label "Copy regexp to clipboard" -command "regexp::dump" -accelerator "Alt-C"
                $mm add separator
                $mm add command -label "Undo" -command "regexp::unredo:regexp -1" -accelerator "Control-Z"
                $mm add command -label "Redo" -command "regexp::unredo:regexp +1" -accelerator "Control-R"
          # view
          $m add cascade -menu $m.view -label "View" -underline 0
          set mm [menu $m.view -tearoff 0 -bd 1 -activeborderwidth 1]
                set regexp::data(v:background) $::background
                regexp::sample:background
                $mm add checkbutton -label "Show background for matches" -command "regexp::sample:background" \
                                -variable regexp::data(v:background)
                $mm add checkbutton -label "Show regexp help" -command "regexp::regexp:help:toggle" \
                                -variable regexp::data(v:help)
                set regexp::data(v:help) $show_help
                $mm add checkbutton -label "Wrap lines in sample" -variable regexp::data(v:wrap) \
                                                -command "$data(w:sample) configure -wrap \$regexp::data(v:wrap)" \
                                                -offvalue "none" -onvalue "char"
                set regexp::data(v:history) $history
                $mm add checkbutton -label "History of Regexp" -variable regexp::data(v:history) \
                                                -command "if {\$regexp::data(v:history)} {wm deiconify .history} else {wm iconify .history}"
          # select mode
          $m add cascade -menu $m.select -label "Select mode" -underline 5
          set mm [menu $m.select -tearoff 0 -bd 1 -activeborderwidth 1]
                $mm add radiobutton -label "select / concat raw matches" \
                                -variable regexp::data(v:mode) -value "raw" -command regexp::replace:toggle
                $mm add radiobutton -label "select / insert new line between matches" \
                                -variable regexp::data(v:mode) -value "nl" -command regexp::replace:toggle
                $mm add radiobutton -label "replace widget" \
                                -variable regexp::data(v:mode) -value "replace" -command regexp::replace:toggle
          # insert well know regexp
          $m add cascade -menu $m.insert -label "Insert regexp" -underline 11
          set mm [menu $m.insert -tearoff 0 -bd 1 -activeborderwidth 1]
                $mm add command -label "Make regexp ..." -command "regexp::make-regexp"
                $mm add separator
                $mm add command -label "Load patterns ..." -command "regexp::pattern:load"
                $mm add separator
                foreach {n e} $regexp_db {
                        $mm add command -label "$n" -command "regexp::regexp:insert [list $e]"
                }
                set data(w:menu) $mm
          # help
          $m add cascade -menu $m.help -label "Help" -underline 0
          set mm [menu $m.help -tearoff 0 -bd 1 -activeborderwidth 1]
                $mm add command -label "Help" -command "regexp::help"


        # key binding
        bind all <Alt-q> "exit"
        bind all <Alt-g> "regexp::go"
        bind $data(w:regexp) <Return> "regexp::go; break"
        bind all <Alt-c> "regexp::dump"
        bind all <Alt-r> "regexp::replace"
        bind all <Alt-o> "regexp::sample:load"
        bind all <Alt-s> "regexp::sample:save auto"

        bind $data(w:regexp) <Control-z> "regexp::unredo:regexp -1"
        bind $data(w:regexp) <Control-r> "regexp::unredo:regexp +1"

        bind $data(w:replace) <Control-z> "regexp::undo:sample"
        bind $data(w:sample) <Control-z> "regexp::undo:sample"

        bind all <Alt-a> "$fo.all toggle"
        bind all <Alt-n> "$fo.nocase toggle"
        bind all <Alt-l> "$fo.line toggle"
        bind all <Alt-k> "$fo.lineanchor toggle"
        bind all <Alt-m> "$fo.linestop toggle"
        bind all <Alt-i> "$fo.inline toggle"
        bind all <Alt-z> "regexp::clear"

        bind $data(w:regexp) <Control-Key> { # nothing }
        bind $data(w:regexp) <Alt-Key> { # nothing }
        bind $data(w:regexp) <Meta-Key> { # nothing }
        bind $data(w:regexp) <Mod1-Key> { # nothing }
        bind $data(w:regexp) <Key> "regexp::undo:regexp:compute %W %K %A"

        bind $data(w:replace) <Control-Tab> "$data(w:replace) insert insert {\\t}; break;"
        bind $data(w:sample) <Control-Tab> "$data(w:sample) insert insert {\t}; break;"
        # special for regexp Ctrl+letter = \<letter>
        bind $data(w:regexp) <Control-Tab> "$data(w:regexp) insert insert {\\t}; break;"
        foreach key {a b B e f n r t v u x 0 d D s S w W A Z m M y Y} {
                bind $data(w:regexp) <Control-$key> "$data(w:regexp) insert insert {\\$key}; break;"
        }
        foreach key {a b B e f n r t v u x 0} {
                bind $data(w:replace) <Control-$key> "$data(w:replace) insert insert {\\$key}; break;"
        }

        bind Text <Control-v> {}

        # font selection popup
        foreach w {regexp replace sample} {
                set m [menu .fonts_$w -tearoff 0]
                foreach f $::fonts {
                        if {$f == "----"} {
                                $m add separator
                        } else {
                                $m add command -label $f -command "$data(w:$w) configure -font [list $f]"
                        }
                }
                bind $data(w:$w) <3> "tk_popup $m %X %Y"
        }

        # some init
        set data(v:nocase) "-nocase"
        set data(v:all) "-all"
        set data(v:wrap) "char"
        set regexp::data(v:mode) $::mode
        replace:toggle                ;# set bindings
        regexp:help:toggle
}

proc regexp::pattern:load {{file ""}} {
variable data

        # get filename
        if {$file == ""} {
                set types [list [list "All" *]]
                set file [tk_getOpenFile -filetypes $types -parent .]
            if {$file == ""} {
                        return
                }
        }
        # do it
        set in [open $file "r"]
        $data(w:menu) delete [expr 4+[llength $::regexp_db]/2] end
        while {![eof $in]} {
                set name [gets $in]
                while {$name == ""} {
                        set name [gets $in]
                }
                set pattern [gets $in]
                while {$pattern == ""} {
                        set pattern [gets $in]
                }
                $data(w:menu) add command -label $name -command "regexp::regexp:insert [list $pattern]"
        }
        close $in
}


#----------------------------------------------------------------------------------------------
#        Main toplevel commands
#----------------------------------------------------------------------------------------------

proc regexp::go {} {
variable data

        set exp [$data(w:regexp) get 1.0 end-1char]
        # check if regexp is OK
        if {[catch { regexp -- $exp dummy } errMsg]} {
                tk_messageBox -type ok -icon error -message "Malformed regexp: $errMsg"
                return
        }
        regexp::regexp:colorize
        regexp::sample:colorize
        regexp::history:add
}

proc regexp::clear {} {
variable data

        regexp::history:add
        $data(w:regexp) delete 1.0 end
        regexp::go
}

proc regexp::dump {} {
variable data

        # update display
        go
        # built list of options
        set dump "regexp"
        foreach option {nocase all   line lineanchor linestop   inline} {
                if {$data(v:$option) != ""} {
                        append dump " $data(v:$option)"
                }
        }
        # build expression
        set exp [$data(w:regexp) get 1.0 end-1char]
        append dump " -- {$exp} string"
        # add variables if needed
        if {$data(v:inline) == ""} {
                append dump " match"
                for {set i 1} {$i < $data(v:nblevels)} {incr i} {
                        append dump " v$i"
                }
        }
        # put dump into the clipboard (by creating a hidden entry ... anyone has a better solution?)
        destroy .e
        entry .e
        .e insert 0 $dump
        .e selection range 0 end
        puts "$dump"
}

proc regexp::select {level} {
variable data

        # update
        go
        if {[llength $data(v:result)] == 0} {
                bell
                return
        }
        # puts regexp
        dump
        # extract matching parts in sample
        set i 0
        set newsample ""
        foreach match $data(v:result) {
                if {($i % $data(v:nblevels)) == $level} {
                        set text [$data(w:sample) get \
                                                        [$data(w:sample) index "1.0+[lindex $match 0]chars"] \
                                                        [$data(w:sample) index "1.0+[expr [lindex $match 1]+1]chars"]]
                        append newsample $text
                        if {$data(v:mode) == "nl"} {
                                append newsample "\n"
                        }
                }
                incr i
        }
        $data(w:sample) delete 1.0 end
        $data(w:sample) insert 1.0 $newsample
        # update with regexp
        go
}

proc regexp::help {} {
global tcl_platform

        toplevel .help
        wm title .help "Help"
        # logo
        label .help.l -image logo
        pack .help.l -side top -padx 10 -pady 10
        # help text
        if {$tcl_platform(platform) == "windows"} {
                text .help.t -bd 2 -relief groove -font {Courier 10}
        } else {
                text .help.t -bd 2 -relief groove
        }
        pack .help.t -side top -padx 20
        .help.t tag configure bold -font "[.help.t cget -font] bold"
        .help.t insert 1.0 "Version:" bold " $::version

" normal "Usage:" bold " tkregexp <sampleFile>

" normal "Key bindings:" bold " Alt-q               exit
              Alt-a               toggle 'all' flag
              Alt-n               toggle 'nocase' flag
              Alt-l               toggle 'line' flag
              Alt-k               toggle 'lineanchor' flag
              Alt-m               toggle 'linestop' flag
              Alt-i               toggle 'inline' flag
              Alt-g               do the highlighting
              Return (in regexp)  do the highlighting

" normal "To clipboard:" bold " Put the 'regexp' command with its arguments to the clipboard

" normal "Tips:" bold " 1) To set the sample, either put a filename on the command line,
         or just copy & paste it in the sample text window.
      2) You can change the default colors or windows size by editing the
         first lines of the program file.
      3) when typing your regexp you can use Control-Z/Control-R
         to undo/redo the last typing.
      4) When using the replace function, using Control-Z restore the value
         of the sample before the replacement : you try, retry, reretry, ..."
        # ok button
        button .help.ok -text "Ok" -width 10 -default active -command "destroy .help"
        pack .help.ok -side bottom -pady 10
}

proc regexp::regexp:help:toggle {} {
variable data

        if {$data(v:help) == 0} {
                pack forget $data(w:help)
        } else {
                pack $data(w:help) -before $data(w:regexp) -fill x -padx 5
        }
}

#----------------------------------------------------------------------------------------------
#        Undo/redo (quick and dirty UNDO/REDO support)
#----------------------------------------------------------------------------------------------

proc regexp::undo:sample {} {
variable data

        # display result
        $data(w:sample) delete 1.0 end
        $data(w:sample) insert 1.0 $data(v:undo:sample)
        # colorize
        go
}

proc regexp::unredo:regexp {dir} {
variable data

        set index [expr ($data(v:undo:index)+$dir) % 100]
        if {![info exists data(v:undo:r$index)]} {
                return
        }
        set data(v:undo:index) $index

        set t $data(w:regexp)
        $t delete 1.0 end
        $t insert 1.0 [lindex $data(v:undo:r$index) 1]
        $t mark set insert [lindex $data(v:undo:r$index) 0]
}

proc regexp::undo:regexp:compute {w k a} {
variable data

        if {[string match -nocase "*control*" $k]
                        || [string match -nocase "*shift*" $k]
                        || [string match -nocase "*alt*" $k]} {
                return
        }

        set data(v:undo:r$data(v:undo:index)) [list [$w index insert] [$w get 1.0 end-1char]]
        set data(v:undo:index) [expr ($data(v:undo:index)+1) % 100]
}

#----------------------------------------------------------------------------------------------
#        Replace
#----------------------------------------------------------------------------------------------

proc regexp::replace {} {
variable data

        set exp [$data(w:regexp) get 1.0 end-1char]
        set subst [$data(w:replace) get 1.0 end-1char]
        if {$exp == ""} {
                set regexp::data(v:nbreplace) "empty regexp"
                return
        }

        # get sample & store it for undo
        set sample [$data(w:sample) get 1.0 end]
        set data(v:undo:sample) $sample
        set result [eval regsub $data(v:all) \
                                                $data(v:line) $data(v:lineanchor) $data(v:linestop) \
                                                $data(v:nocase) -- \
                                                [list $exp] [list $sample] [list [subst -nocommands -novariables $subst]] sample]
        set regexp::data(v:nbreplace) "$result replaced"
        # display result
        $data(w:sample) delete 1.0 end
        $data(w:sample) insert 1.0 $sample
}

proc regexp::replace:toggle {} {
variable data

        if {$regexp::data(v:mode) == "replace"} {
                bind $data(w:regexp) <Tab> "focus $data(w:replace); break;"
                bind $data(w:regexp) <Shift-Tab> "focus $data(w:sample); break;"
                catch { bind $data(w:regexp) <ISO_Left_Tab> "focus $data(w:sample); break;" }

                bind $data(w:replace) <Tab> "focus $data(w:sample); break;"
                bind $data(w:replace) <Shift-Tab> "focus $data(w:regexp); break;"
                catch { bind $data(w:replace) <ISO_Left_Tab> "focus $data(w:regexp); break;" }

                bind $data(w:sample) <Tab> "focus $data(w:regexp); break;"
                bind $data(w:sample) <Shift-Tab> "focus $data(w:replace); break;"
                catch { bind $data(w:sample) <ISO_Left_Tab> "focus $data(w:replace); break;" }

                pack $data(w:allreplace) -side top -fill both

        } else {
                bind $data(w:regexp) <Tab> "focus $data(w:sample); break;"
                catch { bind $data(w:regexp) <ISO_Left_Tab> "focus $data(w:sample); break;" }

                bind $data(w:sample) <Tab> "focus $data(w:regexp); break;"
                catch { bind $data(w:sample) <ISO_Left_Tab> "focus $data(w:regexp); break;" }

                pack forget $data(w:allreplace)
        }
}

#----------------------------------------------------------------------------------------------
#        Manage REGEXP
#----------------------------------------------------------------------------------------------

proc regexp::regexp:set {text} {
variable data

        $data(w:regexp) delete 1.0 end
        $data(w:regexp) insert 1.0 $text
}

proc regexp::regexp:colorize {} {
variable data

        set exp [$data(w:regexp) get 1.0 end-1char]
        set max [string length $exp]
        set stack {}
        # list format : min max min max ...
        set indices [list "report" 0 [string length $exp]]
        # search the groups in the regexp
        set data(v:nblevels) 1
        for {set i 0} {$i < $max} {incr i} {
                set c [string index $exp $i]
                if {$c == "\\"} {
                        incr i
                        continue
                } elseif {$c == "("} {
                        set c [string index $exp [expr $i+1]]
                        set what [string index $exp [expr $i+2]]
                        # test for escape with (?...)
                        if {$c == "?"} {
                                if {$what != ":"} {
                                        lappend indices "lookahead"
                                } else {
                                        lappend indices "noreport"
                                }
                        } else {
                                lappend indices "report"
                                incr data(v:nblevels)
                        }
                        lappend indices $i
                        set stack "[llength $indices] $stack"
                        lappend indices 0

                } elseif {$c == ")"} {
                        set idx [lindex $stack 0]
                        if {$idx == ""} {
                                continue
                        }
                        set stack [lrange $stack 1 end]
                        set indices [lreplace $indices $idx $idx $i]
                }
        }

        # remove old colors
        foreach level $data(v:levels) {
                $data(w:regexp) tag remove $level 1.0 end
        }
        $data(w:regexp) tag remove "lookahead" 1.0 end
        $data(w:regexp) tag remove "noreport" 1.0 end
        # colorize the regexp
        set i 0
        foreach {type min max} $indices {
                if {$type != "report"} {
                        continue
                }
                $data(w:regexp) tag add [lindex $data(v:levels) $i] \
                                [$data(w:regexp) index "1.0+${min}chars"] \
                                [$data(w:regexp) index "1.0+[expr $max+1]chars"]
                incr i
        }
        # apply special item
        foreach {type min max} $indices {
                if {$type == "report"} {
                        continue
                }
                $data(w:regexp) tag add $type \
                                [$data(w:regexp) index "1.0+${min}chars"] \
                                [$data(w:regexp) index "1.0+[expr $max+1]chars"]
        }
}

#----------------------------------------------------------------------------------------------

proc regexp::regexp:load {} {
variable data

        # get filename
        set types [list [list "All" *]]
        set file [tk_getOpenFile -filetypes $types -parent .]
        if {$file == ""} {
                return
        }
        # do it
        set in [open $file "r"]
        regexp:set [read $in [file size $file]]
        close $in
}

#----------------------------------------------------------------------------------------------

proc regexp::regexp:insert {what} {
variable data

        set w $data(w:regexp)
        # prepare undo/redo
        set data(v:undo:r$data(v:undo:index)) [list [$w index insert] [$w get 1.0 end-1char]]
        set data(v:undo:index) [expr ($data(v:undo:index)+1) % 100]
        # do it
        $w insert insert $what
        # prepare undo/redo
        set data(v:undo:r$data(v:undo:index)) [list [$w index insert] [$w get 1.0 end-1char]]
}

#----------------------------------------------------------------------------------------------
# History window to memorize already typed regexp

proc regexp::history:init {} {
variable data
global font

        set w [toplevel .history]
        wm title $w "Visual REGEXP $::version -- REGEXP History"
        wm geometry $w 640x480
        wm protocol $w WM_DELETE_WINDOW "set regexp::data(v:history) 0; wm withdraw $w"

        # text zone        
        set tf [frame $w.t]
        pack $tf -side top -expand true -fill both
        set t [text $tf.t -xscrollcommand "$tf.x set" -yscrollcommand "$tf.y set" \
                                        -bg white -font $::font_regexp -width 5 -height 1 \
                                        -selectbackground lightblue -selectborderwidth 0]
        set data(w:history) $t
        $t tag configure spacing -font {Helvetica 6}
        set tx [scrollbar $tf.x -bd 1 -orient horizontal -command "$t xview"]
        set ty [scrollbar $tf.y -bd 1 -orient vertical -command "$t yview"]
        bindtags $t "$t all"
        grid $t  $ty -sticky news
        grid $tx x   -sticky news
        grid columnconfigure $tf {0} -weight 1
        grid columnconfigure $tf {1} -weight 0
        grid rowconfigure $tf {0} -weight 1
        grid rowconfigure $tf {1} -weight 0

        # buttons
        set bf [frame $w.f]
        pack $bf -side bottom -padx 5 -pady 5

        set b1 [button $bf.1 -bd 1 -text "Hide" -command "wm withdraw $w; set ::regexp::data(v:history) 0"]
        set b2 [button $bf.2 -bd 1 -text "Save ..." -command "regexp::history:save"]
        pack $b2 $b1 -side left -anchor c

        wm withdraw $w
}

set last ""
set counter 0

proc regexp::history:add {} {
variable data

        if {$::inReplay} {
                # avoid to put the same expression again when replaying it
                set ::inReplay 0
                return
        }

        set exp [$data(w:regexp) get 1.0 end-1char]
        if {$exp != "" && $exp != $::last} {
                # memorize position
                set start [$data(w:history) index insert]
                # add text
                $data(w:history) insert end "$exp\n"
                set end [$data(w:history) index insert]
                $data(w:history) insert end "\n" {spacing}
                set ::last $exp
                $data(w:history) yview moveto 1.0
                # do the binding
                set tag "t$::counter"
                incr ::counter
            $data(w:history) tag bind $tag <Any-Enter> "$data(w:history) tag configure $tag -background lightblue"
            $data(w:history) tag bind $tag <Any-Leave> "$data(w:history) tag configure $tag -background {}"
                $data(w:history) tag bind $tag <1> "regexp::history:replay [list $exp]"
                $data(w:history) tag add $tag $start $end

                # colorize the expression in history
                scan $start "%d.%d" sl sc
                incr sl -1
                foreach tag {e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 lookahead noreport} {
                        foreach {start end} [$data(w:regexp) tag ranges $tag] {
                                set start [$data(w:history) index "$start + $sc chars + $sl lines"]
                                set end [$data(w:history) index "$end + $sc chars + $sl lines"]
                                $data(w:history) tag add $tag $start $end
                        }
                }
        }
}

set inReplay 0

proc regexp::history:replay {text} {
variable data

        set ::inReplay 1
        regexp:set $text
        go
}

proc regexp::history:save {} {
variable data

        set file [tk_getSaveFile -defaultextension .txt]
        if {$file != ""} {
                set out [open $file "w"]
                puts -nonewline $out [$data(w:history) get 1.0 end]
                close $out
        }
}


#----------------------------------------------------------------------------------------------
#        Manage SAMPLE
#----------------------------------------------------------------------------------------------

proc regexp::sample:set {text} {
variable data

        $data(w:sample) delete 1.0 end
        $data(w:sample) insert 1.0 $text
        set data(v:undo:sample) $text
}

proc regexp::sample:colorize {} {
variable data

        # remove old tags
        foreach level $data(v:levels) {
                $data(w:sample) tag remove $level 1.0 end
        }
        set data(v:position) 0
        set data(v:positions) [list ]

        # set new tags
        set exp [$data(w:regexp) get 1.0 end-1char]
        if {$exp == ""} {
                set data(v:result) {}
                return
        }
        set result [eval regexp -inline -indices $data(v:all) \
                                                $data(v:line) $data(v:lineanchor) $data(v:linestop) \
                                                $data(v:nocase) -- \
                                                [list $exp] [list [$data(w:sample) get 1.0 end]]]
        set data(v:result) $result
        set i 0
        foreach match $result {
                set start [$data(w:sample) index "1.0+[lindex $match 0]chars"]
                $data(w:sample) tag add e[expr $i % $data(v:nblevels)] \
                                $start [$data(w:sample) index "1.0+[expr [lindex $match 1]+1]chars"]
                lappend data(v:positions) $start
                if {$i == 0} {
                        $data(w:sample) see $start
                }
                incr i
        }
        # set nb of matches
        if {$data(v:nblevels)} {
                set nb 0
                foreach item $result {
                        if {[lindex $item 0] <= [lindex $item 1]} {
                                incr nb
                        }
                }
                set regexp::data(v:nbmatches) "[expr $nb/$data(v:nblevels)] matches"
        } else {
                set regexp::data(v:nbmatches) "? matches"
        }
}

proc regexp::sample:background {} {
variable data

        foreach level $data(v:levels) color $::colors bgcolor $::bgcolors {
                if {$data(v:background)} {
                        $data(w:sample) tag configure $level -foreground $color -background $bgcolor
                } else {
                        $data(w:sample) tag configure $level -foreground $color -background {}
                }
        }
}

proc regexp::sample:move {amount} {
variable data

        if {$amount == -1} {
                if {$data(v:position) > 0} {
                        incr data(v:position) -1
                }
        } else {
                if {$data(v:position) < [llength $data(v:positions)]-1} {
                        incr data(v:position) +1
                }
        }
        set where [lindex $data(v:positions) $data(v:position)]
        if {$where != ""} {
                $data(w:sample) see $where
                $data(w:sample) mark set insert $where
                focus $data(w:sample)
        }
}

#----------------------------------------------------------------------------------------------

proc regexp::sample:load {} {
variable data

        # get filename
        set types [list [list "All" *]]
        set file [tk_getOpenFile -initialdir $data(v:dir) -filetypes $types -parent .]
    if {$file == ""} {
                return
        }
        # memorize location
        set data(v:dir) [file dirname $file]
        set data(v:file) [file tail $file]
        # do it
        set in [open $file "r"]
        sample:set [read $in [file size $file]]
        close $in
}

proc regexp::sample:save {mode} {
variable data

        # get filename
        set types [list [list "All" *]]
        set file [tk_getSaveFile -initialdir $data(v:dir) -initialfile $data(v:file) \
                                                         -filetypes $types -parent .]
    if {$file == ""} {
                return
        }
        # memorize location
        set data(v:dir) [file dirname $file]
        set data(v:file) [file tail $file]
        # do it
        set out [open $file "w"]
        fconfigure $out -translation $mode
        puts $out [$data(w:sample) get 1.0 end]
        close $out
}


#----------------------------------------------------------------------------------------------
#        Main toplevel commands
#----------------------------------------------------------------------------------------------

proc regexp::make-regexp {} {
variable data

        # new dialog
        catch { destroy .mkregexp }
        set w [toplevel .mkregexp]
        wm title $w "Make regexp"
        wm geometry $w 640x480
        # widgets
        set f [frame $w.top]
                # area to input words
                label $f.l1 -text "Words list:"
                set list [text $f.list -wrap char -bg white -font $::font_regexp \
                                                        -selectbackground lightblue -selectborderwidth 0 \
                                                        -width 1 -height 10 -bd 1 -yscrollcommand "$f.sy1 set"]
                scrollbar $f.sy1 -command "$list yview" -orient vertical -bd 1
                # button to compute the regexp
                set doit [button $f.doit -text "Compute" -width 15 -bd 1 -command "regexp::make-regexp:compute"]
                # display result
                label $f.l2 -text "Regexp:"
                set output [text $f.output -wrap char -bg white -font $::font_regexp \
                                                        -selectbackground lightblue -selectborderwidth 0 \
                                                        -width 1 -height 4 -bd 1 -yscrollcommand "$f.sy2 set"]
                bindtags $output "$output all"
                scrollbar $f.sy2 -command "$output yview" -orient vertical -bd 1
                # layout
                grid $f.l1        $list                $f.sy1                -sticky news
                grid $doit        -                        -                        -sticky ns -pady 2
                grid $f.l2        $output        $f.sy2                -sticky news
                grid columnconfigure $f {1} -weight 1
                grid rowconfigure $f {0 2} -weight 1
                # init
                set data(w:make:list) $list
                set data(w:make:output) $output
        # button OK / CANCEL
        set ff [frame $w.bottom]
                set ok [button $ff.ok -text "Insert into regexp" -width 20 -bd 1 -command "regexp::make-regexp:ok $w"]
                set cancel [button $ff.cancel -text "Cancel" -width 20 -bd 1 -command "destroy $w"]
                pack $ok $cancel -side left -fill both -padx 10 -pady 10
        # layout
        pack $f -side top -expand true -fill both
        pack $ff -side bottom -anchor c
}

proc regexp::make-regexp:compute {} {
variable data

        set words [$data(w:make:list) get 1.0 end-1c]
        $data(w:make:output) delete 1.0 end
        $data(w:make:output) insert 1.0 [make-regexp::make-regexp $words]
}

proc regexp::make-regexp:ok {w} {
variable data

        set words [$data(w:make:list) get 1.0 end-1c]

        $data(w:regexp) insert insert "([make-regexp::make-regexp $words])"
        destroy $w
}


#==============================================================================================
#        Main entry point
#==============================================================================================

# try to get customization from 'visual_regexp.ini'
puts "[file exists visual_regexp.ini]"
set filename [file dirname [info nameofexecutable]]/visual_regexp.ini
if {[file exists $filename]} {
        source $filename
} elseif {[file exists visual_regexp.ini]} {
        source visual_regexp.ini
}

# try to auto user patterns
set filename [file dirname [info nameofexecutable]]/regexp.txt
if {[file exists $filename]} {
        regexp::pattern:load $filename
} elseif {[file exists regexp.txt]} {
        regexp::pattern:load regexp.txt
}

# buld the GUI
regexp::history:init
regexp::gui
regexp::go

if {$argc > 1} {
        puts "Usage: $argv0 <sampleFile>"
} elseif {$argc == 1} {
        set filename [lindex $argv 0]
        if [file exists $filename] {
            set file [open $filename]
            set data [read $file [file size $filename]]
            close $file
            # memorize location
            set regexp::data(v:dir) [file dirname $filename]
            set regexp::data(v:file) [file tail $filename]
        } else {
            set data [lindex $argv 0]
        }
        regexp::sample:set $data
        unset data
}


#----------------------------------------------------------------------------------------------

image create photo logo -data {R0lGODlhLAFxAMYAAAICAhcXFzw8WFtbb4+Njq2ssioqNMfGxkJCSgYCtcYtJrjOuEpGVs3Y0FJOYr1JNb53Yt/g4BsXq+i9yspGHOjQ08adlebm5rm57unH0NwjGPY4EsJaIgYCwqOjp2hmet6+wurq6uTYvvcuE77Ovh4altZLE9C0uioqjrljT76OevtCDt7Hx7q5u8LC7tzZ2PsbFnJyhvsqEspWGvxaCgYC0+jh3cLSwh4akujY2Ll8Z5qZm8rK6tDQ6PxODNHQ0f///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////yH5BAEKAEAALAAAAAAsAXAAAAf+gBEvBy2FBz8XiYqLixGEhT8vjJOUjD+PLZGVm5yCl4WghpEREZymlBE/hqWnio8HrbGngoUvrLKEP7eym4+SnS0HpaqEB8bHFyHKF57GycrQ0RcNhAWQsSEvl6O8lJ+Qv92TIY6hoIcvts/im9mfwrLlBYjs4uTF4uXq9YwRwfSbUmUKwYxUMVu7Uh2DF60hwXKgAJoiV5DfIlWgGoSzmA2UtQMaSVk8RW1VvIgjeQ06sDGWvxYiU3bUxYmcqgbP7mVKVCrVJWOacjpcBjEYw6HQeApCiFSaIJFJFYqK0LRqw0QYjeoqtayr1a/RbAyCZAPsQ1AvzKqtOo3mWlr+wtZWFUTiV9Wxkogay/twoUaCrSKQOAev1U+QLVEdtmuzUAGQuyxSO3QLsOWUi2w+kkgSVORZ2j6DxsmrceFJpERTUvb01E8bi14Ewwn4ZwPYOSf6PGcrGgsLDzQIF67gQYqPuppeSBfqRdm+r5JbtTBCgwIIz5M+TJ35qlyrWDcLVR5C1WOqase24AuWGY9gadUuxzdUYNyvzIxxRWpwYDKeGq3T2n8ETiRWA6HQdIEKCsDg4IMQOqiACjyolog2oTRAVTJFsWThMzrIIKIMDwA2zn8mEpgiZvkZQlorIbzy4SQIXiNLR4XMmNk0uaxmwyM6MiMbTJVAQ4xoSSn+QpBly0yk2TkRVKCCBhFW+eB1NZEy2F5LMjOYIc5lCQEMIo6gQAWrJdIli6eQ4Es8P3zUzVinxUJnkIsYs14lL8FyCjmy1clICDa46WeBO67JJH4cYnKABVTCoIEKLpzQoJVXcqZkQelEABtgHcZU5AUpiAjDCDLo0J2am7LZiYx/8vQICTdyuiGMioRUWoy1FCkIbhPxBOxqsgWlpqKINjkeUooI8kgKVGqQgiSpQYqphDmcyOEFZR0rlqNptcPtmCOSOGiKl7k6iQ0lBaOjiWh1ky42x644Cz7jMBnrvCfqZ293yC5LHoeqTAmDAh5kp0gPD1wraWSXmbikTob+HMLNaqWW+0C4TXb5r6sKYeJusDzFWyur7HxcZDaE0JqmvIiiNki4SiKLrsft/RdBDztcasFGrEVwgsMwWNBqoim+8KUhYBaZ8YgKZDtqqyqz026CVTNCjTWJrZz1yiknUqOmNX/NSwOX7LIizh3HHGsPDWrwQA8tbacD0Qqgh/KOzWZlTUT7pagCmWWeqTeKVE/8HbNDFtNCXQJLo+aQJKAHXuKM7m0Wq4Gy13a9zCbb1A8Sfa6iosrimkgKDj7Qggs9BM5qBJdem8LHqZcyiJu8U2YvoSeMQLgMZ5q9N4uCoE36PrGSEknXaRp/og4cqGC06qDiLj3MNXvN78n+cRfAww8vdn8B3ERf/zvVSz21j+SJ9DDiqRT8kLrEx0a+uLYossWqdpkD2OUUQQEa0MAEHDjAACcGuq40cCjrKJtD8vU97dSrNDyB1ANOMCgVNctSDlNAOCp4lVglQgFlgsEDhmWiH7AATUeTCQPtsTbV1eMhMzCgAU1gAam9LHWr2d6NbjYqr9zwApCyQA8QF0NFWCB9zzlXsnLzu441bEQPyB9BKnACCKQAAgcYFpuEWDaOuC1WIsihDmmQAguQ8YgRpJfxlLW/EPAgA/DTnIAadq1JHe9/q+KXvUI0Iggw4gQpQOEIFqkBDqqrQB4L277soSQb2GCNOpwBCGr+0sQOYkN6QPQgyha1FvO5DX+zqx2mNikx7SUpUawCAeE0YIEoTmmRuFzkxh7Jj1BikIzQyAEmMykCXnryjE1c05/YVkoJnlFREcjB4Bz2gM8oE5BTnMQPqCQDDdDDkhTIJS5lwAE89ZKSyOwgMLv3gmEacAbFfFk658k/eY7yRDiTICmZpbKAIasCqqySBkAARMVRMgcaQJUCCAWYB8hAnItU1RhzwzcnrZOe+FREO91pArWB8o3L5FYnsflKdOrLmYh7iAUCGqFqbqpq+lqfDVBIImmcQANlwuUDcrC40L20fwMbj/7yuE//zc6dBxSKUv4XDYjZIAc5+NQycCP+AkuqyZLLqCq3cqBVS1YVN7bQ0DqSZCJWkONd4krXNZNhAx5Eykq0BBoTK+rJJtFUoosIzkO7mQIxjiSSdK0JSFHRD60toHwvUCMmOXCDG7woAgsQVWYaEFnWVGACIJjABGB4gahySwQi8KFVO/tVrn7VBqHV6jR2ZiG99QZQK/KrWtEVx7l6inXXmtBc+XZSqv0HhY30YAVAYIEUqMCRPYXgjj411OVU4LnZAmBYKsBTaETgBgvIruUa4NhlUJYqEWiAeEnA3QYQ6gaKXWMKsnuD62I3u+IN3EPIy63LRvWyE0gEar1azC5VlVCpJch+vYpV1q42vAC60IYQDCD+Aeu3W0gbKW1TB4K3CrSaEavr1JiRDAWYaZOVYIGygGXJEpO4xBsGjA04y4kVswAELMiADbhCCRtkIANKomx2F5BjxyoCuzihbGMdS16CkCC9OkyBkKeBXceKV7wSuy5ObDwB2FwWx58NAWj/+4z/oha0/C3xV6fRA2XE7nylCFB4e8Kdh4i0lRb07U+RmQ3cXut64ipIakhhmeuS4AYzJZ5ZfQuYHGQATRG4MQgy8MLJZQAELG5HoiNdiafeeAIs4KkinoubUlQgA7cAstogSxruHpYrOm4vaxaAZANCAL7kaOxhQ0AC+IqVII3l1lO5pVmeghnAUUzGab8KYBH+EArCrCVI7HY2jRdoSCQa0ohYNdQxxZH1aDGZ8HbAywOWQkgBLbj1fxobk/eyFydrhuwCbrDNEWSxEuXLwQupMtwJ3DgDv6DyoheRgzAdbbiLGC2KWZUBe2+E0czNxo2fgV0aN2vWOoYvMxzbcP0e2Z0WWDdVqH3dh8h61hdobJdsYG8xG1vLXP6PiYn9ZYZ+6tnKjh+Cn71g8z6DFFJ9IG3/0wMXuMDhKbruAsIVARcQgGgPaG8j2Psf8WL3AIdl8rp37AHrGFJApr6ByguOm3ovsUnDVXQFcBPjRY8WMFzXL6NzcNlF+/B8+56cvRthAxawgBW1pi1ktX4B9vb+hDapecgCOOBOFWhcw1lPRK51XfKygNnx/dWvlvmrDAJT8dbpFq/YYrckzeeKrfpdlp47+AIMVGgc6tY6QXQcnD4afhGUPYBjbyH07qrpvSRwqALwKt4dr1u/l11iIi7twxDIuwIvuLLUPr1oTGfAs+ebgEhyoFlI1xvU+tUsjqOZfEw/l7MF70mu0bX3REj8RLVvNQ1aAPKXCn3d5g0BZWnDa2h8uSwtz8x/Wf54aXB+O/LHFWfGRNuha6DnED3AAzxwZk3VAxjgAnZBIKl3ewtAAh7gbQ4iNwUwbqnGXXrzXvE3ce+FQhRgNO+3AAfwZ81ScGhCDgWXaYqwYpv+1W+YBUOk0AMFh1mHlgjDJTU5kFmglmiZpSaJNndXhllIiGUXwAJVxgzZ9S+/p24vMkMgqH7zx1TTUGt/disNQF+65mUod2yg5S0DVgHGhn//lSLUthwbwnkcBlQP0RtY9UcXwAMYcIdlVjNFh4c74ndL8l4v0AMWFiFyIwk6BnU7xhW1Z3PcpXURACkkcgIfB388AQIgcAIqgEf/8WjYlwzUBwIb8oLhAlUvwAP2VnDJ8AJNGAEscAIYAEOMll+p+Gg5ECUZcEf2BgIYcAIHUAERoFkbN37p8ns1EgwsADkTU4GeYgLutHitQon5o13/8WkMNXlhZm0n93gDhj/+4hZBXjFBUGE6i+ACd/hzgGWHD5gXigd1Sic22fUCOTAmfbSBE8d+YrUItlaAj0gBIvIABcB01lUB0CIcI8BBD/FoTXgh8PgpOdADIKACKfAAD6AAFFAcEqkCvkh91KUDFUkBbfSLcbccJUeEj6YCFEABK0ABxmEBLJAMV9gPP0AAOpACHEABJmACPnCTM8ABOnAClcNeiTVMMyCN6SIaS8YtIfB89vdrYJYTWPUcT3lyNOJR+QOHFUFKlICOsFNGe4gBeah4v7cI79UTGCghiNaFkbUpqfcZeiUDIOF7PgYcudRInwKSoIY6QpNIG7ABI7CXe7kCGwCYKQkBiVb+ACkQmIK5ASlwAhPQA11nbxtCEBOgAiuwAj5QmT7gAxhZCtpFFD9gATOAk5npAzRAmjpkmqV5HO/VajPgjKvSHYtXefj3HI+3ZWcYFtCwZcGmJNkWSNbWSmNVCeT4gHRTnDxxAXfolQACX7cSckR5N33UAuSgY6MGZKRhXTglIuTzXmMZHHMJYsxQcDLWHTZwAhywl32Jnn65niuQAheQASmAkpU5nxugApuFdpAWeomWAplpmf2pAt0ijdxyABBAAaNZmqV5oKaJmhzwZzdAeJhkAuumTIIEWYNWeRi6Xyg3dmwVFmhoVRQqWadTRVgZOcl5oqaXFMPpAhySamb+FQKJqF98hCki9H6RoWPUZhmsIwMq9BzhRQK1RgDitAHFAxgT4AJY1iQrxZfF0UYn8KRlpwIPEJiLSXIQoAB/OZ+X+QAilghMWIuWwQMoeZmYqZk8kV08AQH+SZoHepqZaUCoyUbF1GockJbmg0q2x0xiNptYJZv256EFhTvH40CiMxQnygOwM4CJkJw/N3Hn13QCGiXQiSkpYKN6yHQ5UQE4VR2shCLhxQEQpQDAcmUsFgEQYCYbVF27ZkS/8QvMJ5/0WZnuyQyatZuUeZmjmZnXA1nkxZFvqqA0sAI3CQHWg4kQMAOoaQGlAKFrxFh65DZRpCjZ4XLSMDEldmz+1VqVO7dWFAU/SDGcGOA2EZCcPOBx57cMY+mpLMWjkpJxAporErckEeBQIgIBa6MMKQBRGjABS4JfLUgQIDACEMACyfcCL2asEZmwEHACb1cKFoCY81mZG9BDzNecIYCsuFqmbjQN2ZUCopmrmWkCbdRfKcKsNIAmNkCnx4RK12RtUGl/0bos+FdbdFiV3RGOARc5K7ofvMmoLSp75TOB/zNNmOKP8DV7ykANUacILMBNA1VDNpCv4qQABnkBYfd2wcOTOqACM5lIFYmlWKoBKtlDm/ICsBqxK/AAi2Z2vCmfuDqaboRrLcCMwJqTi1kJIkC3BkQbJksDMzCrUkT+R2UUR9VYQqNEKLslOq9JEUkBG5UxVR+zs6iXnMJno5GpbpUlMTPqIOwqKeC2Y3wnf1BHGo9Ir1hyRirwULkkA0ZDEPdGXeFithqAnovkl4kJmH/5AKrSJCcAsRG7ARhwaOxhAyrQn/3pn8h1AWoKsplJmFP0AuYJpwaECCk7TLfjS20TSnBGrSU1VzWkOQOyDK+lYpSgWqhAN0iilRJ4bg8XlgxEO4P4bZUjKkq7ITdFJo3UnC9FHRClAhzyaEDIYiGAiRE5kQ9gAhRJkRW5nhQgNQ/BkWgrq46kJBbAAYBpvLiKZxdQQL9qAvUTWxEAAr6KoAh6AsXUt3+rOQb+BUkxA1pMknIxWFHfW5UD0ixjJQI9oY1+FViTMJzCBxg4umAA+VIvMKk8yq48qgD0MGSJ6AgJxaO1lHNlEzw5tUgpoInR1G+1GETVliIsEJgY9j8PK7Fk7FLP8QIP4AMluAFv27ys8rE5uUm38gMnoAMQkMbSi0kqMKeLpQKvpA4dIwIwWGPPtQ5jiDoxo2K/wmadcgG2eXM4nBsvYGxa5SlaZk6N4IAYQH83F6NOyF4Vtyl2xrmkLDemdm4tAAGRQkt02BUHAFGLpAIOt4S7q63PmwEF8ABpqz5ImQhqiraX6Z6AAQFqvEQpYJmYmZIAAcc+wAFf5LE3yaYJKs3+qJkCwpACmDQD/msiL1YBkvNCEMYILwBpn/JribBlimCbXGab1DLJqOUpNQxgekMQkTxjkVyzNps05Fgh80Kdgud77bckFdZHMAAB5BVtJ9CWxFM34wBQqotLG1CCPIB8j5ZIQCev6QCPFdCKd4ylG6ADP5wivQvMKXkCBMECJzmrOjCaa3ooBpqrOCmaCLqgM32aNMAB4QYBfcwILxZPBPIDxqZrqKVfL8YC2YgbX9aUzCACQD2Gy4HD+xUBLmzJUq0iUl1dlRdNn1XP0zpBp6MIiKqcX117QOx092jV1oLEZAIh0tLRD9JNP9PFiZxIsMxIFJBQRDpjiZTAfA3+th6NmBvAAdWVswShAxFcmSbgRScpYjMGAsjM0hQQRiHAAcwLsgk60zMAARaAk5n0OCcglFubAjpQd3fHCHVXCoJsiTAWJZZo1I4cT1+21MW0ZeQwhlKdw0Ki1IIQQSIQgVl2C1VFsspxPC/gc2qDGiEYPaxiA8BRJUccIaYiNy05W54kTUOqnrlk0qTCl9z9l7YbmH4pyy/KwhAAsYiJqybAmEz4QirAxiA7A250AsxMzdRsAqOdCmpEmjOQCQ3Qt5gUwr74P8PlHHZnSQV+ASCACEkbT6C1YOfs07392jzh00vtKffMIUP9hjh8yU4dH0GlLKIijvdKRB6UA3z+9Nyd+9zSsrHemEc1AwIPIE4ysAEzLratmw0UwN2AWbvoSZELq1TPVKDJDJgUwAE6CF3h5QIm8NgroALmFQG3qqC/mpPabBMIwtkHpAIH0AMNcALqt5MDPigvVgrdzKHkkJ+1ncMUPg0uXNuWNMmy7ciOq1UN3iygNcn1bCK48ZtejT/dS4A8LEoScwCq9Nyca3WaJkqLWyAsEJEJlUsK0EYilQiW0t2B2ZcnObC8JUX61d7J/AAqkFkgIAm40Vgei6sP4M3K0OjRLOUmMAM64AFpgTZog6wHtN+zZwP+XT29CAJYzbQsUBYv9gOrrWUgEMlObQMK4sivTeq2Xc/+OCzVOOzUDQ6Vk0wKsK1yu3JB3ktXK0y4saVfdcy1x6UCxxV5FRTozQINFmA9TSJvz9dlmKgDoGiAO1dpBxgC7a6sjjuSHGJuLaACLbAapNPu1tNp7EYKDUA3ekYOXL4t+n5cCiTQnaozMOZgZljgP7ghTi3tW13boNUAyF7JG+4pfBF6F3SvcsZJh5tR2aRhLLxhnVRFhVVRzDV89qbqDjbpBqXRGyEWinZoUpVh1Id9UYG558oTpMNCDn9mPdADN+Bs5cYDf6TnMBZHAJ4Kwc6K81bUtsDU/6HOwB3toLLpWEhHhIpK2COOguW9wMlb4ssDr2VP/EMomqf2ryT+nswFVTcWYwFODsyngztoY+IZ9KbELQ6piWszXnbaLFz+SvK38LdygzdQZk9fPgFHVQluhgW7YqDIdqrt64kgb8Eu4c3Sm3zeW1UvVIJ+RC2bTB3Um0SoDdXgATtgAAGQ+7q/+7yf+wKgUd/gAR4wAL1f/MUvAK54Ao6xAwKAAMb//C5QADuwAwTw/Naf+y7QAsK/A8Z/XYRg+zvgAMVvAAdQAODv/NfP+wjgyDBmd5aIwwD3VHYHzssAVcK25lx8TNgkQPtERc30rIBwEXJBGDJoKDhIeMGDwROhGBnxc9BS4LFDgJDQkeD5CRqKYhAz+WO5k2nQwdrq2lHjGgv+wFCQSkAAgPIKy1rzCwwM4GKRueMQnKwcDFBpi2vw6wrws9DigUkQoCzBc529vSxegyIQUIH+kmMTEiH4jgj/fhEhUhi/WJg/v58fqejvkMBEhgoaPIiP3yKAAPXt64Eh4guGhCY5y4YilMaNCQw0oIQKmsZOrDi54hSgwLNcJHn1ipXMXKVbAsbBXBagEqZMAWoGQ+HsFoFoyQD0+MbTpk0ADOMdTLRwkQh3URc2rNqvn8CtBeUh/GrQH9amUK9GiIiBqqIXLlpguJTNAce5oAxQUomLAA5OfEl68tsSwUoBEly2ShDr8C9ab7MBkCatFTBYwTogIHHtEq7HyQz+XMokgDOzDwcW2MokWqkyA/MQXT0kz2HZfa+z6vun0DVXsLyv8lMUgeqFBjx68GggfHhEF1QjuHARUWU2nhpRILiOfZPGZtcyaQLVCYD48eTHh0QA4HDJEuzbuy8hQQCCFiemr0pcw0D5/eInWeuuCWWUAaDZUJQJ80IPF4GmzH4MLCOBWLc9JZtWirBjm4QZ3kOQU7r1hhAhPUQwYlURFNfDBS80EhGKikCEAXOEsLVcdN7lopEBAuzIo3zbWZPNUH158kEGRrrjjg02UDJAARZsJgAvAARAZZVWVnnCCS08iUuUkQEQwyA2EGIDCxmwEIEDYb5AgmkroZAMAuD+cBNABA3odIsEygTQ2A4M6LhMVb4FlCFw9GgFVWtcWVXhbLBtuA+NaBVXyIloPfccWjFCcgGMLizCIg8rHoCBB3kZEAoOALxwwGeb7QVKM6Z5B8CQAuSQwQQZYEgICFmiospfrQhQAQi6VhDCC0ZmUEGuIFQCIAF6+tJBAA6JyasgFoWUS2U1IEAAAz4xE8GoACKwTAynqITaMo8iGpyEg7Dww4UiiBCCCOzARlFChTol26CQXhBjpmg1sIimGPQwiHOX0gPjIyIWF8JHb90I6ycGIECiq5oIEAoAQHoH8l81ANAsCxNU8IINJP4aEgMuBZBBDsVWcIENzRppJg/+B7hw2lAw9eIAbbclUi5mAI4rjNA/AUDPD5i5mtovApzYwjfdKgNbBTmoRY8IIODsmw0g2DNIA/ZccK+F1/LbkGvXNjpwPi9UxGJaiEAXYwMAnbUcxMu50w6J0ElH8nZRe7xjKAFkHaQEfKEUXK4TqKxylkDvoAJLrwgwUUWJ0tOOgpBv9lIHKNSNyEd4MpjMgcBYG3VQ0DQYwQ2WYLN1MBE2PHYEY74TAc4z1uPODyAs7869Y+Zbb2zwCBybvxTV3Q+nIeSdIj0Pz+Pwwu2EisiKfKtUQF4BaGTtip/xVLLGkGeyCWCsdaryBJcv3xbVLcECNUQVxGUgCVp6boL+AN2IpSE5IMFFbqcUAxyCVQ8MVzIksCqfUU0ZJSBTBEBwt0go6W4qYsHyKlCm5bGAEG0bRNv+RT3aDORDIAIL4ba3HBICLiJqaQffeEAPvn2qUwfrweFopREHGO5iqAvFB3ZHnU90Aio5yMGIEnQAnZiKABlxhTkicQ98sCprg0kMALFXkRfozlXhGId8KkIcPBEAGZ1BQAGzwTSrvaNYa3uH2Vigs7O9oAKAFNsKWSicF2pokYvqEL8cWUMKMQItwrkUpwQXEYaFD4hEjAipSnUj7XwCBWhxyzMGkBFQCMAammFAeqS4ut+kLYuuQsArThYD28SjXNDKBrogU4P+AAzEaAx5gdR2hws4iUMCtDvRAmg5p6LYqYJ6KoogAimcQbxgbBcwYRWFdwE+zmgqi/hBH3PTlYEpMJKRnAff0pKwSSFnRZPCW4tEhBbp8I4AMciYJwTgFkt8xgG1ChkZ4deJv5SjRz1CQGgKVKuSsEIAvEOPBC6KUYyWAADI1MbQYsHQkArABl8j3hg3uAz9AMd1ISGoMhhw0mwQJU420NcBQECbYrEjAiwwYfBMuLYWshBRRJ3N9NIJN3aGCFSDq4jCFOaCHkykdDxcyzvdgkeNyCekJdgIQKn2FyneJHY7WskqXFECdu2gJ5C5ZVq7Q1DJyE4cAsgACDLAqaT+HXQoMwWGABhwiHLxYGrgyKMEfnBMAypDAM4zWw7A2M0V2iB0H1zhCYVnTqmc8zX+0uUMaahUg1zync25VN4yqb3xMQwqL4hjAQC0vrmcpDpTewaqworbsJIEAIIh2f8EwK5cTEsWrUBBzO7zkrGm7mTMekG8agdFB/R1MeBT0LocU02/vkAEe3WAMpmxDpJykyE9zRmaagqCHFxAhfZ4YT0a5ZthEqo1jEJjVl4UoxJ5L0aPKJdzBaWQRUwCcqYiKF3oEpqDZqIECR3SkBLaAY4WqDCSIdAW09MLlxDoGQAowUeplVxhFKIBCyABCRLL4V8y4x4NIA6QZLqaU1z+o0vT/cX9wple4YGTpz8I5PLORghC/qB5QUWbh4yGZPjSzb5RQURwhLPD7omOLIIql4x5FwBRHjgU17mLZkTZ4AS8hz0SKEE5XIWqV6SEw128JSs2rAq5wgI+Za4zncsh4BssgJXYQM1c9ThiE1NzsQ69DmHEwZRy/liF5q1Uy0h4tPfei3BI7ld8IXs9Jie5yeVajpQDTD07rdExGsGBP0GBg9DUKbHg0C0G39YOGUNUPZahxzRbdRpbZri3mdgFfiSAAEgua3h53nOQDJBdZSRQRAvo3zMepBpEBzsRIvCakpCqy36QExL4iO+GAEZfTcOwKp5imPXC+C5eCjT+WCEbD/t0FBzEzg9HqqyT0aYZ3VcexgENA0l31vqKDxQIMS8Z6btCYFe8RmXA0apaMqw1iB60CYoejTadQoAhJ2N70/W9r8cLhe5HhpY3TW6IpVZbIbI4xZgVvG1dtpjKT0A8WcfcCQGiZDIA8DsrIljXM3b0Cgmgw64gIONOHjOsAp31Jonuh13Vm4/cwSUTLl1KAk/kAm/0uXcWt5owwy3fgLxLeov8eFjWuZuRg6V6YPxQthVICNfB5eYakcA+C6oxTlHw39Jy3AKSo2NK4Bo1DA4MCDJ3AvQZI0q+INAtkP6SABA7H7mCND1wbXOkK4UpzjkAZmyeR6VgEEz+ZMeKoCBLEHVib+1JVbskR9fZAC9QEqyOoir7vNZUNYxN845fQgVwAwE3S3+/Cq6+fWGAnbLgBBbwGIVjkRLfZvhbWYmArohNYqS0qyihF4AgPvLiTCTbxoZmAALMzwDANpKocQtLk0Ete7ajvSygdX06kzz2oh4q6oiVI941lgqgoRHBti1spBEfgDCDkAM9dXhZMnV09wpQ40Po40v40REFUhPTFyaxYQO6IhwkNjJzFHoBIC3KkEtxtDTu8n50E3ZgR0z3dX8t+HEAtmTiZnpxI0v0FQI9ABEyYggshxRCgmoAsANBcmrD4DMVVFAlEUuDoD8ToF4rwnyD8T/+J1M8GZAlzbcTAZBhEmABvjR9qtN2M3J9M7JnWiM0BxIa20cuDUBYptJGwLBsl7Z68cdxOohp62eHcmODmpZ/8UdaiwCERshlAhCAIqFKBmAJFMdFIbMIFTABICQmECEduEBhrkAzFcADiaeFOxAa1AJcczJ9AXR/4UQVxrRXnxgMJeAZSRETk+ANimVN2faCHNd+8MeH06N68mJ6fchIs8chZiFElbJGQhE/n2BhmbcdpeIBeDFH4JEATBECOeACZRhvmPeMVcgUPQACGNCJuVB4bzZr1LJRR2NraSRr6TMAXsIMwMJFyuAApeGO3/ULCHBjMgRydyhAjCRfcFP+dpjmi0yWf+XCg8lxAUJEOBCBe5uhVZcwd8foCaOADQY4OQnAMe2gPyBkZZZgABVlEiYBQFdCJRg2NAEQJD7hC2/kZM4VHC+QIAKwIAZSFN4AIA7HHSlYFALjbX/Ij7h4cKPDfjfYiwGpIY+SIItgRJgCaTskIwfpkFtEb6qkEsgkF6EQYVTyARdmlfzBHz/3P75QAxnVHi7RW7gQjlbDlftBcQEwLcBQAggALWxWFISlCnvybSzIi5lWi54Ve/j3WfbHGyRiHCMCZeX2TmgxIj4UOILwForXJaKAPsz4mFaZAClhKvYoRcJSGeoRjbyTZn0hGbHDCyUwYzcHYhb+h0Hn4WvAYAB1cidQ5EoX9DMoFQzet1TmmH9bMTd2qH9CaT1d0XqAeRCH6QiUdVr9xQNC1F/1RAjJ2T95kSMRYXSowRFyYiq6UJFhBpIfeYECaBjf6UVshB+3JA4dIACtOEfThQBhsi2lWWOPs095hAI6ST3dVoO02Iul+Hb0J5wgwoPHOSMsElXgsxxAtEkj9oC4sIwegAF7xVtatXX/F2YlAZqcIAEC5xjhCJrg2QEb9XMHtFyyMJ4RNgCpgB5guRgFAYRv0hkUtUXjJwBfsUC4+TaJgno1GENGhY9e0Z9f4Q486GkV8UOA9zBRNiPR4THL2KDrpgn/909ollv+2RmlXwUOx0drxNULrfkZ9ghiYYgfk2GZQ6FiA1IIbGI7TuNXABAk9FgD3leHLUifHpeLtVFpKfdIRKlLL1CgP8g3nzYIQRo+KeI+BRAdW2QlU5Jlhap4a3UlDDA/DiCSkSqSMWCmwGIOkoqpd0QAAyCpiBqpAAWbkTptKtIAR6E1rSmSA4AJl2olBlA0u1ifckp2dGpp+fgbeLoh5WYIgVqYQaqnmaQimpIpz/FJ5oZ1WYcc//BcAWMoh7KsFTE8u4Ek/TA84MQoA5Ek08ohzzUoYJMzPNqtwYgbHfcvulh25CpDR3autQGQuJptMCI+wyFEAyopGBBC8Bo6DSD+rB/orcB5q0Z1PXD6fjMUlG5Tcv+Kn0C5elQme33Zm/C3j3dKq//gsODGm+7qKSRUr46QnJakTdDBHIrQAFnXAwhDPDM6g+HmKP6om/j4FGeno/Lir4dgM2SSL89DKHp5NDHIhwfnfgCbs+mqg/kJKRQrsPXXo5LkKSZrRJl0Wi5gsmtRLlaBg5kmsTk6tLMaMLc6htXDIbyJcSEAidenJBPwPBILcvZZlPcpN3T4r51VsX7YbSKXtGuHT46QkGjBki75rDrarruZsIOyKDAbe0dGsD97nzkTtjqjP0aCLCGgK00xTDtpripnoz+LuOgacjNKp7LaIQqbdnUro0j+A2k7SEkKq7mAq2RDOZSP4roqu7PnmhXXpiS1S7vXBrkiMAGNhXAT0LZsC3uAe6MuG3/ehrr6mbLfJrhHJbqSNHYdC087Sau8CLsJe7CHi7yoO7uLa7uGwA61azM6YyT60oG5kgH3gnG6uzb+qLVUZrkewrM4SIPo9oLs6rlnJ7hI27xVWwiecknZa6Mz2Ll8mbhMNibfmzO1671haxC4K7bV1rhGcn29+4T40rvZQr0Xm7gDbI7Uu3tTVbw/6bBj4bfuCqtlakTdw1kruGkJYbEZ3Ie1uys1hSzfy8Deq8BKIgKWc326uzK5UgH3Ern6ssO5Qr6Re5dfC4NUW7T+sSpgwiFvByBj3tqTimKu8CW/Jsw6VTuuFoK1q1ufw0tMB/y9SoIOumI5tItxMvyE51tT+iPEu6u+b3zERHy++mK2+bIyGByMLJy8RUtUxhQvlZBFwdECDdACQ3YKSjan2iu8lxtyo4uneYh/wZujpfjCucEPShJe31rG+7LANWU5bry7CNGBu8u456srFgzHkKgvRoxxqAyJ5ku+usvHRenEYuGSutS39NAC0BIBLXADhjxNNnDIFyDFd4qb/XjFDSu7WryjvblO6XqLf7ujsHHA+TJ04XXD3bsvb3wsHYhCtkvH+OI8uuvGkLu7rmwDsDzH6Lwy5gyJ+/K56Nr+tX9jst7wtYXDA6LCKxGQRRdACcF8N8E8WQcQzMGRzM9cvMAIyFvcn9FcuOuaeneom/yiw9UGzk84xDQswfjyze1szviCyg0Mx2scxOj8yteXK0piJGsM0vkyw+mbxwPbcTypDy0gIz9AQojsAghdCYglMZfXAuf4AkUt0EMmxcF8efvIjyPcwXLbo45MyYX7mwGhY8kxubFstmML0pAYxG0cxCi0xqFc1kZswzuMymrt0hwN0vqyuAu8uHCNw2Ebs7F3J1AWLz/wWgdw1C3QeQodzFnk15WSNSqSyMH8ywg9CWAD1axruX+sTnUrdjhKi2LsGhw9AaylP5zS1jP+7MbtrD/enMMDZNo0vStBrMMcnQEMXFOgbNplXNawTbsd/L5k4jLDcQCm2gJj9APDccinsC9IotBDhhwXoDQIPSGpJ4MQy8SALMYQPdUIu7VWnD0RAHUBptmRkMYDZL4KrMfni8M1dS/jfLs2bAjqq94YN8vi7cCzbcPfLNfgDcpoFG/IYRwXkDVSXAkfkcgC3QJLcgANMyJ+DdDO5dexdgDHTaNbi9N4+dj6CM0GK5S2MXQZsAiWEzoylMp+NMu2O8cDFOLiqysVnN4O/MnqG9cr/sm4K9/yveKxDWqtk0V3cye7bchKrdzeANCFPdCn0H88Tdh+o3K3+Kauy8H+zj2wIKLBfdi54asWuILGyHIBORDBxNPSe7QyOVNF5hvO7Ey7OxzmKM4OOwzXajxAORzfMX7abH4Q1+bJKyXFBe0zP6AgNnAUvz0IBv7fyI3QlOBcx8EOxOFc3nsBAEDPiCCBbTceCzEesNHo79DoYCQeLVgeiyAeBUwIAYSr86cQy9IVHz4PzBJONfO9XkMQzaJeO7wzZM0O42va6OvaaxzSnwzfb27WuI7epkzr871dXQHoAJ089bKrITDQM8LYWUQJPG3siHXPiSCN7cfpBXHpIVAehnDph04eB5HpLqzt5MHQ+5Dpnb656SS+qr4vuILhe1QzGMcsj6tAZj7+QM1iwek7wzaMDrve5nJt1u9N27wO27E90t5LAmPihrex7Dwt2HBkEXr358P8Xy/rwtgugd8u6aToD5Vu7VCj8ZVe6doO8gSh8a/R7R1f8ZH+7Rwf6SvP8gEE7pc9EDaDQsyiXmL70tfELMNTRVsrvuhN7yIu3mkOyucN3+gd8PON9DDewDesNm6owySAL1IcRqYA6MZU0DyNzCQAHHeDWNk08Ub18de+8dej8SAf9kxh8huf8aQInBu/7WM/9mlP7dLo8Wj/6HXv9tGem2GkM6iOK2T99xIPlP8QvmV9wwWR0gE/9LP+FfoOFrKu7+T91jdQuwU/CWxzAz/Q9Pj+Ag86NGTlcgNzfk2CovDGGyIULwjdfvHB+PGpr/KuP/baHvvQzvaPku1qn/d0/+hwf+0j3/t67+1tH07ogAgK7DVk475kUkWH0PcufvTabMHefPi8zu/8Tt46nM35gr71IAJqgy+IpSRqkzMkMAkuybfHQwiI1fVkcq1zQ2ksbOkSWO3jTvstX/LbnvLTnv8UPwh1r/v8DwghgoMAAIKFhoWDIYqHhoSPixeTlCGTkhchNpmcFzkVOZKCl5c2OZuDOaGai4s2rDavrbKCtK21rLMhIiKCDSIRvJYNv7sNIRG/wcovoyINERcRP83DEZatmdjblZSclt7e26OjjYz+jReF2pOI6IjriODnAN3p7Zbq55nv5vfzj/H+nVt0z9ytQesukdM2CFSOTvLGfYtlAxTDQbFg4TqYC9YrWbZyiZBVDFmEZA0u2FAW4UWvCy+SnXTZbNKLH9FaRvv2jRw2Ugwv9jzYCSi+bvIeKRwFMeg6bhfHgSPlUx7PcFizat26deFPnlMZnnoYFKHVTKYy2gp58OOiXh9twN0oVy2wUdUuiEAbQe6kk9F8tZzU4AXEwGGZhvP602dCUU4VPmXEmN7XiFWvnsXcc7HmqWG5ih7d9THVxrMexoLYuBLGjmozvt7FdtfIWnUFzc2N669vS4B3Ar50sihmTK1BA3WVjTqq88StxYlzvLks9KWMpYPVTrq79+kSkYJXSRE1t3G10bvCvR4uRdm6c8mmtIlSYPvQsyFlCnrh9M7nIZcNQq5RJRlU1zEWXXXWKbbUZPV8J+FoET31oDdu1WeafmZxxJFs8L2HGy0gukXKTsxJ0xSBB4Z2YIOsXXaZZ9Jhchp/LB5341D8YSUjdVFJ5eGQRBYpSCAAOy==}




#==============================================================================================
#        Make Regexp
#==============================================================================================
namespace eval make-regexp {
}
#        Takes a list of words, returns a list "prefix <recurse>   prefix <recurse>  ..."
#        after grouping by first common letter.
proc make-regexp::prefix {words} {
        # init
        set result {}
        lappend words ""                ;# to force last completion
        # group by first letter
        set prefix [string range [lindex $words 0] 0 0]
        set subwords [list [string range [lindex $words 0] 1 end]]
        foreach word [lrange $words 1 end] {
                set char [string range $word 0 0]
                if {$char == $prefix} {
                        lappend subwords [string range $word 1 end]
                } else {
                        # compute prefixes recursively
                        set recurse [prefix $subwords]
                        if {[llength $recurse] == 2} {
                                # only one prefix, so concat with previous prefix
                                append prefix [lindex $recurse 0]
                                set recurse [lindex $recurse 1]
                        }
                        append result " [verify [list $prefix $recurse]]"
                        set prefix $char
                        set subwords [list [string range $word 1 end]]
                }
        }
        # return
        set result
}
#        Verification of regexp.
#        After searching common suffixes, some patterns grouped by parenthesis or conditional exps
#        may be broken. We need to fix them.
proc make-regexp::verify {exp} {
        set orphans [isOrphans $exp]
        set result {}
        foreach {prefix recurse} $exp {
                if {![isBalanced $prefix]} {
                        if {[llength $recurse]} {
                                foreach {pp rr} $recurse {
                                        lappend result "$prefix$pp" $rr
                                }
                                if {![isBalanced $prefix] && $orphans} {
                                        set result [verify $result]
                                }
                        } else {
                                lappend result "$prefix" ""
                        }
                } else {
                        lappend result $prefix $recurse
                }
        }
        # return result after fixing
        set result
}
#        Check for orphan grouping ('|' lost in lower level)
proc make-regexp::isOrphans {exp} {
        set orphan 0
        foreach {prefix recurse} $exp {
                if {[string index $prefix 0] == "|"} {
                        set orphan 1
                        break
                }
                if {[isOrphans $recurse]} {
                        set orphan 1
                        break
                }
        }
        set orphan
}
#==============================================================================================
#        Check if parenthesis in 'str' after balanced.
proc make-regexp::isBalanced {str} {
        # if start with '?' skip it
        if {[string index $str 0] == "?"} {
                return 0
        }
        # must start with a ')'
        if {[string index $str 0] != ")"} {
                return 1
        }
        # try to balanced each ')' with an appropriate '('
        set depth 0
        foreach c [split $str {}] {
                if {$c == "("} {
                        incr depth -1
                } elseif {$c == ")"} {
                        incr depth +1
                }
        }
        return [expr $depth == 0]
}
#        Check if 'str' contains a first level grouping
proc make-regexp::firstLevelGroup {str} {
        set depth 0
        foreach c [split $str {}] {
                if {$c == "("} {
                        incr depth -1
                } elseif {$c == ")"} {
                        incr depth +1
                } elseif {$depth == 0 && $c == "|"} {
                        return 1
                }
        }
        return 0
}
#==============================================================================================
#        After having found common prefixes, try to find common suffixes in expression
proc make-regexp::suffix {list} {
        # end of recursion if empty list
        if {[llength $list] == 0} {
                return ""
        }
        set newlist {}
        foreach {prefix recurse} $list {
                set result [suffix $recurse]
                lappend newlist $prefix [lindex $result 0]
        }
        # compute longest common suffixes
        set words {}
        foreach {prefix tail} $newlist {
                if {[firstLevelGroup $tail]} {
                        set tail "($tail)"
                }
                lappend words [reverse $prefix$tail]
        }
        set words [lsort -unique $words]
        set reverse [prefix $words]
        # compute regexp from precomputed reverse list
        set regexp [build "" $reverse]
        # returns computed regexp
        set regexp
}
proc make-regexp::build {mainstem reverse} {
        # flag to indicate need for '?' (optional group)
        set addQuestionMark 0
        set regexp ""
        foreach {prefix recurse} $reverse {
                set stem "[reverse $prefix]$mainstem"
                if {[llength $recurse]} {
                        set fromlower [build $stem $recurse]
                } else {
                        set fromlower ""
                }
                # build regexp
                if {$prefix == ""} {
                        set addQuestionMark 1
                } else {
                        if {[string length $fromlower] > 1 && [string index $fromlower end] != "?"} {
                                set fromlower "($fromlower)"
                        }
                        append regexp "$fromlower[reverse $prefix]|"
                }
        }
        # remove last trailing '|'
        set regexp "[string range $regexp 0 end-1]"
        # add '?' if needed
        if {$addQuestionMark} {
                if {[string length $regexp] == 1} {
                        set regexp "$regexp?"
                } else {
                        set regexp "($regexp)?"
                }
        }
        # result
        set regexp
}
#----------------------------------------------------------------------------------------------
#        Last pass for grouping '(x|y|z|...)' into char range '[xyz...]'
proc make-regexp::optimize:charset {regexp} {
        set optimized ""
        set memory ""
        set ok 1
        set charset ""
        # examine char one by one
        set len [string length $regexp]
        for {set i 0} {$i < $len} {incr i} {
                set char [string index $regexp $i]
                append memory $char
                if {$char =="("} {
                        # start of group
                        if {$ok} {
                                append optimized [string range $memory 0 end-1]
                        }
                        incr i
                        set result [optimize:charset [string range $regexp $i end]]
                        append optimized "[lindex $result 2][lindex $result 0][lindex $result 3]"
                        set memory ""
                        set ok 0
                        incr i [expr [lindex $result 1]]
                        continue
                } elseif {$char ==")"} {
                        # end of group
                        if {$ok} {
                                set optimized "\[$charset\]"
                                return [list $optimized $i "" ""]
                        } else {
                                return [list $optimized $i "(" ")"]
                        }
                }
                if {$ok} {
                        if {$i & 1} {
                                if {$char != "|"} {
                                        set ok 0
                                        append optimized $memory
                                }
                        } else {
                                append charset $char
                        }
                } else {
                        append optimized $char
                }
        }
        # return result
        list $optimized $i "(" ")"
}
#==============================================================================================
#        Compute string in reverse order
proc make-regexp::reverse {string} {
        set result ""
        for {set i [expr [string length $string]-1]} {$i >= 0} {incr i -1} {
                append result [string index $string $i]
        }
        set result
}
#==============================================================================================
proc make-regexp::make-regexp {words} {
        set words [lsort -unique $words]
        # escape special chars used to form regexp
        regsub -all -- {\|} $words "\x01" words
        regsub -all -- {\(} $words "\x02" words
        regsub -all -- {\)} $words "\x03" words
        regsub -all -- {\?} $words "\x04" words
        regsub -all -- {\[} $words "\x07" words
        regsub -all -- {\]} $words "\x08" words
        # do it
        set list [prefix $words]
        set regexp [suffix $list]
        # returns regexp
          set regexp [lindex [optimize:charset $regexp] 0]
        # un-escape special chars used to form regexp
        regsub -all -- "\x01" $regexp "\\|" regexp
        regsub -all -- "\x02" $regexp "\\(" regexp
        regsub -all -- "\x03" $regexp "\\)" regexp
        regsub -all -- "\x04" $regexp "\\?" regexp
        regsub -all -- "\x07" $regexp "\\\[" regexp
        regsub -all -- "\x08" $regexp "\\\]" regexp
        regsub -all -- "\\*" $regexp "\\*" regexp
        regsub -all -- "\\+" $regexp "\\+" regexp
        regsub -all -- "\\\$" $regexp "\$" regexp
        regsub -all -- "\\\^" $regexp "\\\^" regexp
        # returns result
        set regexp
}
#==============================================================================================