git-gui: Convert merge dialog to use class system
[gitweb.git] / lib / browser.tcl
index 631859ae7521d359c23e8e0b5d2a92b4bfe32bc1..b684c671489ed4dfcf93bbb11407b4db5ddec079 100644 (file)
@@ -1,28 +1,28 @@
 # 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
+field w
+field browser_commit
+field browser_path
+field browser_files  {}
+field browser_status {Starting...}
+field browser_stack  {}
+field browser_busy   1
 
-       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 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 \
@@ -31,6 +31,7 @@ proc new_browser {commit} {
        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 \
@@ -49,182 +50,159 @@ proc new_browser {commit} {
        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
                $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 {
@@ -246,18 +224,75 @@ proc read_ls_tree {fd w} {
                        -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
+}
+
 }