git-gui/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         set w $w_list
  74         _ls $this $browser_commit
  75         return $this
  76 }
  77
  78 method _move {dir} {
  79         if {$browser_busy} return
  80         set lno [lindex [split [$w index in_sel.first] .] 0]
  81         incr lno $dir
  82         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
  83                 $w tag remove in_sel 0.0 end
  84                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
  85                 $w see $lno.0
  86         }
  87 }
  88
  89 method _page {dir} {
  90         if {$browser_busy} return
  91         $w yview scroll $dir pages
  92         set lno [expr {int(
  93                   [lindex [$w yview] 0]
  94                 * [llength $browser_files]
  95                 + 1)}]
  96         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
  97                 $w tag remove in_sel 0.0 end
  98                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
  99                 $w see $lno.0
 100         }
 101 }
 102
 103 method _parent {} {
 104         if {$browser_busy} return
 105         set info [lindex $browser_files 0]
 106         if {[lindex $info 0] eq {parent}} {
 107                 set parent [lindex $browser_stack end-1]
 108                 set browser_stack [lrange $browser_stack 0 end-2]
 109                 if {$browser_stack eq {}} {
 110                         regsub {:.*$} $browser_path {:} browser_path
 111                 } else {
 112                         regsub {/[^/]+$} $browser_path {} browser_path
 113                 }
 114                 set browser_status "Loading $browser_path..."
 115                 _ls $this [lindex $parent 0] [lindex $parent 1]
 116         }
 117 }
 118
 119 method _enter {} {
 120         if {$browser_busy} return
 121         set lno [lindex [split [$w index in_sel.first] .] 0]
 122         set info [lindex $browser_files [expr {$lno - 1}]]
 123         if {$info ne {}} {
 124                 switch -- [lindex $info 0] {
 125                 parent {
 126                         _parent $this
 127                 }
 128                 tree {
 129                         set name [lindex $info 2]
 130                         set escn [escape_path $name]
 131                         set browser_status "Loading $escn..."
 132                         append browser_path $escn
 133                         _ls $this [lindex $info 1] $name
 134                 }
 135                 blob {
 136                         set name [lindex $info 2]
 137                         set p {}
 138                         foreach n $browser_stack {
 139                                 append p [lindex $n 1]
 140                         }
 141                         append p $name
 142                         blame::new $browser_commit $p
 143                 }
 144                 }
 145         }
 146 }
 147
 148 method _click {was_double_click pos} {
 149         if {$browser_busy} return
 150         set lno [lindex [split [$w index $pos] .] 0]
 151         focus $w
 152
 153         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 154                 $w tag remove in_sel 0.0 end
 155                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 156                 if {$was_double_click} {
 157                         _enter $this
 158                 }
 159         }
 160 }
 161
 162 method _ls {tree_id {name {}}} {
 163         set browser_buffer {}
 164         set browser_files {}
 165         set browser_busy 1
 166
 167         $w conf -state normal
 168         $w tag remove in_sel 0.0 end
 169         $w delete 0.0 end
 170         if {$browser_stack ne {}} {
 171                 $w image create end \
 172                         -align center -padx 5 -pady 1 \
 173                         -name icon0 \
 174                         -image file_uplevel
 175                 $w insert end {[Up To Parent]}
 176                 lappend browser_files parent
 177         }
 178         lappend browser_stack [list $tree_id $name]
 179         $w conf -state disabled
 180
 181         set cmd [list git ls-tree -z $tree_id]
 182         set fd [open "| $cmd" r]
 183         fconfigure $fd -blocking 0 -translation binary -encoding binary
 184         fileevent $fd readable [cb _read $fd]
 185 }
 186
 187 method _read {fd} {
 188         append browser_buffer [read $fd]
 189         set pck [split $browser_buffer "\0"]
 190         set browser_buffer [lindex $pck end]
 191
 192         set n [llength $browser_files]
 193         $w conf -state normal
 194         foreach p [lrange $pck 0 end-1] {
 195                 set info [split $p "\t"]
 196                 set path [lindex $info 1]
 197                 set info [split [lindex $info 0] { }]
 198                 set type [lindex $info 1]
 199                 set object [lindex $info 2]
 200
 201                 switch -- $type {
 202                 blob {
 203                         set image file_mod
 204                 }
 205                 tree {
 206                         set image file_dir
 207                         append path /
 208                 }
 209                 default {
 210                         set image file_question
 211                 }
 212                 }
 213
 214                 if {$n > 0} {$w insert end "\n"}
 215                 $w image create end \
 216                         -align center -padx 5 -pady 1 \
 217                         -name icon[incr n] \
 218                         -image $image
 219                 $w insert end [escape_path $path]
 220                 lappend browser_files [list $type $object $path]
 221         }
 222         $w conf -state disabled
 223
 224         if {[eof $fd]} {
 225                 close $fd
 226                 set browser_status Ready.
 227                 set browser_busy 0
 228                 unset browser_buffer
 229                 if {$n > 0} {
 230                         $w tag add in_sel 1.0 2.0
 231                         focus -force $w
 232                 }
 233         }
 234 } ifdeleted {
 235         catch {close $fd}
 236 }
 237
 238 }