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 field ls_buf     {}; # Buffered record output from ls-tree
  15
  16 constructor new {commit {path {}}} {
  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:$path
  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         if {$path ne {}} {
  77                 _ls $this $browser_commit:$path $path
  78         } else {
  79                 _ls $this $browser_commit $path
  80         }
  81         return $this
  82 }
  83
  84 method _move {dir} {
  85         if {$browser_busy} return
  86         set lno [lindex [split [$w index in_sel.first] .] 0]
  87         incr lno $dir
  88         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
  89                 $w tag remove in_sel 0.0 end
  90                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
  91                 $w see $lno.0
  92         }
  93 }
  94
  95 method _page {dir} {
  96         if {$browser_busy} return
  97         $w yview scroll $dir pages
  98         set lno [expr {int(
  99                   [lindex [$w yview] 0]
 100                 * [llength $browser_files]
 101                 + 1)}]
 102         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 103                 $w tag remove in_sel 0.0 end
 104                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 105                 $w see $lno.0
 106         }
 107 }
 108
 109 method _parent {} {
 110         if {$browser_busy} return
 111         set info [lindex $browser_files 0]
 112         if {[lindex $info 0] eq {parent}} {
 113                 set parent [lindex $browser_stack end-1]
 114                 set browser_stack [lrange $browser_stack 0 end-2]
 115                 if {$browser_stack eq {}} {
 116                         regsub {:.*$} $browser_path {:} browser_path
 117                 } else {
 118                         regsub {/[^/]+$} $browser_path {} browser_path
 119                 }
 120                 set browser_status "Loading $browser_path..."
 121                 _ls $this [lindex $parent 0] [lindex $parent 1]
 122         }
 123 }
 124
 125 method _enter {} {
 126         if {$browser_busy} return
 127         set lno [lindex [split [$w index in_sel.first] .] 0]
 128         set info [lindex $browser_files [expr {$lno - 1}]]
 129         if {$info ne {}} {
 130                 switch -- [lindex $info 0] {
 131                 parent {
 132                         _parent $this
 133                 }
 134                 tree {
 135                         set name [lindex $info 2]
 136                         set escn [escape_path $name]
 137                         set browser_status "Loading $escn..."
 138                         append browser_path $escn
 139                         _ls $this [lindex $info 1] $name
 140                 }
 141                 blob {
 142                         set name [lindex $info 2]
 143                         set p {}
 144                         foreach n $browser_stack {
 145                                 append p [lindex $n 1]
 146                         }
 147                         append p $name
 148                         blame::new $browser_commit $p
 149                 }
 150                 }
 151         }
 152 }
 153
 154 method _click {was_double_click pos} {
 155         if {$browser_busy} return
 156         set lno [lindex [split [$w index $pos] .] 0]
 157         focus $w
 158
 159         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 160                 $w tag remove in_sel 0.0 end
 161                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 162                 if {$was_double_click} {
 163                         _enter $this
 164                 }
 165         }
 166 }
 167
 168 method _ls {tree_id {name {}}} {
 169         set ls_buf {}
 170         set browser_files {}
 171         set browser_busy 1
 172
 173         $w conf -state normal
 174         $w tag remove in_sel 0.0 end
 175         $w delete 0.0 end
 176         if {$browser_stack ne {}} {
 177                 $w image create end \
 178                         -align center -padx 5 -pady 1 \
 179                         -name icon0 \
 180                         -image file_uplevel
 181                 $w insert end {[Up To Parent]}
 182                 lappend browser_files parent
 183         }
 184         lappend browser_stack [list $tree_id $name]
 185         $w conf -state disabled
 186
 187         set fd [git_read ls-tree -z $tree_id]
 188         fconfigure $fd -blocking 0 -translation binary -encoding binary
 189         fileevent $fd readable [cb _read $fd]
 190 }
 191
 192 method _read {fd} {
 193         append ls_buf [read $fd]
 194         set pck [split $ls_buf "\0"]
 195         set ls_buf [lindex $pck end]
 196
 197         set n [llength $browser_files]
 198         $w conf -state normal
 199         foreach p [lrange $pck 0 end-1] {
 200                 set tab [string first "\t" $p]
 201                 if {$tab == -1} continue
 202
 203                 set info [split [string range $p 0 [expr {$tab - 1}]] { }]
 204                 set path [string range $p [expr {$tab + 1}] end]
 205                 set type   [lindex $info 1]
 206                 set object [lindex $info 2]
 207
 208                 switch -- $type {
 209                 blob {
 210                         set image file_mod
 211                 }
 212                 tree {
 213                         set image file_dir
 214                         append path /
 215                 }
 216                 default {
 217                         set image file_question
 218                 }
 219                 }
 220
 221                 if {$n > 0} {$w insert end "\n"}
 222                 $w image create end \
 223                         -align center -padx 5 -pady 1 \
 224                         -name icon[incr n] \
 225                         -image $image
 226                 $w insert end [escape_path $path]
 227                 lappend browser_files [list $type $object $path]
 228         }
 229         $w conf -state disabled
 230
 231         if {[eof $fd]} {
 232                 close $fd
 233                 set browser_status Ready.
 234                 set browser_busy 0
 235                 set ls_buf {}
 236                 if {$n > 0} {
 237                         $w tag add in_sel 1.0 2.0
 238                         focus -force $w
 239                 }
 240         }
 241 } ifdeleted {
 242         catch {close $fd}
 243 }
 244
 245 }
 246
 247 class browser_open {
 248
 249 field w              ; # widget path
 250 field w_rev          ; # mega-widget to pick the initial revision
 251
 252 constructor dialog {} {
 253         make_toplevel top w
 254         wm title $top "[appname] ([reponame]): Browse Branch Files"
 255         if {$top ne {.}} {
 256                 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
 257         }
 258
 259         label $w.header \
 260                 -text {Browse Branch Files} \
 261                 -font font_uibold
 262         pack $w.header -side top -fill x
 263
 264         frame $w.buttons
 265         button $w.buttons.browse -text Browse \
 266                 -default active \
 267                 -command [cb _open]
 268         pack $w.buttons.browse -side right
 269         button $w.buttons.cancel -text {Cancel} \
 270                 -command [list destroy $w]
 271         pack $w.buttons.cancel -side right -padx 5
 272         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
 273
 274         set w_rev [::choose_rev::new $w.rev {Revision}]
 275         $w_rev bind_listbox <Double-Button-1> [cb _open]
 276         pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
 277
 278         bind $w <Visibility> [cb _visible]
 279         bind $w <Key-Escape> [list destroy $w]
 280         bind $w <Key-Return> [cb _open]\;break
 281         tkwait window $w
 282 }
 283
 284 method _open {} {
 285         if {[catch {$w_rev commit_or_die} err]} {
 286                 return
 287         }
 288         set name [$w_rev get]
 289         destroy $w
 290         browser::new $name
 291 }
 292
 293 method _visible {} {
 294         grab $w
 295         $w_rev focus_filter
 296 }
 297
 298 }