1
0
Fork 0
mirror of https://github.com/git/git.git synced 2024-11-16 14:04:52 +01:00
git/git-gui/git-gui.sh

4016 lines
98 KiB
Bash
Raw Normal View History

#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
if test "z$*" = zversion \
|| test "z$*" = z--version; \
then \
echo 'git-gui version @@GITGUI_VERSION@@'; \
exit; \
fi; \
argv0=$0; \
exec wish "$argv0" -- "$@"
set appvers {@@GITGUI_VERSION@@}
set copyright [string map [list (c) \u00a9] {
Copyright (c) 2006-2010 Shawn Pearce, et. al.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
######################################################################
##
## Tcl/Tk sanity check
if {[catch {package require Tcl 8.4} err]
|| [catch {package require Tk 8.4} err]
} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title "git-gui: fatal error" \
-message $err
exit 1
}
catch {rename send {}} ; # What an evil concept...
######################################################################
##
## locate our library
set oguilib {@@GITGUI_LIBDIR@@}
set oguirel {@@GITGUI_RELATIVE@@}
if {$oguirel eq {1}} {
set oguilib [file dirname [file normalize $argv0]]
if {[file tail $oguilib] eq {git-core}} {
set oguilib [file dirname $oguilib]
}
set oguilib [file dirname $oguilib]
set oguilib [file join $oguilib share git-gui lib]
set oguimsg [file join $oguilib msgs]
} elseif {[string match @@* $oguirel]} {
set oguilib [file join [file dirname [file normalize $argv0]] lib]
set oguimsg [file join [file dirname [file normalize $argv0]] po]
} else {
set oguimsg [file join $oguilib msgs]
}
unset oguirel
######################################################################
##
## 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
}
if {[tk windowingsystem] eq "win32"} { console show }
}
######################################################################
##
## Internationalization (i18n) through msgcat and gettext. See
## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
package require msgcat
# Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
if {[tk windowingsystem] eq "win32"
&& [package vcompare [package provide msgcat] 1.4.4] < 0
} then {
proc _mc_update_locale {} {
set key {HKEY_CURRENT_USER\Control Panel\Desktop}
if {![catch {
package require registry
set uilocale [registry get $key "PreferredUILanguages"]
msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
} uilocale]} {
if {[string length $uilocale] > 0} {
msgcat::mclocale $uilocale
}
}
}
_mc_update_locale
}
proc _mc_trim {fmt} {
set cmk [string first @@ $fmt]
if {$cmk > 0} {
return [string range $fmt 0 [expr {$cmk - 1}]]
}
return $fmt
}
proc mc {en_fmt args} {
set fmt [_mc_trim [::msgcat::mc $en_fmt]]
if {[catch {set msg [eval [list format $fmt] $args]} err]} {
set msg [eval [list format [_mc_trim $en_fmt]] $args]
}
return $msg
}
proc strcat {args} {
return [join $args {}]
}
::msgcat::mcload $oguimsg
unset oguimsg
######################################################################
##
## On Mac, bring the current Wish process window to front
if {[tk windowingsystem] eq "aqua"} {
catch {
exec osascript -e [format {
tell application "System Events"
set frontmost of processes whose unix id is %d to true
end tell
} [pid]]
}
}
######################################################################
##
## read only globals
set _appname {Git Gui}
set _gitdir {}
set _gitworktree {}
set _isbare {}
set _gitexec {}
set _githtmldir {}
set _reponame {}
set _iscygwin {}
set _search_path {}
set _shellpath {@@SHELL_PATH@@}
set _trace [lsearch -exact $argv --trace]
if {$_trace >= 0} {
set argv [lreplace $argv $_trace $_trace]
set _trace 1
if {[tk windowingsystem] eq "win32"} { console show }
} else {
set _trace 0
}
# variable for the last merged branch (useful for a default when deleting
# branches).
set _last_merged_branch {}
proc shellpath {} {
global _shellpath env
if {[string match @@* $_shellpath]} {
if {[info exists env(SHELL)]} {
return $env(SHELL)
} else {
return /bin/sh
}
}
return $_shellpath
}
proc appname {} {
global _appname
return $_appname
}
proc gitdir {args} {
global _gitdir
if {$args eq {}} {
return $_gitdir
}
return [eval [list file join $_gitdir] $args]
}
proc gitexec {args} {
global _gitexec
if {$_gitexec eq {}} {
if {[catch {set _gitexec [git --exec-path]} err]} {
error "Git not installed?\n\n$err"
}
if {[is_Cygwin]} {
set _gitexec [exec cygpath \
--windows \
--absolute \
$_gitexec]
} else {
set _gitexec [file normalize $_gitexec]
}
}
if {$args eq {}} {
return $_gitexec
}
return [eval [list file join $_gitexec] $args]
}
proc githtmldir {args} {
global _githtmldir
if {$_githtmldir eq {}} {
if {[catch {set _githtmldir [git --html-path]}]} {
# Git not installed or option not yet supported
return {}
}
if {[is_Cygwin]} {
set _githtmldir [exec cygpath \
--windows \
--absolute \
$_githtmldir]
} else {
set _githtmldir [file normalize $_githtmldir]
}
}
if {$args eq {}} {
return $_githtmldir
}
return [eval [list file join $_githtmldir] $args]
}
proc reponame {} {
return $::_reponame
}
proc is_MacOSX {} {
if {[tk windowingsystem] eq {aqua}} {
return 1
}
return 0
}
proc is_Windows {} {
if {$::tcl_platform(platform) eq {windows}} {
return 1
}
return 0
}
proc is_Cygwin {} {
global _iscygwin
if {$_iscygwin eq {}} {
if {$::tcl_platform(platform) eq {windows}} {
if {[catch {set p [exec cygpath --windir]} err]} {
set _iscygwin 0
} else {
set _iscygwin 1
}
} else {
set _iscygwin 0
}
}
return $_iscygwin
}
proc is_enabled {option} {
global enabled_options
if {[catch {set on $enabled_options($option)}]} {return 0}
return $on
}
proc enable_option {option} {
global enabled_options
set enabled_options($option) 1
}
proc disable_option {option} {
global enabled_options
set enabled_options($option) 0
}
######################################################################
##
## config
proc is_many_config {name} {
switch -glob -- $name {
gui.recentrepo -
remote.*.fetch -
remote.*.push
{return 1}
*
{return 0}
}
}
proc is_config_true {name} {
global repo_config
if {[catch {set v $repo_config($name)}]} {
return 0
}
set v [string tolower $v]
if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
return 1
} else {
return 0
}
}
proc is_config_false {name} {
global repo_config
if {[catch {set v $repo_config($name)}]} {
return 0
}
set v [string tolower $v]
if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
return 1
} else {
return 0
}
}
proc get_config {name} {
global repo_config
if {[catch {set v $repo_config($name)}]} {
return {}
} else {
return $v
}
}
proc is_bare {} {
global _isbare
global _gitdir
global _gitworktree
if {$_isbare eq {}} {
if {[catch {
set _bare [git rev-parse --is-bare-repository]
switch -- $_bare {
true { set _isbare 1 }
false { set _isbare 0}
default { throw }
}
}]} {
if {[is_config_true core.bare]
|| ($_gitworktree eq {}
&& [lindex [file split $_gitdir] end] ne {.git})} {
set _isbare 1
} else {
set _isbare 0
}
}
}
return $_isbare
}
######################################################################
##
## handy utils
proc _trace_exec {cmd} {
if {!$::_trace} return
set d {}
foreach v $cmd {
if {$d ne {}} {
append d { }
}
if {[regexp {[ \t\r\n'"$?*]} $v]} {
set v [sq $v]
}
append d $v
}
puts stderr $d
}
#'" fix poor old emacs font-lock mode
proc _git_cmd {name} {
global _git_cmd_path
if {[catch {set v $_git_cmd_path($name)}]} {
switch -- $name {
version -
--version -
--exec-path { return [list $::_git $name] }
}
set p [gitexec git-$name$::_search_exe]
if {[file exists $p]} {
set v [list $p]
} elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
# Try to determine what sort of magic will make
# git-$name go and do its thing, because native
# Tcl on Windows doesn't know it.
#
set p [gitexec git-$name]
set f [open $p r]
set s [gets $f]
close $f
switch -glob -- [lindex $s 0] {
#!*sh { set i sh }
#!*perl { set i perl }
#!*python { set i python }
default { error "git-$name is not supported: $s" }
}
upvar #0 _$i interp
if {![info exists interp]} {
set interp [_which $i]
}
if {$interp eq {}} {
error "git-$name requires $i (not in PATH)"
}
set v [concat [list $interp] [lrange $s 1 end] [list $p]]
} else {
# Assume it is builtin to git somehow and we
# aren't actually able to see a file for it.
#
set v [list $::_git $name]
}
set _git_cmd_path($name) $v
}
return $v
}
proc _which {what args} {
global env _search_exe _search_path
if {$_search_path eq {}} {
if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
set _search_path [split [exec cygpath \
--windows \
--path \
--absolute \
$env(PATH)] {;}]
set _search_exe .exe
} elseif {[is_Windows]} {
set gitguidir [file dirname [info script]]
regsub -all ";" $gitguidir "\\;" gitguidir
set env(PATH) "$gitguidir;$env(PATH)"
set _search_path [split $env(PATH) {;}]
set _search_exe .exe
} else {
set _search_path [split $env(PATH) :]
set _search_exe {}
}
}
if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
set suffix {}
} else {
set suffix $_search_exe
}
foreach p $_search_path {
set p [file join $p $what$suffix]
if {[file exists $p]} {
return [file normalize $p]
}
}
return {}
}
# Test a file for a hashbang to identify executable scripts on Windows.
proc is_shellscript {filename} {
if {![file exists $filename]} {return 0}
set f [open $filename r]
fconfigure $f -encoding binary
set magic [read $f 2]
close $f
return [expr {$magic eq "#!"}]
}
# Run a command connected via pipes on stdout.
# This is for use with textconv filters and uses sh -c "..." to allow it to
# contain a command with arguments. On windows we must check for shell
# scripts specifically otherwise just call the filter command.
proc open_cmd_pipe {cmd path} {
global env
if {![file executable [shellpath]]} {
set exe [auto_execok [lindex $cmd 0]]
if {[is_shellscript [lindex $exe 0]]} {
set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
} else {
set run [concat $exe [lrange $cmd 1 end] $path]
}
} else {
set run [list [shellpath] -c "$cmd \"\$0\"" $path]
}
return [open |$run r]
}
proc _lappend_nice {cmd_var} {
global _nice
upvar $cmd_var cmd
if {![info exists _nice]} {
set _nice [_which nice]
if {[catch {exec $_nice git version}]} {
set _nice {}
} elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
set _nice {}
}
}
if {$_nice ne {}} {
lappend cmd $_nice
}
}
proc git {args} {
set opt [list]
while {1} {
switch -- [lindex $args 0] {
--nice {
_lappend_nice opt
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
_trace_exec [concat $opt $cmdp $args]
set result [eval exec $opt $cmdp $args]
if {$::_trace} {
puts stderr "< $result"
}
return $result
}
proc _open_stdout_stderr {cmd} {
_trace_exec $cmd
if {[catch {
set fd [open [concat [list | ] $cmd] r]
} err]} {
if { [lindex $cmd end] eq {2>@1}
&& $err eq {can not find channel named "1"}
} {
# Older versions of Tcl 8.4 don't have this 2>@1 IO
# redirect operator. Fallback to |& cat for those.
# The command was not actually started, so its safe
# to try to start it a second time.
#
set fd [open [concat \
[list | ] \
[lrange $cmd 0 end-1] \
[list |& cat] \
] r]
} else {
error $err
}
}
fconfigure $fd -eofchar {}
return $fd
}
proc git_read {args} {
set opt [list]
while {1} {
switch -- [lindex $args 0] {
--nice {
_lappend_nice opt
}
--stderr {
lappend args 2>@1
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
return [_open_stdout_stderr [concat $opt $cmdp $args]]
}
proc git_write {args} {
set opt [list]
while {1} {
switch -- [lindex $args 0] {
--nice {
_lappend_nice opt
}
default {
break
}
}
set args [lrange $args 1 end]
}
set cmdp [_git_cmd [lindex $args 0]]
set args [lrange $args 1 end]
_trace_exec [concat $opt $cmdp $args]
return [open [concat [list | ] $opt $cmdp $args] w]
}
proc githook_read {hook_name args} {
set pchook [gitdir hooks $hook_name]
lappend args 2>@1
# On Windows [file executable] might lie so we need to ask
# the shell if the hook is executable. Yes that's annoying.
#
if {[is_Windows]} {
upvar #0 _sh interp
if {![info exists interp]} {
set interp [_which sh]
}
if {$interp eq {}} {
error "hook execution requires sh (not in PATH)"
}
set scr {if test -x "$1";then exec "$@";fi}
set sh_c [list $interp -c $scr $interp $pchook]
return [_open_stdout_stderr [concat $sh_c $args]]
}
if {[file executable $pchook]} {
return [_open_stdout_stderr [concat [list $pchook] $args]]
}
return {}
}
proc kill_file_process {fd} {
set process [pid $fd]
catch {
if {[is_Windows]} {
# Use a Cygwin-specific flag to allow killing
# native Windows processes
exec kill -f $process
} else {
exec kill $process
}
}
}
proc gitattr {path attr default} {
if {[catch {set r [git check-attr $attr -- $path]}]} {
set r unspecified
} else {
set r [join [lrange [split $r :] 2 end] :]
regsub {^ } $r {} r
}
if {$r eq {unspecified}} {
return $default
}
return $r
}
proc sq {value} {
regsub -all ' $value "'\\''" value
return "'$value'"
}
proc load_current_branch {} {
global current_branch is_detached
set fd [open [gitdir HEAD] r]
if {[gets $fd ref] < 1} {
set ref {}
}
close $fd
set pfx {ref: refs/heads/}
set len [string length $pfx]
if {[string equal -length $len $pfx $ref]} {
# We're on a branch. It might not exist. But
# HEAD looks good enough to be a branch.
#
set current_branch [string range $ref $len end]
set is_detached 0
} else {
# Assume this is a detached head.
#
set current_branch HEAD
set is_detached 1
}
}
auto_load tk_optionMenu
rename tk_optionMenu real__tkOptionMenu
proc tk_optionMenu {w varName args} {
set m [eval real__tkOptionMenu $w $varName $args]
$m configure -font font_ui
$w configure -font font_ui
return $m
}
proc rmsel_tag {text} {
$text tag conf sel \
-background [$text cget -background] \
-foreground [$text cget -foreground] \
-borderwidth 0
$text tag conf in_sel -background lightgray
bind $text <Motion> break
return $text
}
wm withdraw .
set root_exists 0
bind . <Visibility> {
bind . <Visibility> {}
set root_exists 1
}
if {[is_Windows]} {
wm iconbitmap . -default $oguilib/git-gui.ico
set ::tk::AlwaysShowSelection 1
bind . <Control-F2> {console show}
# Spoof an X11 display for SSH
if {![info exists env(DISPLAY)]} {
set env(DISPLAY) :9999
}
} else {
catch {
image create photo gitlogo -width 16 -height 16
gitlogo put #33CC33 -to 7 0 9 2
gitlogo put #33CC33 -to 4 2 12 4
gitlogo put #33CC33 -to 7 4 9 6
gitlogo put #CC3333 -to 4 6 12 8
gitlogo put gray26 -to 4 9 6 10
gitlogo put gray26 -to 3 10 6 12
gitlogo put gray26 -to 8 9 13 11
gitlogo put gray26 -to 8 11 10 12
gitlogo put gray26 -to 11 11 13 14
gitlogo put gray26 -to 3 12 5 14
gitlogo put gray26 -to 5 13
gitlogo put gray26 -to 10 13
gitlogo put gray26 -to 4 14 12 15
gitlogo put gray26 -to 5 15 11 16
gitlogo redither
image create photo gitlogo32 -width 32 -height 32
gitlogo32 copy gitlogo -zoom 2 2
wm iconphoto . -default gitlogo gitlogo32
}
}
######################################################################
##
## config defaults
set cursor_ptr arrow
font create font_ui
if {[lsearch -exact [font names] TkDefaultFont] != -1} {
eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
eval [linsert [font actual TkFixedFont] 0 font create font_diff]
} else {
font create font_diff -family Courier -size 10
catch {
label .dummy
eval font configure font_ui [font actual [.dummy cget -font]]
destroy .dummy
}
}
font create font_uiitalic
font create font_uibold
font create font_diffbold
font create font_diffitalic
foreach class {Button Checkbutton Entry Label
Labelframe Listbox Message
Radiobutton Spinbox Text} {
option add *$class.font font_ui
}
if {![is_MacOSX]} {
option add *Menu.font font_ui
option add *Entry.borderWidth 1 startupFile
option add *Entry.relief sunken startupFile
option add *RadioButton.anchor w startupFile
}
unset class
if {[is_Windows] || [is_MacOSX]} {
option add *Menu.tearOff 0
}
if {[is_MacOSX]} {
set M1B M1
set M1T Cmd
} else {
set M1B Control
set M1T Ctrl
}
proc bind_button3 {w cmd} {
bind $w <Any-Button-3> $cmd
if {[is_MacOSX]} {
# Mac OS X sends Button-2 on right click through three-button mouse,
# or through trackpad right-clicking (two-finger touch + click).
bind $w <Any-Button-2> $cmd
bind $w <Control-Button-1> $cmd
}
}
proc apply_config {} {
global repo_config font_descs
foreach option $font_descs {
set name [lindex $option 0]
set font [lindex $option 1]
if {[catch {
set need_weight 1
foreach {cn cv} $repo_config(gui.$name) {
if {$cn eq {-weight}} {
set need_weight 0
}
font configure $font $cn $cv
}
if {$need_weight} {
font configure $font -weight normal
}
} err]} {
error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
}
foreach {cn cv} [font configure $font] {
font configure ${font}bold $cn $cv
font configure ${font}italic $cn $cv
}
font configure ${font}bold -weight bold
font configure ${font}italic -slant italic
}
global use_ttk NS
set use_ttk 0
set NS {}
if {$repo_config(gui.usettk)} {
set use_ttk [package vsatisfies [package provide Tk] 8.5]
if {$use_ttk} {
set NS ttk
bind [winfo class .] <<ThemeChanged>> [list InitTheme]
pave_toplevel .
}
}
}
set default_config(branch.autosetupmerge) true
set default_config(merge.tool) {}
set default_config(mergetool.keepbackup) true
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.encoding) [encoding system]
set default_config(gui.matchtrackingbranch) false
set default_config(gui.textconv) true
set default_config(gui.pruneduringfetch) false
set default_config(gui.trustmtime) false
set default_config(gui.fastcopyblame) false
set default_config(gui.maxrecentrepo) 10
set default_config(gui.copyblamethreshold) 40
set default_config(gui.blamehistoryctx) 7
set default_config(gui.diffcontext) 5
set default_config(gui.diffopts) {}
set default_config(gui.commitmsgwidth) 75
set default_config(gui.newbranchtemplate) {}
git-gui: Automatically spell check commit messages as the user types Many user friendly tools like word processors, email editors and web browsers allow users to spell check the message they are writing as they type it, making it easy to identify a common misspelling of a word and correct it on the fly. We now open a bi-directional pipe to Aspell and feed the message text the user is editing off to the program about once every 300 milliseconds. This is frequent enough that the user sees the results almost immediately, but is not so frequent as to cause significant additional load on the system. If the user has modified the message text during the last 300 milliseconds we delay until the next period, ensuring that we avoid flooding the Aspell process with a lot of text while the user is actively typing their message. We wait to send the current message buffer to Aspell until the user is at a word boundary, thus ensuring that we are not likely to ask for misspelled word detection on a word that the user is actively typing, as most words are misspelled when only partially typed, even if the user has thus far typed it correctly. Misspelled words are highlighted in red and are given an underline, causing the word to stand out from the others in the buffer. This is a very common user interface idiom for displaying misspelled words, but differs from one platform to the next in slight variations. For example the Mac OS X system prefers using a dashed red underline, leaving the word in the original text color. Unfortunately the control that Tk gives us over text display is not powerful enough to handle such formatting so we have to work with the least common denominator. The top suggestions for a misspelling are saved in an array and offered to the user when they right-click (or on the Mac ctrl-click) a misspelled word. Selecting an entry from this menu will replace the misspelling with the correction shown. Replacement is integrated with the undo/redo stack so undoing a replacement will restore the misspelled original text. If Aspell could not be started during git-gui launch we silently eat the error and run without spell checking support. This way users who do not have Aspell in their $PATH can continue to use git-gui, although they will not get the advanced spelling functionality. If Aspell started successfully the version line and language are shown in git-gui's about box, below the Tcl/Tk versions. This way the user can verify the Aspell function has been activated. If Aspell crashes while we are running we inform the user with an error dialog and then disable Aspell entirely for the rest of this git-gui session. This prevents us from fork-bombing the system with Aspell instances that always crash when presented with the current message text, should there be a bug in either Aspell or in git-gui's output to it. We escape all input lines with ^, as recommended by the Aspell manual page, as this allows Aspell to properly ignore any input line that is otherwise looking like a command (e.g. ! to enable terse output). By using this escape however we need to correct all word offsets by -1 as Aspell is apparently considering the ^ escape to be part of the line's character count, but our Tk text widget obviously does not. Available dictionaries are offered in the Options dialog, allowing the user to select the language they want to spellcheck commit messages with for the current repository, as well as the global user setting that all repositories inherit. Special thanks to Adam Flott for suggesting connecting git-gui to Aspell for the purpose of spell checking the commit message, and to Wincent Colaiuta for the idea to wait for a word boundary before passing the message over for checking. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-07 08:35:25 +01:00
set default_config(gui.spellingdictionary) {}
set default_config(gui.fontui) [font configure font_ui]
set default_config(gui.fontdiff) [font configure font_diff]
# TODO: this option should be added to the git-config documentation
set default_config(gui.maxfilesdisplayed) 5000
set default_config(gui.usettk) 1
set default_config(gui.warndetachedcommit) 1
set font_descs {
{fontui font_ui {mc "Main Font"}}
{fontdiff font_diff {mc "Diff/Console Font"}}
}
set default_config(gui.stageuntracked) ask
set default_config(gui.displayuntracked) true
######################################################################
##
## find git
set _git [_which git]
if {$_git eq {}} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "git-gui: fatal error"] \
-message [mc "Cannot find git in PATH."]
exit 1
}
######################################################################
##
## version check
if {[catch {set _git_version [git --version]} err]} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "git-gui: fatal error"] \
-message "Cannot determine Git version:
$err
[appname] requires Git 1.5.0 or later."
exit 1
}
if {![regsub {^git version } $_git_version {} _git_version]} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "git-gui: fatal error"] \
-message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
exit 1
}
proc get_trimmed_version {s} {
set r {}
foreach x [split $s -._] {
if {[string is integer -strict $x]} {
lappend r $x
} else {
break
}
}
return [join $r .]
}
set _real_git_version $_git_version
set _git_version [get_trimmed_version $_git_version]
if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
catch {wm withdraw .}
if {[tk_messageBox \
-icon warning \
-type yesno \
-default no \
-title "[appname]: warning" \
-message [mc "Git version cannot be determined.
%s claims it is version '%s'.
%s requires at least Git 1.5.0 or later.
Assume '%s' is version 1.5.0?
" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
set _git_version 1.5.0
} else {
exit 1
}
}
unset _real_git_version
proc git-version {args} {
global _git_version
switch [llength $args] {
0 {
return $_git_version
}
2 {
set op [lindex $args 0]
set vr [lindex $args 1]
set cm [package vcompare $_git_version $vr]
return [expr $cm $op 0]
}
4 {
set type [lindex $args 0]
set name [lindex $args 1]
set parm [lindex $args 2]
set body [lindex $args 3]
if {($type ne {proc} && $type ne {method})} {
error "Invalid arguments to git-version"
}
if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
error "Last arm of $type $name must be default"
}
foreach {op vr cb} [lrange $body 0 end-2] {
if {[git-version $op $vr]} {
return [uplevel [list $type $name $parm $cb]]
}
}
return [uplevel [list $type $name $parm [lindex $body end]]]
}
default {
error "git-version >= x"
}
}
}
if {[git-version < 1.5]} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "git-gui: fatal error"] \
-message "[appname] requires Git 1.5.0 or later.
You are using [git-version]:
[git --version]"
exit 1
}
######################################################################
##
## configure our library
set idx [file join $oguilib tclIndex]
if {[catch {set fd [open $idx r]} err]} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "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
if {$idx ne {}} {
set loaded [list]
foreach p $idx {
if {[lsearch -exact $loaded $p] >= 0} continue
source [file join $oguilib $p]
lappend loaded $p
}
unset loaded p
} else {
set auto_path [concat [list $oguilib] $auto_path]
}
unset -nocomplain idx fd
######################################################################
##
## config file parsing
git-version proc _parse_config {arr_name args} {
>= 1.5.3 {
upvar $arr_name arr
array unset arr
set buf {}
catch {
set fd_rc [eval \
[list git_read config] \
$args \
[list --null --list]]
fconfigure $fd_rc -translation binary
set buf [read $fd_rc]
close $fd_rc
}
foreach line [split $buf "\0"] {
if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
if {[is_many_config $name]} {
lappend arr($name) $value
} else {
set arr($name) $value
}
} elseif {[regexp {^([^\n]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
}
default {
upvar $arr_name arr
array unset arr
catch {
set fd_rc [eval [list git_read config --list] $args]
while {[gets $fd_rc line] >= 0} {
if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
if {[is_many_config $name]} {
lappend arr($name) $value
} else {
set arr($name) $value
}
} elseif {[regexp {^([^=]+)$} $line line name]} {
# no value given, but interpreting them as
# boolean will be handled as true
set arr($name) {}
}
}
close $fd_rc
}
}
}
proc load_config {include_global} {
global repo_config global_config system_config default_config
if {$include_global} {
_parse_config system_config --system
_parse_config global_config --global
}
_parse_config repo_config
foreach name [array names default_config] {
if {[catch {set v $system_config($name)}]} {
set system_config($name) $default_config($name)
}
}
foreach name [array names system_config] {
if {[catch {set v $global_config($name)}]} {
set global_config($name) $system_config($name)
}
if {[catch {set v $repo_config($name)}]} {
set repo_config($name) $system_config($name)
}
}
}
######################################################################
##
## feature option selection
if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
unset _junk
} else {
set subcommand gui
}
if {$subcommand eq {gui.sh}} {
set subcommand gui
}
if {$subcommand eq {gui} && [llength $argv] > 0} {
set subcommand [lindex $argv 0]
set argv [lrange $argv 1 end]
}
enable_option multicommit
enable_option branch
enable_option transport
disable_option bare
switch -- $subcommand {
browser -
blame {
enable_option bare
disable_option multicommit
disable_option branch
disable_option transport
}
citool {
enable_option singlecommit
enable_option retcode
disable_option multicommit
disable_option branch
disable_option transport
while {[llength $argv] > 0} {
set a [lindex $argv 0]
switch -- $a {
--amend {
enable_option initialamend
}
--nocommit {
enable_option nocommit
enable_option nocommitmsg
}
--commitmsg {
disable_option nocommitmsg
}
default {
break
}
}
set argv [lrange $argv 1 end]
}
}
}
######################################################################
##
## execution environment
set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
# Suggest our implementation of askpass, if none is set
if {![info exists env(SSH_ASKPASS)]} {
set env(SSH_ASKPASS) [gitexec git-gui--askpass]
}
######################################################################
##
## repository setup
set picked 0
if {[catch {
set _gitdir $env(GIT_DIR)
set _prefix {}
}]
&& [catch {
# beware that from the .git dir this sets _gitdir to .
# and _prefix to the empty string
set _gitdir [git rev-parse --git-dir]
set _prefix [git rev-parse --show-prefix]
} err]} {
git-gui: Allow users to choose/create/clone a repository If we are started outside of a git repository than it is likely the user started us from some sort of desktop shortcut icon in the operating system. In such a case the user is expecting us to prompt them to locate the git repository they want to work on, or to help them make a new repository, or to clone one from an existing location. This is a very simple wizard that offers the user one of these three choices. When we clone a repository we always use the name `master` in the local repository, even if the remote side does not appear to point to that name. I chose this as a policy decision. Much of the Git documentation talks about `master` being the default branch in a repository and that's what git-init does too. If the remote side doesn't call its default branch `master` most users just don't care, they just want to use Git the way the documentation describes. Rather than relying on the git-clone Porcelain that ships with git we build the new repository ourselves and then obtain content by git-fetch. This technique simplifies the entire clone process to roughly: `git init && git fetch && git pull`. Today we use three passes with git-fetch; the first pass gets us the bulk of the objects and the branches, the second pass gets us the tags, and the final pass gets us the current value of HEAD to initialize the default branch. If the source repository is on the local disk we try to use a hardlink to connect the objects into the new clone as this can be many times faster than copying the objects or packing them and passing the data through a pipe to index-pack. Unlike git-clone we stick to pure Tcl [file link -hard] operation thus avoiding the need to fork a cpio process to setup the hardlinks. If hardlinks do not appear to be supported (e.g. filesystem doesn't allow them or we are crossing filesystem boundaries) we use file copying instead. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-09-22 09:47:43 +02:00
load_config 1
apply_config
choose_repository::pick
set picked 1
}
# we expand the _gitdir when it's just a single dot (i.e. when we're being
# run from the .git dir itself) lest the routines to find the worktree
# get confused
if {$_gitdir eq "."} {
set _gitdir [pwd]
}
if {![file isdirectory $_gitdir] && [is_Cygwin]} {
catch {set _gitdir [exec cygpath --windows $_gitdir]}
}
if {![file isdirectory $_gitdir]} {
catch {wm withdraw .}
error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
exit 1
}
# _gitdir exists, so try loading the config
load_config 0
apply_config
# v1.7.0 introduced --show-toplevel to return the canonical work-tree
if {[package vsatisfies $_git_version 1.7.0-]} {
if { [is_Cygwin] } {
catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
} else {
set _gitworktree [git rev-parse --show-toplevel]
}
} else {
# try to set work tree from environment, core.worktree or use
# cdup to obtain a relative path to the top of the worktree. If
# run from the top, the ./ prefix ensures normalize expands pwd.
if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
set _gitworktree [get_config core.worktree]
if {$_gitworktree eq ""} {
set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
}
}
}
if {$_prefix ne {}} {
if {$_gitworktree eq {}} {
regsub -all {[^/]+/} $_prefix ../ cdup
} else {
set cdup $_gitworktree
}
if {[catch {cd $cdup} err]} {
catch {wm withdraw .}
error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
exit 1
}
set _gitworktree [pwd]
unset cdup
} elseif {![is_enabled bare]} {
if {[is_bare]} {
catch {wm withdraw .}
error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
exit 1
}
if {$_gitworktree eq {}} {
set _gitworktree [file dirname $_gitdir]
}
if {[catch {cd $_gitworktree} err]} {
catch {wm withdraw .}
error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
exit 1
}
set _gitworktree [pwd]
}
set _reponame [file split [file normalize $_gitdir]]
if {[lindex $_reponame end] eq {.git}} {
set _reponame [lindex $_reponame end-1]
} else {
set _reponame [lindex $_reponame end]
}
set env(GIT_DIR) $_gitdir
set env(GIT_WORK_TREE) $_gitworktree
######################################################################
##
## global init
set current_diff_path {}
set current_diff_side {}
set diff_actions [list]
set HEAD {}
set PARENT {}
set MERGE_HEAD [list]
set commit_type {}
set empty_tree {}
set current_branch {}
set is_detached 0
set current_diff_path {}
set is_3way_diff 0
set is_submodule_diff 0
set is_conflict_diff 0
set selected_commit_type new
set diff_empty_count 0
set nullid "0000000000000000000000000000000000000000"
set nullid2 "0000000000000000000000000000000000000001"
######################################################################
##
## task management
set rescan_active 0
set diff_active 0
set last_clicked {}
set disable_on_lock [list]
set index_lock_type none
proc lock_index {type} {
global index_lock_type disable_on_lock
if {$index_lock_type eq {none}} {
set index_lock_type $type
foreach w $disable_on_lock {
uplevel #0 $w disabled
}
return 1
} elseif {$index_lock_type eq "begin-$type"} {
set index_lock_type $type
return 1
}
return 0
}
proc unlock_index {} {
global index_lock_type disable_on_lock
set index_lock_type none
foreach w $disable_on_lock {
uplevel #0 $w normal
}
}
######################################################################
##
## status
proc repository_state {ctvar hdvar mhvar} {
global current_branch
upvar $ctvar ct $hdvar hd $mhvar mh
set mh [list]
load_current_branch
if {[catch {set hd [git rev-parse --verify HEAD]}]} {
set hd {}
set ct initial
return
}
set merge_head [gitdir MERGE_HEAD]
if {[file exists $merge_head]} {
set ct merge
set fd_mh [open $merge_head r]
while {[gets $fd_mh line] >= 0} {
lappend mh $line
}
close $fd_mh
return
}
set ct normal
}
proc PARENT {} {
global PARENT empty_tree
set p [lindex $PARENT 0]
if {$p ne {}} {
return $p
}
if {$empty_tree eq {}} {
set empty_tree [git mktree << {}]
}
return $empty_tree
}
proc force_amend {} {
global selected_commit_type
global HEAD PARENT MERGE_HEAD commit_type
repository_state newType newHEAD newMERGE_HEAD
set HEAD $newHEAD
set PARENT $newHEAD
set MERGE_HEAD $newMERGE_HEAD
set commit_type $newType
set selected_commit_type amend
do_select_commit_type
}
proc rescan {after {honor_trustmtime 1}} {
global HEAD PARENT MERGE_HEAD commit_type
global ui_index ui_workdir ui_comm
global rescan_active file_states
global repo_config
if {$rescan_active > 0 || ![lock_index read]} return
repository_state newType newHEAD newMERGE_HEAD
if {[string match amend* $commit_type]
&& $newType eq {normal}
&& $newHEAD eq $HEAD} {
} else {
set HEAD $newHEAD
set PARENT $newHEAD
set MERGE_HEAD $newMERGE_HEAD
set commit_type $newType
}
array unset file_states
if {!$::GITGUI_BCK_exists &&
(![$ui_comm edit modified]
|| [string trim [$ui_comm get 0.0 end]] eq {})} {
if {[string match amend* $commit_type]} {
} elseif {[load_message GITGUI_MSG utf-8]} {
} elseif {[run_prepare_commit_msg_hook]} {
} elseif {[load_message MERGE_MSG]} {
} elseif {[load_message SQUASH_MSG]} {
}
$ui_comm edit reset
$ui_comm edit modified false
}
if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
rescan_stage2 {} $after
} else {
set rescan_active 1
ui_status [mc "Refreshing file status..."]
set fd_rf [git_read update-index \
-q \
--unmerged \
--ignore-missing \
--refresh \
]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[list rescan_stage2 $fd_rf $after]
}
}
if {[is_Cygwin]} {
set is_git_info_exclude {}
proc have_info_exclude {} {
global is_git_info_exclude
if {$is_git_info_exclude eq {}} {
if {[catch {exec test -f [gitdir info exclude]}]} {
set is_git_info_exclude 0
} else {
set is_git_info_exclude 1
}
}
return $is_git_info_exclude
}
} else {
proc have_info_exclude {} {
return [file readable [gitdir info exclude]]
}
}
proc rescan_stage2 {fd after} {
global rescan_active buf_rdi buf_rdf buf_rlo
if {$fd ne {}} {
read $fd
if {![eof $fd]} return
close $fd
}
if {[package vsatisfies $::_git_version 1.6.3-]} {
set ls_others [list --exclude-standard]
} else {
set ls_others [list --exclude-per-directory=.gitignore]
if {[have_info_exclude]} {
lappend ls_others "--exclude-from=[gitdir info exclude]"
}
set user_exclude [get_config core.excludesfile]
if {$user_exclude ne {} && [file readable $user_exclude]} {
lappend ls_others "--exclude-from=[file normalize $user_exclude]"
}
}
set buf_rdi {}
set buf_rdf {}
set buf_rlo {}
set rescan_active 2
ui_status [mc "Scanning for modified files ..."]
if {[git-version >= "1.7.2"]} {
set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]]
} else {
set fd_di [git_read diff-index --cached -z [PARENT]]
}
set fd_df [git_read diff-files -z]
fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary
fileevent $fd_di readable [list read_diff_index $fd_di $after]
fileevent $fd_df readable [list read_diff_files $fd_df $after]
if {[is_config_true gui.displayuntracked]} {
set fd_lo [eval git_read ls-files --others -z $ls_others]
fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
incr rescan_active
}
}
proc load_message {file {encoding {}}} {
global ui_comm
set f [gitdir $file]
if {[file isfile $f]} {
if {[catch {set fd [open $f r]}]} {
return 0
}
fconfigure $fd -eofchar {}
if {$encoding ne {}} {
fconfigure $fd -encoding $encoding
}
set content [string trim [read $fd]]
close $fd
regsub -all -line {[ \r\t]+$} $content {} content
$ui_comm delete 0.0 end
$ui_comm insert end $content
return 1
}
return 0
}
proc run_prepare_commit_msg_hook {} {
global pch_error
# prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
# it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
# empty file but existent file.
set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
if {[file isfile [gitdir MERGE_MSG]]} {
set pcm_source "merge"
set fd_mm [open [gitdir MERGE_MSG] r]
puts -nonewline $fd_pcm [read $fd_mm]
close $fd_mm
} elseif {[file isfile [gitdir SQUASH_MSG]]} {
set pcm_source "squash"
set fd_sm [open [gitdir SQUASH_MSG] r]
puts -nonewline $fd_pcm [read $fd_sm]
close $fd_sm
} else {
set pcm_source ""
}
close $fd_pcm
set fd_ph [githook_read prepare-commit-msg \
[gitdir PREPARE_COMMIT_MSG] $pcm_source]
if {$fd_ph eq {}} {
catch {file delete [gitdir PREPARE_COMMIT_MSG]}
return 0;
}
ui_status [mc "Calling prepare-commit-msg hook..."]
set pch_error {}
fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fileevent $fd_ph readable \
[list prepare_commit_msg_hook_wait $fd_ph]
return 1;
}
proc prepare_commit_msg_hook_wait {fd_ph} {
global pch_error
append pch_error [read $fd_ph]
fconfigure $fd_ph -blocking 1
if {[eof $fd_ph]} {
if {[catch {close $fd_ph}]} {
ui_status [mc "Commit declined by prepare-commit-msg hook."]
hook_failed_popup prepare-commit-msg $pch_error
catch {file delete [gitdir PREPARE_COMMIT_MSG]}
exit 1
} else {
load_message PREPARE_COMMIT_MSG
}
set pch_error {}
catch {file delete [gitdir PREPARE_COMMIT_MSG]}
return
}
fconfigure $fd_ph -blocking 0
catch {file delete [gitdir PREPARE_COMMIT_MSG]}
}
proc read_diff_index {fd after} {
global buf_rdi
append buf_rdi [read $fd]
set c 0
set n [string length $buf_rdi]
while {$c < $n} {
set z1 [string first "\0" $buf_rdi $c]
if {$z1 == -1} break
incr z1
set z2 [string first "\0" $buf_rdi $z1]
if {$z2 == -1} break
incr c
set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
merge_state \
[encoding convertfrom $p] \
[lindex $i 4]? \
[list [lindex $i 0] [lindex $i 2]] \
[list]
set c $z2
incr c
}
if {$c < $n} {
set buf_rdi [string range $buf_rdi $c end]
} else {
set buf_rdi {}
}
rescan_done $fd buf_rdi $after
}
proc read_diff_files {fd after} {
global buf_rdf
append buf_rdf [read $fd]
set c 0
set n [string length $buf_rdf]
while {$c < $n} {
set z1 [string first "\0" $buf_rdf $c]
if {$z1 == -1} break
incr z1
set z2 [string first "\0" $buf_rdf $z1]
if {$z2 == -1} break
incr c
set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
merge_state \
[encoding convertfrom $p] \
?[lindex $i 4] \
[list] \
[list [lindex $i 0] [lindex $i 2]]
set c $z2
incr c
}
if {$c < $n} {
set buf_rdf [string range $buf_rdf $c end]
} else {
set buf_rdf {}
}
rescan_done $fd buf_rdf $after
}
proc read_ls_others {fd after} {
global buf_rlo
append buf_rlo [read $fd]
set pck [split $buf_rlo "\0"]
set buf_rlo [lindex $pck end]
foreach p [lrange $pck 0 end-1] {
set p [encoding convertfrom $p]
if {[string index $p end] eq {/}} {
set p [string range $p 0 end-1]
}
merge_state $p ?O
}
rescan_done $fd buf_rlo $after
}
proc rescan_done {fd buf after} {
global rescan_active current_diff_path
global file_states repo_config
upvar $buf to_clear
if {![eof $fd]} return
set to_clear {}
close $fd
if {[incr rescan_active -1] > 0} return
prune_selection
unlock_index
display_all_files
if {$current_diff_path ne {}} { reshow_diff $after }
if {$current_diff_path eq {}} { select_first_diff $after }
}
proc prune_selection {} {
global file_states selected_paths
foreach path [array names selected_paths] {
if {[catch {set still_here $file_states($path)}]} {
unset selected_paths($path)
}
}
}
######################################################################
##
## ui helpers
proc mapicon {w state path} {
global all_icons
if {[catch {set r $all_icons($state$w)}]} {
puts "error: no icon for $w state={$state} $path"
return file_plain
}
return $r
}
proc mapdesc {state path} {
global all_descs
if {[catch {set r $all_descs($state)}]} {
puts "error: no desc for state={$state} $path"
return $state
}
return $r
}
proc ui_status {msg} {
global main_status
if {[info exists main_status]} {
$main_status show $msg
}
}
proc ui_ready {{test {}}} {
global main_status
if {[info exists main_status]} {
$main_status show [mc "Ready."] $test
}
}
proc escape_path {path} {
regsub -all {\\} $path "\\\\" path
regsub -all "\n" $path "\\n" path
return $path
}
proc short_path {path} {
return [escape_path [lindex [file split $path] end]]
}
set next_icon_id 0
set null_sha1 [string repeat 0 40]
proc merge_state {path new_state {head_info {}} {index_info {}}} {
global file_states next_icon_id null_sha1
set s0 [string index $new_state 0]
set s1 [string index $new_state 1]
if {[catch {set info $file_states($path)}]} {
set state __
set icon n[incr next_icon_id]
} else {
set state [lindex $info 0]
set icon [lindex $info 1]
if {$head_info eq {}} {set head_info [lindex $info 2]}
if {$index_info eq {}} {set index_info [lindex $info 3]}
}
if {$s0 eq {?}} {set s0 [string index $state 0]} \
elseif {$s0 eq {_}} {set s0 _}
if {$s1 eq {?}} {set s1 [string index $state 1]} \
elseif {$s1 eq {_}} {set s1 _}
if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
set head_info [list 0 $null_sha1]
} elseif {$s0 ne {_} && [string index $state 0] eq {_}
&& $head_info eq {}} {
set head_info $index_info
} elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
set index_info $head_info
set head_info {}
}
set file_states($path) [list $s0$s1 $icon \
$head_info $index_info \
]
return $state
}
proc display_file_helper {w path icon_name old_m new_m} {
global file_lists
if {$new_m eq {_}} {
set lno [lsearch -sorted -exact $file_lists($w) $path]
if {$lno >= 0} {
set file_lists($w) [lreplace $file_lists($w) $lno $lno]
incr lno
$w conf -state normal
$w delete $lno.0 [expr {$lno + 1}].0
$w conf -state disabled
}
} elseif {$old_m eq {_} && $new_m ne {_}} {
lappend file_lists($w) $path
set file_lists($w) [lsort -unique $file_lists($w)]
set lno [lsearch -sorted -exact $file_lists($w) $path]
incr lno
$w conf -state normal
$w image create $lno.0 \
-align center -padx 5 -pady 1 \
-name $icon_name \
-image [mapicon $w $new_m $path]
$w insert $lno.1 "[escape_path $path]\n"
$w conf -state disabled
} elseif {$old_m ne $new_m} {
$w conf -state normal
$w image conf $icon_name -image [mapicon $w $new_m $path]
$w conf -state disabled
}
}
proc display_file {path state} {
global file_states selected_paths
global ui_index ui_workdir
set old_m [merge_state $path $state]
set s $file_states($path)
set new_m [lindex $s 0]
set icon_name [lindex $s 1]
set o [string index $old_m 0]
set n [string index $new_m 0]
if {$o eq {U}} {
set o _
}
if {$n eq {U}} {
set n _
}
display_file_helper $ui_index $path $icon_name $o $n
if {[string index $old_m 0] eq {U}} {
set o U
} else {
set o [string index $old_m 1]
}
if {[string index $new_m 0] eq {U}} {
set n U
} else {
set n [string index $new_m 1]
}
display_file_helper $ui_workdir $path $icon_name $o $n
if {$new_m eq {__}} {
unset file_states($path)
catch {unset selected_paths($path)}
}
}
proc display_all_files_helper {w path icon_name m} {
global file_lists
lappend file_lists($w) $path
set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
$w image create end \
-align center -padx 5 -pady 1 \
-name $icon_name \
-image [mapicon $w $m $path]
$w insert end "[escape_path $path]\n"
}
set files_warning 0
proc display_all_files {} {
global ui_index ui_workdir
global file_states file_lists
global last_clicked
global files_warning
$ui_index conf -state normal
$ui_workdir conf -state normal
$ui_index delete 0.0 end
$ui_workdir delete 0.0 end
set last_clicked {}
set file_lists($ui_index) [list]
set file_lists($ui_workdir) [list]
set to_display [lsort [array names file_states]]
set display_limit [get_config gui.maxfilesdisplayed]
if {[llength $to_display] > $display_limit} {
if {!$files_warning} {
# do not repeatedly warn:
set files_warning 1
info_popup [mc "Displaying only %s of %s files." \
$display_limit [llength $to_display]]
}
set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
}
foreach path $to_display {
set s $file_states($path)
set m [lindex $s 0]
set icon_name [lindex $s 1]
set s [string index $m 0]
if {$s ne {U} && $s ne {_}} {
display_all_files_helper $ui_index $path \
$icon_name $s
}
if {[string index $m 0] eq {U}} {
set s U
} else {
set s [string index $m 1]
git-gui: Allow staging/unstaging individual diff hunks. Just like `git-add --interactive` we can now stage and unstage individual hunks within a file, rather than the entire file at once. This works on the basic idea of scanning backwards from the mouse position to find the hunk header, then going forwards to find the end of the hunk. Everything in that is sent to `git apply --cached`, prefixed by the diff header lines. We ignore whitespace errors while applying a hunk, as we expect the user's pre-commit hook to catch any possible problems. This matches our existing behavior with regards to adding an entire file with no whitespace error checking. Applying hunks means that we now have to capture and save the diff header lines, rather than chucking them. Not really a big deal, we just needed a new global to hang onto that current header information. We probably could have recreated it on demand during apply_hunk but that would mean we need to implement all of the funny rules about how to encode weird path names (e.g. ones containing LF) into a diff header so that the `git apply` process would understand what we are asking it to do. Much simpler to just store this small amount of data in a global and replay it when needed. I'm making absolutely no attempt to correct the line numbers on the remaining hunk headers after one hunk has been applied. This may cause some hunks to fail, as the position information would not be correct. Users can always refresh the current diff before applying a failing hunk to work around the issue. Perhaps if we ever implement hunk splitting we could also fix the remaining hunk headers. Applying hunks directly means that we need to process the diff data in binary, rather than using the system encoding and an automatic linefeed translation. This ensures that CRLF formatted files will be able to be fed directly to `git apply` without failures. Unfortunately it also means we will see CRs show up in the GUI as ugly little boxes at the end of each line in a CRLF file. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-25 03:20:57 +01:00
}
if {$s ne {_}} {
display_all_files_helper $ui_workdir $path \
$icon_name $s
git-gui: Allow staging/unstaging individual diff hunks. Just like `git-add --interactive` we can now stage and unstage individual hunks within a file, rather than the entire file at once. This works on the basic idea of scanning backwards from the mouse position to find the hunk header, then going forwards to find the end of the hunk. Everything in that is sent to `git apply --cached`, prefixed by the diff header lines. We ignore whitespace errors while applying a hunk, as we expect the user's pre-commit hook to catch any possible problems. This matches our existing behavior with regards to adding an entire file with no whitespace error checking. Applying hunks means that we now have to capture and save the diff header lines, rather than chucking them. Not really a big deal, we just needed a new global to hang onto that current header information. We probably could have recreated it on demand during apply_hunk but that would mean we need to implement all of the funny rules about how to encode weird path names (e.g. ones containing LF) into a diff header so that the `git apply` process would understand what we are asking it to do. Much simpler to just store this small amount of data in a global and replay it when needed. I'm making absolutely no attempt to correct the line numbers on the remaining hunk headers after one hunk has been applied. This may cause some hunks to fail, as the position information would not be correct. Users can always refresh the current diff before applying a failing hunk to work around the issue. Perhaps if we ever implement hunk splitting we could also fix the remaining hunk headers. Applying hunks directly means that we need to process the diff data in binary, rather than using the system encoding and an automatic linefeed translation. This ensures that CRLF formatted files will be able to be fed directly to `git apply` without failures. Unfortunately it also means we will see CRs show up in the GUI as ugly little boxes at the end of each line in a CRLF file. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-25 03:20:57 +01:00
}
}
$ui_index conf -state disabled
$ui_workdir conf -state disabled
git-gui: Allow staging/unstaging individual diff hunks. Just like `git-add --interactive` we can now stage and unstage individual hunks within a file, rather than the entire file at once. This works on the basic idea of scanning backwards from the mouse position to find the hunk header, then going forwards to find the end of the hunk. Everything in that is sent to `git apply --cached`, prefixed by the diff header lines. We ignore whitespace errors while applying a hunk, as we expect the user's pre-commit hook to catch any possible problems. This matches our existing behavior with regards to adding an entire file with no whitespace error checking. Applying hunks means that we now have to capture and save the diff header lines, rather than chucking them. Not really a big deal, we just needed a new global to hang onto that current header information. We probably could have recreated it on demand during apply_hunk but that would mean we need to implement all of the funny rules about how to encode weird path names (e.g. ones containing LF) into a diff header so that the `git apply` process would understand what we are asking it to do. Much simpler to just store this small amount of data in a global and replay it when needed. I'm making absolutely no attempt to correct the line numbers on the remaining hunk headers after one hunk has been applied. This may cause some hunks to fail, as the position information would not be correct. Users can always refresh the current diff before applying a failing hunk to work around the issue. Perhaps if we ever implement hunk splitting we could also fix the remaining hunk headers. Applying hunks directly means that we need to process the diff data in binary, rather than using the system encoding and an automatic linefeed translation. This ensures that CRLF formatted files will be able to be fed directly to `git apply` without failures. Unfortunately it also means we will see CRs show up in the GUI as ugly little boxes at the end of each line in a CRLF file. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-25 03:20:57 +01:00
}
######################################################################
##
## icons
set filemask {
#define mask_width 14
#define mask_height 15
static unsigned char mask_bits[] = {
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
}
image create bitmap file_plain -background white -foreground black -data {
#define plain_width 14
#define plain_height 15
static unsigned char plain_bits[] = {
0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_mod -background white -foreground blue -data {
#define mod_width 14
#define mod_height 15
static unsigned char mod_bits[] = {
0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_fulltick -background white -foreground "#007000" -data {
#define file_fulltick_width 14
#define file_fulltick_height 15
static unsigned char file_fulltick_bits[] = {
0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_question -background white -foreground black -data {
#define file_question_width 14
#define file_question_height 15
static unsigned char file_question_bits[] = {
0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_removed -background white -foreground red -data {
#define file_removed_width 14
#define file_removed_height 15
static unsigned char file_removed_bits[] = {
0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_merge -background white -foreground blue -data {
#define file_merge_width 14
#define file_merge_height 15
static unsigned char file_merge_bits[] = {
0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
image create bitmap file_statechange -background white -foreground green -data {
#define file_statechange_width 14
#define file_statechange_height 15
static unsigned char file_statechange_bits[] = {
0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
} -maskdata $filemask
set ui_index .vpane.files.index.list
set ui_workdir .vpane.files.workdir.list
set all_icons(_$ui_index) file_plain
set all_icons(A$ui_index) file_plain
set all_icons(M$ui_index) file_fulltick
set all_icons(D$ui_index) file_removed
set all_icons(U$ui_index) file_merge
set all_icons(T$ui_index) file_statechange
set all_icons(_$ui_workdir) file_plain
set all_icons(M$ui_workdir) file_mod
set all_icons(D$ui_workdir) file_question
set all_icons(U$ui_workdir) file_merge
set all_icons(O$ui_workdir) file_plain
set all_icons(T$ui_workdir) file_statechange
set max_status_desc 0
foreach i {
{__ {mc "Unmodified"}}
{_M {mc "Modified, not staged"}}
{M_ {mc "Staged for commit"}}
{MM {mc "Portions staged for commit"}}
{MD {mc "Staged for commit, missing"}}
{_T {mc "File type changed, not staged"}}
{MT {mc "File type changed, old type staged for commit"}}
{AT {mc "File type changed, old type staged for commit"}}
{T_ {mc "File type changed, staged"}}
{TM {mc "File type change staged, modification not staged"}}
{TD {mc "File type change staged, file missing"}}
{_O {mc "Untracked, not staged"}}
{A_ {mc "Staged for commit"}}
{AM {mc "Portions staged for commit"}}
{AD {mc "Staged for commit, missing"}}
{_D {mc "Missing"}}
{D_ {mc "Staged for removal"}}
{DO {mc "Staged for removal, still present"}}
{_U {mc "Requires merge resolution"}}
{U_ {mc "Requires merge resolution"}}
{UU {mc "Requires merge resolution"}}
{UM {mc "Requires merge resolution"}}
{UD {mc "Requires merge resolution"}}
{UT {mc "Requires merge resolution"}}
} {
set text [eval [lindex $i 1]]
if {$max_status_desc < [string length $text]} {
set max_status_desc [string length $text]
}
set all_descs([lindex $i 0]) $text
}
unset i
######################################################################
##
## util
proc scrollbar2many {list mode args} {
foreach w $list {eval $w $mode $args}
}
proc many2scrollbar {list mode sb top bottom} {
$sb set $top $bottom
foreach w $list {$w $mode moveto $top}
}
proc incr_font_size {font {amt 1}} {
set sz [font configure $font -size]
incr sz $amt
font configure $font -size $sz
font configure ${font}bold -size $sz
font configure ${font}italic -size $sz
}
######################################################################
##
## ui commands
set starting_gitk_msg [mc "Starting gitk... please wait..."]
proc do_gitk {revs {is_submodule false}} {
global current_diff_path file_states current_diff_side ui_index
global _gitdir _gitworktree
# -- Always start gitk through whatever we were loaded with. This
# lets us bypass using shell process on Windows systems.
#
set exe [_which gitk -script]
set cmd [list [info nameofexecutable] $exe]
if {$exe eq {}} {
error_popup [mc "Couldn't find gitk in PATH"]
} else {
global env
set pwd [pwd]
if {!$is_submodule} {
if {![is_bare]} {
cd $_gitworktree
}
} else {
cd $current_diff_path
if {$revs eq {--}} {
set s $file_states($current_diff_path)
set old_sha1 {}
set new_sha1 {}
switch -glob -- [lindex $s 0] {
M_ { set old_sha1 [lindex [lindex $s 2] 1] }
_M { set old_sha1 [lindex [lindex $s 3] 1] }
MM {
if {$current_diff_side eq $ui_index} {
set old_sha1 [lindex [lindex $s 2] 1]
set new_sha1 [lindex [lindex $s 3] 1]
} else {
set old_sha1 [lindex [lindex $s 3] 1]
}
}
}
set revs $old_sha1...$new_sha1
}
# GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
# we've been using for the main repository, so unset them.
# TODO we could make life easier (start up faster?) for gitk
# by setting these to the appropriate values to allow gitk
# to skip the heuristics to find their proper value
unset env(GIT_DIR)
unset env(GIT_WORK_TREE)
}
eval exec $cmd $revs "--" "--" &
set env(GIT_DIR) $_gitdir
set env(GIT_WORK_TREE) $_gitworktree
cd $pwd
ui_status $::starting_gitk_msg
after 10000 {
ui_ready $starting_gitk_msg
}
}
}
proc do_git_gui {} {
global current_diff_path
# -- Always start git gui through whatever we were loaded with. This
# lets us bypass using shell process on Windows systems.
#
set exe [list [_which git]]
if {$exe eq {}} {
error_popup [mc "Couldn't find git gui in PATH"]
} else {
global env
global _gitdir _gitworktree
# see note in do_gitk about unsetting these vars when
# running tools in a submodule
unset env(GIT_DIR)
unset env(GIT_WORK_TREE)
set pwd [pwd]
cd $current_diff_path
eval exec $exe gui &
set env(GIT_DIR) $_gitdir
set env(GIT_WORK_TREE) $_gitworktree
cd $pwd
ui_status $::starting_gitk_msg
after 10000 {
ui_ready $starting_gitk_msg
}
}
}
proc do_explore {} {
global _gitworktree
set explorer {}
if {[is_Cygwin] || [is_Windows]} {
set explorer "explorer.exe"
} elseif {[is_MacOSX]} {
set explorer "open"
} else {
# freedesktop.org-conforming system is our best shot
set explorer "xdg-open"
}
eval exec $explorer [list [file nativename $_gitworktree]] &
}
set is_quitting 0
set ret_code 1
proc terminate_me {win} {
global ret_code
if {$win ne {.}} return
exit $ret_code
}
proc do_quit {{rc {1}}} {
global ui_comm is_quitting repo_config commit_type
global GITGUI_BCK_exists GITGUI_BCK_i
git-gui: Automatically spell check commit messages as the user types Many user friendly tools like word processors, email editors and web browsers allow users to spell check the message they are writing as they type it, making it easy to identify a common misspelling of a word and correct it on the fly. We now open a bi-directional pipe to Aspell and feed the message text the user is editing off to the program about once every 300 milliseconds. This is frequent enough that the user sees the results almost immediately, but is not so frequent as to cause significant additional load on the system. If the user has modified the message text during the last 300 milliseconds we delay until the next period, ensuring that we avoid flooding the Aspell process with a lot of text while the user is actively typing their message. We wait to send the current message buffer to Aspell until the user is at a word boundary, thus ensuring that we are not likely to ask for misspelled word detection on a word that the user is actively typing, as most words are misspelled when only partially typed, even if the user has thus far typed it correctly. Misspelled words are highlighted in red and are given an underline, causing the word to stand out from the others in the buffer. This is a very common user interface idiom for displaying misspelled words, but differs from one platform to the next in slight variations. For example the Mac OS X system prefers using a dashed red underline, leaving the word in the original text color. Unfortunately the control that Tk gives us over text display is not powerful enough to handle such formatting so we have to work with the least common denominator. The top suggestions for a misspelling are saved in an array and offered to the user when they right-click (or on the Mac ctrl-click) a misspelled word. Selecting an entry from this menu will replace the misspelling with the correction shown. Replacement is integrated with the undo/redo stack so undoing a replacement will restore the misspelled original text. If Aspell could not be started during git-gui launch we silently eat the error and run without spell checking support. This way users who do not have Aspell in their $PATH can continue to use git-gui, although they will not get the advanced spelling functionality. If Aspell started successfully the version line and language are shown in git-gui's about box, below the Tcl/Tk versions. This way the user can verify the Aspell function has been activated. If Aspell crashes while we are running we inform the user with an error dialog and then disable Aspell entirely for the rest of this git-gui session. This prevents us from fork-bombing the system with Aspell instances that always crash when presented with the current message text, should there be a bug in either Aspell or in git-gui's output to it. We escape all input lines with ^, as recommended by the Aspell manual page, as this allows Aspell to properly ignore any input line that is otherwise looking like a command (e.g. ! to enable terse output). By using this escape however we need to correct all word offsets by -1 as Aspell is apparently considering the ^ escape to be part of the line's character count, but our Tk text widget obviously does not. Available dictionaries are offered in the Options dialog, allowing the user to select the language they want to spellcheck commit messages with for the current repository, as well as the global user setting that all repositories inherit. Special thanks to Adam Flott for suggesting connecting git-gui to Aspell for the purpose of spell checking the commit message, and to Wincent Colaiuta for the idea to wait for a word boundary before passing the message over for checking. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-07 08:35:25 +01:00
global ui_comm_spell
global ret_code use_ttk
if {$is_quitting} return
set is_quitting 1
if {[winfo exists $ui_comm]} {
# -- Stash our current commit buffer.
#
set save [gitdir GITGUI_MSG]
if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
file rename -force [gitdir GITGUI_BCK] $save
set GITGUI_BCK_exists 0
} else {
set msg [string trim [$ui_comm get 0.0 end]]
regsub -all -line {[ \r\t]+$} $msg {} msg
if {(![string match amend* $commit_type]
|| [$ui_comm edit modified])
&& $msg ne {}} {
catch {
set fd [open $save w]
fconfigure $fd -encoding utf-8
puts -nonewline $fd $msg
close $fd
}
} else {
catch {file delete $save}
}
}
git-gui: Automatically spell check commit messages as the user types Many user friendly tools like word processors, email editors and web browsers allow users to spell check the message they are writing as they type it, making it easy to identify a common misspelling of a word and correct it on the fly. We now open a bi-directional pipe to Aspell and feed the message text the user is editing off to the program about once every 300 milliseconds. This is frequent enough that the user sees the results almost immediately, but is not so frequent as to cause significant additional load on the system. If the user has modified the message text during the last 300 milliseconds we delay until the next period, ensuring that we avoid flooding the Aspell process with a lot of text while the user is actively typing their message. We wait to send the current message buffer to Aspell until the user is at a word boundary, thus ensuring that we are not likely to ask for misspelled word detection on a word that the user is actively typing, as most words are misspelled when only partially typed, even if the user has thus far typed it correctly. Misspelled words are highlighted in red and are given an underline, causing the word to stand out from the others in the buffer. This is a very common user interface idiom for displaying misspelled words, but differs from one platform to the next in slight variations. For example the Mac OS X system prefers using a dashed red underline, leaving the word in the original text color. Unfortunately the control that Tk gives us over text display is not powerful enough to handle such formatting so we have to work with the least common denominator. The top suggestions for a misspelling are saved in an array and offered to the user when they right-click (or on the Mac ctrl-click) a misspelled word. Selecting an entry from this menu will replace the misspelling with the correction shown. Replacement is integrated with the undo/redo stack so undoing a replacement will restore the misspelled original text. If Aspell could not be started during git-gui launch we silently eat the error and run without spell checking support. This way users who do not have Aspell in their $PATH can continue to use git-gui, although they will not get the advanced spelling functionality. If Aspell started successfully the version line and language are shown in git-gui's about box, below the Tcl/Tk versions. This way the user can verify the Aspell function has been activated. If Aspell crashes while we are running we inform the user with an error dialog and then disable Aspell entirely for the rest of this git-gui session. This prevents us from fork-bombing the system with Aspell instances that always crash when presented with the current message text, should there be a bug in either Aspell or in git-gui's output to it. We escape all input lines with ^, as recommended by the Aspell manual page, as this allows Aspell to properly ignore any input line that is otherwise looking like a command (e.g. ! to enable terse output). By using this escape however we need to correct all word offsets by -1 as Aspell is apparently considering the ^ escape to be part of the line's character count, but our Tk text widget obviously does not. Available dictionaries are offered in the Options dialog, allowing the user to select the language they want to spellcheck commit messages with for the current repository, as well as the global user setting that all repositories inherit. Special thanks to Adam Flott for suggesting connecting git-gui to Aspell for the purpose of spell checking the commit message, and to Wincent Colaiuta for the idea to wait for a word boundary before passing the message over for checking. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-07 08:35:25 +01:00
# -- Cancel our spellchecker if its running.
#
if {[info exists ui_comm_spell]} {
$ui_comm_spell stop
}
# -- Remove our editor backup, its not needed.
#
after cancel $GITGUI_BCK_i
if {$GITGUI_BCK_exists} {
catch {file delete [gitdir GITGUI_BCK]}
}
# -- Stash our current window geometry into this repository.
#
set cfg_wmstate [wm state .]
if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
set rc_wmstate {}
}
if {$cfg_wmstate ne $rc_wmstate} {
catch {git config gui.wmstate $cfg_wmstate}
}
if {$cfg_wmstate eq {zoomed}} {
# on Windows wm geometry will lie about window
# position (but not size) when window is zoomed
# restore the window before querying wm geometry
wm state . normal
}
set cfg_geometry [list]
lappend cfg_geometry [wm geometry .]
if {$use_ttk} {
lappend cfg_geometry [.vpane sashpos 0]
lappend cfg_geometry [.vpane.files sashpos 0]
} else {
lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
}
if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
set rc_geometry {}
}
if {$cfg_geometry ne $rc_geometry} {
catch {git config gui.geometry $cfg_geometry}
}
}
set ret_code $rc
# Briefly enable send again, working around Tk bug
# http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
tk appname [appname]
destroy .
}
proc do_rescan {} {
rescan ui_ready
}
proc ui_do_rescan {} {
rescan {force_first_diff ui_ready}
}
proc do_commit {} {
commit_tree
}
proc next_diff {{after {}}} {
global next_diff_p next_diff_w next_diff_i
show_diff $next_diff_p $next_diff_w {} {} $after
}
proc find_anchor_pos {lst name} {
set lid [lsearch -sorted -exact $lst $name]
if {$lid == -1} {
set lid 0
foreach lname $lst {
if {$lname >= $name} break
incr lid
}
}
return $lid
}
proc find_file_from {flist idx delta path mmask} {
global file_states
set len [llength $flist]
while {$idx >= 0 && $idx < $len} {
set name [lindex $flist $idx]
if {$name ne $path && [info exists file_states($name)]} {
set state [lindex $file_states($name) 0]
if {$mmask eq {} || [regexp $mmask $state]} {
return $idx
}
}
incr idx $delta
}
return {}
}
proc find_next_diff {w path {lno {}} {mmask {}}} {
global next_diff_p next_diff_w next_diff_i
global file_lists ui_index ui_workdir
set flist $file_lists($w)
if {$lno eq {}} {
set lno [find_anchor_pos $flist $path]
} else {
incr lno -1
}
if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
if {$w eq $ui_index} {
set mmask "^$mmask"
} else {
set mmask "$mmask\$"
}
}
set idx [find_file_from $flist $lno 1 $path $mmask]
if {$idx eq {}} {
incr lno -1
set idx [find_file_from $flist $lno -1 $path $mmask]
}
if {$idx ne {}} {
set next_diff_w $w
set next_diff_p [lindex $flist $idx]
set next_diff_i [expr {$idx+1}]
return 1
} else {
return 0
}
}
proc next_diff_after_action {w path {lno {}} {mmask {}}} {
global current_diff_path
if {$path ne $current_diff_path} {
return {}
} elseif {[find_next_diff $w $path $lno $mmask]} {
return {next_diff;}
} else {
return {reshow_diff;}
}
}
proc select_first_diff {after} {
global ui_workdir
if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
[find_next_diff $ui_workdir {} 1 {[^O]$}]} {
next_diff $after
} else {
uplevel #0 $after
}
}
proc force_first_diff {after} {
global ui_workdir current_diff_path file_states
if {[info exists file_states($current_diff_path)]} {
set state [lindex $file_states($current_diff_path) 0]
} else {
set state {OO}
}
set reselect 0
if {[string first {U} $state] >= 0} {
# Already a conflict, do nothing
} elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
set reselect 1
} elseif {[string index $state 1] ne {O}} {
# Already a diff & no conflicts, do nothing
} elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
set reselect 1
}
if {$reselect} {
next_diff $after
} else {
uplevel #0 $after
}
}
proc toggle_or_diff {w x y} {
global file_states file_lists current_diff_path ui_index ui_workdir
global last_clicked selected_paths
set pos [split [$w index @$x,$y] .]
set lno [lindex $pos 0]
set col [lindex $pos 1]
set path [lindex $file_lists($w) [expr {$lno - 1}]]
if {$path eq {}} {
set last_clicked {}
return
}
set last_clicked [list $w $lno]
array unset selected_paths
$ui_index tag remove in_sel 0.0 end
$ui_workdir tag remove in_sel 0.0 end
# Determine the state of the file
if {[info exists file_states($path)]} {
set state [lindex $file_states($path) 0]
} else {
set state {__}
}
# Restage the file, or simply show the diff
if {$col == 0 && $y > 1} {
# Conflicts need special handling
if {[string first {U} $state] >= 0} {
# $w must always be $ui_workdir, but...
if {$w ne $ui_workdir} { set lno {} }
merge_stage_workdir $path $lno
return
}
if {[string index $state 1] eq {O}} {
set mmask {}
} else {
set mmask {[^O]}
}
set after [next_diff_after_action $w $path $lno $mmask]
if {$w eq $ui_index} {
update_indexinfo \
"Unstaging [short_path $path] from commit" \
[list $path] \
[concat $after [list ui_ready]]
} elseif {$w eq $ui_workdir} {
update_index \
"Adding [short_path $path]" \
[list $path] \
[concat $after [list ui_ready]]
}
} else {
set selected_paths($path) 1
show_diff $path $w $lno
}
}
proc add_one_to_selection {w x y} {
global file_lists last_clicked selected_paths
set lno [lindex [split [$w index @$x,$y] .] 0]
set path [lindex $file_lists($w) [expr {$lno - 1}]]
if {$path eq {}} {
set last_clicked {}
return
}
if {$last_clicked ne {}
&& [lindex $last_clicked 0] ne $w} {
array unset selected_paths
[lindex $last_clicked 0] tag remove in_sel 0.0 end
}
set last_clicked [list $w $lno]
if {[catch {set in_sel $selected_paths($path)}]} {
set in_sel 0
}
if {$in_sel} {
unset selected_paths($path)
$w tag remove in_sel $lno.0 [expr {$lno + 1}].0
} else {
set selected_paths($path) 1
$w tag add in_sel $lno.0 [expr {$lno + 1}].0
}
}
proc add_range_to_selection {w x y} {
global file_lists last_clicked selected_paths
if {[lindex $last_clicked 0] ne $w} {
toggle_or_diff $w $x $y
return
}
set lno [lindex [split [$w index @$x,$y] .] 0]
set lc [lindex $last_clicked 1]
if {$lc < $lno} {
set begin $lc
set end $lno
} else {
set begin $lno
set end $lc
}
foreach path [lrange $file_lists($w) \
[expr {$begin - 1}] \
[expr {$end - 1}]] {
set selected_paths($path) 1
}
$w tag add in_sel $begin.0 [expr {$end + 1}].0
}
proc show_more_context {} {
global repo_config
if {$repo_config(gui.diffcontext) < 99} {
incr repo_config(gui.diffcontext)
reshow_diff
}
}
proc show_less_context {} {
global repo_config
if {$repo_config(gui.diffcontext) > 1} {
incr repo_config(gui.diffcontext) -1
reshow_diff
}
}
######################################################################
##
## ui construction
set ui_comm {}
# -- Menu Bar
#
menu .mbar -tearoff 0
if {[is_MacOSX]} {
# -- Apple Menu (Mac OS X only)
#
.mbar add cascade -label Apple -menu .mbar.apple
menu .mbar.apple
}
.mbar add cascade -label [mc Repository] -menu .mbar.repository
.mbar add cascade -label [mc Edit] -menu .mbar.edit
if {[is_enabled branch]} {
.mbar add cascade -label [mc Branch] -menu .mbar.branch
}
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
.mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
}
if {[is_enabled transport]} {
.mbar add cascade -label [mc Merge] -menu .mbar.merge
.mbar add cascade -label [mc Remote] -menu .mbar.remote
}
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
.mbar add cascade -label [mc Tools] -menu .mbar.tools
}
# -- Repository Menu
#
menu .mbar.repository
if {![is_bare]} {
.mbar.repository add command \
-label [mc "Explore Working Copy"] \
-command {do_explore}
}
if {[is_Windows]} {
.mbar.repository add command \
-label [mc "Git Bash"] \
-command {eval exec [auto_execok start] \
[list "Git Bash" bash --login -l &]}
}
if {[is_Windows] || ![is_bare]} {
.mbar.repository add separator
}
.mbar.repository add command \
-label [mc "Browse Current Branch's Files"] \
-command {browser::new $current_branch}
set ui_browse_current [.mbar.repository index last]
.mbar.repository add command \
-label [mc "Browse Branch Files..."] \
-command browser_open::dialog
.mbar.repository add separator
.mbar.repository add command \
-label [mc "Visualize Current Branch's History"] \
-command {do_gitk $current_branch}
set ui_visualize_current [.mbar.repository index last]
.mbar.repository add command \
-label [mc "Visualize All Branch History"] \
-command {do_gitk --all}
.mbar.repository add separator
proc current_branch_write {args} {
global current_branch
.mbar.repository entryconf $::ui_browse_current \
-label [mc "Browse %s's Files" $current_branch]
.mbar.repository entryconf $::ui_visualize_current \
-label [mc "Visualize %s's History" $current_branch]
}
trace add variable current_branch write current_branch_write
if {[is_enabled multicommit]} {
.mbar.repository add command -label [mc "Database Statistics"] \
-command do_stats
.mbar.repository add command -label [mc "Compress Database"] \
-command do_gc
.mbar.repository add command -label [mc "Verify Database"] \
-command do_fsck_objects
.mbar.repository add separator
if {[is_Cygwin]} {
.mbar.repository add command \
-label [mc "Create Desktop Icon"] \
-command do_cygwin_shortcut
} elseif {[is_Windows]} {
.mbar.repository add command \
-label [mc "Create Desktop Icon"] \
-command do_windows_shortcut
} elseif {[is_MacOSX]} {
.mbar.repository add command \
-label [mc "Create Desktop Icon"] \
-command do_macosx_app
}
}
if {[is_MacOSX]} {
proc ::tk::mac::Quit {args} { do_quit }
} else {
.mbar.repository add command -label [mc Quit] \
-command do_quit \
-accelerator $M1T-Q
}
# -- Edit Menu
#
menu .mbar.edit
.mbar.edit add command -label [mc Undo] \
-command {catch {[focus] edit undo}} \
-accelerator $M1T-Z
.mbar.edit add command -label [mc Redo] \
-command {catch {[focus] edit redo}} \
-accelerator $M1T-Y
.mbar.edit add separator
.mbar.edit add command -label [mc Cut] \
-command {catch {tk_textCut [focus]}} \
-accelerator $M1T-X
.mbar.edit add command -label [mc Copy] \
-command {catch {tk_textCopy [focus]}} \
-accelerator $M1T-C
.mbar.edit add command -label [mc Paste] \
-command {catch {tk_textPaste [focus]; [focus] see insert}} \
-accelerator $M1T-V
.mbar.edit add command -label [mc Delete] \
-command {catch {[focus] delete sel.first sel.last}} \
-accelerator Del
.mbar.edit add separator
.mbar.edit add command -label [mc "Select All"] \
-command {catch {[focus] tag add sel 0.0 end}} \
-accelerator $M1T-A
# -- Branch Menu
#
if {[is_enabled branch]} {
menu .mbar.branch
.mbar.branch add command -label [mc "Create..."] \
-command branch_create::dialog \
-accelerator $M1T-N
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label [mc "Checkout..."] \
-command branch_checkout::dialog \
-accelerator $M1T-O
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label [mc "Rename..."] \
-command branch_rename::dialog
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label [mc "Delete..."] \
-command branch_delete::dialog
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
.mbar.branch add command -label [mc "Reset..."] \
-command merge::reset_hard
lappend disable_on_lock [list .mbar.branch entryconf \
[.mbar.branch index last] -state]
}
# -- Commit Menu
#
proc commit_btn_caption {} {
if {[is_enabled nocommit]} {
return [mc "Done"]
} else {
return [mc Commit@@verb]
}
}
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
menu .mbar.commit
if {![is_enabled nocommit]} {
.mbar.commit add radiobutton \
-label [mc "New Commit"] \
-command do_select_commit_type \
-variable selected_commit_type \
-value new
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add radiobutton \
-label [mc "Amend Last Commit"] \
-command do_select_commit_type \
-variable selected_commit_type \
-value amend
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add separator
}
.mbar.commit add command -label [mc Rescan] \
-command ui_do_rescan \
-accelerator F5
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add command -label [mc "Stage To Commit"] \
-command do_add_selection \
-accelerator $M1T-T
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
-command do_add_all \
-accelerator $M1T-I
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add command -label [mc "Unstage From Commit"] \
-command do_unstage_selection \
-accelerator $M1T-U
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add command -label [mc "Revert Changes"] \
-command do_revert_selection \
-accelerator $M1T-J
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
.mbar.commit add separator
.mbar.commit add command -label [mc "Show Less Context"] \
-command show_less_context \
-accelerator $M1T-\-
.mbar.commit add command -label [mc "Show More Context"] \
-command show_more_context \
-accelerator $M1T-=
.mbar.commit add separator
if {![is_enabled nocommitmsg]} {
.mbar.commit add command -label [mc "Sign Off"] \
-command do_signoff \
-accelerator $M1T-S
}
.mbar.commit add command -label [commit_btn_caption] \
-command do_commit \
-accelerator $M1T-Return
lappend disable_on_lock \
[list .mbar.commit entryconf [.mbar.commit index last] -state]
}
# -- Merge Menu
#
if {[is_enabled branch]} {
menu .mbar.merge
.mbar.merge add command -label [mc "Local Merge..."] \
-command merge::dialog \
-accelerator $M1T-M
lappend disable_on_lock \
[list .mbar.merge entryconf [.mbar.merge index last] -state]
.mbar.merge add command -label [mc "Abort Merge..."] \
-command merge::reset_hard
lappend disable_on_lock \
[list .mbar.merge entryconf [.mbar.merge index last] -state]
}
# -- Transport Menu
#
if {[is_enabled transport]} {
menu .mbar.remote
.mbar.remote add command \
-label [mc "Add..."] \
-command remote_add::dialog \
-accelerator $M1T-A
.mbar.remote add command \
-label [mc "Push..."] \
-command do_push_anywhere \
-accelerator $M1T-P
.mbar.remote add command \
-label [mc "Delete Branch..."] \
git-gui: Allow users to delete remote branches Git has supported remote branch deletion for quite some time, but I've just never gotten around to supporting it in git-gui. Some workflows have users push short-term branches to some remote Git repository, then delete them a few days/weeks later when that topic has been fully merged into the main trunk. Typically in that style of workflow the user will want to remove the branches they created. We now offer a "Delete..." option in the Push menu, right below the generic "Push..." option. When the user opens our generic delete dialog they can select a preconfigured remote, or enter a random URL. We run `git ls-remote $url` to obtain the list of branches and tags known there, and offer this list in a listbox for the user to select one or more from. Like our local branch delete dialog we offer the user a way to filter their selected branch list down to only those branches that have been merged into another branch. This is a very common operation as the user will likely want to select a range of topic branches, but only delete them if they have been merged into some sort of common trunk. Unfortunately our remote merge base detection is not nearly as strict as the local branch version. We only offer remote heads as the test commit (not any local ones) and we require that all necessary commits to successfully run git-merge-base are available locally. If one or more is missing we suggest that the user run a fetch first. Since the Git remote protocol doesn't let us specify what the tested commit was when we evaluated our decision to execute the remote delete there is a race condition here. The user could do a merge test against the trunk, determine a topic branch was fully merged, but before they can start pushing the delete request another user could fast-forward the remote topic branch to a new commit that is not merged into the trunk. The delete will arrive after, and remove the topic, even though it was not fully merged. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-05-28 21:23:32 +02:00
-command remote_branch_delete::dialog
}
if {[is_MacOSX]} {
proc ::tk::mac::ShowPreferences {} {do_options}
} else {
# -- Edit Menu
#
.mbar.edit add separator
.mbar.edit add command -label [mc "Options..."] \
-command do_options
}
# -- Tools Menu
#
if {[is_enabled multicommit] || [is_enabled singlecommit]} {
set tools_menubar .mbar.tools
menu $tools_menubar
$tools_menubar add separator
$tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
$tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
set tools_tailcnt 3
if {[array names repo_config guitool.*.cmd] ne {}} {
tools_populate_all
}
}
# -- Help Menu
#
.mbar add cascade -label [mc Help] -menu .mbar.help
menu .mbar.help
if {[is_MacOSX]} {
.mbar.apple add command -label [mc "About %s" [appname]] \
-command do_about
.mbar.apple add separator
} else {
.mbar.help add command -label [mc "About %s" [appname]] \
-command do_about
}
. configure -menu .mbar
set doc_path [githtmldir]
if {$doc_path ne {}} {
set doc_path [file join $doc_path index.html]
if {[is_Cygwin]} {
set doc_path [exec cygpath --mixed $doc_path]
}
}
if {[file isfile $doc_path]} {
set doc_url "file:$doc_path"
} else {
set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
}
proc start_browser {url} {
git "web--browse" $url
}
.mbar.help add command -label [mc "Online Documentation"] \
-command [list start_browser $doc_url]
.mbar.help add command -label [mc "Show SSH Key"] \
-command do_ssh_key
unset doc_path doc_url
# -- Standard bindings
#
wm protocol . WM_DELETE_WINDOW do_quit
bind all <$M1B-Key-q> do_quit
bind all <$M1B-Key-Q> do_quit
bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
set subcommand_args {}
proc usage {} {
set s "usage: $::argv0 $::subcommand $::subcommand_args"
if {[tk windowingsystem] eq "win32"} {
wm withdraw .
tk_messageBox -icon info -message $s \
-title [mc "Usage"]
} else {
puts stderr $s
}
exit 1
}
proc normalize_relpath {path} {
set elements {}
foreach item [file split $path] {
if {$item eq {.}} continue
if {$item eq {..} && [llength $elements] > 0
&& [lindex $elements end] ne {..}} {
set elements [lrange $elements 0 end-1]
continue
}
lappend elements $item
}
return [eval file join $elements]
}
# -- Not a normal commit type invocation? Do that instead!
#
switch -- $subcommand {
browser -
blame {
if {$subcommand eq "blame"} {
set subcommand_args {[--line=<num>] rev? path}
} else {
set subcommand_args {rev? path}
}
if {$argv eq {}} usage
set head {}
set path {}
set jump_spec {}
set is_path 0
foreach a $argv {
set p [file join $_prefix $a]
if {$is_path || [file exists $p]} {
if {$path ne {}} usage
set path [normalize_relpath $p]
break
} elseif {$a eq {--}} {
if {$path ne {}} {
if {$head ne {}} usage
set head $path
set path {}
}
set is_path 1
} elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
if {$jump_spec ne {} || $head ne {}} usage
set jump_spec [list $lnum]
} elseif {$head eq {}} {
if {$head ne {}} usage
set head $a
set is_path 1
} else {
usage
}
}
unset is_path
if {$head ne {} && $path eq {}} {
if {[string index $head 0] eq {/}} {
set path [normalize_relpath $head]
set head {}
} else {
set path [normalize_relpath $_prefix$head]
set head {}
}
}
if {$head eq {}} {
load_current_branch
} else {
if {[regexp {^[0-9a-f]{1,39}$} $head]} {
if {[catch {
set head [git rev-parse --verify $head]
} err]} {
if {[tk windowingsystem] eq "win32"} {
tk_messageBox -icon error -title [mc Error] -message $err
} else {
puts stderr $err
}
exit 1
}
}
set current_branch $head
}
wm deiconify .
switch -- $subcommand {
browser {
if {$jump_spec ne {}} usage
if {$head eq {}} {
if {$path ne {} && [file isdirectory $path]} {
set head $current_branch
} else {
set head $path
set path {}
}
}
browser::new $head $path
}
blame {
if {$head eq {} && ![file exists $path]} {
catch {wm withdraw .}
tk_messageBox \
-icon error \
-type ok \
-title [mc "git-gui: fatal error"] \
-message [mc "fatal: cannot stat path %s: No such file or directory" $path]
exit 1
}
blame::new $head $path $jump_spec
}
}
return
}
citool -
gui {
if {[llength $argv] != 0} {
usage
}
# fall through to setup UI for commits
}
default {
set err "usage: $argv0 \[{blame|browser|citool}\]"
if {[tk windowingsystem] eq "win32"} {
wm withdraw .
tk_messageBox -icon error -message $err \
-title [mc "Usage"]
} else {
puts stderr $err
}
exit 1
}
}
# -- Branch Control
#
${NS}::frame .branch
if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
${NS}::label .branch.l1 \
-text [mc "Current Branch:"] \
-anchor w \
-justify left
${NS}::label .branch.cb \
-textvariable current_branch \
-anchor w \
-justify left
pack .branch.l1 -side left
pack .branch.cb -side left -fill x
pack .branch -side top -fill x
# -- Main Window Layout
#
${NS}::panedwindow .vpane -orient horizontal
${NS}::panedwindow .vpane.files -orient vertical
if {$use_ttk} {
.vpane add .vpane.files
} else {
.vpane add .vpane.files -sticky nsew -height 100 -width 200
}
pack .vpane -anchor n -side top -fill both -expand 1
# -- Index File List
#
${NS}::frame .vpane.files.index -height 100 -width 200
tlabel .vpane.files.index.title \
-text [mc "Staged Changes (Will Commit)"] \
-background lightgreen -foreground black
text $ui_index -background white -foreground black \
-borderwidth 0 \
-width 20 -height 10 \
-wrap none \
-cursor $cursor_ptr \
-xscrollcommand {.vpane.files.index.sx set} \
-yscrollcommand {.vpane.files.index.sy set} \
-state disabled
${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
pack .vpane.files.index.title -side top -fill x
pack .vpane.files.index.sx -side bottom -fill x
pack .vpane.files.index.sy -side right -fill y
pack $ui_index -side left -fill both -expand 1
# -- Working Directory File List
#
${NS}::frame .vpane.files.workdir -height 100 -width 200
tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
-background lightsalmon -foreground black
text $ui_workdir -background white -foreground black \
-borderwidth 0 \
-width 20 -height 10 \
-wrap none \
-cursor $cursor_ptr \
-xscrollcommand {.vpane.files.workdir.sx set} \
-yscrollcommand {.vpane.files.workdir.sy set} \
-state disabled
${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
pack .vpane.files.workdir.title -side top -fill x
pack .vpane.files.workdir.sx -side bottom -fill x
pack .vpane.files.workdir.sy -side right -fill y
pack $ui_workdir -side left -fill both -expand 1
.vpane.files add .vpane.files.workdir
.vpane.files add .vpane.files.index
if {!$use_ttk} {
.vpane.files paneconfigure .vpane.files.workdir -sticky news
.vpane.files paneconfigure .vpane.files.index -sticky news
}
foreach i [list $ui_index $ui_workdir] {
rmsel_tag $i
$i tag conf in_diff -background [$i tag cget in_sel -background]
}
unset i
# -- Diff and Commit Area
#
if {$have_tk85} {
${NS}::panedwindow .vpane.lower -orient vertical
${NS}::frame .vpane.lower.commarea
${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
.vpane.lower add .vpane.lower.diff
.vpane.lower add .vpane.lower.commarea
.vpane add .vpane.lower
if {$use_ttk} {
.vpane.lower pane .vpane.lower.diff -weight 1
.vpane.lower pane .vpane.lower.commarea -weight 0
} else {
.vpane.lower paneconfigure .vpane.lower.diff -stretch always
.vpane.lower paneconfigure .vpane.lower.commarea -stretch never
}
} else {
frame .vpane.lower -height 300 -width 400
frame .vpane.lower.commarea
frame .vpane.lower.diff -relief sunken -borderwidth 1
pack .vpane.lower.diff -fill both -expand 1
pack .vpane.lower.commarea -side bottom -fill x
.vpane add .vpane.lower
.vpane paneconfigure .vpane.lower -sticky nsew
}
# -- Commit Area Buttons
#
${NS}::frame .vpane.lower.commarea.buttons
${NS}::label .vpane.lower.commarea.buttons.l -text {} \
-anchor w \
-justify left
pack .vpane.lower.commarea.buttons.l -side top -fill x
pack .vpane.lower.commarea.buttons -side left -fill y
${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
-command ui_do_rescan
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.rescan conf -state}
${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
-command do_add_all
pack .vpane.lower.commarea.buttons.incall -side top -fill x
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.incall conf -state}
if {![is_enabled nocommitmsg]} {
${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
-command do_signoff
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
}
${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
-command do_commit
pack .vpane.lower.commarea.buttons.commit -side top -fill x
lappend disable_on_lock \
{.vpane.lower.commarea.buttons.commit conf -state}
if {![is_enabled nocommit]} {
${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
-command do_push_anywhere
pack .vpane.lower.commarea.buttons.push -side top -fill x
}
# -- Commit Message Buffer
#
${NS}::frame .vpane.lower.commarea.buffer
${NS}::frame .vpane.lower.commarea.buffer.header
set ui_comm .vpane.lower.commarea.buffer.t
set ui_coml .vpane.lower.commarea.buffer.header.l
if {![is_enabled nocommit]} {
${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
-text [mc "New Commit"] \
-command do_select_commit_type \
-variable selected_commit_type \
-value new
lappend disable_on_lock \
[list .vpane.lower.commarea.buffer.header.new conf -state]
${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
-text [mc "Amend Last Commit"] \
-command do_select_commit_type \
-variable selected_commit_type \
-value amend
lappend disable_on_lock \
[list .vpane.lower.commarea.buffer.header.amend conf -state]
}
${NS}::label $ui_coml \
-anchor w \
-justify left
proc trace_commit_type {varname args} {
global ui_coml commit_type
switch -glob -- $commit_type {
initial {set txt [mc "Initial Commit Message:"]}
amend {set txt [mc "Amended Commit Message:"]}
amend-initial {set txt [mc "Amended Initial Commit Message:"]}
amend-merge {set txt [mc "Amended Merge Commit Message:"]}
merge {set txt [mc "Merge Commit Message:"]}
* {set txt [mc "Commit Message:"]}
}
$ui_coml conf -text $txt
}
trace add variable commit_type write trace_commit_type
pack $ui_coml -side left -fill x
if {![is_enabled nocommit]} {
pack .vpane.lower.commarea.buffer.header.amend -side right
pack .vpane.lower.commarea.buffer.header.new -side right
}
text $ui_comm -background white -foreground black \
-borderwidth 1 \
-undo true \
-maxundo 20 \
-autoseparators true \
-relief sunken \
-width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
-font font_diff \
-yscrollcommand {.vpane.lower.commarea.buffer.sby set}
${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
-command [list $ui_comm yview]
pack .vpane.lower.commarea.buffer.header -side top -fill x
pack .vpane.lower.commarea.buffer.sby -side right -fill y
pack $ui_comm -side left -fill y
pack .vpane.lower.commarea.buffer -side left -fill y
# -- Commit Message Buffer Context Menu
#
set ctxm .vpane.lower.commarea.buffer.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
-label [mc Cut] \
-command {tk_textCut $ui_comm}
$ctxm add command \
-label [mc Copy] \
-command {tk_textCopy $ui_comm}
$ctxm add command \
-label [mc Paste] \
-command {tk_textPaste $ui_comm}
$ctxm add command \
-label [mc Delete] \
-command {catch {$ui_comm delete sel.first sel.last}}
$ctxm add separator
$ctxm add command \
-label [mc "Select All"] \
-command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
$ctxm add command \
-label [mc "Copy All"] \
-command {
$ui_comm tag add sel 0.0 end
tk_textCopy $ui_comm
$ui_comm tag remove sel 0.0 end
}
$ctxm add separator
$ctxm add command \
-label [mc "Sign Off"] \
-command do_signoff
git-gui: Automatically spell check commit messages as the user types Many user friendly tools like word processors, email editors and web browsers allow users to spell check the message they are writing as they type it, making it easy to identify a common misspelling of a word and correct it on the fly. We now open a bi-directional pipe to Aspell and feed the message text the user is editing off to the program about once every 300 milliseconds. This is frequent enough that the user sees the results almost immediately, but is not so frequent as to cause significant additional load on the system. If the user has modified the message text during the last 300 milliseconds we delay until the next period, ensuring that we avoid flooding the Aspell process with a lot of text while the user is actively typing their message. We wait to send the current message buffer to Aspell until the user is at a word boundary, thus ensuring that we are not likely to ask for misspelled word detection on a word that the user is actively typing, as most words are misspelled when only partially typed, even if the user has thus far typed it correctly. Misspelled words are highlighted in red and are given an underline, causing the word to stand out from the others in the buffer. This is a very common user interface idiom for displaying misspelled words, but differs from one platform to the next in slight variations. For example the Mac OS X system prefers using a dashed red underline, leaving the word in the original text color. Unfortunately the control that Tk gives us over text display is not powerful enough to handle such formatting so we have to work with the least common denominator. The top suggestions for a misspelling are saved in an array and offered to the user when they right-click (or on the Mac ctrl-click) a misspelled word. Selecting an entry from this menu will replace the misspelling with the correction shown. Replacement is integrated with the undo/redo stack so undoing a replacement will restore the misspelled original text. If Aspell could not be started during git-gui launch we silently eat the error and run without spell checking support. This way users who do not have Aspell in their $PATH can continue to use git-gui, although they will not get the advanced spelling functionality. If Aspell started successfully the version line and language are shown in git-gui's about box, below the Tcl/Tk versions. This way the user can verify the Aspell function has been activated. If Aspell crashes while we are running we inform the user with an error dialog and then disable Aspell entirely for the rest of this git-gui session. This prevents us from fork-bombing the system with Aspell instances that always crash when presented with the current message text, should there be a bug in either Aspell or in git-gui's output to it. We escape all input lines with ^, as recommended by the Aspell manual page, as this allows Aspell to properly ignore any input line that is otherwise looking like a command (e.g. ! to enable terse output). By using this escape however we need to correct all word offsets by -1 as Aspell is apparently considering the ^ escape to be part of the line's character count, but our Tk text widget obviously does not. Available dictionaries are offered in the Options dialog, allowing the user to select the language they want to spellcheck commit messages with for the current repository, as well as the global user setting that all repositories inherit. Special thanks to Adam Flott for suggesting connecting git-gui to Aspell for the purpose of spell checking the commit message, and to Wincent Colaiuta for the idea to wait for a word boundary before passing the message over for checking. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-07 08:35:25 +01:00
set ui_comm_ctxm $ctxm
# -- Diff Header
#
proc trace_current_diff_path {varname args} {
global current_diff_path diff_actions file_states
if {$current_diff_path eq {}} {
set s {}
set f {}
set p {}
set o disabled
} else {
set p $current_diff_path
set s [mapdesc [lindex $file_states($p) 0] $p]
set f [mc "File:"]
set p [escape_path $p]
set o normal
}
.vpane.lower.diff.header.status configure -text $s
.vpane.lower.diff.header.file configure -text $f
.vpane.lower.diff.header.path configure -text $p
foreach w $diff_actions {
uplevel #0 $w $o
}
}
trace add variable current_diff_path write trace_current_diff_path
gold_frame .vpane.lower.diff.header
tlabel .vpane.lower.diff.header.status \
-background gold \
-foreground black \
-width $max_status_desc \
-anchor w \
-justify left
tlabel .vpane.lower.diff.header.file \
-background gold \
-foreground black \
-anchor w \
-justify left
tlabel .vpane.lower.diff.header.path \
-background gold \
-foreground black \
-anchor w \
-justify left
pack .vpane.lower.diff.header.status -side left
pack .vpane.lower.diff.header.file -side left
pack .vpane.lower.diff.header.path -fill x
set ctxm .vpane.lower.diff.header.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
-label [mc Copy] \
-command {
clipboard clear
clipboard append \
-format STRING \
-type STRING \
-- $current_diff_path
}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
# -- Diff Body
#
${NS}::frame .vpane.lower.diff.body
set ui_diff .vpane.lower.diff.body.t
text $ui_diff -background white -foreground black \
-borderwidth 0 \
-width 80 -height 5 -wrap none \
-font font_diff \
-xscrollcommand {.vpane.lower.diff.body.sbx set} \
-yscrollcommand {.vpane.lower.diff.body.sby set} \
-state disabled
catch {$ui_diff configure -tabstyle wordprocessor}
${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
-command [list $ui_diff xview]
${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
-command [list $ui_diff yview]
pack .vpane.lower.diff.body.sbx -side bottom -fill x
pack .vpane.lower.diff.body.sby -side right -fill y
pack $ui_diff -side left -fill both -expand 1
pack .vpane.lower.diff.header -side top -fill x
pack .vpane.lower.diff.body -side bottom -fill both -expand 1
foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
$ui_diff tag configure clr4$n -background $c
$ui_diff tag configure clri4$n -foreground $c
$ui_diff tag configure clr3$n -foreground $c
$ui_diff tag configure clri3$n -background $c
}
$ui_diff tag configure clr1 -font font_diffbold
$ui_diff tag configure clr4 -underline 1
$ui_diff tag conf d_info -foreground blue -font font_diffbold
$ui_diff tag conf d_cr -elide true
$ui_diff tag conf d_@ -font font_diffbold
$ui_diff tag conf d_+ -foreground {#00a000}
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d_- -foreground red
$ui_diff tag conf d_++ -foreground {#00a000}
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d_-- -foreground red
$ui_diff tag conf d_+s \
-foreground {#00a000} \
-background {#e2effa}
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d_-s \
-foreground red \
-background {#e2effa}
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d_s+ \
-foreground {#00a000} \
-background ivory1
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d_s- \
-foreground red \
-background ivory1
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
$ui_diff tag conf d< \
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
-foreground orange \
-font font_diffbold
$ui_diff tag conf d= \
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
-foreground orange \
-font font_diffbold
$ui_diff tag conf d> \
git-gui: Improve diff --cc viewing for unmerged files. Now that we are using 'git diff' to display unmerged working directory files we are getting 'diff --cc' output rather than 'diff --combined' output. Further the markers in the first two columns actually make sense here, we shouldn't attempt to rewrite them to something else. I've added 'diff --cc *' to the skip list in our diff viewer, as that particular line is not very interesting to display. I've completely refactored how we perform detection of the state of a line during diff parsing; we now report an error message if we don't understand the particular state of any given line. This way we know if we aren't tagging something we maybe should have tagged in the UI. I've also added special display of the standard conflict hunk markers (<<<<<<<, =======, >>>>>>>). These are formatted without a patch op as the patch op is always '+' or '++' (meaning the line has been added relative to the committed state) and are displayed in orange bold text, sort of like the @@ or @@@ marker line is at the start of each hunk. In a 3 way merge diff hunks which came from our HEAD are shown with a azure2 background, and hunks which came from the incoming MERGE_HEAD are displayed with a 'light goldenrod yellow' background. This makes the two different hunks clearly visible within the file. Hunks which are ++ or -- (added or deleted relative to both parents) are shown without any background at all. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-21 19:12:02 +01:00
-foreground orange \
-font font_diffbold
$ui_diff tag raise sel
# -- Diff Body Context Menu
#
proc create_common_diff_popup {ctxm} {
$ctxm add command \
-label [mc Refresh] \
-command reshow_diff
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
-label [mc Copy] \
-command {tk_textCopy $ui_diff}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
-label [mc "Select All"] \
-command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
-label [mc "Copy All"] \
-command {
$ui_diff tag add sel 0.0 end
tk_textCopy $ui_diff
$ui_diff tag remove sel 0.0 end
}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command \
-label [mc "Decrease Font Size"] \
-command {incr_font_size font_diff -1}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
-label [mc "Increase Font Size"] \
-command {incr_font_size font_diff 1}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
set emenu $ctxm.enc
menu $emenu
build_encoding_menu $emenu [list force_diff_encoding]
$ctxm add cascade \
-label [mc "Encoding"] \
-menu $emenu
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
$ctxm add command -label [mc "Options..."] \
-command do_options
}
set ctxm .vpane.lower.diff.body.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
-label [mc "Apply/Reverse Hunk"] \
-command {apply_hunk $cursorX $cursorY}
set ui_diff_applyhunk [$ctxm index last]
lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
$ctxm add command \
-label [mc "Apply/Reverse Line"] \
-command {apply_range_or_line $cursorX $cursorY; do_rescan}
set ui_diff_applyline [$ctxm index last]
lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
$ctxm add separator
$ctxm add command \
-label [mc "Show Less Context"] \
-command show_less_context
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add command \
-label [mc "Show More Context"] \
-command show_more_context
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
$ctxm add separator
create_common_diff_popup $ctxm
set ctxmmg .vpane.lower.diff.body.ctxmmg
menu $ctxmmg -tearoff 0
$ctxmmg add command \
-label [mc "Run Merge Tool"] \
-command {merge_resolve_tool}
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add separator
$ctxmmg add command \
-label [mc "Use Remote Version"] \
-command {merge_resolve_one 3}
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add command \
-label [mc "Use Local Version"] \
-command {merge_resolve_one 2}
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add command \
-label [mc "Revert To Base"] \
-command {merge_resolve_one 1}
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add separator
$ctxmmg add command \
-label [mc "Show Less Context"] \
-command show_less_context
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add command \
-label [mc "Show More Context"] \
-command show_more_context
lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
$ctxmmg add separator
create_common_diff_popup $ctxmmg
set ctxmsm .vpane.lower.diff.body.ctxmsm
menu $ctxmsm -tearoff 0
$ctxmsm add command \
-label [mc "Visualize These Changes In The Submodule"] \
-command {do_gitk -- true}
lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
$ctxmsm add command \
-label [mc "Visualize Current Branch History In The Submodule"] \
-command {do_gitk {} true}
lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
$ctxmsm add command \
-label [mc "Visualize All Branch History In The Submodule"] \
-command {do_gitk --all true}
lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
$ctxmsm add separator
$ctxmsm add command \
-label [mc "Start git gui In The Submodule"] \
-command {do_git_gui}
lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
$ctxmsm add separator
create_common_diff_popup $ctxmsm
proc has_textconv {path} {
if {[is_config_false gui.textconv]} {
return 0
}
set filter [gitattr $path diff set]
set textconv [get_config [join [list diff $filter textconv] .]]
if {$filter ne {set} && $textconv ne {}} {
return 1
} else {
return 0
}
}
proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
global current_diff_path file_states
set ::cursorX $x
set ::cursorY $y
if {[info exists file_states($current_diff_path)]} {
set state [lindex $file_states($current_diff_path) 0]
git-gui: Allow staging/unstaging individual diff hunks. Just like `git-add --interactive` we can now stage and unstage individual hunks within a file, rather than the entire file at once. This works on the basic idea of scanning backwards from the mouse position to find the hunk header, then going forwards to find the end of the hunk. Everything in that is sent to `git apply --cached`, prefixed by the diff header lines. We ignore whitespace errors while applying a hunk, as we expect the user's pre-commit hook to catch any possible problems. This matches our existing behavior with regards to adding an entire file with no whitespace error checking. Applying hunks means that we now have to capture and save the diff header lines, rather than chucking them. Not really a big deal, we just needed a new global to hang onto that current header information. We probably could have recreated it on demand during apply_hunk but that would mean we need to implement all of the funny rules about how to encode weird path names (e.g. ones containing LF) into a diff header so that the `git apply` process would understand what we are asking it to do. Much simpler to just store this small amount of data in a global and replay it when needed. I'm making absolutely no attempt to correct the line numbers on the remaining hunk headers after one hunk has been applied. This may cause some hunks to fail, as the position information would not be correct. Users can always refresh the current diff before applying a failing hunk to work around the issue. Perhaps if we ever implement hunk splitting we could also fix the remaining hunk headers. Applying hunks directly means that we need to process the diff data in binary, rather than using the system encoding and an automatic linefeed translation. This ensures that CRLF formatted files will be able to be fed directly to `git apply` without failures. Unfortunately it also means we will see CRs show up in the GUI as ugly little boxes at the end of each line in a CRLF file. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2007-01-25 03:20:57 +01:00
} else {
set state {__}
}
if {[string first {U} $state] >= 0} {
tk_popup $ctxmmg $X $Y
} elseif {$::is_submodule_diff} {
tk_popup $ctxmsm $X $Y
} else {
set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
if {$::ui_index eq $::current_diff_side} {
set l [mc "Unstage Hunk From Commit"]
if {$has_range} {
set t [mc "Unstage Lines From Commit"]
} else {
set t [mc "Unstage Line From Commit"]
}
} else {
set l [mc "Stage Hunk For Commit"]
if {$has_range} {
set t [mc "Stage Lines For Commit"]
} else {
set t [mc "Stage Line For Commit"]
}
}
if {$::is_3way_diff
|| $current_diff_path eq {}
|| {__} eq $state
|| {_O} eq $state
|| [string match {?T} $state]
|| [string match {T?} $state]
|| [has_textconv $current_diff_path]} {
set s disabled
} else {
set s normal
}
$ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
$ctxm entryconf $::ui_diff_applyline -state $s -label $t
tk_popup $ctxm $X $Y
}
}
bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
# -- Status Bar
#
set main_status [::status_bar::new .status]
pack .status -anchor w -side bottom -fill x
$main_status show [mc "Initializing..."]
# -- Load geometry
#
proc on_ttk_pane_mapped {w pane pos} {
bind $w <Map> {}
after 0 [list after idle [list $w sashpos $pane $pos]]
}
proc on_tk_pane_mapped {w pane x y} {
bind $w <Map> {}
after 0 [list after idle [list $w sash place $pane $x $y]]
}
proc on_application_mapped {} {
global repo_config use_ttk
bind . <Map> {}
set gm $repo_config(gui.geometry)
if {$use_ttk} {
bind .vpane <Map> \
[list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
bind .vpane.files <Map> \
[list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
} else {
bind .vpane <Map> \
[list on_tk_pane_mapped %W 0 \
[lindex $gm 1] \
[lindex [.vpane sash coord 0] 1]]
bind .vpane.files <Map> \
[list on_tk_pane_mapped %W 0 \
[lindex [.vpane.files sash coord 0] 0] \
[lindex $gm 2]]
}
wm geometry . [lindex $gm 0]
}
if {[info exists repo_config(gui.geometry)]} {
bind . <Map> [list on_application_mapped]
wm geometry . [lindex $repo_config(gui.geometry) 0]
}
# -- Load window state
#
if {[info exists repo_config(gui.wmstate)]} {
catch {wm state . $repo_config(gui.wmstate)}
}
# -- Key Bindings
#
bind $ui_comm <$M1B-Key-Return> {do_commit;break}
bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
bind $ui_comm <$M1B-Key-i> {do_add_all;break}
bind $ui_comm <$M1B-Key-I> {do_add_all;break}
bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
bind $ui_diff <$M1B-Key-v> {break}
bind $ui_diff <$M1B-Key-V> {break}
bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
bind $ui_diff <Button-1> {focus %W}
if {[is_enabled branch]} {
bind . <$M1B-Key-n> branch_create::dialog
bind . <$M1B-Key-N> branch_create::dialog
bind . <$M1B-Key-o> branch_checkout::dialog
bind . <$M1B-Key-O> branch_checkout::dialog
bind . <$M1B-Key-m> merge::dialog
bind . <$M1B-Key-M> merge::dialog
}
if {[is_enabled transport]} {
bind . <$M1B-Key-p> do_push_anywhere
bind . <$M1B-Key-P> do_push_anywhere
}
bind . <Key-F5> ui_do_rescan
bind . <$M1B-Key-r> ui_do_rescan
bind . <$M1B-Key-R> ui_do_rescan
bind . <$M1B-Key-s> do_signoff
bind . <$M1B-Key-S> do_signoff
bind . <$M1B-Key-t> do_add_selection
bind . <$M1B-Key-T> do_add_selection
bind . <$M1B-Key-u> do_unstage_selection
bind . <$M1B-Key-U> do_unstage_selection
bind . <$M1B-Key-j> do_revert_selection
bind . <$M1B-Key-J> do_revert_selection
bind . <$M1B-Key-i> do_add_all
bind . <$M1B-Key-I> do_add_all
bind . <$M1B-Key-minus> {show_less_context;break}
bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
bind . <$M1B-Key-equal> {show_more_context;break}
bind . <$M1B-Key-plus> {show_more_context;break}
bind . <$M1B-Key-KP_Add> {show_more_context;break}
bind . <$M1B-Key-Return> do_commit
foreach i [list $ui_index $ui_workdir] {
bind $i <Button-1> "toggle_or_diff $i %x %y; break"
bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
}
unset i
set file_lists($ui_index) [list]
set file_lists($ui_workdir) [list]
wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
focus -force $ui_comm
# -- Warn the user about environmental problems. Cygwin's Tcl
# does *not* pass its env array onto any processes it spawns.
# This means that git processes get none of our environment.
#
if {[is_Cygwin]} {
set ignored_env 0
set suggest_user {}
set msg [mc "Possible environment issues exist.
The following environment variables are probably
going to be ignored by any Git subprocess run
by %s:
" [appname]]
foreach name [array names env] {
switch -regexp -- $name {
{^GIT_INDEX_FILE$} -
{^GIT_OBJECT_DIRECTORY$} -
{^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
{^GIT_DIFF_OPTS$} -
{^GIT_EXTERNAL_DIFF$} -
{^GIT_PAGER$} -
{^GIT_TRACE$} -
{^GIT_CONFIG$} -
{^GIT_(AUTHOR|COMMITTER)_DATE$} {
append msg " - $name\n"
incr ignored_env
}
{^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
append msg " - $name\n"
incr ignored_env
set suggest_user $name
}
}
}
if {$ignored_env > 0} {
append msg [mc "
This is due to a known issue with the
Tcl binary distributed by Cygwin."]
if {$suggest_user ne {}} {
append msg [mc "
A good replacement for %s
is placing values for the user.name and
user.email settings into your personal
~/.gitconfig file.
" $suggest_user]
}
warn_popup $msg
}
unset ignored_env msg suggest_user name
}
# -- Only initialize complex UI if we are going to stay running.
#
if {[is_enabled transport]} {
load_all_remotes
set n [.mbar.remote index end]
populate_remotes_menu
set n [expr {[.mbar.remote index end] - $n}]
if {$n > 0} {
if {[.mbar.remote type 0] eq "tearoff"} { incr n }
.mbar.remote insert $n separator
}
unset n
}
if {[winfo exists $ui_comm]} {
set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
# -- If both our backup and message files exist use the
# newer of the two files to initialize the buffer.
#
if {$GITGUI_BCK_exists} {
set m [gitdir GITGUI_MSG]
if {[file isfile $m]} {
if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
catch {file delete [gitdir GITGUI_MSG]}
} else {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
catch {file delete [gitdir GITGUI_BCK]}
set GITGUI_BCK_exists 0
}
}
unset m
}
proc backup_commit_buffer {} {
global ui_comm GITGUI_BCK_exists
set m [$ui_comm edit modified]
if {$m || $GITGUI_BCK_exists} {
set msg [string trim [$ui_comm get 0.0 end]]
regsub -all -line {[ \r\t]+$} $msg {} msg
if {$msg eq {}} {
if {$GITGUI_BCK_exists} {
catch {file delete [gitdir GITGUI_BCK]}
set GITGUI_BCK_exists 0
}
} elseif {$m} {
catch {
set fd [open [gitdir GITGUI_BCK] w]
fconfigure $fd -encoding utf-8
puts -nonewline $fd $msg
close $fd
set GITGUI_BCK_exists 1
}
}
$ui_comm edit modified false
}
set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
}
backup_commit_buffer
git-gui: Automatically spell check commit messages as the user types Many user friendly tools like word processors, email editors and web browsers allow users to spell check the message they are writing as they type it, making it easy to identify a common misspelling of a word and correct it on the fly. We now open a bi-directional pipe to Aspell and feed the message text the user is editing off to the program about once every 300 milliseconds. This is frequent enough that the user sees the results almost immediately, but is not so frequent as to cause significant additional load on the system. If the user has modified the message text during the last 300 milliseconds we delay until the next period, ensuring that we avoid flooding the Aspell process with a lot of text while the user is actively typing their message. We wait to send the current message buffer to Aspell until the user is at a word boundary, thus ensuring that we are not likely to ask for misspelled word detection on a word that the user is actively typing, as most words are misspelled when only partially typed, even if the user has thus far typed it correctly. Misspelled words are highlighted in red and are given an underline, causing the word to stand out from the others in the buffer. This is a very common user interface idiom for displaying misspelled words, but differs from one platform to the next in slight variations. For example the Mac OS X system prefers using a dashed red underline, leaving the word in the original text color. Unfortunately the control that Tk gives us over text display is not powerful enough to handle such formatting so we have to work with the least common denominator. The top suggestions for a misspelling are saved in an array and offered to the user when they right-click (or on the Mac ctrl-click) a misspelled word. Selecting an entry from this menu will replace the misspelling with the correction shown. Replacement is integrated with the undo/redo stack so undoing a replacement will restore the misspelled original text. If Aspell could not be started during git-gui launch we silently eat the error and run without spell checking support. This way users who do not have Aspell in their $PATH can continue to use git-gui, although they will not get the advanced spelling functionality. If Aspell started successfully the version line and language are shown in git-gui's about box, below the Tcl/Tk versions. This way the user can verify the Aspell function has been activated. If Aspell crashes while we are running we inform the user with an error dialog and then disable Aspell entirely for the rest of this git-gui session. This prevents us from fork-bombing the system with Aspell instances that always crash when presented with the current message text, should there be a bug in either Aspell or in git-gui's output to it. We escape all input lines with ^, as recommended by the Aspell manual page, as this allows Aspell to properly ignore any input line that is otherwise looking like a command (e.g. ! to enable terse output). By using this escape however we need to correct all word offsets by -1 as Aspell is apparently considering the ^ escape to be part of the line's character count, but our Tk text widget obviously does not. Available dictionaries are offered in the Options dialog, allowing the user to select the language they want to spellcheck commit messages with for the current repository, as well as the global user setting that all repositories inherit. Special thanks to Adam Flott for suggesting connecting git-gui to Aspell for the purpose of spell checking the commit message, and to Wincent Colaiuta for the idea to wait for a word boundary before passing the message over for checking. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
2008-02-07 08:35:25 +01:00
# -- If the user has aspell available we can drive it
# in pipe mode to spellcheck the commit message.
#
set spell_cmd [list |]
set spell_dict [get_config gui.spellingdictionary]
lappend spell_cmd aspell
if {$spell_dict ne {}} {
lappend spell_cmd --master=$spell_dict
}
lappend spell_cmd --mode=none
lappend spell_cmd --encoding=utf-8
lappend spell_cmd pipe
if {$spell_dict eq {none}
|| [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
} else {
set ui_comm_spell [spellcheck::init \
$spell_fd \
$ui_comm \
$ui_comm_ctxm \
]
}
unset -nocomplain spell_cmd spell_fd spell_err spell_dict
}
lock_index begin-read
if {![winfo ismapped .]} {
wm deiconify .
}
after 1 {
if {[is_enabled initialamend]} {
force_amend
} else {
do_rescan
}
if {[is_enabled nocommitmsg]} {
$ui_comm configure -state disabled -background gray
}
}
if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
after 1000 hint_gc
}
if {[is_enabled retcode]} {
bind . <Destroy> {+terminate_me %W}
}
if {$picked && [is_config_true gui.autoexplore]} {
do_explore
}
# Local variables:
# mode: tcl
# indent-tabs-mode: t
# tab-width: 4
# End: