fd86b11217cae2eab380362363cd7f4e8f79296a
1 # git-gui tree browser
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 class browser {
6 field w
7 field browser_commit
8 field browser_path
9 field browser_files {}
10 field browser_status {Starting...}
11 field browser_stack {}
12 field browser_busy 1
14 constructor new {commit} {
15 global cursor_ptr M1B
16 make_toplevel top w
17 wm title $top "[appname] ([reponame]): File Browser"
19 set browser_commit $commit
20 set browser_path $browser_commit:
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
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
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
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
72 bind $w_list <Visibility> [list focus $w_list]
73 bind $w_list <Destroy> [list delete_this $this]
74 set w $w_list
75 _ls $this $browser_commit
76 return $this
77 }
79 method _move {dir} {
80 if {$browser_busy} return
81 set lno [lindex [split [$w index in_sel.first] .] 0]
82 incr lno $dir
83 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
84 $w tag remove in_sel 0.0 end
85 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
86 $w see $lno.0
87 }
88 }
90 method _page {dir} {
91 if {$browser_busy} return
92 $w yview scroll $dir pages
93 set lno [expr {int(
94 [lindex [$w yview] 0]
95 * [llength $browser_files]
96 + 1)}]
97 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
98 $w tag remove in_sel 0.0 end
99 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
100 $w see $lno.0
101 }
102 }
104 method _parent {} {
105 if {$browser_busy} return
106 set info [lindex $browser_files 0]
107 if {[lindex $info 0] eq {parent}} {
108 set parent [lindex $browser_stack end-1]
109 set browser_stack [lrange $browser_stack 0 end-2]
110 if {$browser_stack eq {}} {
111 regsub {:.*$} $browser_path {:} browser_path
112 } else {
113 regsub {/[^/]+$} $browser_path {} browser_path
114 }
115 set browser_status "Loading $browser_path..."
116 _ls $this [lindex $parent 0] [lindex $parent 1]
117 }
118 }
120 method _enter {} {
121 if {$browser_busy} return
122 set lno [lindex [split [$w index in_sel.first] .] 0]
123 set info [lindex $browser_files [expr {$lno - 1}]]
124 if {$info ne {}} {
125 switch -- [lindex $info 0] {
126 parent {
127 _parent $this
128 }
129 tree {
130 set name [lindex $info 2]
131 set escn [escape_path $name]
132 set browser_status "Loading $escn..."
133 append browser_path $escn
134 _ls $this [lindex $info 1] $name
135 }
136 blob {
137 set name [lindex $info 2]
138 set p {}
139 foreach n $browser_stack {
140 append p [lindex $n 1]
141 }
142 append p $name
143 blame::new $browser_commit $p
144 }
145 }
146 }
147 }
149 method _click {was_double_click pos} {
150 if {$browser_busy} return
151 set lno [lindex [split [$w index $pos] .] 0]
152 focus $w
154 if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
155 $w tag remove in_sel 0.0 end
156 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
157 if {$was_double_click} {
158 _enter $this
159 }
160 }
161 }
163 method _ls {tree_id {name {}}} {
164 set browser_buffer {}
165 set browser_files {}
166 set browser_busy 1
168 $w conf -state normal
169 $w tag remove in_sel 0.0 end
170 $w delete 0.0 end
171 if {$browser_stack ne {}} {
172 $w image create end \
173 -align center -padx 5 -pady 1 \
174 -name icon0 \
175 -image file_uplevel
176 $w insert end {[Up To Parent]}
177 lappend browser_files parent
178 }
179 lappend browser_stack [list $tree_id $name]
180 $w conf -state disabled
182 set cmd [list git ls-tree -z $tree_id]
183 set fd [open "| $cmd" r]
184 fconfigure $fd -blocking 0 -translation binary -encoding binary
185 fileevent $fd readable [cb _read $fd]
186 }
188 method _read {fd} {
189 append browser_buffer [read $fd]
190 set pck [split $browser_buffer "\0"]
191 set browser_buffer [lindex $pck end]
193 set n [llength $browser_files]
194 $w conf -state normal
195 foreach p [lrange $pck 0 end-1] {
196 set info [split $p "\t"]
197 set path [lindex $info 1]
198 set info [split [lindex $info 0] { }]
199 set type [lindex $info 1]
200 set object [lindex $info 2]
202 switch -- $type {
203 blob {
204 set image file_mod
205 }
206 tree {
207 set image file_dir
208 append path /
209 }
210 default {
211 set image file_question
212 }
213 }
215 if {$n > 0} {$w insert end "\n"}
216 $w image create end \
217 -align center -padx 5 -pady 1 \
218 -name icon[incr n] \
219 -image $image
220 $w insert end [escape_path $path]
221 lappend browser_files [list $type $object $path]
222 }
223 $w conf -state disabled
225 if {[eof $fd]} {
226 close $fd
227 set browser_status Ready.
228 set browser_busy 0
229 unset browser_buffer
230 if {$n > 0} {
231 $w tag add in_sel 1.0 2.0
232 focus -force $w
233 }
234 }
235 } ifdeleted {
236 catch {close $fd}
237 }
239 }