Merge branch 'master' of git://repo.or.cz/git-gui
[git/git.git] / 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 }