Merge branch 'maint'
[git] / lib / browser.tcl
1 # git-gui tree browser
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 class browser {
5
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
13
14 constructor 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
78 method _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
89 method _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
103 method _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
119 method _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
148 method _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
162 method _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
187 method _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 }