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