Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Started to rebuild debug proc editor |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
96d2928ff7b77d2e2037698828e2f802 |
User & Date: | peter 2019-11-09 00:37:32.450 |
Context
2019-11-10
| ||
16:29 | Cleanup check-in: 46064856af user: peter tags: trunk | |
2019-11-09
| ||
00:37 | Started to rebuild debug proc editor check-in: 96d2928ff7 user: peter tags: trunk | |
00:09 | Highlight tabs tool check-in: 65d9923993 user: peter tags: trunk | |
Changes
Changes to htdocs/changes.wiki.
1 2 3 4 5 | <title>Changes</title> Upcoming changes (not yet released): * TBW | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | <title>Changes</title> Upcoming changes (not yet released): * TBW * Added -subst command line, to access PreProcess Subst function. * Better SVN commit, handling added directories. * Ctrl-E to enable Edit Mode. Changes in v2.8.4 (2019-02-06): * Commit dialog includes a selection of files, for partial commit. * Better support for multiple files and directories with -review. |
︙ | ︙ |
Changes to src/debug.tcl.
1 2 3 4 5 | # debug.tcl # # Helpers for debugging. # # | | | | | | | | | | | | | > > > > > | | > > | < | | | | | | | | | | | | | | | | | | | | | | | | | | | < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > | > > > | | > > > > > > > > | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 | # debug.tcl # # Helpers for debugging. # # namespace eval ::_Debug { } proc ::_Debug::TRenter {cmd op} { set fr [info frame -2] puts "Line [dict get $fr line] Enter: '$cmd'" } proc ::_Debug::TRenterstep {cmd op} { set fr [info frame -2] #puts "$fr" puts "Line [dict get $fr line] Enterstep: '$cmd'" } proc ::_Debug::TRleave {cmd core res op} { puts "Leave: '$res'" } proc ::_Debug::TRleavestep {cmd code res op} { puts "Leavestep: '$res'" } proc ::_Debug::TR {cmd} { trace add execution $cmd enter ::_Debug::TRenter trace add execution $cmd leave ::_Debug::TRleave trace add execution $cmd enterstep ::_Debug::TRenterstep trace add execution $cmd leavestep ::_Debug::TRleavestep } # Get procs in global namespace proc ::_Debug::Procs {pat} { return [uplevel \#0 [list info procs $pat]] } proc debugMenu {m} { $m add cascade -label "Debug" -menu $m.debug -underline 0 menu $m.debug if {$::tcl_platform(platform) eq "windows"} { $m.debug add checkbutton -label "Console" -variable consolestate \ -onvalue show -offvalue hide -command {console $consolestate} \ -underline 0 $m.debug add separator } $m.debug add command -label "Edit" -command ::_Debug::ProcEditor \ -underline 0 #::_Debug::DumpStuff return $m.debug } proc ::_Debug::ProcEditorUpdate {a k} { # Only update on keys generating characters if {$a eq "" || ![string is graph $a]} return set p [Procs $::_Debug::ProcEditor(proc)] if {$p eq "" && $::_Debug::ProcEditor(proc) ne ""} { # Try prefix matching set p [Procs $::_Debug::ProcEditor(proc)*] # Include namespaces if starting with :: if {[string match "::*" $::_Debug::ProcEditor(proc)]} { if {[regexp {^(.*::)([^:]*)$} $::_Debug::ProcEditor(proc) -> ns pat]} { if {[namespace exists $ns]} { set child [namespace children $ns $pat*] lappend p {*}$child } } } } set p [lsort -dictionary $p] $::_Debug::ProcEditor(procW) configure -values $p # Keep the first set p [lindex $p 0] if {$p eq ""} { set ::_Debug::ProcEditor(args) "" $::_Debug::ProcEditor(bodyW) delete 1.0 end return } if {$p ne $::_Debug::ProcEditor(proc)} { after idle [list set "::_Debug::ProcEditor(proc)" $p] after idle [list $::_Debug::ProcEditor(procW) selection range insert end] } after idle ::_Debug::ProcEditorSelected } proc ::_Debug::ProcEditorSelected {} { set p [Procs $::_Debug::ProcEditor(proc)] if {$p eq ""} { set ::_Debug::ProcEditor(args) "" $::_Debug::ProcEditor(bodyW) delete 1.0 end return } set arglist {} foreach i [info args $p] { if {[info default $p $i value]} { lappend arglist [list $i $value] } else { lappend arglist [list $i] } } set body [info body $p] set ::_Debug::ProcEditor(args) $arglist $::_Debug::ProcEditor(bodyW) delete 1.0 end $::_Debug::ProcEditor(bodyW) insert end $body } proc ::_Debug::ProcEditorRedefine {} { set body [$::_Debug::ProcEditor(bodyW) get 1.0 end] set body [string trimright $body] uplevel \#0 [list proc $::_Debug::ProcEditor(proc) \ $::_Debug::ProcEditor(args) $body] } proc ::_Debug::ProcEditorDisas {} { set da [tcl::unsupported::disassemble proc $::_Debug::ProcEditor(proc)] set top .proceditor.disas destroy $top ttk::toplevel $top wm title $top "Proc Editor Disassemble" text $top.t -yscrollcommand "$top.sby set" ttk::scrollbar $top.sby -orient vertical -command "$top.t yview" grid $top.t $top.sby -padx 3 -pady 3 -sticky news grid columnconfigure $top 0 -weight 1 grid rowconfigure $top 0 -weight 1 $top.t insert end $da } #----------------------------------------------------------------------------- # Tree view and filter #----------------------------------------------------------------------------- proc ::_Debug::ProcEditorFilter {a k} { # Only update on keys generating characters if {$a eq "" || ![string is graph $a]} return set f $::_Debug::ProcEditor(filter) set tree $::_Debug::ProcEditor(treeW) #foreach item [$tree] } proc ::_Debug::TreeCreatePath {tree path} { if {[$tree exists $path]} return set parent [namespace qualifiers $path] TreeCreatePath $tree $parent set tail [namespace tail $path] $tree insert $parent end -id $path -text $tail -open 0 } proc ::_Debug::TreePopulate {tree} { foreach cmd [lsort -dictionary [array names ::_Debug::allcmds]] { if {$::_Debug::allcmds($cmd) ne "proc"} continue set cmd2 [string trim $cmd ":"] set path [namespace qualifiers $cmd2] set tail [namespace tail $cmd2] if {$path ne ""} { TreeCreatePath $tree $path } $tree insert $path end -text $tail -values [list $cmd] } } #----------------------------------------------------------------------------- # Main Proc Editor window #----------------------------------------------------------------------------- proc ::_Debug::ProcEditor {} { ::_Debug::CollectInfo set top .proceditor destroy $top ttk::toplevel $top -padx 3 -pady 3 wm title $top "Proc Editor" ttk::frame $top.ftree set ::_Debug::ProcEditor(filter) "" ttk::entry $top.ftree.ef -textvariable ::_Debug::ProcEditor(filter) bind $top.ftree.ef <KeyRelease> {::_Debug::ProcEditorFilter %A %K} set tree $top.ftree.tree set ::_Debug::ProcEditor(treeW) $tree ttk::treeview $tree -height 20 -selectmode browse -show "tree" \ -yscrollcommand "$top.ftree.sby set" ttk::scrollbar $top.ftree.sby -orient vertical -command "$tree yview" $tree column "#0" -minwidth 50 -width 200 pack $top.ftree.ef -side "top" -fill x -padx 3 -pady 3 pack $top.ftree.sby -side right -fill y -pady 3 -padx {0 3} pack $tree -fill both -expand 1 -pady 3 -padx {3 0} TreePopulate $tree ttk::label $top.l1 -text "Proc" -anchor w ttk::combobox $top.e1 -textvariable ::_Debug::ProcEditor(proc) -values "" set ::_Debug::ProcEditor(procW) $top.e1 bind $top.e1 <KeyRelease> {::_Debug::ProcEditorUpdate %A %K} bind $top.e1 <<ComboboxSelected>> ::_Debug::ProcEditorSelected #trace add variable ::_Debug::ProcEditor(proc) write "::_Debug::ProcEditorUpdate" ttk::label $top.l2 -text "Args" -anchor w ttk::entry $top.e2 -textvariable ::_Debug::ProcEditor(args) set ::_Debug::ProcEditor(bodyW) [text $top.t -yscrollcommand "$top.sby set"] ttk::scrollbar $top.sby -orient vertical -command "$top.t yview" ttk::frame $top.fb ttk::button $top.b1 -text "Redefine" -command ::_Debug::ProcEditorRedefine ttk::button $top.b2 -text "Disas" -command ::_Debug::ProcEditorDisas grid $top.b1 $top.b2 -in $top.fb grid columnconfigure $top.fb all -weight 1 -uniform a grid $top.ftree $top.l1 $top.e1 - -padx 3 -pady 3 -sticky we grid ^ $top.l2 $top.e2 - -padx 3 -pady 3 -sticky we grid ^ $top.t - $top.sby -padx 3 -pady 3 -sticky news grid ^ $top.fb - - -padx 3 -pady 3 -sticky we grid columnconfigure $top 2 -weight 1 grid rowconfigure $top 2 -weight 1 } # Collect all info about procedures/method/whatever. # This is work in progress... proc ::_Debug::CollectInfo {} { variable allcmds array set allcmds {} # Only do this once if {[array size allcmds] > 0} return # Find all commands in all namespaces set todoNs [list ::] while {[llength $todoNs] != 0} { set ns [lindex $todoNs 0] set todoNs [lrange $todoNs 1 end] set preNs [string trimright $ns ":"] if {$ns eq "::_Debug"} continue foreach child [namespace children $ns] { lappend todoNs $child } array unset thisround array set thisround {} # First collect commands, since we want to override with detail later foreach cmd [info commands ${preNs}::*] { set allcmds($cmd) "cmd" set thisround($cmd) 1 } # Which ones are procs? foreach cmd [info procs ${preNs}::*] { set allcmds($cmd) "proc" set thisround($cmd) 0 } # Which ones are imports? if {![catch {namespace eval $ns {namespace import}} imports]} { foreach cmd $imports { set allcmds(${preNs}::$cmd) "import" set thisround(${preNs}::$cmd) 0 } } # Look through and command that is not something identified foreach cmd [array names thisround] { if {!$thisround($cmd)} continue # Is it an ensemble? if {[namespace ensemble exists $cmd]} { set allcmds($cmd) ensemble foreach {key val} [namespace ensemble configure $cmd] { #lappend allcmds($cmd) $key $val if {$key eq "-map"} { #puts "$cmd $val" lappend allcmds($cmd) {*}$val } # Recognise a snit class if {$key eq "-unknown" && [string match ::snit::* $val]} { lset allcmds($cmd) 0 snit } } } # Is it oo::class? if {![catch {info class methods $cmd -private} methods]} { set allcmds($cmd) "oo::class $methods" } } # info class # info object # How to recognise methods? #allcmds(::eskilprint) = cmd #allcmds(::eskilprint::install) = cmd #allcmds(::eskilprint::Snit_methodnewPage) = proc #allcmds(::DirCompareTree::Snit_methodaddCmdCol) = proc #allcmds(::pdf4tcl::pdf4tcl) = cmd #allcmds(::Account) = cmd # Namespace ensembles? } } # Debug of debug proc ::_Debug::DumpStuff {} { ::_Debug::CollectInfo parray ::_Debug::allcmds *Account* parray ::_Debug::allcmds *eskilprint* } #----------------------------------------------------------------------------- # Test just to include an OO object in the code #----------------------------------------------------------------------------- catch {Account destroy} oo::class create Account { constructor {{ownerName undisclosed}} { my variable total overdrawLimit owner set total 0 set overdrawLimit 10 set owner $ownerName } method deposit amount { my variable total set total [expr {$total + $amount}] } method withdraw amount { my variable total overdrawLimit if {($amount - $total) > $overdrawLimit} { error "Can't overdraw - total: $total, limit: $overdrawLimit" } set total [expr {$total - $amount}] } method transfer {amount targetAccount} { my variable total my withdraw $amount $targetAccount deposit $amount set total } method dump {} { } destructor { my variable total if {$total} {puts "remaining $total will be given to charity"} } } |
Changes to src/eskil.syntax.
1 2 3 4 5 6 7 | ##nagelfar syntax textSearch::searchMenu x ##nagelfar syntax textSearch::enableSearch x p* ##nagelfar option textSearch::enableSearch -label ##nagelfar option textSearch::enableSearch\ -label n ##nagelfar package known textSearch ##nagelfar syntax DiffUtil::LocateDiffExe x | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | ##nagelfar syntax textSearch::searchMenu x ##nagelfar syntax textSearch::enableSearch x p* ##nagelfar option textSearch::enableSearch -label ##nagelfar option textSearch::enableSearch\ -label n ##nagelfar package known textSearch ##nagelfar syntax DiffUtil::LocateDiffExe x ##nagelfar syntax DiffUtil::diffStrings o* x x ##nagelfar syntax DiffUtil::diffFiles o* x x ##nagelfar package known DiffUtil ##nagelfar syntax dde s x ##nagelfar package known dde ##nagelfar syntax safeLoad x n ##nagelfar syntax helpWin x x ##nagelfar syntax commonYScroll x x* ##nagelfar syntax locateEditor n ##nagelfar syntax locateTmp n ##nagelfar package known pstools ##nagelfar package known psballoon ##nagelfar syntax wcb::cancel 0 ##nagelfar syntax wcb::callback 4 ##nagelfar package known wcb ##nagelfar syntax ::tk::GetSelection x x ##nagelfar syntax ::tk::ScrollButton2Down x x x ##nagelfar syntax console x ##nagelfar syntax ::tk::dialog::file:: x* ##nagelfar syntax fileLabel x p* ##nagelfar option fileLabel -textvariable ##nagelfar option fileLabel\ -textvariable n ##nagelfar syntax createPluginInterp x x x n ##nagelfar syntax registry x x x |
︙ | ︙ |