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