diff options
| -rwxr-xr-x | GIT-VERSION-GEN | 2 | ||||
| -rwxr-xr-x | git-gui.sh | 122 | ||||
| -rw-r--r-- | lib/branch_rename.tcl | 137 | ||||
| -rw-r--r-- | lib/option.tcl | 17 | ||||
| -rw-r--r-- | lib/remote.tcl | 11 | ||||
| -rw-r--r-- | lib/remote_branch_delete.tcl | 348 | ||||
| -rw-r--r-- | lib/transport.tcl | 16 |
7 files changed, 601 insertions, 52 deletions
diff --git a/GIT-VERSION-GEN b/GIT-VERSION-GEN index 25647c8060..638de99e9e 100755 --- a/GIT-VERSION-GEN +++ b/GIT-VERSION-GEN @@ -1,7 +1,7 @@ #!/bin/sh GVF=GIT-VERSION-FILE -DEF_VER=0.7.GITGUI +DEF_VER=0.8.GITGUI LF=' ' diff --git a/git-gui.sh b/git-gui.sh index 6a5e2dc160..c76622e4e9 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -38,6 +38,24 @@ if {[catch {package require Tcl 8.4} err] ###################################################################### ## +## enable verbose loading? + +if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} { + unset _verbose + rename auto_load real__auto_load + proc auto_load {name args} { + puts stderr "auto_load $name" + return [uplevel 1 real__auto_load $name $args] + } + rename source real__source + proc source {name} { + puts stderr "source $name" + uplevel 1 real__source $name + } +} + +###################################################################### +## ## configure our library set oguilib {@@GITGUI_LIBDIR@@} @@ -48,26 +66,33 @@ if {$oguirel eq {1}} { } elseif {[string match @@* $oguirel]} { set oguilib [file join [file dirname [file normalize $argv0]] lib] } + set idx [file join $oguilib tclIndex] -catch { - set fd [open $idx r] - if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} { - set idx [list] - while {[gets $fd n] >= 0} { - if {$n ne {} && ![string match #* $n]} { - lappend idx $n - } +if {[catch {set fd [open $idx r]} err]} { + catch {wm withdraw .} + tk_messageBox \ + -icon error \ + -type ok \ + -title "git-gui: fatal error" \ + -message $err + exit 1 +} +if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} { + set idx [list] + while {[gets $fd n] >= 0} { + if {$n ne {} && ![string match #* $n]} { + lappend idx $n } - } else { - set idx {} } - close $fd +} else { + set idx {} } +close $fd + if {$idx ne {}} { set loaded [list] foreach p $idx { if {[lsearch -exact $loaded $p] >= 0} continue - puts $p source [file join $oguilib $p] lappend loaded $p } @@ -75,21 +100,7 @@ if {$idx ne {}} { } else { set auto_path [concat [list $oguilib] $auto_path] } -unset -nocomplain oguilib oguirel idx fd - -if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} { - unset _verbose - rename auto_load real__auto_load - proc auto_load {name args} { - puts stderr "auto_load $name" - return [uplevel 1 real__auto_load $name $args] - } - rename source real__source - proc source {name} { - puts stderr "source $name" - uplevel 1 real__source $name - } -} +unset -nocomplain oguirel idx fd ###################################################################### ## @@ -205,6 +216,15 @@ proc is_config_true {name} { } } +proc get_config {name} { + global repo_config + if {[catch {set v $repo_config($name)}]} { + return {} + } else { + return $v + } +} + proc load_config {include_global} { global repo_config global_config default_config @@ -258,6 +278,17 @@ proc git {args} { return [eval exec git $args] } +proc current-branch {} { + set ref {} + set fd [open [gitdir HEAD] r] + if {[gets $fd ref] <16 + || ![regsub {^ref: refs/heads/} $ref {} ref]} { + set ref {} + } + close $fd + return $ref +} + auto_load tk_optionMenu rename tk_optionMenu real__tkOptionMenu proc tk_optionMenu {w varName args} { @@ -406,15 +437,7 @@ proc repository_state {ctvar hdvar mhvar} { set mh [list] - if {[catch {set current_branch [git symbolic-ref HEAD]}]} { - set current_branch {} - } else { - regsub ^refs/((heads|tags|remotes)/)? \ - $current_branch \ - {} \ - current_branch - } - + set current_branch [current-branch] if {[catch {set hd [git rev-parse --verify HEAD]}]} { set hd {} set ct initial @@ -1226,6 +1249,10 @@ foreach class {Button Checkbutton Entry Label } unset class +if {[is_Windows] || [is_MacOSX]} { + option add *Menu.tearOff 0 +} + if {[is_MacOSX]} { set M1B M1 set M1T Cmd @@ -1254,11 +1281,13 @@ proc apply_config {} { } } +set default_config(merge.diffstat) true set default_config(merge.summary) false set default_config(merge.verbosity) 2 set default_config(user.name) {} set default_config(user.email) {} +set default_config(gui.pruneduringfetch) false set default_config(gui.trustmtime) false set default_config(gui.diffcontext) 5 set default_config(gui.newbranchtemplate) {} @@ -1420,6 +1449,11 @@ if {[is_enabled branch]} { lappend disable_on_lock [list .mbar.branch entryconf \ [.mbar.branch index last] -state] + .mbar.branch add command -label {Rename...} \ + -command branch_rename::dialog + lappend disable_on_lock [list .mbar.branch entryconf \ + [.mbar.branch index last] -state] + .mbar.branch add command -label {Delete...} \ -command do_delete_branch lappend disable_on_lock [list .mbar.branch entryconf \ @@ -1517,6 +1551,8 @@ if {[is_enabled transport]} { menu .mbar.push .mbar.push add command -label {Push...} \ -command do_push_anywhere + .mbar.push add command -label {Delete...} \ + -command remote_branch_delete::dialog } if {[is_MacOSX]} { @@ -1634,14 +1670,8 @@ switch -- $subcommand { browser { set subcommand_args {rev?} switch [llength $argv] { - 0 { - set current_branch [git symbolic-ref HEAD] - regsub ^refs/((heads|tags|remotes)/)? \ - $current_branch {} current_branch - } - 1 { - set current_branch [lindex $argv 0] - } + 0 { set current_branch [current-branch] } + 1 { set current_branch [lindex $argv 0] } default usage } browser::new $current_branch @@ -1674,9 +1704,7 @@ blame { unset is_path if {$head eq {}} { - set current_branch [git symbolic-ref HEAD] - regsub ^refs/((heads|tags|remotes)/)? \ - $current_branch {} current_branch + set current_branch [current-branch] } else { set current_branch $head } diff --git a/lib/branch_rename.tcl b/lib/branch_rename.tcl new file mode 100644 index 0000000000..54c72b980c --- /dev/null +++ b/lib/branch_rename.tcl @@ -0,0 +1,137 @@ +# git-gui branch rename support +# Copyright (C) 2007 Shawn Pearce + +class branch_rename { + +field w +field oldname +field newname + +constructor dialog {} { + global all_heads current_branch + + make_toplevel top w + wm title $top "[appname] ([reponame]): Rename Branch" + if {$top ne {.}} { + wm geometry $top "+[winfo rootx .]+[winfo rooty .]" + } + + set oldname $current_branch + set newname [get_config gui.newbranchtemplate] + + label $w.header -text {Rename Branch} -font font_uibold + pack $w.header -side top -fill x + + frame $w.buttons + button $w.buttons.rename -text Rename \ + -default active \ + -command [cb _rename] + pack $w.buttons.rename -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 + + frame $w.rename + label $w.rename.oldname_l -text {Branch:} + eval tk_optionMenu $w.rename.oldname_m @oldname $all_heads + + label $w.rename.newname_l -text {New Name:} + entry $w.rename.newname_t \ + -borderwidth 1 \ + -relief sunken \ + -width 40 \ + -textvariable @newname \ + -validate key \ + -validatecommand { + if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0} + return 1 + } + + grid $w.rename.oldname_l $w.rename.oldname_m -sticky w -padx {0 5} + grid $w.rename.newname_l $w.rename.newname_t -sticky we -padx {0 5} + grid columnconfigure $w.rename 1 -weight 1 + pack $w.rename -anchor nw -fill x -pady 5 -padx 5 + + bind $w <Key-Return> [cb _rename] + bind $w <Key-Escape> [list destroy $w] + bind $w <Visibility> " + grab $w + $w.rename.newname_t icursor end + focus $w.rename.newname_t + " + bind $w.header <Destroy> [list delete_this $this] + tkwait window $w +} + +method _rename {} { + global all_heads current_branch + + if {$oldname eq {}} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "Please select a branch to rename." + focus $w.rename.oldname_m + return + } + if {$newname eq {} + || $newname eq [get_config gui.newbranchtemplate]} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "Please supply a branch name." + focus $w.rename.newname_t + return + } + if {![catch {git show-ref --verify -- "refs/heads/$newname"}]} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "Branch '$newname' already exists." + focus $w.rename.newname_t + return + } + if {[catch {git check-ref-format "heads/$newname"}]} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "We do not like '$newname' as a branch name." + focus $w.rename.newname_t + return + } + + if {[catch {git branch -m $oldname $newname} err]} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "Failed to rename '$oldname'.\n\n$err" + return + } + + set oldidx [lsearch -exact -sorted $all_heads $oldname] + if {$oldidx >= 0} { + set all_heads [lreplace $all_heads $oldidx $oldidx] + } + lappend all_heads $newname + set all_heads [lsort $all_heads] + populate_branch_menu + + if {$current_branch eq $oldname} { + set current_branch $newname + } + + destroy $w +} + +} diff --git a/lib/option.tcl b/lib/option.tcl index 11dd9be6b9..ba2a723fce 100644 --- a/lib/option.tcl +++ b/lib/option.tcl @@ -52,7 +52,7 @@ proc save_config {} { } proc do_about {} { - global appvers copyright + global appvers copyright oguilib global tcl_patchLevel tk_patchLevel set w .about_dialog @@ -91,6 +91,10 @@ $copyright" \ append v ", Tk version $tk_patchLevel" } + set d {} + append d "git exec dir: [gitexec]\n" + append d "git-gui lib: $oguilib" + label $w.vers \ -text $v \ -padx 5 -pady 5 \ @@ -100,6 +104,15 @@ $copyright" \ -relief solid pack $w.vers -side top -fill x -padx 5 -pady 5 + label $w.dirs \ + -text $d \ + -padx 5 -pady 5 \ + -justify left \ + -anchor w \ + -borderwidth 1 \ + -relief solid + pack $w.dirs -side top -fill x -padx 5 -pady 5 + menu $w.ctxm -tearoff 0 $w.ctxm add command \ -label {Copy} \ @@ -171,8 +184,10 @@ proc do_options {} { {b merge.summary {Summarize Merge Commits}} {i-1..5 merge.verbosity {Merge Verbosity}} + {b merge.diffstat {Show Diffstat After Merge}} {b gui.trustmtime {Trust File Modification Timestamps}} + {b gui.pruneduringfetch {Prune Tracking Branches During Fetch}} {i-0..99 gui.diffcontext {Number of Diff Context Lines}} {t gui.newbranchtemplate {New Branch Name Template}} } { diff --git a/lib/remote.tcl b/lib/remote.tcl index 99f353ed7d..b54824ab72 100644 --- a/lib/remote.tcl +++ b/lib/remote.tcl @@ -95,6 +95,7 @@ proc populate_fetch_menu {} { global all_remotes repo_config set m .mbar.fetch + set prune_list [list] foreach r $all_remotes { set enable 0 if {![catch {set a $repo_config(remote.$r.url)}]} { @@ -115,11 +116,21 @@ proc populate_fetch_menu {} { } if {$enable} { + lappend prune_list $r $m add command \ -label "Fetch from $r..." \ -command [list fetch_from $r] } } + + if {$prune_list ne {}} { + $m add separator + } + foreach r $prune_list { + $m add command \ + -label "Prune from $r..." \ + -command [list prune_from $r] + } } proc populate_push_menu {} { diff --git a/lib/remote_branch_delete.tcl b/lib/remote_branch_delete.tcl new file mode 100644 index 0000000000..bc39581b86 --- /dev/null +++ b/lib/remote_branch_delete.tcl @@ -0,0 +1,348 @@ +# git-gui remote branch deleting support +# Copyright (C) 2007 Shawn Pearce + +class remote_branch_delete { + +field w +field head_m + +field urltype {url} +field remote {} +field url {} + +field checktype {head} +field check_head {} + +field status {} +field idle_id {} +field full_list {} +field head_list {} +field active_ls {} +field head_cache +field full_cache +field cached + +constructor dialog {} { + global all_remotes M1B + + make_toplevel top w + wm title $top "[appname] ([reponame]): Delete Remote Branch" + if {$top ne {.}} { + wm geometry $top "+[winfo rootx .]+[winfo rooty .]" + } + + label $w.header -text {Delete Remote Branch} -font font_uibold + pack $w.header -side top -fill x + + frame $w.buttons + button $w.buttons.delete -text Delete \ + -default active \ + -command [cb _delete] + pack $w.buttons.delete -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 + + labelframe $w.dest -text {From Repository} + if {$all_remotes ne {}} { + radiobutton $w.dest.remote_r \ + -text {Remote:} \ + -value remote \ + -variable @urltype + eval tk_optionMenu $w.dest.remote_m @remote $all_remotes + grid $w.dest.remote_r $w.dest.remote_m -sticky w + if {[lsearch -sorted -exact $all_remotes origin] != -1} { + set remote origin + } else { + set remote [lindex $all_remotes 0] + } + set urltype remote + trace add variable @remote write [cb _write_remote] + } else { + set urltype url + } + radiobutton $w.dest.url_r \ + -text {Arbitrary URL:} \ + -value url \ + -variable @urltype + entry $w.dest.url_t \ + -borderwidth 1 \ + -relief sunken \ + -width 50 \ + -textvariable @url \ + -validate key \ + -validatecommand { + if {%d == 1 && [regexp {\s} %S]} {return 0} + return 1 + } + trace add variable @url write [cb _write_url] + grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5} + grid columnconfigure $w.dest 1 -weight 1 + pack $w.dest -anchor nw -fill x -pady 5 -padx 5 + + labelframe $w.heads -text {Branches} + listbox $w.heads.l \ + -height 10 \ + -width 70 \ + -listvariable @head_list \ + -selectmode extended \ + -yscrollcommand [list $w.heads.sby set] + scrollbar $w.heads.sby -command [list $w.heads.l yview] + + frame $w.heads.footer + label $w.heads.footer.status \ + -textvariable @status \ + -anchor w \ + -justify left + button $w.heads.footer.rescan \ + -text {Rescan} \ + -command [cb _rescan] + pack $w.heads.footer.status -side left -fill x -expand 1 + pack $w.heads.footer.rescan -side right + + pack $w.heads.footer -side bottom -fill x -expand 1 + pack $w.heads.sby -side right -fill y + pack $w.heads.l -side left -fill both -expand 1 + pack $w.heads -fill both -expand 1 -pady 5 -padx 5 + + labelframe $w.validate -text {Delete Only If} + radiobutton $w.validate.head_r \ + -text {Merged Into:} \ + -value head \ + -variable @checktype + set head_m [tk_optionMenu $w.validate.head_m @check_head {}] + trace add variable @head_list write [cb _write_head_list] + trace add variable @check_head write [cb _write_check_head] + grid $w.validate.head_r $w.validate.head_m -sticky w + radiobutton $w.validate.always_r \ + -text {Always (Do not perform merge checks)} \ + -value always \ + -variable @checktype + grid $w.validate.always_r -columnspan 2 -sticky w + grid columnconfigure $w.validate 1 -weight 1 + pack $w.validate -anchor nw -fill x -pady 5 -padx 5 + + trace add variable @urltype write [cb _write_urltype] + _rescan $this + + bind $w <Key-F5> [cb _rescan] + bind $w <$M1B-Key-r> [cb _rescan] + bind $w <$M1B-Key-R> [cb _rescan] + bind $w <Key-Return> [cb _delete] + bind $w <Key-Escape> [list destroy $w] + bind $w.header <Destroy> [list delete_this $this] + return $w +} + +method _delete {} { + switch $urltype { + remote {set uri $remote} + url {set uri $url} + } + + set cache $urltype:$uri + set crev {} + if {$checktype eq {head}} { + if {$check_head eq {}} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "A branch is required for 'Merged Into'." + return + } + set crev $full_cache("$cache\nrefs/heads/$check_head") + } + + set not_merged [list] + set need_fetch 0 + set have_selection 0 + set push_cmd [list git push] + lappend push_cmd -v + lappend push_cmd $uri + + foreach i [$w.heads.l curselection] { + set ref [lindex $full_list $i] + if {$crev ne {}} { + set obj $full_cache("$cache\n$ref") + if {[catch {set m [git merge-base $obj $crev]}]} { + set need_fetch 1 + set m {} + } + if {$obj ne $m} { + lappend not_merged [lindex $head_list $i] + continue + } + } + + lappend push_cmd :$ref + set have_selection 1 + } + + if {$not_merged ne {}} { + set msg "The following branches are not completely merged into $check_head: + + - [join $not_merged "\n - "]" + + if {$need_fetch} { + append msg " + +One or more of the merge tests failed because you have not fetched the necessary commits. Try fetching from $uri first." + } + + tk_messageBox \ + -icon info \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message $msg + if {!$have_selection} return + } + + if {!$have_selection} { + tk_messageBox \ + -icon error \ + -type ok \ + -title [wm title $w] \ + -parent $w \ + -message "Please select one or more branches to delete." + return + } + + if {[tk_messageBox \ + -icon warning \ + -type yesno \ + -title [wm title $w] \ + -parent $w \ + -message {Recovering deleted branches is difficult. + +Delete the selected branches?}] ne yes} { + return + } + + destroy $w + + set cons [console::new \ + "push $uri" \ + "Deleting branches from $uri"] + console::exec $cons $push_cmd +} + +method _rescan {{force 1}} { + switch $urltype { + remote {set uri $remote} + url {set uri $url} + } + + if {$force} { + unset -nocomplain cached($urltype:$uri) + } + + if {$idle_id ne {}} { + after cancel $idle_id + set idle_id {} + } + + _load $this $urltype:$uri $uri +} + +method _write_remote {args} { set urltype remote } +method _write_url {args} { set urltype url } +method _write_check_head {args} { set checktype head } + +method _write_head_list {args} { + $head_m delete 0 end + foreach abr $head_list { + $head_m insert end radiobutton \ + -label $abr \ + -value $abr \ + -variable @check_head + } + if {[lsearch -exact -sorted $head_list $check_head] < 0} { + set check_head {} + } +} + +method _write_urltype {args} { + if {$urltype eq {url}} { + if {$idle_id ne {}} { + after cancel $idle_id + } + _load $this none: {} + set idle_id [after 1000 [cb _rescan 0]] + } else { + _rescan $this 0 + } +} + +method _load {cache uri} { + if {$active_ls ne {}} { + catch {close $active_ls} + } + + if {$uri eq {}} { + $w.heads.l conf -state disabled + set head_list [list] + set full_list [list] + set status {No repository selected.} + return + } + + if {[catch {set x $cached($cache)}]} { + set status "Scanning $uri..." + $w.heads.l conf -state disabled + set head_list [list] + set full_list [list] + set head_cache($cache) [list] + set full_cache($cache) [list] + set active_ls [open "| [list git ls-remote $uri]" r] + fconfigure $active_ls \ + -blocking 0 \ + -translation lf \ + -encoding utf-8 + fileevent $active_ls readable [cb _read $cache $active_ls] + } else { + set status {} + set full_list $full_cache($cache) + set head_list $head_cache($cache) + $w.heads.l conf -state normal + } +} + +method _read {cache fd} { + if {$fd ne $active_ls} { + catch {close $fd} + return + } + + while {[gets $fd line] >= 0} { + if {[string match {*^{}} $line]} continue + if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} { + if {[regsub ^refs/heads/ $ref {} abr]} { + lappend head_list $abr + lappend head_cache($cache) $abr + lappend full_list $ref + lappend full_cache($cache) $ref + set full_cache("$cache\n$ref") $obj + } + } + } + + if {[eof $fd]} { + if {[catch {close $fd} err]} { + set status $err + set head_list [list] + set full_list [list] + } else { + set status {} + set cached($cache) 1 + $w.heads.l conf -state normal + } + } +} ifdeleted { + catch {close $fd} +} + +} diff --git a/lib/transport.tcl b/lib/transport.tcl index c0e7d20fce..e8ebc6eda0 100644 --- a/lib/transport.tcl +++ b/lib/transport.tcl @@ -5,9 +5,19 @@ proc fetch_from {remote} { set w [console::new \ "fetch $remote" \ "Fetching new changes from $remote"] - set cmd [list git fetch] - lappend cmd $remote - console::exec $w $cmd + set cmds [list] + lappend cmds [list exec git fetch $remote] + if {[is_config_true gui.pruneduringfetch]} { + lappend cmds [list exec git remote prune $remote] + } + console::chain $w $cmds +} + +proc prune_from {remote} { + set w [console::new \ + "remote prune $remote" \ + "Pruning tracking branches deleted from $remote"] + console::exec $w [list git remote prune $remote] } proc push_to {remote} { |