1# git-gui tree browser
2# Copyright (C) 2006, 2007 Shawn Pearce
3
4class browser {
5
6field w
7field browser_commit
8field browser_path
9field browser_files {}
10field browser_status {Starting...}
11field browser_stack {}
12field browser_busy 1
13
14field ls_buf {}; # Buffered record output from ls-tree
15
16constructor new {commit} {
17 global cursor_ptr M1B
18 make_toplevel top w
19 wm title $top "[appname] ([reponame]): File Browser"
20
21 set browser_commit $commit
22 set browser_path $browser_commit:
23
24 label $w.path \
25 -textvariable @browser_path \
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 set w_list $w.list.l
35 text $w_list -background white -borderwidth 0 \
36 -cursor $cursor_ptr \
37 -state disabled \
38 -wrap none \
39 -height 20 \
40 -width 70 \
41 -xscrollcommand [list $w.list.sbx set] \
42 -yscrollcommand [list $w.list.sby set]
43 $w_list tag conf in_sel \
44 -background [$w_list cget -foreground] \
45 -foreground [$w_list cget -background]
46 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
47 scrollbar $w.list.sby -orient v -command [list $w_list yview]
48 pack $w.list.sbx -side bottom -fill x
49 pack $w.list.sby -side right -fill y
50 pack $w_list -side left -fill both -expand 1
51 pack $w.list -side top -fill both -expand 1
52
53 label $w.status \
54 -textvariable @browser_status \
55 -anchor w \
56 -justify left \
57 -borderwidth 1 \
58 -relief sunken
59 pack $w.status -anchor w -side bottom -fill x
60
61 bind $w_list <Button-1> "[cb _click 0 @%x,%y];break"
62 bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
63 bind $w_list <$M1B-Up> "[cb _parent] ;break"
64 bind $w_list <$M1B-Left> "[cb _parent] ;break"
65 bind $w_list <Up> "[cb _move -1] ;break"
66 bind $w_list <Down> "[cb _move 1] ;break"
67 bind $w_list <$M1B-Right> "[cb _enter] ;break"
68 bind $w_list <Return> "[cb _enter] ;break"
69 bind $w_list <Prior> "[cb _page -1] ;break"
70 bind $w_list <Next> "[cb _page 1] ;break"
71 bind $w_list <Left> break
72 bind $w_list <Right> break
73
74 bind $w_list <Visibility> [list focus $w_list]
75 set w $w_list
76 _ls $this $browser_commit
77 return $this
78}
79
80method _move {dir} {
81 if {$browser_busy} return
82 set lno [lindex [split [$w index in_sel.first] .] 0]
83 incr lno $dir
84 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
85 $w tag remove in_sel 0.0 end
86 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
87 $w see $lno.0
88 }
89}
90
91method _page {dir} {
92 if {$browser_busy} return
93 $w yview scroll $dir pages
94 set lno [expr {int(
95 [lindex [$w yview] 0]
96 * [llength $browser_files]
97 + 1)}]
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 _parent {} {
106 if {$browser_busy} return
107 set info [lindex $browser_files 0]
108 if {[lindex $info 0] eq {parent}} {
109 set parent [lindex $browser_stack end-1]
110 set browser_stack [lrange $browser_stack 0 end-2]
111 if {$browser_stack eq {}} {
112 regsub {:.*$} $browser_path {:} browser_path
113 } else {
114 regsub {/[^/]+$} $browser_path {} browser_path
115 }
116 set browser_status "Loading $browser_path..."
117 _ls $this [lindex $parent 0] [lindex $parent 1]
118 }
119}
120
121method _enter {} {
122 if {$browser_busy} return
123 set lno [lindex [split [$w index in_sel.first] .] 0]
124 set info [lindex $browser_files [expr {$lno - 1}]]
125 if {$info ne {}} {
126 switch -- [lindex $info 0] {
127 parent {
128 _parent $this
129 }
130 tree {
131 set name [lindex $info 2]
132 set escn [escape_path $name]
133 set browser_status "Loading $escn..."
134 append browser_path $escn
135 _ls $this [lindex $info 1] $name
136 }
137 blob {
138 set name [lindex $info 2]
139 set p {}
140 foreach n $browser_stack {
141 append p [lindex $n 1]
142 }
143 append p $name
144 blame::new $browser_commit $p
145 }
146 }
147 }
148}
149
150method _click {was_double_click pos} {
151 if {$browser_busy} return
152 set lno [lindex [split [$w index $pos] .] 0]
153 focus $w
154
155 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
156 $w tag remove in_sel 0.0 end
157 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
158 if {$was_double_click} {
159 _enter $this
160 }
161 }
162}
163
164method _ls {tree_id {name {}}} {
165 set ls_buf {}
166 set browser_files {}
167 set browser_busy 1
168
169 $w conf -state normal
170 $w tag remove in_sel 0.0 end
171 $w delete 0.0 end
172 if {$browser_stack ne {}} {
173 $w image create end \
174 -align center -padx 5 -pady 1 \
175 -name icon0 \
176 -image file_uplevel
177 $w insert end {[Up To Parent]}
178 lappend browser_files parent
179 }
180 lappend browser_stack [list $tree_id $name]
181 $w conf -state disabled
182
183 set cmd [list git ls-tree -z $tree_id]
184 set fd [open "| $cmd" r]
185 fconfigure $fd -blocking 0 -translation binary -encoding binary
186 fileevent $fd readable [cb _read $fd]
187}
188
189method _read {fd} {
190 append ls_buf [read $fd]
191 set pck [split $ls_buf "\0"]
192 set ls_buf [lindex $pck end]
193
194 set n [llength $browser_files]
195 $w conf -state normal
196 foreach p [lrange $pck 0 end-1] {
197 set tab [string first "\t" $p]
198 if {$tab == -1} continue
199
200 set info [split [string range $p 0 [expr {$tab - 1}]] { }]
201 set path [string range $p [expr {$tab + 1}] end]
202 set type [lindex $info 1]
203 set object [lindex $info 2]
204
205 switch -- $type {
206 blob {
207 set image file_mod
208 }
209 tree {
210 set image file_dir
211 append path /
212 }
213 default {
214 set image file_question
215 }
216 }
217
218 if {$n > 0} {$w insert end "\n"}
219 $w image create end \
220 -align center -padx 5 -pady 1 \
221 -name icon[incr n] \
222 -image $image
223 $w insert end [escape_path $path]
224 lappend browser_files [list $type $object $path]
225 }
226 $w conf -state disabled
227
228 if {[eof $fd]} {
229 close $fd
230 set browser_status Ready.
231 set browser_busy 0
232 set ls_buf {}
233 if {$n > 0} {
234 $w tag add in_sel 1.0 2.0
235 focus -force $w
236 }
237 }
238} ifdeleted {
239 catch {close $fd}
240}
241
242}