ab470d12648c1dd3560b411e70ea210cc4381e3e
[git/git.git] / lib / browser.tcl
1 # git-gui tree browser
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 class browser {
5
6 image create photo ::browser::img_parent -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
7 image create photo ::browser::img_rblob -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
8 image create photo ::browser::img_xblob -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
9 image create photo ::browser::img_tree -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
10 image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
11 image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
12
13 field w
14 field browser_commit
15 field browser_path
16 field browser_files {}
17 field browser_status [mc "Starting..."]
18 field browser_stack {}
19 field browser_busy 1
20
21 field ls_buf {}; # Buffered record output from ls-tree
22
23 constructor new {commit {path {}}} {
24 global cursor_ptr M1B
25 make_toplevel top w
26 wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]]
27
28 set browser_commit $commit
29 set browser_path $browser_commit:$path
30
31 label $w.path \
32 -textvariable @browser_path \
33 -anchor w \
34 -justify left \
35 -borderwidth 1 \
36 -relief sunken \
37 -font font_uibold
38 pack $w.path -anchor w -side top -fill x
39
40 frame $w.list
41 set w_list $w.list.l
42 text $w_list -background white -foreground black \
43 -borderwidth 0 \
44 -cursor $cursor_ptr \
45 -state disabled \
46 -wrap none \
47 -height 20 \
48 -width 70 \
49 -xscrollcommand [list $w.list.sbx set] \
50 -yscrollcommand [list $w.list.sby set]
51 rmsel_tag $w_list
52 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
53 scrollbar $w.list.sby -orient v -command [list $w_list yview]
54 pack $w.list.sbx -side bottom -fill x
55 pack $w.list.sby -side right -fill y
56 pack $w_list -side left -fill both -expand 1
57 pack $w.list -side top -fill both -expand 1
58
59 label $w.status \
60 -textvariable @browser_status \
61 -anchor w \
62 -justify left \
63 -borderwidth 1 \
64 -relief sunken
65 pack $w.status -anchor w -side bottom -fill x
66
67 bind $w_list <Button-1> "[cb _click 0 @%x,%y];break"
68 bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
69 bind $w_list <$M1B-Up> "[cb _parent] ;break"
70 bind $w_list <$M1B-Left> "[cb _parent] ;break"
71 bind $w_list <Up> "[cb _move -1] ;break"
72 bind $w_list <Down> "[cb _move 1] ;break"
73 bind $w_list <$M1B-Right> "[cb _enter] ;break"
74 bind $w_list <Return> "[cb _enter] ;break"
75 bind $w_list <Prior> "[cb _page -1] ;break"
76 bind $w_list <Next> "[cb _page 1] ;break"
77 bind $w_list <Left> break
78 bind $w_list <Right> break
79
80 bind $w_list <Visibility> [list focus $w_list]
81 set w $w_list
82 if {$path ne {}} {
83 _ls $this $browser_commit:$path $path
84 } else {
85 _ls $this $browser_commit $path
86 }
87 return $this
88 }
89
90 method _move {dir} {
91 if {$browser_busy} return
92 set lno [lindex [split [$w index in_sel.first] .] 0]
93 incr lno $dir
94 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
95 $w tag remove in_sel 0.0 end
96 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
97 $w see $lno.0
98 }
99 }
100
101 method _page {dir} {
102 if {$browser_busy} return
103 $w yview scroll $dir pages
104 set lno [expr {int(
105 [lindex [$w yview] 0]
106 * [llength $browser_files]
107 + 1)}]
108 if {[lindex $browser_files [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 method _parent {} {
116 if {$browser_busy} return
117 set info [lindex $browser_files 0]
118 if {[lindex $info 0] eq {parent}} {
119 set parent [lindex $browser_stack end-1]
120 set browser_stack [lrange $browser_stack 0 end-2]
121 if {$browser_stack eq {}} {
122 regsub {:.*$} $browser_path {:} browser_path
123 } else {
124 regsub {/[^/]+$} $browser_path {} browser_path
125 }
126 set browser_status [mc "Loading %s..." $browser_path]
127 _ls $this [lindex $parent 0] [lindex $parent 1]
128 }
129 }
130
131 method _enter {} {
132 if {$browser_busy} return
133 set lno [lindex [split [$w index in_sel.first] .] 0]
134 set info [lindex $browser_files [expr {$lno - 1}]]
135 if {$info ne {}} {
136 switch -- [lindex $info 0] {
137 parent {
138 _parent $this
139 }
140 tree {
141 set name [lindex $info 2]
142 set escn [escape_path $name]
143 set browser_status [mc "Loading %s..." $escn]
144 append browser_path $escn
145 _ls $this [lindex $info 1] $name
146 }
147 blob {
148 set name [lindex $info 2]
149 set p {}
150 foreach n $browser_stack {
151 append p [lindex $n 1]
152 }
153 append p $name
154 blame::new $browser_commit $p
155 }
156 }
157 }
158 }
159
160 method _click {was_double_click pos} {
161 if {$browser_busy} return
162 set lno [lindex [split [$w index $pos] .] 0]
163 focus $w
164
165 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
166 $w tag remove in_sel 0.0 end
167 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
168 if {$was_double_click} {
169 _enter $this
170 }
171 }
172 }
173
174 method _ls {tree_id {name {}}} {
175 set ls_buf {}
176 set browser_files {}
177 set browser_busy 1
178
179 $w conf -state normal
180 $w tag remove in_sel 0.0 end
181 $w delete 0.0 end
182 if {$browser_stack ne {}} {
183 $w image create end \
184 -align center -padx 5 -pady 1 \
185 -name icon0 \
186 -image ::browser::img_parent
187 $w insert end [mc "\[Up To Parent\]"]
188 lappend browser_files parent
189 }
190 lappend browser_stack [list $tree_id $name]
191 $w conf -state disabled
192
193 set fd [git_read ls-tree -z $tree_id]
194 fconfigure $fd -blocking 0 -translation binary -encoding binary
195 fileevent $fd readable [cb _read $fd]
196 }
197
198 method _read {fd} {
199 append ls_buf [read $fd]
200 set pck [split $ls_buf "\0"]
201 set ls_buf [lindex $pck end]
202
203 set n [llength $browser_files]
204 $w conf -state normal
205 foreach p [lrange $pck 0 end-1] {
206 set tab [string first "\t" $p]
207 if {$tab == -1} continue
208
209 set info [split [string range $p 0 [expr {$tab - 1}]] { }]
210 set path [string range $p [expr {$tab + 1}] end]
211 set type [lindex $info 1]
212 set object [lindex $info 2]
213
214 switch -- $type {
215 blob {
216 scan [lindex $info 0] %o mode
217 if {$mode == 0120000} {
218 set image ::browser::img_symlink
219 } elseif {($mode & 0100) != 0} {
220 set image ::browser::img_xblob
221 } else {
222 set image ::browser::img_rblob
223 }
224 }
225 tree {
226 set image ::browser::img_tree
227 append path /
228 }
229 default {
230 set image ::browser::img_unknown
231 }
232 }
233
234 if {$n > 0} {$w insert end "\n"}
235 $w image create end \
236 -align center -padx 5 -pady 1 \
237 -name icon[incr n] \
238 -image $image
239 $w insert end [escape_path $path]
240 lappend browser_files [list $type $object $path]
241 }
242 $w conf -state disabled
243
244 if {[eof $fd]} {
245 close $fd
246 set browser_status [mc "Ready."]
247 set browser_busy 0
248 set ls_buf {}
249 if {$n > 0} {
250 $w tag add in_sel 1.0 2.0
251 focus -force $w
252 }
253 }
254 } ifdeleted {
255 catch {close $fd}
256 }
257
258 }
259
260 class browser_open {
261
262 field w ; # widget path
263 field w_rev ; # mega-widget to pick the initial revision
264
265 constructor dialog {} {
266 make_toplevel top w
267 wm title $top [append "[appname] ([reponame]): " [mc "Browse Branch Files"]]
268 if {$top ne {.}} {
269 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
270 }
271
272 label $w.header \
273 -text [mc "Browse Branch Files"] \
274 -font font_uibold
275 pack $w.header -side top -fill x
276
277 frame $w.buttons
278 button $w.buttons.browse -text [mc Browse] \
279 -default active \
280 -command [cb _open]
281 pack $w.buttons.browse -side right
282 button $w.buttons.cancel -text [mc Cancel] \
283 -command [list destroy $w]
284 pack $w.buttons.cancel -side right -padx 5
285 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
286
287 set w_rev [::choose_rev::new $w.rev [mc Revision]]
288 $w_rev bind_listbox <Double-Button-1> [cb _open]
289 pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
290
291 bind $w <Visibility> [cb _visible]
292 bind $w <Key-Escape> [list destroy $w]
293 bind $w <Key-Return> [cb _open]\;break
294 tkwait window $w
295 }
296
297 method _open {} {
298 if {[catch {$w_rev commit_or_die} err]} {
299 return
300 }
301 set name [$w_rev get]
302 destroy $w
303 browser::new $name
304 }
305
306 method _visible {} {
307 grab $w
308 $w_rev focus_filter
309 }
310
311 }