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