lib / browser.tclon commit git-gui: Don't linewrap within console windows (e87fb0f)
   1# git-gui tree browser
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4class browser {
   5
   6field w
   7field browser_commit
   8field browser_path
   9field browser_files  {}
  10field browser_status {Starting...}
  11field browser_stack  {}
  12field browser_busy   1
  13
  14field ls_buf     {}; # Buffered record output from ls-tree
  15
  16constructor new {commit} {
  17        global cursor_ptr M1B
  18        make_toplevel top w
  19        wm title $top "[appname] ([reponame]): File Browser"
  20
  21        set browser_commit $commit
  22        set browser_path $browser_commit:
  23
  24        label $w.path \
  25                -textvariable @browser_path \
  26                -anchor w \
  27                -justify left \
  28                -borderwidth 1 \
  29                -relief sunken \
  30                -font font_uibold
  31        pack $w.path -anchor w -side top -fill x
  32
  33        frame $w.list
  34        set w_list $w.list.l
  35        text $w_list -background white -borderwidth 0 \
  36                -cursor $cursor_ptr \
  37                -state disabled \
  38                -wrap none \
  39                -height 20 \
  40                -width 70 \
  41                -xscrollcommand [list $w.list.sbx set] \
  42                -yscrollcommand [list $w.list.sby set]
  43        $w_list tag conf in_sel \
  44                -background [$w_list cget -foreground] \
  45                -foreground [$w_list cget -background]
  46        scrollbar $w.list.sbx -orient h -command [list $w_list xview]
  47        scrollbar $w.list.sby -orient v -command [list $w_list yview]
  48        pack $w.list.sbx -side bottom -fill x
  49        pack $w.list.sby -side right -fill y
  50        pack $w_list -side left -fill both -expand 1
  51        pack $w.list -side top -fill both -expand 1
  52
  53        label $w.status \
  54                -textvariable @browser_status \
  55                -anchor w \
  56                -justify left \
  57                -borderwidth 1 \
  58                -relief sunken
  59        pack $w.status -anchor w -side bottom -fill x
  60
  61        bind $w_list <Button-1>        "[cb _click 0 @%x,%y];break"
  62        bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
  63        bind $w_list <$M1B-Up>         "[cb _parent]        ;break"
  64        bind $w_list <$M1B-Left>       "[cb _parent]        ;break"
  65        bind $w_list <Up>              "[cb _move -1]       ;break"
  66        bind $w_list <Down>            "[cb _move  1]       ;break"
  67        bind $w_list <$M1B-Right>      "[cb _enter]         ;break"
  68        bind $w_list <Return>          "[cb _enter]         ;break"
  69        bind $w_list <Prior>           "[cb _page -1]       ;break"
  70        bind $w_list <Next>            "[cb _page  1]       ;break"
  71        bind $w_list <Left>            break
  72        bind $w_list <Right>           break
  73
  74        bind $w_list <Visibility> [list focus $w_list]
  75        set w $w_list
  76        _ls $this $browser_commit
  77        return $this
  78}
  79
  80method _move {dir} {
  81        if {$browser_busy} return
  82        set lno [lindex [split [$w index in_sel.first] .] 0]
  83        incr lno $dir
  84        if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
  85                $w tag remove in_sel 0.0 end
  86                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
  87                $w see $lno.0
  88        }
  89}
  90
  91method _page {dir} {
  92        if {$browser_busy} return
  93        $w yview scroll $dir pages
  94        set lno [expr {int(
  95                  [lindex [$w yview] 0]
  96                * [llength $browser_files]
  97                + 1)}]
  98        if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
  99                $w tag remove in_sel 0.0 end
 100                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 101                $w see $lno.0
 102        }
 103}
 104
 105method _parent {} {
 106        if {$browser_busy} return
 107        set info [lindex $browser_files 0]
 108        if {[lindex $info 0] eq {parent}} {
 109                set parent [lindex $browser_stack end-1]
 110                set browser_stack [lrange $browser_stack 0 end-2]
 111                if {$browser_stack eq {}} {
 112                        regsub {:.*$} $browser_path {:} browser_path
 113                } else {
 114                        regsub {/[^/]+$} $browser_path {} browser_path
 115                }
 116                set browser_status "Loading $browser_path..."
 117                _ls $this [lindex $parent 0] [lindex $parent 1]
 118        }
 119}
 120
 121method _enter {} {
 122        if {$browser_busy} return
 123        set lno [lindex [split [$w index in_sel.first] .] 0]
 124        set info [lindex $browser_files [expr {$lno - 1}]]
 125        if {$info ne {}} {
 126                switch -- [lindex $info 0] {
 127                parent {
 128                        _parent $this
 129                }
 130                tree {
 131                        set name [lindex $info 2]
 132                        set escn [escape_path $name]
 133                        set browser_status "Loading $escn..."
 134                        append browser_path $escn
 135                        _ls $this [lindex $info 1] $name
 136                }
 137                blob {
 138                        set name [lindex $info 2]
 139                        set p {}
 140                        foreach n $browser_stack {
 141                                append p [lindex $n 1]
 142                        }
 143                        append p $name
 144                        blame::new $browser_commit $p
 145                }
 146                }
 147        }
 148}
 149
 150method _click {was_double_click pos} {
 151        if {$browser_busy} return
 152        set lno [lindex [split [$w index $pos] .] 0]
 153        focus $w
 154
 155        if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 156                $w tag remove in_sel 0.0 end
 157                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 158                if {$was_double_click} {
 159                        _enter $this
 160                }
 161        }
 162}
 163
 164method _ls {tree_id {name {}}} {
 165        set ls_buf {}
 166        set browser_files {}
 167        set browser_busy 1
 168
 169        $w conf -state normal
 170        $w tag remove in_sel 0.0 end
 171        $w delete 0.0 end
 172        if {$browser_stack ne {}} {
 173                $w image create end \
 174                        -align center -padx 5 -pady 1 \
 175                        -name icon0 \
 176                        -image file_uplevel
 177                $w insert end {[Up To Parent]}
 178                lappend browser_files parent
 179        }
 180        lappend browser_stack [list $tree_id $name]
 181        $w conf -state disabled
 182
 183        set cmd [list git ls-tree -z $tree_id]
 184        set fd [open "| $cmd" r]
 185        fconfigure $fd -blocking 0 -translation binary -encoding binary
 186        fileevent $fd readable [cb _read $fd]
 187}
 188
 189method _read {fd} {
 190        append ls_buf [read $fd]
 191        set pck [split $ls_buf "\0"]
 192        set ls_buf [lindex $pck end]
 193
 194        set n [llength $browser_files]
 195        $w conf -state normal
 196        foreach p [lrange $pck 0 end-1] {
 197                set tab [string first "\t" $p]
 198                if {$tab == -1} continue
 199
 200                set info [split [string range $p 0 [expr {$tab - 1}]] { }]
 201                set path [string range $p [expr {$tab + 1}] end]
 202                set type   [lindex $info 1]
 203                set object [lindex $info 2]
 204
 205                switch -- $type {
 206                blob {
 207                        set image file_mod
 208                }
 209                tree {
 210                        set image file_dir
 211                        append path /
 212                }
 213                default {
 214                        set image file_question
 215                }
 216                }
 217
 218                if {$n > 0} {$w insert end "\n"}
 219                $w image create end \
 220                        -align center -padx 5 -pady 1 \
 221                        -name icon[incr n] \
 222                        -image $image
 223                $w insert end [escape_path $path]
 224                lappend browser_files [list $type $object $path]
 225        }
 226        $w conf -state disabled
 227
 228        if {[eof $fd]} {
 229                close $fd
 230                set browser_status Ready.
 231                set browser_busy 0
 232                set ls_buf {}
 233                if {$n > 0} {
 234                        $w tag add in_sel 1.0 2.0
 235                        focus -force $w
 236                }
 237        }
 238} ifdeleted {
 239        catch {close $fd}
 240}
 241
 242}