# 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 "browser_click 0 $w_list @%x,%y;break" bind $w_list "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 "browser_move -1 $w_list;break" bind $w_list "browser_move 1 $w_list;break" bind $w_list <$M1B-Right> "browser_enter $w_list;break" bind $w_list "browser_enter $w_list;break" bind $w_list "browser_page -1 $w_list;break" bind $w_list "browser_page 1 $w_list;break" bind $w_list break bind $w_list break bind $tl "focus $w" bind $tl " 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 } } }