lib/browser.tcl

   1 # git-gui tree browser
   2 # Copyright (C) 2006, 2007 Shawn Pearce
   3
   4 class browser {
   5
   6 field w
   7 field browser_commit
   8 field browser_path
   9 field browser_files  {}
  10 field browser_status {Starting...}
  11 field browser_stack  {}
  12 field browser_busy   1
  13
  14 constructor 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
  79 method _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
  90 method _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
 104 method _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
 120 method _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
 149 method _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
 163 method _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
 188 method _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 }