summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: f522c9b)
raw | patch | inline | side by side (parent: f522c9b)
author | Shawn O. Pearce <spearce@spearce.org> | |
Tue, 1 May 2007 06:59:53 +0000 (02:59 -0400) | ||
committer | Shawn O. Pearce <spearce@spearce.org> | |
Tue, 8 May 2007 03:35:50 +0000 (23:35 -0400) |
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>
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>
lib/console.tcl | patch | blob | history | |
lib/database.tcl | patch | blob | history | |
lib/merge.tcl | patch | blob | history | |
lib/transport.tcl | patch | blob | history |
diff --git a/lib/console.tcl b/lib/console.tcl
index e40ec9639bdf053969e0dd0716119607a8cd7d43..75f3e0463bc06c4a51865ac77107ca3b52028e1f 100644 (file)
--- a/lib/console.tcl
+++ b/lib/console.tcl
# 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
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. :-(
#
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]
} 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 {
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"
}
}
}
} 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
array unset console_cr $w
array unset console_data $w
}
+
+}
diff --git a/lib/database.tcl b/lib/database.tcl
index e31466fb50b49bce3673680b2ad7308c249647f8..73058a826911dd5f75bb33636000b905096e975d 100644 (file)
--- a/lib/database.tcl
+++ b/lib/database.tcl
}
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 75724a930f3bc543868cef61568f7f7e9010a96c..e0e84aeabebe2bf3ed35d1bc0d485254a6f168c3 100644 (file)
--- 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 ce6fc45eba1d26a9d4221793f1da8ae1ebf06a66..c0e7d20fce67349938373c0cfdf879aa3137d18f 100644 (file)
--- a/lib/transport.tcl
+++ b/lib/transport.tcl
# 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} {
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
}