diff options
Diffstat (limited to 'git-gui/lib/browser.tcl')
| -rw-r--r-- | git-gui/lib/browser.tcl | 263 |
1 files changed, 263 insertions, 0 deletions
diff --git a/git-gui/lib/browser.tcl b/git-gui/lib/browser.tcl new file mode 100644 index 0000000..631859a --- /dev/null +++ b/git-gui/lib/browser.tcl @@ -0,0 +1,263 @@ +# git-gui tree browser +# Copyright (C) 2006, 2007 Shawn Pearce + +set next_browser_id 0 + +proc new_browser {commit} { + global next_browser_id cursor_ptr M1B + global browser_commit browser_status browser_stack browser_path browser_busy + + if {[winfo ismapped .]} { + set w .browser[incr next_browser_id] + set tl $w + toplevel $w + } else { + set w {} + set tl . + } + set w_list $w.list.l + set browser_commit($w_list) $commit + set browser_status($w_list) {Starting...} + set browser_stack($w_list) {} + set browser_path($w_list) $browser_commit($w_list): + set browser_busy($w_list) 1 + + label $w.path -textvariable browser_path($w_list) \ + -anchor w \ + -justify left \ + -borderwidth 1 \ + -relief sunken \ + -font font_uibold + pack $w.path -anchor w -side top -fill x + + frame $w.list + text $w_list -background white -borderwidth 0 \ + -cursor $cursor_ptr \ + -state disabled \ + -wrap none \ + -height 20 \ + -width 70 \ + -xscrollcommand [list $w.list.sbx set] \ + -yscrollcommand [list $w.list.sby set] + $w_list tag conf in_sel \ + -background [$w_list cget -foreground] \ + -foreground [$w_list cget -background] + scrollbar $w.list.sbx -orient h -command [list $w_list xview] + scrollbar $w.list.sby -orient v -command [list $w_list yview] + pack $w.list.sbx -side bottom -fill x + pack $w.list.sby -side right -fill y + pack $w_list -side left -fill both -expand 1 + pack $w.list -side top -fill both -expand 1 + + label $w.status -textvariable browser_status($w_list) \ + -anchor w \ + -justify left \ + -borderwidth 1 \ + -relief sunken + pack $w.status -anchor w -side bottom -fill x + + bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break" + bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break" + bind $w_list <$M1B-Up> "browser_parent $w_list;break" + bind $w_list <$M1B-Left> "browser_parent $w_list;break" + bind $w_list <Up> "browser_move -1 $w_list;break" + bind $w_list <Down> "browser_move 1 $w_list;break" + bind $w_list <$M1B-Right> "browser_enter $w_list;break" + bind $w_list <Return> "browser_enter $w_list;break" + bind $w_list <Prior> "browser_page -1 $w_list;break" + bind $w_list <Next> "browser_page 1 $w_list;break" + bind $w_list <Left> break + bind $w_list <Right> break + + bind $tl <Visibility> "focus $w" + bind $tl <Destroy> " + array unset browser_buffer $w_list + array unset browser_files $w_list + array unset browser_status $w_list + array unset browser_stack $w_list + array unset browser_path $w_list + array unset browser_commit $w_list + array unset browser_busy $w_list + " + wm title $tl "[appname] ([reponame]): File Browser" + ls_tree $w_list $browser_commit($w_list) {} +} + +proc browser_move {dir w} { + global browser_files browser_busy + + if {$browser_busy($w)} return + set lno [lindex [split [$w index in_sel.first] .] 0] + incr lno $dir + if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} { + $w tag remove in_sel 0.0 end + $w tag add in_sel $lno.0 [expr {$lno + 1}].0 + $w see $lno.0 + } +} + +proc browser_page {dir w} { + global browser_files browser_busy + + if {$browser_busy($w)} return + $w yview scroll $dir pages + set lno [expr {int( + [lindex [$w yview] 0] + * [llength $browser_files($w)] + + 1)}] + if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} { + $w tag remove in_sel 0.0 end + $w tag add in_sel $lno.0 [expr {$lno + 1}].0 + $w see $lno.0 + } +} + +proc browser_parent {w} { + global browser_files browser_status browser_path + global browser_stack browser_busy + + if {$browser_busy($w)} return + set info [lindex $browser_files($w) 0] + if {[lindex $info 0] eq {parent}} { + set parent [lindex $browser_stack($w) end-1] + set browser_stack($w) [lrange $browser_stack($w) 0 end-2] + if {$browser_stack($w) eq {}} { + regsub {:.*$} $browser_path($w) {:} browser_path($w) + } else { + regsub {/[^/]+$} $browser_path($w) {} browser_path($w) + } + set browser_status($w) "Loading $browser_path($w)..." + ls_tree $w [lindex $parent 0] [lindex $parent 1] + } +} + +proc browser_enter {w} { + global browser_files browser_status browser_path + global browser_commit browser_stack browser_busy + + if {$browser_busy($w)} return + set lno [lindex [split [$w index in_sel.first] .] 0] + set info [lindex $browser_files($w) [expr {$lno - 1}]] + if {$info ne {}} { + switch -- [lindex $info 0] { + parent { + browser_parent $w + } + tree { + set name [lindex $info 2] + set escn [escape_path $name] + set browser_status($w) "Loading $escn..." + append browser_path($w) $escn + ls_tree $w [lindex $info 1] $name + } + blob { + set name [lindex $info 2] + set p {} + foreach n $browser_stack($w) { + append p [lindex $n 1] + } + append p $name + show_blame $browser_commit($w) $p + } + } + } +} + +proc browser_click {was_double_click w pos} { + global browser_files browser_busy + + if {$browser_busy($w)} return + set lno [lindex [split [$w index $pos] .] 0] + focus $w + + if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} { + $w tag remove in_sel 0.0 end + $w tag add in_sel $lno.0 [expr {$lno + 1}].0 + if {$was_double_click} { + browser_enter $w + } + } +} + +proc ls_tree {w tree_id name} { + global browser_buffer browser_files browser_stack browser_busy + + set browser_buffer($w) {} + set browser_files($w) {} + set browser_busy($w) 1 + + $w conf -state normal + $w tag remove in_sel 0.0 end + $w delete 0.0 end + if {$browser_stack($w) ne {}} { + $w image create end \ + -align center -padx 5 -pady 1 \ + -name icon0 \ + -image file_uplevel + $w insert end {[Up To Parent]} + lappend browser_files($w) parent + } + lappend browser_stack($w) [list $tree_id $name] + $w conf -state disabled + + set cmd [list git ls-tree -z $tree_id] + set fd [open "| $cmd" r] + fconfigure $fd -blocking 0 -translation binary -encoding binary + fileevent $fd readable [list read_ls_tree $fd $w] +} + +proc read_ls_tree {fd w} { + global browser_buffer browser_files browser_status browser_busy + + if {![winfo exists $w]} { + catch {close $fd} + return + } + + append browser_buffer($w) [read $fd] + set pck [split $browser_buffer($w) "\0"] + set browser_buffer($w) [lindex $pck end] + + set n [llength $browser_files($w)] + $w conf -state normal + foreach p [lrange $pck 0 end-1] { + set info [split $p "\t"] + set path [lindex $info 1] + set info [split [lindex $info 0] { }] + set type [lindex $info 1] + set object [lindex $info 2] + + switch -- $type { + blob { + set image file_mod + } + tree { + set image file_dir + append path / + } + default { + set image file_question + } + } + + if {$n > 0} {$w insert end "\n"} + $w image create end \ + -align center -padx 5 -pady 1 \ + -name icon[incr n] \ + -image $image + $w insert end [escape_path $path] + lappend browser_files($w) [list $type $object $path] + } + $w conf -state disabled + + if {[eof $fd]} { + close $fd + set browser_status($w) Ready. + set browser_busy($w) 0 + array unset browser_buffer $w + if {$n > 0} { + $w tag add in_sel 1.0 2.0 + focus -force $w + } + } +} |