git-gui: Move console procs into their own namespace
To help modularize git-gui better I'm isolating the code and variables required to handle our little console windows into their own namespace. This way we can say console::new rather than new_console, and the hidden internal procs to create the window and read data from our filehandle are off in their own private little land, where most users don't see them. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
This commit is contained in:
@ -1,17 +1,25 @@
|
|||||||
# git-gui console support
|
# git-gui console support
|
||||||
# Copyright (C) 2006, 2007 Shawn Pearce
|
# 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 w .console[incr next_console_id]
|
||||||
set console_data($w) [list $short_title $long_title]
|
set console_data($w) [list $short_title $long_title]
|
||||||
return [console_init $w]
|
return [_init $w]
|
||||||
}
|
}
|
||||||
|
|
||||||
proc console_init {w} {
|
proc _init {w} {
|
||||||
global console_cr console_data M1B
|
global M1B
|
||||||
|
variable console_cr
|
||||||
|
variable console_data
|
||||||
|
|
||||||
set console_cr($w) 1.0
|
set console_cr($w) 1.0
|
||||||
toplevel $w
|
toplevel $w
|
||||||
@ -63,7 +71,7 @@ proc console_init {w} {
|
|||||||
return $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.
|
# -- Cygwin's Tcl tosses the enviroment when we exec our child.
|
||||||
# But most users need that so we have to relogin. :-(
|
# 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]
|
set fd_f [open $cmd r]
|
||||||
fconfigure $fd_f -blocking 0 -translation binary
|
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} {
|
proc _read {w fd after} {
|
||||||
global console_cr
|
variable console_cr
|
||||||
|
|
||||||
set buf [read $fd]
|
set buf [read $fd]
|
||||||
if {$buf ne {}} {
|
if {$buf ne {}} {
|
||||||
if {![winfo exists $w]} {console_init $w}
|
if {![winfo exists $w]} {_init $w}
|
||||||
$w.m.t conf -state normal
|
$w.m.t conf -state normal
|
||||||
set c 0
|
set c 0
|
||||||
set n [string length $buf]
|
set n [string length $buf]
|
||||||
@ -120,36 +129,41 @@ proc console_read {w fd after} {
|
|||||||
} else {
|
} else {
|
||||||
set ok 1
|
set ok 1
|
||||||
}
|
}
|
||||||
uplevel #0 $after $w $ok
|
if {$after ne {}} {
|
||||||
|
uplevel #0 $after $w $ok
|
||||||
|
} else {
|
||||||
|
done $w $ok
|
||||||
|
}
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
fconfigure $fd -blocking 0
|
fconfigure $fd -blocking 0
|
||||||
}
|
}
|
||||||
|
|
||||||
proc console_chain {cmdlist w {ok 1}} {
|
proc chain {cmdlist w {ok 1}} {
|
||||||
if {$ok} {
|
if {$ok} {
|
||||||
if {[llength $cmdlist] == 0} {
|
if {[llength $cmdlist] == 0} {
|
||||||
console_done $w $ok
|
done $w $ok
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
|
|
||||||
set cmd [lindex $cmdlist 0]
|
set cmd [lindex $cmdlist 0]
|
||||||
set cmdlist [lrange $cmdlist 1 end]
|
set cmdlist [lrange $cmdlist 1 end]
|
||||||
|
|
||||||
if {[lindex $cmd 0] eq {console_exec}} {
|
if {[lindex $cmd 0] eq {exec}} {
|
||||||
console_exec $w \
|
exec $w \
|
||||||
[lindex $cmd 1] \
|
[lindex $cmd 1] \
|
||||||
[list console_chain $cmdlist]
|
[namespace code [list chain $cmdlist]]
|
||||||
} else {
|
} else {
|
||||||
uplevel #0 $cmd $cmdlist $w $ok
|
uplevel #0 $cmd $cmdlist $w $ok
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
console_done $w $ok
|
done $w $ok
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
proc console_done {args} {
|
proc done {args} {
|
||||||
global console_cr console_data
|
variable console_cr
|
||||||
|
variable console_data
|
||||||
|
|
||||||
switch -- [llength $args] {
|
switch -- [llength $args] {
|
||||||
2 {
|
2 {
|
||||||
@ -161,7 +175,7 @@ proc console_done {args} {
|
|||||||
set ok [lindex $args 2]
|
set ok [lindex $args 2]
|
||||||
}
|
}
|
||||||
default {
|
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 {
|
} else {
|
||||||
if {![winfo exists $w]} {
|
if {![winfo exists $w]} {
|
||||||
console_init $w
|
_init $w
|
||||||
}
|
}
|
||||||
$w.m.s conf -background red -text {Error: Command Failed}
|
$w.m.s conf -background red -text {Error: Command Failed}
|
||||||
$w.ok conf -state normal
|
$w.ok conf -state normal
|
||||||
@ -183,3 +197,5 @@ proc console_done {args} {
|
|||||||
array unset console_cr $w
|
array unset console_cr $w
|
||||||
array unset console_data $w
|
array unset console_data $w
|
||||||
}
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
@ -69,21 +69,21 @@ proc do_stats {} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc do_gc {} {
|
proc do_gc {} {
|
||||||
set w [new_console {gc} {Compressing the object database}]
|
set w [console::new {gc} {Compressing the object database}]
|
||||||
console_chain {
|
console::chain {
|
||||||
{console_exec {git pack-refs --prune}}
|
{exec {git pack-refs --prune}}
|
||||||
{console_exec {git reflog expire --all}}
|
{exec {git reflog expire --all}}
|
||||||
{console_exec {git repack -a -d -l}}
|
{exec {git repack -a -d -l}}
|
||||||
{console_exec {git rerere gc}}
|
{exec {git rerere gc}}
|
||||||
} $w
|
} $w
|
||||||
}
|
}
|
||||||
|
|
||||||
proc do_fsck_objects {} {
|
proc do_fsck_objects {} {
|
||||||
set w [new_console {fsck-objects} \
|
set w [console::new {fsck-objects} \
|
||||||
{Verifying the object database with fsck-objects}]
|
{Verifying the object database with fsck-objects}]
|
||||||
set cmd [list git fsck-objects]
|
set cmd [list git fsck-objects]
|
||||||
lappend cmd --full
|
lappend cmd --full
|
||||||
lappend cmd --cache
|
lappend cmd --cache
|
||||||
lappend cmd --strict
|
lappend cmd --strict
|
||||||
console_exec $w $cmd console_done
|
console::exec $w $cmd
|
||||||
}
|
}
|
||||||
|
@ -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 msg "Merging $current_branch, [join $names {, }]"
|
||||||
set ui_status_value "$msg..."
|
set ui_status_value "$msg..."
|
||||||
set cons [new_console "Merge" $msg]
|
set cons [console::new "Merge" $msg]
|
||||||
console_exec $cons $cmd [list finish_merge $revcnt]
|
console::exec $cons $cmd [list finish_merge $revcnt]
|
||||||
bind $w <Destroy> {}
|
bind $w <Destroy> {}
|
||||||
destroy $w
|
destroy $w
|
||||||
}
|
}
|
||||||
|
|
||||||
proc finish_merge {revcnt w ok} {
|
proc finish_merge {revcnt w ok} {
|
||||||
console_done $w $ok
|
console::done $w $ok
|
||||||
if {$ok} {
|
if {$ok} {
|
||||||
set msg {Merge completed successfully.}
|
set msg {Merge completed successfully.}
|
||||||
} else {
|
} else {
|
||||||
|
@ -2,22 +2,22 @@
|
|||||||
# Copyright (C) 2006, 2007 Shawn Pearce
|
# Copyright (C) 2006, 2007 Shawn Pearce
|
||||||
|
|
||||||
proc fetch_from {remote} {
|
proc fetch_from {remote} {
|
||||||
set w [new_console \
|
set w [console::new \
|
||||||
"fetch $remote" \
|
"fetch $remote" \
|
||||||
"Fetching new changes from $remote"]
|
"Fetching new changes from $remote"]
|
||||||
set cmd [list git fetch]
|
set cmd [list git fetch]
|
||||||
lappend cmd $remote
|
lappend cmd $remote
|
||||||
console_exec $w $cmd console_done
|
console::exec $w $cmd
|
||||||
}
|
}
|
||||||
|
|
||||||
proc push_to {remote} {
|
proc push_to {remote} {
|
||||||
set w [new_console \
|
set w [console::new \
|
||||||
"push $remote" \
|
"push $remote" \
|
||||||
"Pushing changes to $remote"]
|
"Pushing changes to $remote"]
|
||||||
set cmd [list git push]
|
set cmd [list git push]
|
||||||
lappend cmd -v
|
lappend cmd -v
|
||||||
lappend cmd $remote
|
lappend cmd $remote
|
||||||
console_exec $w $cmd console_done
|
console::exec $w $cmd
|
||||||
}
|
}
|
||||||
|
|
||||||
proc start_push_anywhere_action {w} {
|
proc start_push_anywhere_action {w} {
|
||||||
@ -53,8 +53,10 @@ proc start_push_anywhere_action {w} {
|
|||||||
set unit branches
|
set unit branches
|
||||||
}
|
}
|
||||||
|
|
||||||
set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
|
set cons [console::new \
|
||||||
console_exec $cons $cmd console_done
|
"push $r_url" \
|
||||||
|
"Pushing $cnt $unit to $r_url"]
|
||||||
|
console::exec $cons $cmd
|
||||||
destroy $w
|
destroy $w
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user