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