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