git-gui/lib/browser.tcl

   1 # git-gui tree browser
   2 # Copyright (C) 2006, 2007 Shawn Pearce
   3
   4 class browser {
   5
   6 image create photo ::browser::img_parent  -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
   7 image create photo ::browser::img_rblob   -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
   8 image create photo ::browser::img_xblob   -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
   9 image create photo ::browser::img_tree    -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}
  10 image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
  11 image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
  12
  13 field w
  14 field browser_commit
  15 field browser_path
  16 field browser_files  {}
  17 field browser_status [mc "Starting..."]
  18 field browser_stack  {}
  19 field browser_busy   1
  20
  21 field ls_buf     {}; # Buffered record output from ls-tree
  22
  23 constructor new {commit {path {}}} {
  24         global cursor_ptr M1B use_ttk NS
  25         make_dialog top w
  26         wm withdraw $top
  27         wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]]
  28
  29         if {$path ne {}} {
  30                 if {[string index $path end] ne {/}} {
  31                         append path /
  32                 }
  33         }
  34
  35         set browser_commit $commit
  36         set browser_path "$browser_commit:[escape_path $path]"
  37
  38         ${NS}::label $w.path \
  39                 -textvariable @browser_path \
  40                 -anchor w \
  41                 -justify left \
  42                 -font font_uibold
  43         if {!$use_ttk} { $w.path configure -borderwidth 1 -relief sunken}
  44         pack $w.path -anchor w -side top -fill x
  45
  46         ${NS}::frame $w.list
  47         set w_list $w.list.l
  48         text $w_list -background white -foreground black \
  49                 -borderwidth 0 \
  50                 -cursor $cursor_ptr \
  51                 -state disabled \
  52                 -wrap none \
  53                 -height 20 \
  54                 -width 70 \
  55                 -xscrollcommand [list $w.list.sbx set] \
  56                 -yscrollcommand [list $w.list.sby set]
  57         rmsel_tag $w_list
  58         ${NS}::scrollbar $w.list.sbx -orient h -command [list $w_list xview]
  59         ${NS}::scrollbar $w.list.sby -orient v -command [list $w_list yview]
  60         pack $w.list.sbx -side bottom -fill x
  61         pack $w.list.sby -side right -fill y
  62         pack $w_list -side left -fill both -expand 1
  63         pack $w.list -side top -fill both -expand 1
  64
  65         ${NS}::label $w.status \
  66                 -textvariable @browser_status \
  67                 -anchor w \
  68                 -justify left
  69         if {!$use_ttk} { $w.status configure -borderwidth 1 -relief sunken}
  70         pack $w.status -anchor w -side bottom -fill x
  71
  72         bind $w_list <Button-1>        "[cb _click 0 @%x,%y];break"
  73         bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
  74         bind $w_list <$M1B-Up>         "[cb _parent]        ;break"
  75         bind $w_list <$M1B-Left>       "[cb _parent]        ;break"
  76         bind $w_list <Up>              "[cb _move -1]       ;break"
  77         bind $w_list <Down>            "[cb _move  1]       ;break"
  78         bind $w_list <$M1B-Right>      "[cb _enter]         ;break"
  79         bind $w_list <Return>          "[cb _enter]         ;break"
  80         bind $w_list <Prior>           "[cb _page -1]       ;break"
  81         bind $w_list <Next>            "[cb _page  1]       ;break"
  82         bind $w_list <Left>            break
  83         bind $w_list <Right>           break
  84
  85         bind $w_list <Visibility> [list focus $w_list]
  86         wm deiconify $top
  87         set w $w_list
  88         if {$path ne {}} {
  89                 _ls $this $browser_commit:$path $path
  90         } else {
  91                 _ls $this $browser_commit $path
  92         }
  93         return $this
  94 }
  95
  96 method _move {dir} {
  97         if {$browser_busy} return
  98         set lno [lindex [split [$w index in_sel.first] .] 0]
  99         incr lno $dir
 100         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 101                 $w tag remove in_sel 0.0 end
 102                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 103                 $w see $lno.0
 104         }
 105 }
 106
 107 method _page {dir} {
 108         if {$browser_busy} return
 109         $w yview scroll $dir pages
 110         set lno [expr {int(
 111                   [lindex [$w yview] 0]
 112                 * [llength $browser_files]
 113                 + 1)}]
 114         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 115                 $w tag remove in_sel 0.0 end
 116                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 117                 $w see $lno.0
 118         }
 119 }
 120
 121 method _parent {} {
 122         if {$browser_busy} return
 123         set info [lindex $browser_files 0]
 124         if {[lindex $info 0] eq {parent}} {
 125                 set parent [lindex $browser_stack end-1]
 126                 set browser_stack [lrange $browser_stack 0 end-2]
 127                 if {$browser_stack eq {}} {
 128                         regsub {:.*$} $browser_path {:} browser_path
 129                 } else {
 130                         regsub {/[^/]+/$} $browser_path {/} browser_path
 131                 }
 132                 set browser_status [mc "Loading %s..." $browser_path]
 133                 _ls $this [lindex $parent 0] [lindex $parent 1]
 134         }
 135 }
 136
 137 method _enter {} {
 138         if {$browser_busy} return
 139         set lno [lindex [split [$w index in_sel.first] .] 0]
 140         set info [lindex $browser_files [expr {$lno - 1}]]
 141         if {$info ne {}} {
 142                 switch -- [lindex $info 0] {
 143                 parent {
 144                         _parent $this
 145                 }
 146                 tree {
 147                         set name [lindex $info 2]
 148                         set escn [escape_path $name]
 149                         set browser_status [mc "Loading %s..." $escn]
 150                         append browser_path $escn
 151                         _ls $this [lindex $info 1] $name
 152                 }
 153                 blob {
 154                         set name [lindex $info 2]
 155                         set p {}
 156                         foreach n $browser_stack {
 157                                 append p [lindex $n 1]
 158                         }
 159                         append p $name
 160                         blame::new $browser_commit $p {}
 161                 }
 162                 }
 163         }
 164 }
 165
 166 method _click {was_double_click pos} {
 167         if {$browser_busy} return
 168         set lno [lindex [split [$w index $pos] .] 0]
 169         focus $w
 170
 171         if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 172                 $w tag remove in_sel 0.0 end
 173                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
 174                 if {$was_double_click} {
 175                         _enter $this
 176                 }
 177         }
 178 }
 179
 180 method _ls {tree_id {name {}}} {
 181         set ls_buf {}
 182         set browser_files {}
 183         set browser_busy 1
 184
 185         $w conf -state normal
 186         $w tag remove in_sel 0.0 end
 187         $w delete 0.0 end
 188         if {$browser_stack ne {}} {
 189                 $w image create end \
 190                         -align center -padx 5 -pady 1 \
 191                         -name icon0 \
 192                         -image ::browser::img_parent
 193                 $w insert end [mc "\[Up To Parent\]"]
 194                 lappend browser_files parent
 195         }
 196         lappend browser_stack [list $tree_id $name]
 197         $w conf -state disabled
 198
 199         set fd [git_read ls-tree -z $tree_id]
 200         fconfigure $fd -blocking 0 -translation binary -encoding binary
 201         fileevent $fd readable [cb _read $fd]
 202 }
 203
 204 method _read {fd} {
 205         append ls_buf [read $fd]
 206         set pck [split $ls_buf "\0"]
 207         set ls_buf [lindex $pck end]
 208
 209         set n [llength $browser_files]
 210         $w conf -state normal
 211         foreach p [lrange $pck 0 end-1] {
 212                 set tab [string first "\t" $p]
 213                 if {$tab == -1} continue
 214
 215                 set info [split [string range $p 0 [expr {$tab - 1}]] { }]
 216                 set path [string range $p [expr {$tab + 1}] end]
 217                 set type   [lindex $info 1]
 218                 set object [lindex $info 2]
 219
 220                 switch -- $type {
 221                 blob {
 222                         scan [lindex $info 0] %o mode
 223                         if {$mode == 0120000} {
 224                                 set image ::browser::img_symlink
 225                         } elseif {($mode & 0100) != 0} {
 226                                 set image ::browser::img_xblob
 227                         } else {
 228                                 set image ::browser::img_rblob
 229                         }
 230                 }
 231                 tree {
 232                         set image ::browser::img_tree
 233                         append path /
 234                 }
 235                 default {
 236                         set image ::browser::img_unknown
 237                 }
 238                 }
 239
 240                 if {$n > 0} {$w insert end "\n"}
 241                 $w image create end \
 242                         -align center -padx 5 -pady 1 \
 243                         -name icon[incr n] \
 244                         -image $image
 245                 $w insert end [escape_path $path]
 246                 lappend browser_files [list $type $object $path]
 247         }
 248         $w conf -state disabled
 249
 250         if {[eof $fd]} {
 251                 close $fd
 252                 set browser_status [mc "Ready."]
 253                 set browser_busy 0
 254                 set ls_buf {}
 255                 if {$n > 0} {
 256                         $w tag add in_sel 1.0 2.0
 257                         focus -force $w
 258                 }
 259         }
 260 } ifdeleted {
 261         catch {close $fd}
 262 }
 263
 264 }
 265
 266 class browser_open {
 267
 268 field w              ; # widget path
 269 field w_rev          ; # mega-widget to pick the initial revision
 270
 271 constructor dialog {} {
 272         global use_ttk NS
 273         make_dialog top w
 274         wm withdraw $top
 275         wm title $top [append "[appname] ([reponame]): " [mc "Browse Branch Files"]]
 276         if {$top ne {.}} {
 277                 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
 278                 wm transient $top .
 279         }
 280
 281         ${NS}::label $w.header \
 282                 -text [mc "Browse Branch Files"] \
 283                 -font font_uibold \
 284                 -anchor center
 285         pack $w.header -side top -fill x
 286
 287         ${NS}::frame $w.buttons
 288         ${NS}::button $w.buttons.browse -text [mc Browse] \
 289                 -default active \
 290                 -command [cb _open]
 291         pack $w.buttons.browse -side right
 292         ${NS}::button $w.buttons.cancel -text [mc Cancel] \
 293                 -command [list destroy $w]
 294         pack $w.buttons.cancel -side right -padx 5
 295         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
 296
 297         set w_rev [::choose_rev::new $w.rev [mc Revision]]
 298         $w_rev bind_listbox <Double-Button-1> [cb _open]
 299         pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
 300
 301         bind $w <Visibility> [cb _visible]
 302         bind $w <Key-Escape> [list destroy $w]
 303         bind $w <Key-Return> [cb _open]\;break
 304         wm deiconify $top
 305         tkwait window $w
 306 }
 307
 308 method _open {} {
 309         if {[catch {$w_rev commit_or_die} err]} {
 310                 return
 311         }
 312         set name [$w_rev get]
 313         destroy $w
 314         browser::new $name
 315 }
 316
 317 method _visible {} {
 318         grab $w
 319         $w_rev focus_filter
 320 }
 321
 322 }