diff options
| author | Shawn O. Pearce <spearce@spearce.org> | 2007-05-07 23:35:48 -0400 |
|---|---|---|
| committer | Shawn O. Pearce <spearce@spearce.org> | 2007-05-07 23:35:48 -0400 |
| commit | f522c9b5ed367172f969397589ae3d686b867ac0 (patch) | |
| tree | 61315e92a1cf8f5edb67181a4e22a724195babeb /lib/console.tcl | |
| parent | c6a5e4030320c934bca70471d04aa9e7d8e2cd67 (diff) | |
| download | git-f522c9b5ed367172f969397589ae3d686b867ac0.tar.gz git-f522c9b5ed367172f969397589ae3d686b867ac0.tar.xz | |
git-gui: Refactor into multiple files to save my sanity
I'm finding it difficult to work with a 6,000+ line Tcl script
and not go insane while looking for a particular block of code.
Since most of the program is organized into different units of
functionality and not all users will need all units immediately
on startup we can improve things by splitting procs out into
multiple files and let auto_load handle things for us.
This should help not only to better organize the source, but
it may also improve startup times for some users as the Tcl
parser does not need to read as much script before it can show
the UI. In many cases the user can avoid reading at least half
of git-gui now.
Unfortunately we now need a library directory in our runtime
location. This is currently assumed to be $(sharedir)/git-gui/lib
and its expected that the Makefile invoker will setup some sort of
reasonable sharedir value for us, or let us assume its going to be
$(gitexecdir)/../share.
We now also require a tclsh (in TCL_PATH) to just run the Makefile,
as we use tclsh to generate the tclIndex for our lib directory. I'm
hoping this is not an unncessary burden on end-users who are building
from source.
I haven't really made any functionality changes here, this is just a
huge migration of code from one file to many smaller files. All of
the new changes are to setup the library path and install the library
files.
Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
Diffstat (limited to 'lib/console.tcl')
| -rw-r--r-- | lib/console.tcl | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/lib/console.tcl b/lib/console.tcl new file mode 100644 index 000000000..e40ec9639 --- /dev/null +++ b/lib/console.tcl @@ -0,0 +1,185 @@ +# git-gui console support +# Copyright (C) 2006, 2007 Shawn Pearce + +set next_console_id 0 + +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] +} + +proc console_init {w} { + global console_cr console_data M1B + + set console_cr($w) 1.0 + toplevel $w + frame $w.m + label $w.m.l1 -text "[lindex $console_data($w) 1]:" \ + -anchor w \ + -justify left \ + -font font_uibold + text $w.m.t \ + -background white -borderwidth 1 \ + -relief sunken \ + -width 80 -height 10 \ + -font font_diff \ + -state disabled \ + -yscrollcommand [list $w.m.sby set] + label $w.m.s -text {Working... please wait...} \ + -anchor w \ + -justify left \ + -font font_uibold + scrollbar $w.m.sby -command [list $w.m.t yview] + pack $w.m.l1 -side top -fill x + pack $w.m.s -side bottom -fill x + pack $w.m.sby -side right -fill y + pack $w.m.t -side left -fill both -expand 1 + pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10 + + menu $w.ctxm -tearoff 0 + $w.ctxm add command -label "Copy" \ + -command "tk_textCopy $w.m.t" + $w.ctxm add command -label "Select All" \ + -command "focus $w.m.t;$w.m.t tag add sel 0.0 end" + $w.ctxm add command -label "Copy All" \ + -command " + $w.m.t tag add sel 0.0 end + tk_textCopy $w.m.t + $w.m.t tag remove sel 0.0 end + " + + button $w.ok -text {Close} \ + -state disabled \ + -command "destroy $w" + pack $w.ok -side bottom -anchor e -pady 10 -padx 10 + + bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y" + bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break" + bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break" + bind $w <Visibility> "focus $w" + wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]" + return $w +} + +proc console_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. :-( + # + if {[is_Cygwin]} { + set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"] + } + + # -- Tcl won't let us redirect both stdout and stderr to + # the same pipe. So pass it through cat... + # + set cmd [concat | $cmd |& cat] + + set fd_f [open $cmd r] + fconfigure $fd_f -blocking 0 -translation binary + fileevent $fd_f readable [list console_read $w $fd_f $after] +} + +proc console_read {w fd after} { + global console_cr + + set buf [read $fd] + if {$buf ne {}} { + if {![winfo exists $w]} {console_init $w} + $w.m.t conf -state normal + set c 0 + set n [string length $buf] + while {$c < $n} { + set cr [string first "\r" $buf $c] + set lf [string first "\n" $buf $c] + if {$cr < 0} {set cr [expr {$n + 1}]} + if {$lf < 0} {set lf [expr {$n + 1}]} + + if {$lf < $cr} { + $w.m.t insert end [string range $buf $c $lf] + set console_cr($w) [$w.m.t index {end -1c}] + set c $lf + incr c + } else { + $w.m.t delete $console_cr($w) end + $w.m.t insert end "\n" + $w.m.t insert end [string range $buf $c $cr] + set c $cr + incr c + } + } + $w.m.t conf -state disabled + $w.m.t see end + } + + fconfigure $fd -blocking 1 + if {[eof $fd]} { + if {[catch {close $fd}]} { + set ok 0 + } else { + set ok 1 + } + uplevel #0 $after $w $ok + return + } + fconfigure $fd -blocking 0 +} + +proc console_chain {cmdlist w {ok 1}} { + if {$ok} { + if {[llength $cmdlist] == 0} { + console_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 \ + [lindex $cmd 1] \ + [list console_chain $cmdlist] + } else { + uplevel #0 $cmd $cmdlist $w $ok + } + } else { + console_done $w $ok + } +} + +proc console_done {args} { + global console_cr console_data + + switch -- [llength $args] { + 2 { + set w [lindex $args 0] + set ok [lindex $args 1] + } + 3 { + set w [lindex $args 1] + set ok [lindex $args 2] + } + default { + error "wrong number of args: console_done ?ignored? w ok" + } + } + + if {$ok} { + if {[winfo exists $w]} { + $w.m.s conf -background green -text {Success} + $w.ok conf -state normal + focus $w.ok + } + } else { + if {![winfo exists $w]} { + console_init $w + } + $w.m.s conf -background red -text {Error: Command Failed} + $w.ok conf -state normal + focus $w.ok + } + + array unset console_cr $w + array unset console_data $w +} |