summaryrefslogtreecommitdiff
path: root/git-gui/lib/browser.tcl
diff options
context:
space:
mode:
authorLibravatar Shawn O. Pearce <spearce@spearce.org>2007-05-07 23:36:31 -0400
committerLibravatar Shawn O. Pearce <spearce@spearce.org>2007-05-07 23:51:00 -0400
commit5f5dbd719d0d8ec136f32a0a56674902bd85f72f (patch)
treef5898a282daf34722256709c7ac2ac7f78f9bbb7 /git-gui/lib/browser.tcl
parentUse GIT_OBJECT_DIR for temporary files of pack-objects (diff)
parentgit-gui: Use vi-like keys in merge dialog (diff)
downloadtgif-5f5dbd719d0d8ec136f32a0a56674902bd85f72f.tar.xz
Merge branch 'master' of git://repo.or.cz/git-gui
* 'master' of git://repo.or.cz/git-gui: git-gui: Use vi-like keys in merge dialog git-gui: Include commit id/subject in merge choices git-gui: Show all possible branches for merge git-gui: Move merge support into a namespace git-gui: Allow vi keys to scroll the diff/blame regions git-gui: Move console procs into their own namespace git-gui: Refactor into multiple files to save my sanity git-gui: Track our own embedded values and rebuild when they change git-gui: Refactor to use our git proc more often git-gui: Use option database defaults to set the font git-gui: Cleanup common font handling for font_ui git-gui: Correct line wrapping for too many branch message git-gui: Warn users before making an octopus merge git-gui: Include the subject in the status bar after commit Also perform an evil merge change to update Git's main Makefile to pass the proper options down into git-gui now that it depends on reasonable values for 'sharedir' and 'TCL_PATH'. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
Diffstat (limited to 'git-gui/lib/browser.tcl')
-rw-r--r--git-gui/lib/browser.tcl263
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 0000000000..631859ae75
--- /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
+ }
+ }
+}