bug fixes

.gitignore

@@ -1,2 +1,3 @@
 repository.sql
+test.sh
 

repo/IDEEditor/classes/IDE..TclModeEdit/Instance/highligthErrors.tcl

@@ -17,8 +17,20 @@ IDE::TclModeEdit instproc highligthErrors errors {
         }
         incr num
         set startIndex [$twin index "1.0 + [lindex $e 0] char"]
+        set endIndex [$twin index "1.0 + [expr {[lindex $e 1]+1}] char"]
         lappend linesErrors [lindex [split $startIndex .] 0] $startIndex $e
-        $twin tag add $tag $startIndex "1.0 + [expr {[lindex $e 1]+1}] char"
+        set tremove [list]
+        # remove other tags because the disturb by binding
+        # so only error hover should be show
+        foreach {tcommand tagname start} [$twin dump -tag $startIndex $endIndex] {
+            if {$tcommand in {tagon tagoff}} {
+                lappend tremove $tagname
+            }
+        }
+        foreach t [lsort -unique $tremove] {
+            $twin tag remove $t $startIndex $endIndex
+        }
+        $twin tag add $tag $startIndex $endIndex
         set errorsArr($tag) $e
     }
     set lastLine [lindex [split [$twin index end] .] 0]

repo/IDEPersistence/classes/IDE..ClassDescription/Instance/instproc.tcl

@@ -1,9 +1,10 @@
 IDE::ClassDescription instproc instproc {procname arguments body args} {
-    if {[self callingproc] ne "initFromDB"} {
+    if {[self callingproc] ni {initFromDB evalBody}} {
         if {![[my getDescription] questForChange]} return
     }
     next
-    if {[self callingproc] eq "initFromDB"} return
+    # this is call from loading from db it do not need to be tracked
+    if {[self callingproc] in {initFromDB evalBody}} return
     set parameters [list]
     set object [[my getDescription] getObject]
     foreach par [$object info parameter] {

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/cleanUpDir.tcl

@@ -4,17 +4,17 @@ IDE::CompFileExporter instproc cleanUpDir {directory time} {
     foreach f [glob -directory $directory -nocomplain *] {
         if {[file isdirectory $f]} {
             if {![my cleanUpDir $f $time]} {
-                # file delete $f
-                puts "delete $f"
+                file delete $f
+                # puts "delete $f"
             } else {
                 set dirisused 1
             }
         } else {
             set ext [file extension $f]
             if {$ext in {".tcl" ".meta" ".txt" ".list" ".info"}} {
                 if {[file mtime $f]<$time} {
-                    # file delete $f
-                    puts "delete file $f"
+                    file delete $f
+                    #puts "delete file $f"
                 } else {
                     set dirisused 1
                 }

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/exportCompObj.tcl

@@ -8,10 +8,11 @@ IDE::CompFileExporter instproc exportCompObj {cobj directory {withCleanUp 0}} {
     if {$withCleanUp} {
         set time [clock seconds]
     }
-    set compDir [file join $directory [my getFileName [$cobj getName]]]
+    set fileName [my getFileName [$cobj getName]]
+    set compDir [file join $directory $fileName]
     file mkdir $compDir
-    my writeFileDataIfContent $compDir [$cobj getName].tcl [$cobj getPreScript]
-    my writeFileDataIfContent $compDir [$cobj getName].txt [$cobj getComment]
+    my writeFileDataIfContent $compDir $fileName.tcl [$cobj getPreScript]
+    my writeFileDataIfContent $compDir $fileName.txt [$cobj getComment]
     set classes [$cobj getClasses]
     my exportObjList $classes classes $cobj $compDir
     set deflist [$cobj getObjectDefineList]
@@ -25,7 +26,7 @@ IDE::CompFileExporter instproc exportCompObj {cobj directory {withCleanUp 0}} {
     if {[llength $reqlist]>0} {
         my writeFileData $compDir require.list [join $reqlist \n]
     }
-    my writeFileDataIfContent $compDir [$cobj getName].init [$cobj getInitScript]
+    my writeFileDataIfContent $compDir $fileName.init [$cobj getInitScript]
     if {$withCleanUp} {
         incr time -30
         my cleanUpDir $compDir $time

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/exportObject.tcl

@@ -3,9 +3,10 @@ IDE::CompFileExporter instproc exportObject {cobj directory class} {
     set desc [$introProxy getDescriptionForObject $class]
     set cdir [file join $directory [my getFileName [$desc getName]]]
     file mkdir $cdir
-    my writeFileData $cdir [$desc getName].tcl [$desc getDefBody]
-    my writeFileDataIfContent $cdir [$desc getName].txt [$cobj getComment]
-    my writeFileDic $cdir [$desc getName].meta [dict create version [$cobj set versioninfo]]
+    set fileName [my getFileName [$desc getName]]
+    my writeFileData $cdir $fileName.tcl [$desc getDefBody]
+    my writeFileDataIfContent $cdir $fileName.txt [$cobj getComment]
+    my writeFileDic $cdir $fileName.meta [dict create version [$cobj set versioninfo]]
     foreach method [$desc getMethodDescriptions] {
         set type [$method getType]
         if {![info exists typedir($type)]} {

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/getFileName.tcl

@@ -1,3 +1,3 @@
 IDE::CompFileExporter instproc getFileName name {
-    string map {:: ..} $name
+   repobs::asFileName $name
 }

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/writeFileData.tcl

@@ -1,5 +1,5 @@
 IDE::CompFileExporter instproc writeFileData {dir fileName content} {
-    set out [open [file join $dir [my getFileName $fileName]] w]
+    set out [open [file join $dir $fileName] w]
     fconfigure $out -translation lf
     puts -nonewline $out $content
 

repo/IDEPersistence/classes/IDE..CompFileExporter/Instance/writeFileDic.tcl

@@ -2,7 +2,7 @@ IDE::CompFileExporter instproc writeFileDic {dir fileName dic} {
     if {[dict size $dic]==0} {
         return
     }
-    set out [open [file join $dir [my getFileName $fileName]] w]
+    set out [open [file join $dir $fileName] w]
     fconfigure $out -translation lf
     dict for {key value} $dic {
         puts $out [list $key $value]

repo/IDEPersistence/classes/IDE..MethodDescription/Instance/updateVersion.tcl

@@ -4,7 +4,7 @@ IDE::MethodDescription instproc updateVersion {} {
     set ret [my makeTransistent]
     my makePersistent
     if {[my returnAffectedRows] && $ret!=1} {
-        IDE::Dialog message "DB Warning! Actual Version Control Database is not consistent with client. Probable another user have changed the method first. The operation have no effect in version control system! The method body was saved!"
+        IDE::Dialog message "DB Warning! Repository is not consistent with client. Probably another user have changed the method first. The operation have no effect in version control system! The method body was saved!"
         return
     }
     [my getPersistenceManager] addRelationship [my getObjectDescription] [self]

repo/IDEPersistence/classes/IDE..ObjectDescription/Instance/handleMethodChange.tcl

@@ -4,7 +4,7 @@ IDE::ObjectDescription instproc handleMethodChange {mobj class methodid} {
         # load another Version of method , change Relationships
         set ret [$mobj makeTransistent]
         if {[my returnAffectedRows] && $ret!=1} {
-            IDE::Dialog message "DB Warning! Actual Version Control Database is not consistent with client. Probable another user have changed the method first. The operation have no effect in version control system!"
+            IDE::Dialog message "DB Warning! Repository is not consistent with client. Probably another user have changed the method first. The operation have no effect in version control system!"
             return
         }
         set relation [[my getDescriptor] set weakRelationship]

repo/IDEPersistence/classes/IDE..ObjectDescription/Instance/proc.tcl

@@ -1,9 +1,9 @@
 IDE::ObjectDescription instproc proc {procname arguments body args} {
-    if {[self callingproc] ne "initFromDB"} {
+    if {[self callingproc] ni {initFromDB evalBody}} {
         if {![[self]::description questForChange]} return
     }
     next
-    if {[self callingproc] eq "initFromDB"} return
+    if {[self callingproc] eq {initFromDB evalBody}} return
     if {$body eq ""} {
         [self]::description deleteClassMethod $procname
     } else {

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Aadd.meta

@@ -0,0 +1 @@
+category history

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Aadd.tcl

@@ -0,0 +1,38 @@
+IDE::RegexpBrowser instproc history:add {} {
+    my instvar data winRegexp w_history last counter inReplay
+
+    if {$inReplay} {
+        set inReplay 0
+        return
+    }
+
+    set exp [$winRegexp get 1.0 end-1char]
+    if {$exp != "" && $exp != $last} {
+        # memorize position
+        set start [$w_history index insert]
+        # add text
+        $w_history insert end "$exp\n"
+        set end [$w_history index insert]
+        $w_history insert end "\n" {spacing}
+        set last $exp
+        $w_history yview moveto 1.0
+        # do the binding
+        set tag "t$counter"
+        incr counter
+        $w_history tag bind $tag <Any-Enter> "$w_history tag configure $tag -background lightblue"
+        $w_history tag bind $tag <Any-Leave> "$w_history tag configure $tag -background {}"
+        $w_history tag bind $tag <1> [list [self] history:replay [list $exp]]
+        $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 [$w_history index "$start + $sc chars + $sl lines"]
+                set end [$w_history index "$end + $sc chars + $sl lines"]
+                $w_history tag add $tag $start $end
+            }
+        }
+    }
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Ainit.meta

@@ -0,0 +1 @@
+category history

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Ainit.tcl

@@ -0,0 +1,39 @@
+IDE::RegexpBrowser instproc history:init {} {
+    my instvar data w_history historyWin
+    IDE::RegexpBrowser instvar font
+    set w [toplevel [Object autoname .history]]
+    set historyWin $w
+
+    wm title $w "Visual REGEXP [IDE::RegexpBrowser set version] -- REGEXP History"
+    wm geometry $w 640x480
+    wm protocol $w WM_DELETE_WINDOW "[self] set 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 [IDE::RegexpBrowser set font_regexp] -width 5 -height 1  -selectbackground lightblue -selectborderwidth 0]
+
+    set w_history $t
+    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; [self] set v_history 0"]
+    set b2 [button $bf.2 -bd 1 -text "Save ..." -command [list [self] history:save]]
+    pack $b2 $b1 -side left -anchor c
+
+    wm withdraw $w
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Areplay.meta

@@ -0,0 +1 @@
+category history

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Areplay.tcl

@@ -0,0 +1,5 @@
+IDE::RegexpBrowser instproc history:replay text {
+    my set inReplay 1
+    my regexp:set $text
+    my go
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Asave.meta

@@ -0,0 +1 @@
+category history

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/history%3Asave.tcl

@@ -0,0 +1,9 @@
+IDE::RegexpBrowser instproc history:save {} {
+    my instvar w_history
+    set file [tk_getSaveFile -defaultextension .txt]
+    if {$file != ""} {
+        set out [open $file "w"]
+        puts -nonewline $out [$w_history get 1.0 end]
+        close $out
+    }
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/make-regexp%3Acompute.meta

@@ -0,0 +1 @@
+category make-regexp

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/make-regexp%3Acompute.tcl

@@ -0,0 +1,7 @@
+IDE::RegexpBrowser instproc make-regexp:compute {} {
+    my instvar 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]
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/make-regexp%3Aok.meta

@@ -0,0 +1 @@
+category make-regexp

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/make-regexp%3Aok.tcl

@@ -0,0 +1,8 @@
+IDE::RegexpBrowser instproc make-regexp:ok w {
+    my instvar data
+
+    set words [$data(w:make:list) get 1.0 end-1c]
+
+    $data(w:regexp) insert insert "([make-regexp::make-regexp $words])"
+    destroy $w
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/pattern%3Aload.tcl

@@ -0,0 +1,28 @@
+IDE::RegexpBrowser instproc pattern:load {{file {}}} {
+    my instvar data
+    IDE::RegexpBrowser instvar regexp_db
+
+    # 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 [list [self] regexp:insert [list $pattern]]
+    }
+    close $in
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Acolorize.meta

@@ -0,0 +1 @@
+category regexp

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Acolorize.tcl

@@ -0,0 +1,66 @@
+IDE::RegexpBrowser instproc regexp:colorize {} {
+    my instvar 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"]
+    }
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Ahelp%3Atoggle.meta

@@ -0,0 +1 @@
+category regexp

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Ahelp%3Atoggle.tcl

@@ -0,0 +1,8 @@
+IDE::RegexpBrowser instproc regexp:help:toggle {} {
+    my instvar v_help data
+    if {$v_help == 0} {
+        pack forget $data(w:help)
+    } else {
+        pack $data(w:help) -before $data(w:regexp) -fill x -padx 5
+    }
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Ainsert.meta

@@ -0,0 +1 @@
+category regexp

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Ainsert.tcl

@@ -0,0 +1,12 @@
+IDE::RegexpBrowser instproc regexp:insert what {
+    my instvar 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]]
+}

repo/IDERegexpBrowser/classes/IDE..RegexpBrowser/Instance/regexp%3Aload.meta

@@ -0,0 +1 @@
+category regexp