#!/bin/sh
GVF=GIT-VERSION-FILE
-DEF_VER=0.7.GITGUI
+DEF_VER=0.8.GITGUI
LF='
'
exit 1
}
+######################################################################
+##
+## 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
} 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
}
} 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
######################################################################
##
}
}
+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
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} {
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
}
unset class
+if {[is_Windows] || [is_MacOSX]} {
+ option add *Menu.tearOff 0
+}
+
if {[is_MacOSX]} {
set M1B M1
set M1T Cmd
}
}
+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) {}
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 \
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]} {
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
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
}
--- /dev/null
+# 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
+}
+
+}
}
proc do_about {} {
- global appvers copyright
+ global appvers copyright oguilib
global tcl_patchLevel tk_patchLevel
set w .about_dialog
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 \
-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} \
{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}}
} {
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)}]} {
}
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 {} {
--- /dev/null
+# 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}
+}
+
+}
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} {