e40ec9639bdf053969e0dd0716119607a8cd7d43
   1# git-gui console support
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4set next_console_id 0
   5
   6proc new_console {short_title long_title} {
   7        global next_console_id console_data
   8        set w .console[incr next_console_id]
   9        set console_data($w) [list $short_title $long_title]
  10        return [console_init $w]
  11}
  12
  13proc console_init {w} {
  14        global console_cr console_data M1B
  15
  16        set console_cr($w) 1.0
  17        toplevel $w
  18        frame $w.m
  19        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
  20                -anchor w \
  21                -justify left \
  22                -font font_uibold
  23        text $w.m.t \
  24                -background white -borderwidth 1 \
  25                -relief sunken \
  26                -width 80 -height 10 \
  27                -font font_diff \
  28                -state disabled \
  29                -yscrollcommand [list $w.m.sby set]
  30        label $w.m.s -text {Working... please wait...} \
  31                -anchor w \
  32                -justify left \
  33                -font font_uibold
  34        scrollbar $w.m.sby -command [list $w.m.t yview]
  35        pack $w.m.l1 -side top -fill x
  36        pack $w.m.s -side bottom -fill x
  37        pack $w.m.sby -side right -fill y
  38        pack $w.m.t -side left -fill both -expand 1
  39        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
  40
  41        menu $w.ctxm -tearoff 0
  42        $w.ctxm add command -label "Copy" \
  43                -command "tk_textCopy $w.m.t"
  44        $w.ctxm add command -label "Select All" \
  45                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
  46        $w.ctxm add command -label "Copy All" \
  47                -command "
  48                        $w.m.t tag add sel 0.0 end
  49                        tk_textCopy $w.m.t
  50                        $w.m.t tag remove sel 0.0 end
  51                "
  52
  53        button $w.ok -text {Close} \
  54                -state disabled \
  55                -command "destroy $w"
  56        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
  57
  58        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
  59        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
  60        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
  61        bind $w <Visibility> "focus $w"
  62        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
  63        return $w
  64}
  65
  66proc console_exec {w cmd after} {
  67        # -- Cygwin's Tcl tosses the enviroment when we exec our child.
  68        #    But most users need that so we have to relogin. :-(
  69        #
  70        if {[is_Cygwin]} {
  71                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
  72        }
  73
  74        # -- Tcl won't let us redirect both stdout and stderr to
  75        #    the same pipe.  So pass it through cat...
  76        #
  77        set cmd [concat | $cmd |& cat]
  78
  79        set fd_f [open $cmd r]
  80        fconfigure $fd_f -blocking 0 -translation binary
  81        fileevent $fd_f readable [list console_read $w $fd_f $after]
  82}
  83
  84proc console_read {w fd after} {
  85        global console_cr
  86
  87        set buf [read $fd]
  88        if {$buf ne {}} {
  89                if {![winfo exists $w]} {console_init $w}
  90                $w.m.t conf -state normal
  91                set c 0
  92                set n [string length $buf]
  93                while {$c < $n} {
  94                        set cr [string first "\r" $buf $c]
  95                        set lf [string first "\n" $buf $c]
  96                        if {$cr < 0} {set cr [expr {$n + 1}]}
  97                        if {$lf < 0} {set lf [expr {$n + 1}]}
  98
  99                        if {$lf < $cr} {
 100                                $w.m.t insert end [string range $buf $c $lf]
 101                                set console_cr($w) [$w.m.t index {end -1c}]
 102                                set c $lf
 103                                incr c
 104                        } else {
 105                                $w.m.t delete $console_cr($w) end
 106                                $w.m.t insert end "\n"
 107                                $w.m.t insert end [string range $buf $c $cr]
 108                                set c $cr
 109                                incr c
 110                        }
 111                }
 112                $w.m.t conf -state disabled
 113                $w.m.t see end
 114        }
 115
 116        fconfigure $fd -blocking 1
 117        if {[eof $fd]} {
 118                if {[catch {close $fd}]} {
 119                        set ok 0
 120                } else {
 121                        set ok 1
 122                }
 123                uplevel #0 $after $w $ok
 124                return
 125        }
 126        fconfigure $fd -blocking 0
 127}
 128
 129proc console_chain {cmdlist w {ok 1}} {
 130        if {$ok} {
 131                if {[llength $cmdlist] == 0} {
 132                        console_done $w $ok
 133                        return
 134                }
 135
 136                set cmd [lindex $cmdlist 0]
 137                set cmdlist [lrange $cmdlist 1 end]
 138
 139                if {[lindex $cmd 0] eq {console_exec}} {
 140                        console_exec $w \
 141                                [lindex $cmd 1] \
 142                                [list console_chain $cmdlist]
 143                } else {
 144                        uplevel #0 $cmd $cmdlist $w $ok
 145                }
 146        } else {
 147                console_done $w $ok
 148        }
 149}
 150
 151proc console_done {args} {
 152        global console_cr console_data
 153
 154        switch -- [llength $args] {
 155        2 {
 156                set w [lindex $args 0]
 157                set ok [lindex $args 1]
 158        }
 159        3 {
 160                set w [lindex $args 1]
 161                set ok [lindex $args 2]
 162        }
 163        default {
 164                error "wrong number of args: console_done ?ignored? w ok"
 165        }
 166        }
 167
 168        if {$ok} {
 169                if {[winfo exists $w]} {
 170                        $w.m.s conf -background green -text {Success}
 171                        $w.ok conf -state normal
 172                        focus $w.ok
 173                }
 174        } else {
 175                if {![winfo exists $w]} {
 176                        console_init $w
 177                }
 178                $w.m.s conf -background red -text {Error: Command Failed}
 179                $w.ok conf -state normal
 180                focus $w.ok
 181        }
 182
 183        array unset console_cr $w
 184        array unset console_data $w
 185}