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