git-gui/lib/browser.tcl

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