Andrew's git - gitweb.git/blob

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