X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=blobdiff_plain;f=lib%2Fconsole.tcl;h=1f3248ffd11353200c64bdbde630b4147dc96c0a;hb=2473543caabe63a9787e7ac42765c8f7169d7197;hp=75f3e0463bc06c4a51865ac77107ca3b52028e1f;hpb=a35d65d9c8a2a6a10d369c00e22aded6fbdff2a9;p=git.git diff --git a/lib/console.tcl b/lib/console.tcl index 75f3e0463..1f3248ffd 100644 --- a/lib/console.tcl +++ b/lib/console.tcl @@ -1,102 +1,111 @@ # git-gui console support # Copyright (C) 2006, 2007 Shawn Pearce -namespace eval console { +class console { + +field t_short +field t_long +field w +field w_t +field console_cr +field is_toplevel 1; # are we our own window? + +constructor new {short_title long_title} { + set t_short $short_title + set t_long $long_title + _init $this + return $this +} -variable next_console_id 0 -variable console_data -variable console_cr +constructor embed {path title} { + set t_short {} + set t_long $title + set w $path + set is_toplevel 0 + _init $this + return $this +} -proc new {short_title long_title} { - variable next_console_id - variable console_data +method _init {} { + global M1B use_ttk NS - set w .console[incr next_console_id] - set console_data($w) [list $short_title $long_title] - return [_init $w] -} + if {$is_toplevel} { + make_dialog top w -autodelete 0 + wm title $top "[appname] ([reponame]): $t_short" + } else { + ${NS}::frame $w + } -proc _init {w} { - global M1B - variable console_cr - variable console_data + set console_cr 1.0 + set w_t $w.m.t - set console_cr($w) 1.0 - toplevel $w - frame $w.m - label $w.m.l1 -text "[lindex $console_data($w) 1]:" \ + ${NS}::frame $w.m + ${NS}::label $w.m.l1 \ + -textvariable @t_long \ -anchor w \ -justify left \ -font font_uibold - text $w.m.t \ - -background white -borderwidth 1 \ + text $w_t \ + -background white \ + -foreground black \ + -borderwidth 1 \ -relief sunken \ -width 80 -height 10 \ + -wrap none \ -font font_diff \ -state disabled \ - -yscrollcommand [list $w.m.sby set] - label $w.m.s -text {Working... please wait...} \ + -xscrollcommand [cb _sb_set $w.m.sbx h] \ + -yscrollcommand [cb _sb_set $w.m.sby v] + label $w.m.s -text [mc "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_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" \ + $w.ctxm add command -label [mc "Copy"] \ + -command "tk_textCopy $w_t" + $w.ctxm add command -label [mc "Select All"] \ + -command "focus $w_t;$w_t tag add sel 0.0 end" + $w.ctxm add command -label [mc "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 + $w_t tag add sel 0.0 end + tk_textCopy $w_t + $w_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 "focus $w" - wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]" - return $w -} - -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. :-( - # - if {[is_Cygwin]} { - set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"] + if {$is_toplevel} { + ${NS}::button $w.ok -text [mc "Close"] \ + -state disabled \ + -command [list destroy $w] + pack $w.ok -side bottom -anchor e -pady 10 -padx 10 + bind $w [list focus $w] } - # -- Tcl won't let us redirect both stdout and stderr to - # the same pipe. So pass it through cat... - # - set cmd [concat | $cmd |& cat] + bind_button3 $w_t "tk_popup $w.ctxm %X %Y" + bind $w_t <$M1B-Key-a> "$w_t tag add sel 0.0 end;break" + bind $w_t <$M1B-Key-A> "$w_t tag add sel 0.0 end;break" +} - set fd_f [open $cmd r] +method exec {cmd {after {}}} { + if {[lindex $cmd 0] eq {git}} { + set fd_f [eval git_read --stderr [lrange $cmd 1 end]] + } else { + lappend cmd 2>@1 + set fd_f [_open_stdout_stderr $cmd] + } fconfigure $fd_f -blocking 0 -translation binary - fileevent $fd_f readable \ - [namespace code [list _read $w $fd_f $after]] + fileevent $fd_f readable [cb _read $fd_f $after] } -proc _read {w fd after} { - variable console_cr - +method _read {fd after} { set buf [read $fd] if {$buf ne {}} { - if {![winfo exists $w]} {_init $w} - $w.m.t conf -state normal + if {![winfo exists $w_t]} {_init $this} + $w_t conf -state normal set c 0 set n [string length $buf] while {$c < $n} { @@ -106,20 +115,20 @@ proc _read {w fd after} { 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}] + $w_t insert end [string range $buf $c $lf] + set console_cr [$w_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] + $w_t delete $console_cr end + $w_t insert end "\n" + $w_t insert end [string range $buf $c [expr {$cr - 1}]] set c $cr incr c } } - $w.m.t conf -state disabled - $w.m.t see end + $w_t conf -state disabled + $w_t see end } fconfigure $fd -blocking 1 @@ -130,19 +139,19 @@ proc _read {w fd after} { set ok 1 } if {$after ne {}} { - uplevel #0 $after $w $ok + uplevel #0 $after $ok } else { - done $w $ok + done $this $ok } return } fconfigure $fd -blocking 0 } -proc chain {cmdlist w {ok 1}} { +method chain {cmdlist {ok 1}} { if {$ok} { if {[llength $cmdlist] == 0} { - done $w $ok + done $this $ok return } @@ -150,52 +159,65 @@ proc chain {cmdlist w {ok 1}} { set cmdlist [lrange $cmdlist 1 end] if {[lindex $cmd 0] eq {exec}} { - exec $w \ - [lindex $cmd 1] \ - [namespace code [list chain $cmdlist]] + exec $this \ + [lrange $cmd 1 end] \ + [cb chain $cmdlist] } else { - uplevel #0 $cmd $cmdlist $w $ok + uplevel #0 $cmd [cb chain $cmdlist] } } else { - done $w $ok + done $this $ok } } -proc done {args} { - variable console_cr - variable 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: done ?ignored? w ok" - } - } +method insert {txt} { + if {![winfo exists $w_t]} {_init $this} + $w_t conf -state normal + $w_t insert end "$txt\n" + set console_cr [$w_t index {end -1c}] + $w_t conf -state disabled +} +method done {ok} { if {$ok} { - if {[winfo exists $w]} { - $w.m.s conf -background green -text {Success} - $w.ok conf -state normal - focus $w.ok + if {[winfo exists $w.m.s]} { + bind $w.m.s [list delete_this $this] + $w.m.s conf -background green -foreground black \ + -text [mc "Success"] + if {$is_toplevel} { + $w.ok conf -state normal + focus $w.ok + } + } else { + delete_this } } else { - if {![winfo exists $w]} { - _init $w + if {![winfo exists $w.m.s]} { + _init $this + } + bind $w.m.s [list delete_this $this] + $w.m.s conf -background red -foreground black \ + -text [mc "Error: Command Failed"] + if {$is_toplevel} { + $w.ok conf -state normal + focus $w.ok } - $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 +method _sb_set {sb orient first last} { + global NS + if {![winfo exists $sb]} { + if {$first == $last || ($first == 0 && $last == 1)} return + if {$orient eq {h}} { + ${NS}::scrollbar $sb -orient h -command [list $w_t xview] + pack $sb -fill x -side bottom -before $w_t + } else { + ${NS}::scrollbar $sb -orient v -command [list $w_t yview] + pack $sb -fill y -side right -before $w_t + } + } + $sb set $first $last } }