diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/console.tcl | 60 | ||||
| -rw-r--r-- | lib/database.tcl | 16 | ||||
| -rw-r--r-- | lib/merge.tcl | 6 | ||||
| -rw-r--r-- | lib/transport.tcl | 14 |
4 files changed, 57 insertions, 39 deletions
diff --git a/lib/console.tcl b/lib/console.tcl index e40ec9639b..75f3e0463b 100644 --- a/lib/console.tcl +++ b/lib/console.tcl @@ -1,17 +1,25 @@ # git-gui console support # Copyright (C) 2006, 2007 Shawn Pearce -set next_console_id 0 +namespace eval console { + +variable next_console_id 0 +variable console_data +variable console_cr + +proc new {short_title long_title} { + variable next_console_id + variable console_data -proc new_console {short_title long_title} { - global next_console_id console_data set w .console[incr next_console_id] set console_data($w) [list $short_title $long_title] - return [console_init $w] + return [_init $w] } -proc console_init {w} { - global console_cr console_data M1B +proc _init {w} { + global M1B + variable console_cr + variable console_data set console_cr($w) 1.0 toplevel $w @@ -63,7 +71,7 @@ proc console_init {w} { return $w } -proc console_exec {w cmd after} { +proc exec {w cmd {after {}}} { # -- Cygwin's Tcl tosses the enviroment when we exec our child. # But most users need that so we have to relogin. :-( # @@ -78,15 +86,16 @@ proc console_exec {w cmd after} { set fd_f [open $cmd r] fconfigure $fd_f -blocking 0 -translation binary - fileevent $fd_f readable [list console_read $w $fd_f $after] + fileevent $fd_f readable \ + [namespace code [list _read $w $fd_f $after]] } -proc console_read {w fd after} { - global console_cr +proc _read {w fd after} { + variable console_cr set buf [read $fd] if {$buf ne {}} { - if {![winfo exists $w]} {console_init $w} + if {![winfo exists $w]} {_init $w} $w.m.t conf -state normal set c 0 set n [string length $buf] @@ -120,36 +129,41 @@ proc console_read {w fd after} { } else { set ok 1 } - uplevel #0 $after $w $ok + if {$after ne {}} { + uplevel #0 $after $w $ok + } else { + done $w $ok + } return } fconfigure $fd -blocking 0 } -proc console_chain {cmdlist w {ok 1}} { +proc chain {cmdlist w {ok 1}} { if {$ok} { if {[llength $cmdlist] == 0} { - console_done $w $ok + done $w $ok return } set cmd [lindex $cmdlist 0] set cmdlist [lrange $cmdlist 1 end] - if {[lindex $cmd 0] eq {console_exec}} { - console_exec $w \ + if {[lindex $cmd 0] eq {exec}} { + exec $w \ [lindex $cmd 1] \ - [list console_chain $cmdlist] + [namespace code [list chain $cmdlist]] } else { uplevel #0 $cmd $cmdlist $w $ok } } else { - console_done $w $ok + done $w $ok } } -proc console_done {args} { - global console_cr console_data +proc done {args} { + variable console_cr + variable console_data switch -- [llength $args] { 2 { @@ -161,7 +175,7 @@ proc console_done {args} { set ok [lindex $args 2] } default { - error "wrong number of args: console_done ?ignored? w ok" + error "wrong number of args: done ?ignored? w ok" } } @@ -173,7 +187,7 @@ proc console_done {args} { } } else { if {![winfo exists $w]} { - console_init $w + _init $w } $w.m.s conf -background red -text {Error: Command Failed} $w.ok conf -state normal @@ -183,3 +197,5 @@ proc console_done {args} { array unset console_cr $w array unset console_data $w } + +} diff --git a/lib/database.tcl b/lib/database.tcl index e31466fb50..73058a8269 100644 --- a/lib/database.tcl +++ b/lib/database.tcl @@ -69,21 +69,21 @@ proc do_stats {} { } proc do_gc {} { - set w [new_console {gc} {Compressing the object database}] - console_chain { - {console_exec {git pack-refs --prune}} - {console_exec {git reflog expire --all}} - {console_exec {git repack -a -d -l}} - {console_exec {git rerere gc}} + set w [console::new {gc} {Compressing the object database}] + console::chain { + {exec {git pack-refs --prune}} + {exec {git reflog expire --all}} + {exec {git repack -a -d -l}} + {exec {git rerere gc}} } $w } proc do_fsck_objects {} { - set w [new_console {fsck-objects} \ + set w [console::new {fsck-objects} \ {Verifying the object database with fsck-objects}] set cmd [list git fsck-objects] lappend cmd --full lappend cmd --cache lappend cmd --strict - console_exec $w $cmd console_done + console::exec $w $cmd } diff --git a/lib/merge.tcl b/lib/merge.tcl index 75724a930f..e0e84aeabe 100644 --- a/lib/merge.tcl +++ b/lib/merge.tcl @@ -120,14 +120,14 @@ Please select fewer branches. To merge more than 15 branches, merge the branche set msg "Merging $current_branch, [join $names {, }]" set ui_status_value "$msg..." - set cons [new_console "Merge" $msg] - console_exec $cons $cmd [list finish_merge $revcnt] + set cons [console::new "Merge" $msg] + console::exec $cons $cmd [list finish_merge $revcnt] bind $w <Destroy> {} destroy $w } proc finish_merge {revcnt w ok} { - console_done $w $ok + console::done $w $ok if {$ok} { set msg {Merge completed successfully.} } else { diff --git a/lib/transport.tcl b/lib/transport.tcl index ce6fc45eba..c0e7d20fce 100644 --- a/lib/transport.tcl +++ b/lib/transport.tcl @@ -2,22 +2,22 @@ # Copyright (C) 2006, 2007 Shawn Pearce proc fetch_from {remote} { - set w [new_console \ + set w [console::new \ "fetch $remote" \ "Fetching new changes from $remote"] set cmd [list git fetch] lappend cmd $remote - console_exec $w $cmd console_done + console::exec $w $cmd } proc push_to {remote} { - set w [new_console \ + set w [console::new \ "push $remote" \ "Pushing changes to $remote"] set cmd [list git push] lappend cmd -v lappend cmd $remote - console_exec $w $cmd console_done + console::exec $w $cmd } proc start_push_anywhere_action {w} { @@ -53,8 +53,10 @@ proc start_push_anywhere_action {w} { set unit branches } - set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"] - console_exec $cons $cmd console_done + set cons [console::new \ + "push $r_url" \ + "Pushing $cnt $unit to $r_url"] + console::exec $cons $cmd destroy $w } |