# git-gui tree browser
# Copyright (C) 2006, 2007 Shawn Pearce
-set next_browser_id 0
+class browser {
-proc new_browser {commit} {
- global next_browser_id cursor_ptr M1B
- global browser_commit browser_status browser_stack browser_path browser_busy
+image create photo ::browser::img_parent -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_rblob -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_xblob -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_tree -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
+image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
+image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
- 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
+field w
+field browser_commit
+field browser_path
+field browser_files {}
+field browser_status {Starting...}
+field browser_stack {}
+field browser_busy 1
+
+field ls_buf {}; # Buffered record output from ls-tree
+
+constructor new {commit {path {}}} {
+ global cursor_ptr M1B
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): File Browser"
+
+ set browser_commit $commit
+ set browser_path $browser_commit:$path
- label $w.path -textvariable browser_path($w_list) \
+ label $w.path \
+ -textvariable @browser_path \
-anchor w \
-justify left \
-borderwidth 1 \
pack $w.path -anchor w -side top -fill x
frame $w.list
+ set w_list $w.list.l
text $w_list -background white -borderwidth 0 \
-cursor $cursor_ptr \
-state disabled \
-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]
+ rmsel_tag $w_list
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 -side left -fill both -expand 1
pack $w.list -side top -fill both -expand 1
- label $w.status -textvariable browser_status($w_list) \
+ label $w.status \
+ -textvariable @browser_status \
-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 <Button-1> "[cb _click 0 @%x,%y];break"
+ bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
+ bind $w_list <$M1B-Up> "[cb _parent] ;break"
+ bind $w_list <$M1B-Left> "[cb _parent] ;break"
+ bind $w_list <Up> "[cb _move -1] ;break"
+ bind $w_list <Down> "[cb _move 1] ;break"
+ bind $w_list <$M1B-Right> "[cb _enter] ;break"
+ bind $w_list <Return> "[cb _enter] ;break"
+ bind $w_list <Prior> "[cb _page -1] ;break"
+ bind $w_list <Next> "[cb _page 1] ;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) {}
+ bind $w_list <Visibility> [list focus $w_list]
+ set w $w_list
+ if {$path ne {}} {
+ _ls $this $browser_commit:$path $path
+ } else {
+ _ls $this $browser_commit $path
+ }
+ return $this
}
-proc browser_move {dir w} {
- global browser_files browser_busy
-
- if {$browser_busy($w)} return
+method _move {dir} {
+ if {$browser_busy} return
set lno [lindex [split [$w index in_sel.first] .] 0]
incr lno $dir
- if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+ if {[lindex $browser_files [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
+method _page {dir} {
+ if {$browser_busy} return
$w yview scroll $dir pages
set lno [expr {int(
[lindex [$w yview] 0]
- * [llength $browser_files($w)]
+ * [llength $browser_files]
+ 1)}]
- if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+ if {[lindex $browser_files [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]
+method _parent {} {
+ if {$browser_busy} return
+ set info [lindex $browser_files 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)
+ set parent [lindex $browser_stack end-1]
+ set browser_stack [lrange $browser_stack 0 end-2]
+ if {$browser_stack eq {}} {
+ regsub {:.*$} $browser_path {:} browser_path
} else {
- regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
+ regsub {/[^/]+$} $browser_path {} browser_path
}
- set browser_status($w) "Loading $browser_path($w)..."
- ls_tree $w [lindex $parent 0] [lindex $parent 1]
+ set browser_status "Loading $browser_path..."
+ _ls $this [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
+method _enter {} {
+ if {$browser_busy} return
set lno [lindex [split [$w index in_sel.first] .] 0]
- set info [lindex $browser_files($w) [expr {$lno - 1}]]
+ set info [lindex $browser_files [expr {$lno - 1}]]
if {$info ne {}} {
switch -- [lindex $info 0] {
parent {
- browser_parent $w
+ _parent $this
}
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
+ set browser_status "Loading $escn..."
+ append browser_path $escn
+ _ls $this [lindex $info 1] $name
}
blob {
set name [lindex $info 2]
set p {}
- foreach n $browser_stack($w) {
+ foreach n $browser_stack {
append p [lindex $n 1]
}
append p $name
- show_blame $browser_commit($w) $p
+ blame::new $browser_commit $p
}
}
}
}
-proc browser_click {was_double_click w pos} {
- global browser_files browser_busy
-
- if {$browser_busy($w)} return
+method _click {was_double_click pos} {
+ if {$browser_busy} return
set lno [lindex [split [$w index $pos] .] 0]
focus $w
- if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+ if {[lindex $browser_files [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
+ _enter $this
}
}
}
-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
+method _ls {tree_id {name {}}} {
+ set ls_buf {}
+ set browser_files {}
+ set browser_busy 1
$w conf -state normal
$w tag remove in_sel 0.0 end
$w delete 0.0 end
- if {$browser_stack($w) ne {}} {
+ if {$browser_stack ne {}} {
$w image create end \
-align center -padx 5 -pady 1 \
-name icon0 \
- -image file_uplevel
+ -image ::browser::img_parent
$w insert end {[Up To Parent]}
- lappend browser_files($w) parent
+ lappend browser_files parent
}
- lappend browser_stack($w) [list $tree_id $name]
+ lappend browser_stack [list $tree_id $name]
$w conf -state disabled
- set cmd [list git ls-tree -z $tree_id]
- set fd [open "| $cmd" r]
+ set fd [git_read ls-tree -z $tree_id]
fconfigure $fd -blocking 0 -translation binary -encoding binary
- fileevent $fd readable [list read_ls_tree $fd $w]
+ fileevent $fd readable [cb _read $fd]
}
-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]
+method _read {fd} {
+ append ls_buf [read $fd]
+ set pck [split $ls_buf "\0"]
+ set ls_buf [lindex $pck end]
- set n [llength $browser_files($w)]
+ set n [llength $browser_files]
$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 tab [string first "\t" $p]
+ if {$tab == -1} continue
+
+ set info [split [string range $p 0 [expr {$tab - 1}]] { }]
+ set path [string range $p [expr {$tab + 1}] end]
+ set type [lindex $info 1]
set object [lindex $info 2]
switch -- $type {
blob {
- set image file_mod
+ scan [lindex $info 0] %o mode
+ if {$mode == 0120000} {
+ set image ::browser::img_symlink
+ } elseif {($mode & 0100) != 0} {
+ set image ::browser::img_xblob
+ } else {
+ set image ::browser::img_rblob
+ }
}
tree {
- set image file_dir
+ set image ::browser::img_tree
append path /
}
default {
- set image file_question
+ set image ::browser::img_unknown
}
}
-name icon[incr n] \
-image $image
$w insert end [escape_path $path]
- lappend browser_files($w) [list $type $object $path]
+ lappend browser_files [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
+ set browser_status Ready.
+ set browser_busy 0
+ set ls_buf {}
if {$n > 0} {
$w tag add in_sel 1.0 2.0
focus -force $w
}
}
+} ifdeleted {
+ catch {close $fd}
+}
+
+}
+
+class browser_open {
+
+field w ; # widget path
+field w_rev ; # mega-widget to pick the initial revision
+
+constructor dialog {} {
+ make_toplevel top w
+ wm title $top "[appname] ([reponame]): Browse Branch Files"
+ if {$top ne {.}} {
+ wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
+ }
+
+ label $w.header \
+ -text {Browse Branch Files} \
+ -font font_uibold
+ pack $w.header -side top -fill x
+
+ frame $w.buttons
+ button $w.buttons.browse -text Browse \
+ -default active \
+ -command [cb _open]
+ pack $w.buttons.browse -side right
+ button $w.buttons.cancel -text {Cancel} \
+ -command [list destroy $w]
+ pack $w.buttons.cancel -side right -padx 5
+ pack $w.buttons -side bottom -fill x -pady 10 -padx 10
+
+ set w_rev [::choose_rev::new $w.rev {Revision}]
+ $w_rev bind_listbox <Double-Button-1> [cb _open]
+ pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
+
+ bind $w <Visibility> [cb _visible]
+ bind $w <Key-Escape> [list destroy $w]
+ bind $w <Key-Return> [cb _open]\;break
+ tkwait window $w
+}
+
+method _open {} {
+ if {[catch {$w_rev commit_or_die} err]} {
+ return
+ }
+ set name [$w_rev get]
+ destroy $w
+ browser::new $name
+}
+
+method _visible {} {
+ grab $w
+ $w_rev focus_filter
+}
+
}