Merge branch 'maint-1.5.1' into maint
[git] / 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         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 }