2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
10 exec wish
"$argv0" -- "$@"
12 set appvers
{@@GITGUI_VERSION@@
}
13 set copyright
[encoding convertfrom utf-8
{
14 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
16 This program is free software
; you can redistribute it and
/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation
; either version
2 of the License
, or
19 (at your option
) any later version.
21 This program is distributed
in the hope that it will be useful
,
22 but WITHOUT ANY WARRANTY
; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License
for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program
; if not
, write to the Free Software
28 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch
{package require Tcl
8.4} err
]
35 ||
[catch
{package require Tk
8.4} err
]
41 -title [mc
"git-gui: fatal error"] \
46 catch
{rename send
{}} ; # What an evil concept...
48 ######################################################################
52 set oguilib
{@@GITGUI_LIBDIR@@
}
53 set oguirel
{@@GITGUI_RELATIVE@@
}
54 if {$oguirel eq
{1}} {
55 set oguilib
[file dirname [file normalize
$argv0]]
56 if {[file tail $oguilib] eq
{git-core
}} {
57 set oguilib
[file dirname $oguilib]
59 set oguilib
[file dirname $oguilib]
60 set oguilib
[file join $oguilib share git-gui lib
]
61 set oguimsg
[file join $oguilib msgs
]
62 } elseif
{[string match @@
* $oguirel]} {
63 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
64 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
66 set oguimsg
[file join $oguilib msgs
]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
76 rename auto_load real__auto_load
77 proc auto_load
{name args
} {
78 puts stderr
"auto_load $name"
79 return [uplevel
1 real__auto_load
$name $args]
81 rename
source real__source
83 puts stderr
"source $name"
84 uplevel
1 real__source
$name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
96 set cmk
[string first @@
$fmt]
98 return [string range
$fmt 0 [expr {$cmk - 1}]]
103 proc mc
{en_fmt args
} {
104 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
105 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
106 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
112 return [join $args {}]
115 ::msgcat
::mcload
$oguimsg
118 ######################################################################
122 set _appname
{Git Gui
}
130 set _trace
[lsearch
-exact $argv --trace]
132 set argv
[lreplace
$argv $_trace $_trace]
148 return [eval [list
file join $_gitdir] $args]
151 proc gitexec
{args
} {
153 if {$_gitexec eq
{}} {
154 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
155 error
"Git not installed?\n\n$err"
158 set _gitexec
[exec cygpath \
163 set _gitexec
[file normalize
$_gitexec]
169 return [eval [list
file join $_gitexec] $args]
172 proc githtmldir
{args
} {
174 if {$_githtmldir eq
{}} {
175 if {[catch
{set _githtmldir
[git
--html-path]}]} {
176 # Git not installed or option not yet supported
180 set _githtmldir
[exec cygpath \
185 set _githtmldir
[file normalize
$_githtmldir]
191 return [eval [list
file join $_githtmldir] $args]
199 if {[tk windowingsystem
] eq
{aqua
}} {
206 if {$
::tcl_platform
(platform
) eq
{windows
}} {
214 if {$_iscygwin eq
{}} {
215 if {$
::tcl_platform
(platform
) eq
{windows
}} {
216 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
228 proc is_enabled
{option
} {
229 global enabled_options
230 if {[catch
{set on
$enabled_options($option)}]} {return 0}
234 proc enable_option
{option
} {
235 global enabled_options
236 set enabled_options
($option) 1
239 proc disable_option
{option
} {
240 global enabled_options
241 set enabled_options
($option) 0
244 ######################################################################
248 proc is_many_config
{name
} {
249 switch
-glob -- $name {
259 proc is_config_true
{name
} {
261 if {[catch
{set v
$repo_config($name)}]} {
263 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
270 proc get_config
{name
} {
272 if {[catch
{set v
$repo_config($name)}]} {
279 ######################################################################
283 proc _trace_exec
{cmd
} {
284 if {!$
::_trace
} return
290 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
298 proc _git_cmd {name} {
301 if {[catch {set v $_git_cmd_path($name)}]} {
305 --exec-path { return [list $::_git $name] }
308 set p [gitexec git-$name$::_search_exe]
309 if {[file exists $p]} {
311 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
312 # Try to determine what sort of magic will make
313 # git-$name go and do its thing, because native
314 # Tcl on Windows doesn't know it.
316 set p
[gitexec git-
$name]
321 switch
-glob -- [lindex
$s 0] {
323 #!*perl { set i perl }
324 #!*python { set i python }
325 default
{ error
"git-$name is not supported: $s" }
329 if {![info exists interp
]} {
330 set interp
[_which
$i]
333 error
"git-$name requires $i (not in PATH)"
335 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
337 # Assume it is builtin to git somehow and we
338 # aren't actually able to see a file for it.
340 set v
[list $
::_git
$name]
342 set _git_cmd_path
($name) $v
347 proc _which
{what args
} {
348 global env _search_exe _search_path
350 if {$_search_path eq
{}} {
351 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
352 set _search_path
[split [exec cygpath \
358 } elseif
{[is_Windows
]} {
359 set gitguidir
[file dirname [info
script]]
360 regsub
-all ";" $gitguidir "\\;" gitguidir
361 set env
(PATH
) "$gitguidir;$env(PATH)"
362 set _search_path
[split $env(PATH
) {;}]
365 set _search_path
[split $env(PATH
) :]
370 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
373 set suffix
$_search_exe
376 foreach p
$_search_path {
377 set p
[file join $p $what$suffix]
378 if {[file exists
$p]} {
379 return [file normalize
$p]
385 proc _lappend_nice
{cmd_var
} {
389 if {![info exists _nice
]} {
390 set _nice
[_which nice
]
391 if {[catch
{exec $_nice git version
}]} {
404 switch
-- [lindex
$args 0] {
415 set args
[lrange
$args 1 end
]
418 set cmdp
[_git_cmd
[lindex
$args 0]]
419 set args
[lrange
$args 1 end
]
421 _trace_exec
[concat
$opt $cmdp $args]
422 set result
[eval exec $opt $cmdp $args]
424 puts stderr
"< $result"
429 proc _open_stdout_stderr
{cmd
} {
432 set fd
[open
[concat
[list |
] $cmd] r
]
434 if { [lindex
$cmd end
] eq
{2>@
1}
435 && $err eq
{can not
find channel named
"1"}
437 # Older versions of Tcl 8.4 don't have this 2>@1 IO
438 # redirect operator. Fallback to |& cat for those.
439 # The command was not actually started, so its safe
440 # to try to start it a second time.
442 set fd
[open
[concat \
444 [lrange
$cmd 0 end-1
] \
451 fconfigure
$fd -eofchar {}
455 proc git_read
{args
} {
459 switch
-- [lindex
$args 0] {
474 set args
[lrange
$args 1 end
]
477 set cmdp
[_git_cmd
[lindex
$args 0]]
478 set args
[lrange
$args 1 end
]
480 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
483 proc git_write
{args
} {
487 switch
-- [lindex
$args 0] {
498 set args
[lrange
$args 1 end
]
501 set cmdp
[_git_cmd
[lindex
$args 0]]
502 set args
[lrange
$args 1 end
]
504 _trace_exec
[concat
$opt $cmdp $args]
505 return [open
[concat
[list |
] $opt $cmdp $args] w
]
508 proc githook_read
{hook_name args
} {
509 set pchook
[gitdir hooks
$hook_name]
512 # On Windows [file executable] might lie so we need to ask
513 # the shell if the hook is executable. Yes that's annoying.
517 if {![info exists interp
]} {
518 set interp
[_which sh
]
521 error
"hook execution requires sh (not in PATH)"
524 set scr
{if test -x "$1";then exec "$@";fi}
525 set sh_c
[list
$interp -c $scr $interp $pchook]
526 return [_open_stdout_stderr
[concat
$sh_c $args]]
529 if {[file executable
$pchook]} {
530 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
536 proc kill_file_process
{fd
} {
537 set process
[pid
$fd]
541 # Use a Cygwin-specific flag to allow killing
542 # native Windows processes
543 exec kill -f $process
550 proc gitattr
{path attr default
} {
551 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
554 set r
[join [lrange
[split $r :] 2 end
] :]
557 if {$r eq
{unspecified
}} {
564 regsub
-all ' $value "'\\''" value
568 proc load_current_branch {} {
569 global current_branch is_detached
571 set fd [open [gitdir HEAD] r]
572 if {[gets $fd ref] < 1} {
577 set pfx {ref: refs/heads/}
578 set len [string length $pfx]
579 if {[string equal -length $len $pfx $ref]} {
580 # We're on a branch. It might not exist. But
581 # HEAD looks good enough to be a branch.
583 set current_branch [string range $ref $len end]
586 # Assume this is a detached head.
588 set current_branch HEAD
593 auto_load tk_optionMenu
594 rename tk_optionMenu real__tkOptionMenu
595 proc tk_optionMenu {w varName args} {
596 set m [eval real__tkOptionMenu $w $varName $args]
597 $m configure -font font_ui
598 $w configure -font font_ui
602 proc rmsel_tag {text} {
604 -background [$text cget -background] \
605 -foreground [$text cget -foreground] \
607 $text tag conf in_sel -background lightgray
608 bind $text <Motion> break
613 bind . <Visibility> {
614 bind . <Visibility> {}
619 wm iconbitmap . -default $oguilib/git-gui.ico
620 set ::tk::AlwaysShowSelection 1
622 # Spoof an X11 display for SSH
623 if {![info exists env(DISPLAY)]} {
624 set env(DISPLAY) :9999
628 image create photo gitlogo -width 16 -height 16
630 gitlogo put #33CC33 -to 7 0 9 2
631 gitlogo put #33CC33 -to 4 2 12 4
632 gitlogo put #33CC33 -to 7 4 9 6
633 gitlogo put #CC3333 -to 4 6 12 8
634 gitlogo put gray26 -to 4 9 6 10
635 gitlogo put gray26 -to 3 10 6 12
636 gitlogo put gray26 -to 8 9 13 11
637 gitlogo put gray26 -to 8 11 10 12
638 gitlogo put gray26 -to 11 11 13 14
639 gitlogo put gray26 -to 3 12 5 14
640 gitlogo put gray26 -to 5 13
641 gitlogo put gray26 -to 10 13
642 gitlogo put gray26 -to 4 14 12 15
643 gitlogo put gray26 -to 5 15 11 16
646 wm iconphoto . -default gitlogo
650 ######################################################################
655 font create font_diff -family Courier -size 10
659 eval font configure font_ui [font actual [.dummy cget -font]]
663 font create font_uiitalic
664 font create font_uibold
665 font create font_diffbold
666 font create font_diffitalic
668 foreach class {Button Checkbutton Entry Label
669 Labelframe Listbox Message
670 Radiobutton Spinbox Text} {
671 option add *$class.font font_ui
674 option add *Menu.font font_ui
678 if {[is_Windows] || [is_MacOSX]} {
679 option add *Menu.tearOff 0
690 proc bind_button3 {w cmd} {
691 bind $w <Any-Button-3> $cmd
693 # Mac OS X sends Button-2 on right click through three-button mouse,
694 # or through trackpad right-clicking (two-finger touch + click).
695 bind $w <Any-Button-2> $cmd
696 bind $w <Control-Button-1> $cmd
700 proc apply_config {} {
701 global repo_config font_descs
703 foreach option $font_descs {
704 set name [lindex $option 0]
705 set font [lindex $option 1]
708 foreach {cn cv} $repo_config(gui.$name) {
709 if {$cn eq {-weight}} {
712 font configure $font $cn $cv
715 font configure $font -weight normal
718 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
720 foreach {cn cv} [font configure $font] {
721 font configure ${font}bold $cn $cv
722 font configure ${font}italic $cn $cv
724 font configure ${font}bold -weight bold
725 font configure ${font}italic -slant italic
729 set default_config(branch.autosetupmerge) true
730 set default_config(merge.tool) {}
731 set default_config(mergetool.keepbackup) true
732 set default_config(merge.diffstat) true
733 set default_config(merge.summary) false
734 set default_config(merge.verbosity) 2
735 set default_config(user.name) {}
736 set default_config(user.email) {}
738 set default_config(gui.encoding) [encoding system]
739 set default_config(gui.matchtrackingbranch) false
740 set default_config(gui.pruneduringfetch) false
741 set default_config(gui.trustmtime) false
742 set default_config(gui.fastcopyblame) false
743 set default_config(gui.copyblamethreshold) 40
744 set default_config(gui.blamehistoryctx) 7
745 set default_config(gui.diffcontext) 5
746 set default_config(gui.commitmsgwidth) 75
747 set default_config(gui.newbranchtemplate) {}
748 set default_config(gui.spellingdictionary) {}
749 set default_config(gui.fontui) [font configure font_ui]
750 set default_config(gui.fontdiff) [font configure font_diff]
751 # TODO: this option should be added to the git-config documentation
752 set default_config(gui.maxfilesdisplayed) 5000
754 {fontui font_ui {mc "Main Font
"}}
755 {fontdiff font_diff {mc "Diff
/Console Font
"}}
758 ######################################################################
762 set _git [_which git]
764 catch {wm withdraw .}
768 -title [mc "git-gui
: fatal error
"] \
769 -message [mc "Cannot
find git
in PATH.
"]
773 ######################################################################
777 if {[catch {set _git_version [git --version]} err]} {
778 catch {wm withdraw .}
782 -title [mc "git-gui
: fatal error
"] \
783 -message "Cannot determine Git version
:
787 [appname
] requires Git
1.5.0 or later.
"
790 if {![regsub {^git version } $_git_version {} _git_version]} {
791 catch {wm withdraw .}
795 -title [mc "git-gui
: fatal error
"] \
796 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
800 set _real_git_version $_git_version
801 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
802 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
803 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
804 regsub {\.GIT$} $_git_version {} _git_version
805 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
807 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
808 catch {wm withdraw .}
813 -title "[appname
]: warning
" \
814 -message [mc "Git version cannot be determined.
816 %s claims it is version
'%s'.
818 %s requires
at least Git
1.5.0 or later.
820 Assume
'%s' is version
1.5.0?
821 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
822 set _git_version 1.5.0
827 unset _real_git_version
829 proc git-version {args} {
832 switch [llength $args] {
838 set op [lindex $args 0]
839 set vr [lindex $args 1]
840 set cm [package vcompare $_git_version $vr]
841 return [expr $cm $op 0]
845 set type [lindex $args 0]
846 set name [lindex $args 1]
847 set parm [lindex $args 2]
848 set body [lindex $args 3]
850 if {($type ne {proc} && $type ne {method})} {
851 error "Invalid arguments to git-version
"
853 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
854 error "Last arm of
$type $name must be default
"
857 foreach {op vr cb} [lrange $body 0 end-2] {
858 if {[git-version $op $vr]} {
859 return [uplevel [list $type $name $parm $cb]]
863 return [uplevel [list $type $name $parm [lindex $body end]]]
867 error "git-version
>= x
"
873 if {[git-version < 1.5]} {
874 catch {wm withdraw .}
878 -title [mc "git-gui
: fatal error
"] \
879 -message "[appname
] requires Git
1.5.0 or later.
881 You are using
[git-version
]:
887 ######################################################################
889 ## configure our library
891 set idx [file join $oguilib tclIndex]
892 if {[catch {set fd [open $idx r]} err]} {
893 catch {wm withdraw .}
897 -title [mc "git-gui
: fatal error
"] \
901 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
903 while {[gets $fd n] >= 0} {
904 if {$n ne {} && ![string match #* $n]} {
916 if {[lsearch -exact $loaded $p] >= 0} continue
917 source [file join $oguilib $p]
922 set auto_path [concat [list $oguilib] $auto_path]
924 unset -nocomplain idx fd
926 ######################################################################
928 ## config file parsing
930 git-version proc _parse_config {arr_name args} {
937 [list git_read config] \
939 [list --null --list]]
940 fconfigure $fd_rc -translation binary
941 set buf [read $fd_rc]
944 foreach line [split $buf "\
0"] {
945 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
946 if {[is_many_config $name]} {
947 lappend arr($name) $value
949 set arr($name) $value
958 set fd_rc [eval [list git_read config --list] $args]
959 while {[gets $fd_rc line] >= 0} {
960 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
961 if {[is_many_config $name]} {
962 lappend arr($name) $value
964 set arr($name) $value
973 proc load_config {include_global} {
974 global repo_config global_config system_config default_config
976 if {$include_global} {
977 _parse_config system_config --system
978 _parse_config global_config --global
980 _parse_config repo_config
982 foreach name [array names default_config] {
983 if {[catch {set v $system_config($name)}]} {
984 set system_config($name) $default_config($name)
987 foreach name [array names system_config] {
988 if {[catch {set v $global_config($name)}]} {
989 set global_config($name) $system_config($name)
991 if {[catch {set v $repo_config($name)}]} {
992 set repo_config($name) $system_config($name)
997 ######################################################################
999 ## feature option selection
1001 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1006 if {$subcommand eq {gui.sh}} {
1009 if {$subcommand eq {gui} && [llength $argv] > 0} {
1010 set subcommand [lindex $argv 0]
1011 set argv [lrange $argv 1 end]
1014 enable_option multicommit
1015 enable_option branch
1016 enable_option transport
1019 switch -- $subcommand {
1024 disable_option multicommit
1025 disable_option branch
1026 disable_option transport
1029 enable_option singlecommit
1030 enable_option retcode
1032 disable_option multicommit
1033 disable_option branch
1034 disable_option transport
1036 while {[llength $argv] > 0} {
1037 set a [lindex $argv 0]
1040 enable_option initialamend
1043 enable_option nocommit
1044 enable_option nocommitmsg
1047 disable_option nocommitmsg
1054 set argv [lrange $argv 1 end]
1059 ######################################################################
1061 ## execution environment
1063 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1065 # Suggest our implementation of askpass, if none is set
1066 if {![info exists env(SSH_ASKPASS)]} {
1067 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1070 ######################################################################
1076 set _gitdir $env(GIT_DIR)
1080 # beware that from the .git dir this sets _gitdir to .
1081 # and _prefix to the empty string
1082 set _gitdir [git rev-parse --git-dir]
1083 set _prefix [git rev-parse --show-prefix]
1087 choose_repository::pick
1091 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1092 # run from the .git dir itself) lest the routines to find the worktree
1094 if {$_gitdir eq ".
"} {
1098 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1099 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1101 if {![file isdirectory $_gitdir]} {
1102 catch {wm withdraw .}
1103 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1106 if {$_prefix ne {}} {
1107 regsub -all {[^/]+/} $_prefix ../ cdup
1108 if {[catch {cd $cdup} err]} {
1109 catch {wm withdraw .}
1110 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1114 } elseif {![is_enabled bare]} {
1115 if {[lindex [file split $_gitdir] end] ne {.git}} {
1116 catch {wm withdraw .}
1117 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1120 if {[catch {cd [file dirname $_gitdir]} err]} {
1121 catch {wm withdraw .}
1122 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1126 set _reponame [file split [file normalize $_gitdir]]
1127 if {[lindex $_reponame end] eq {.git}} {
1128 set _reponame [lindex $_reponame end-1]
1130 set _reponame [lindex $_reponame end]
1133 ######################################################################
1137 set current_diff_path {}
1138 set current_diff_side {}
1139 set diff_actions [list]
1143 set MERGE_HEAD [list]
1146 set current_branch {}
1148 set current_diff_path {}
1150 set is_submodule_diff 0
1151 set is_conflict_diff 0
1152 set selected_commit_type new
1153 set diff_empty_count 0
1155 set nullid "0000000000000000000000000000000000000000"
1156 set nullid2 "0000000000000000000000000000000000000001"
1158 ######################################################################
1166 set disable_on_lock [list]
1167 set index_lock_type none
1169 proc lock_index {type} {
1170 global index_lock_type disable_on_lock
1172 if {$index_lock_type eq {none}} {
1173 set index_lock_type $type
1174 foreach w $disable_on_lock {
1175 uplevel #0 $w disabled
1178 } elseif {$index_lock_type eq "begin-
$type"} {
1179 set index_lock_type $type
1185 proc unlock_index {} {
1186 global index_lock_type disable_on_lock
1188 set index_lock_type none
1189 foreach w $disable_on_lock {
1190 uplevel #0 $w normal
1194 ######################################################################
1198 proc repository_state {ctvar hdvar mhvar} {
1199 global current_branch
1200 upvar $ctvar ct $hdvar hd $mhvar mh
1205 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1211 set merge_head [gitdir MERGE_HEAD]
1212 if {[file exists $merge_head]} {
1214 set fd_mh [open $merge_head r]
1215 while {[gets $fd_mh line] >= 0} {
1226 global PARENT empty_tree
1228 set p [lindex $PARENT 0]
1232 if {$empty_tree eq {}} {
1233 set empty_tree [git mktree << {}]
1238 proc force_amend {} {
1239 global selected_commit_type
1240 global HEAD PARENT MERGE_HEAD commit_type
1242 repository_state newType newHEAD newMERGE_HEAD
1245 set MERGE_HEAD $newMERGE_HEAD
1246 set commit_type $newType
1248 set selected_commit_type amend
1249 do_select_commit_type
1252 proc rescan {after {honor_trustmtime 1}} {
1253 global HEAD PARENT MERGE_HEAD commit_type
1254 global ui_index ui_workdir ui_comm
1255 global rescan_active file_states
1258 if {$rescan_active > 0 || ![lock_index read]} return
1260 repository_state newType newHEAD newMERGE_HEAD
1261 if {[string match amend* $commit_type]
1262 && $newType eq {normal}
1263 && $newHEAD eq $HEAD} {
1267 set MERGE_HEAD $newMERGE_HEAD
1268 set commit_type $newType
1271 array unset file_states
1273 if {!$::GITGUI_BCK_exists &&
1274 (![$ui_comm edit modified]
1275 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1276 if {[string match amend* $commit_type]} {
1277 } elseif {[load_message GITGUI_MSG]} {
1278 } elseif {[run_prepare_commit_msg_hook]} {
1279 } elseif {[load_message MERGE_MSG]} {
1280 } elseif {[load_message SQUASH_MSG]} {
1283 $ui_comm edit modified false
1286 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1287 rescan_stage2 {} $after
1290 ui_status [mc "Refreshing
file status...
"]
1291 set fd_rf [git_read update-index \
1297 fconfigure $fd_rf -blocking 0 -translation binary
1298 fileevent $fd_rf readable \
1299 [list rescan_stage2 $fd_rf $after]
1304 set is_git_info_exclude {}
1305 proc have_info_exclude {} {
1306 global is_git_info_exclude
1308 if {$is_git_info_exclude eq {}} {
1309 if {[catch {exec test -f [gitdir info exclude]}]} {
1310 set is_git_info_exclude 0
1312 set is_git_info_exclude 1
1315 return $is_git_info_exclude
1318 proc have_info_exclude {} {
1319 return [file readable [gitdir info exclude]]
1323 proc rescan_stage2 {fd after} {
1324 global rescan_active buf_rdi buf_rdf buf_rlo
1328 if {![eof $fd]} return
1332 set ls_others [list --exclude-per-directory=.gitignore]
1333 if {[have_info_exclude]} {
1334 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1336 set user_exclude [get_config core.excludesfile]
1337 if {$user_exclude ne {} && [file readable $user_exclude]} {
1338 lappend ls_others "--exclude-from=$user_exclude"
1346 ui_status [mc "Scanning
for modified files ...
"]
1347 set fd_di [git_read diff-index --cached -z [PARENT]]
1348 set fd_df [git_read diff-files -z]
1349 set fd_lo [eval git_read ls-files --others -z $ls_others]
1351 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1352 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1353 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1354 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1355 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1356 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1359 proc load_message {file} {
1362 set f [gitdir $file]
1363 if {[file isfile $f]} {
1364 if {[catch {set fd [open $f r]}]} {
1367 fconfigure $fd -eofchar {}
1368 set content [string trim [read $fd]]
1370 regsub -all -line {[ \r\t]+$} $content {} content
1371 $ui_comm delete 0.0 end
1372 $ui_comm insert end $content
1378 proc run_prepare_commit_msg_hook {} {
1381 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1382 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1383 # empty file but existant file.
1385 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1387 if {[file isfile [gitdir MERGE_MSG]]} {
1388 set pcm_source "merge
"
1389 set fd_mm [open [gitdir MERGE_MSG] r]
1390 puts -nonewline $fd_pcm [read $fd_mm]
1392 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1393 set pcm_source "squash
"
1394 set fd_sm [open [gitdir SQUASH_MSG] r]
1395 puts -nonewline $fd_pcm [read $fd_sm]
1403 set fd_ph [githook_read prepare-commit-msg \
1404 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1406 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1410 ui_status [mc "Calling prepare-commit-msg hook...
"]
1413 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1414 fileevent $fd_ph readable \
1415 [list prepare_commit_msg_hook_wait $fd_ph]
1420 proc prepare_commit_msg_hook_wait {fd_ph} {
1423 append pch_error [read $fd_ph]
1424 fconfigure $fd_ph -blocking 1
1426 if {[catch {close $fd_ph}]} {
1427 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1428 hook_failed_popup prepare-commit-msg $pch_error
1429 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1432 load_message PREPARE_COMMIT_MSG
1435 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1438 fconfigure $fd_ph -blocking 0
1439 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1442 proc read_diff_index {fd after} {
1445 append buf_rdi [read $fd]
1447 set n [string length $buf_rdi]
1449 set z1 [string first "\
0" $buf_rdi $c]
1450 if {$z1 == -1} break
1452 set z2 [string first "\
0" $buf_rdi $z1]
1453 if {$z2 == -1} break
1456 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1457 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1459 [encoding convertfrom $p] \
1461 [list [lindex $i 0] [lindex $i 2]] \
1467 set buf_rdi [string range $buf_rdi $c end]
1472 rescan_done $fd buf_rdi $after
1475 proc read_diff_files {fd after} {
1478 append buf_rdf [read $fd]
1480 set n [string length $buf_rdf]
1482 set z1 [string first "\
0" $buf_rdf $c]
1483 if {$z1 == -1} break
1485 set z2 [string first "\
0" $buf_rdf $z1]
1486 if {$z2 == -1} break
1489 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1490 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1492 [encoding convertfrom $p] \
1495 [list [lindex $i 0] [lindex $i 2]]
1500 set buf_rdf [string range $buf_rdf $c end]
1505 rescan_done $fd buf_rdf $after
1508 proc read_ls_others {fd after} {
1511 append buf_rlo [read $fd]
1512 set pck [split $buf_rlo "\
0"]
1513 set buf_rlo [lindex $pck end]
1514 foreach p [lrange $pck 0 end-1] {
1515 set p [encoding convertfrom $p]
1516 if {[string index $p end] eq {/}} {
1517 set p [string range $p 0 end-1]
1521 rescan_done $fd buf_rlo $after
1524 proc rescan_done {fd buf after} {
1525 global rescan_active current_diff_path
1526 global file_states repo_config
1529 if {![eof $fd]} return
1532 if {[incr rescan_active -1] > 0} return
1537 if {$current_diff_path ne {}} { reshow_diff $after }
1538 if {$current_diff_path eq {}} { select_first_diff $after }
1541 proc prune_selection {} {
1542 global file_states selected_paths
1544 foreach path [array names selected_paths] {
1545 if {[catch {set still_here $file_states($path)}]} {
1546 unset selected_paths($path)
1551 ######################################################################
1555 proc mapicon {w state path} {
1558 if {[catch {set r $all_icons($state$w)}]} {
1559 puts "error
: no icon
for $w state
={$state} $path"
1565 proc mapdesc {state path} {
1568 if {[catch {set r $all_descs($state)}]} {
1569 puts "error
: no desc
for state
={$state} $path"
1575 proc ui_status {msg} {
1577 if {[info exists main_status]} {
1578 $main_status show $msg
1582 proc ui_ready {{test {}}} {
1584 if {[info exists main_status]} {
1585 $main_status show [mc "Ready.
"] $test
1589 proc escape_path {path} {
1590 regsub -all {\\} $path "\\\\" path
1591 regsub -all "\n" $path "\\n
" path
1595 proc short_path {path} {
1596 return [escape_path [lindex [file split $path] end]]
1600 set null_sha1 [string repeat 0 40]
1602 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1603 global file_states next_icon_id null_sha1
1605 set s0 [string index $new_state 0]
1606 set s1 [string index $new_state 1]
1608 if {[catch {set info $file_states($path)}]} {
1610 set icon n[incr next_icon_id]
1612 set state [lindex $info 0]
1613 set icon [lindex $info 1]
1614 if {$head_info eq {}} {set head_info [lindex $info 2]}
1615 if {$index_info eq {}} {set index_info [lindex $info 3]}
1618 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1619 elseif {$s0 eq {_}} {set s0 _}
1621 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1622 elseif {$s1 eq {_}} {set s1 _}
1624 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1625 set head_info [list 0 $null_sha1]
1626 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1627 && $head_info eq {}} {
1628 set head_info $index_info
1629 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1630 set index_info $head_info
1634 set file_states($path) [list $s0$s1 $icon \
1635 $head_info $index_info \
1640 proc display_file_helper {w path icon_name old_m new_m} {
1643 if {$new_m eq {_}} {
1644 set lno [lsearch -sorted -exact $file_lists($w) $path]
1646 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1648 $w conf -state normal
1649 $w delete $lno.0 [expr {$lno + 1}].0
1650 $w conf -state disabled
1652 } elseif {$old_m eq {_} && $new_m ne {_}} {
1653 lappend file_lists($w) $path
1654 set file_lists($w) [lsort -unique $file_lists($w)]
1655 set lno [lsearch -sorted -exact $file_lists($w) $path]
1657 $w conf -state normal
1658 $w image create $lno.0 \
1659 -align center -padx 5 -pady 1 \
1661 -image [mapicon $w $new_m $path]
1662 $w insert $lno.1 "[escape_path
$path]\n"
1663 $w conf -state disabled
1664 } elseif {$old_m ne $new_m} {
1665 $w conf -state normal
1666 $w image conf $icon_name -image [mapicon $w $new_m $path]
1667 $w conf -state disabled
1671 proc display_file {path state} {
1672 global file_states selected_paths
1673 global ui_index ui_workdir
1675 set old_m [merge_state $path $state]
1676 set s $file_states($path)
1677 set new_m [lindex $s 0]
1678 set icon_name [lindex $s 1]
1680 set o [string index $old_m 0]
1681 set n [string index $new_m 0]
1688 display_file_helper $ui_index $path $icon_name $o $n
1690 if {[string index $old_m 0] eq {U}} {
1693 set o [string index $old_m 1]
1695 if {[string index $new_m 0] eq {U}} {
1698 set n [string index $new_m 1]
1700 display_file_helper $ui_workdir $path $icon_name $o $n
1702 if {$new_m eq {__}} {
1703 unset file_states($path)
1704 catch {unset selected_paths($path)}
1708 proc display_all_files_helper {w path icon_name m} {
1711 lappend file_lists($w) $path
1712 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1713 $w image create end \
1714 -align center -padx 5 -pady 1 \
1716 -image [mapicon $w $m $path]
1717 $w insert end "[escape_path
$path]\n"
1721 proc display_all_files {} {
1722 global ui_index ui_workdir
1723 global file_states file_lists
1725 global files_warning
1727 $ui_index conf -state normal
1728 $ui_workdir conf -state normal
1730 $ui_index delete 0.0 end
1731 $ui_workdir delete 0.0 end
1734 set file_lists($ui_index) [list]
1735 set file_lists($ui_workdir) [list]
1737 set to_display [lsort [array names file_states]]
1738 set display_limit [get_config gui.maxfilesdisplayed]
1739 if {[llength $to_display] > $display_limit} {
1740 if {!$files_warning} {
1741 # do not repeatedly warn:
1743 info_popup [mc "Displaying only
%s of
%s files.
" \
1744 $display_limit [llength $to_display]]
1746 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1748 foreach path $to_display {
1749 set s $file_states($path)
1751 set icon_name [lindex $s 1]
1753 set s [string index $m 0]
1754 if {$s ne {U} && $s ne {_}} {
1755 display_all_files_helper $ui_index $path \
1759 if {[string index $m 0] eq {U}} {
1762 set s [string index $m 1]
1765 display_all_files_helper $ui_workdir $path \
1770 $ui_index conf -state disabled
1771 $ui_workdir conf -state disabled
1774 ######################################################################
1779 #define mask_width 14
1780 #define mask_height 15
1781 static unsigned char mask_bits[] = {
1782 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1783 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1784 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1787 image create bitmap file_plain -background white -foreground black -data {
1788 #define plain_width 14
1789 #define plain_height 15
1790 static unsigned char plain_bits[] = {
1791 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1792 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1793 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1794 } -maskdata $filemask
1796 image create bitmap file_mod -background white -foreground blue -data {
1797 #define mod_width 14
1798 #define mod_height 15
1799 static unsigned char mod_bits[] = {
1800 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1801 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1802 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1803 } -maskdata $filemask
1805 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1806 #define file_fulltick_width 14
1807 #define file_fulltick_height 15
1808 static unsigned char file_fulltick_bits
[] = {
1809 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1810 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1811 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1812 } -maskdata $filemask
1814 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1815 #define parttick_width 14
1816 #define parttick_height 15
1817 static unsigned char parttick_bits
[] = {
1818 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1819 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1820 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1821 } -maskdata $filemask
1823 image create bitmap file_question
-background white
-foreground black
-data {
1824 #define file_question_width 14
1825 #define file_question_height 15
1826 static unsigned char file_question_bits
[] = {
1827 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1828 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1829 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1830 } -maskdata $filemask
1832 image create bitmap file_removed
-background white
-foreground red
-data {
1833 #define file_removed_width 14
1834 #define file_removed_height 15
1835 static unsigned char file_removed_bits
[] = {
1836 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1837 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1838 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1839 } -maskdata $filemask
1841 image create bitmap file_merge
-background white
-foreground blue
-data {
1842 #define file_merge_width 14
1843 #define file_merge_height 15
1844 static unsigned char file_merge_bits
[] = {
1845 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1846 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1847 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1848 } -maskdata $filemask
1850 image create bitmap file_statechange
-background white
-foreground green
-data {
1851 #define file_merge_width 14
1852 #define file_merge_height 15
1853 static unsigned char file_statechange_bits
[] = {
1854 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1855 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1856 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1857 } -maskdata $filemask
1859 set ui_index .vpane.files.index.list
1860 set ui_workdir .vpane.files.workdir.list
1862 set all_icons
(_
$ui_index) file_plain
1863 set all_icons
(A
$ui_index) file_fulltick
1864 set all_icons
(M
$ui_index) file_fulltick
1865 set all_icons
(D
$ui_index) file_removed
1866 set all_icons
(U
$ui_index) file_merge
1867 set all_icons
(T
$ui_index) file_statechange
1869 set all_icons
(_
$ui_workdir) file_plain
1870 set all_icons
(M
$ui_workdir) file_mod
1871 set all_icons
(D
$ui_workdir) file_question
1872 set all_icons
(U
$ui_workdir) file_merge
1873 set all_icons
(O
$ui_workdir) file_plain
1874 set all_icons
(T
$ui_workdir) file_statechange
1876 set max_status_desc
0
1878 {__
{mc
"Unmodified"}}
1880 {_M
{mc
"Modified, not staged"}}
1881 {M_
{mc
"Staged for commit"}}
1882 {MM
{mc
"Portions staged for commit"}}
1883 {MD
{mc
"Staged for commit, missing"}}
1885 {_T
{mc
"File type changed, not staged"}}
1886 {T_
{mc
"File type changed, staged"}}
1888 {_O
{mc
"Untracked, not staged"}}
1889 {A_
{mc
"Staged for commit"}}
1890 {AM
{mc
"Portions staged for commit"}}
1891 {AD
{mc
"Staged for commit, missing"}}
1894 {D_
{mc
"Staged for removal"}}
1895 {DO
{mc
"Staged for removal, still present"}}
1897 {_U
{mc
"Requires merge resolution"}}
1898 {U_
{mc
"Requires merge resolution"}}
1899 {UU
{mc
"Requires merge resolution"}}
1900 {UM
{mc
"Requires merge resolution"}}
1901 {UD
{mc
"Requires merge resolution"}}
1902 {UT
{mc
"Requires merge resolution"}}
1904 set text
[eval [lindex
$i 1]]
1905 if {$max_status_desc < [string length
$text]} {
1906 set max_status_desc
[string length
$text]
1908 set all_descs
([lindex
$i 0]) $text
1912 ######################################################################
1916 proc scrollbar2many
{list mode args
} {
1917 foreach w
$list {eval $w $mode $args}
1920 proc many2scrollbar
{list mode sb top bottom
} {
1921 $sb set $top $bottom
1922 foreach w
$list {$w $mode moveto
$top}
1925 proc incr_font_size
{font
{amt
1}} {
1926 set sz
[font configure
$font -size]
1928 font configure
$font -size $sz
1929 font configure
${font}bold
-size $sz
1930 font configure
${font}italic
-size $sz
1933 ######################################################################
1937 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1939 proc do_gitk
{revs
} {
1940 # -- Always start gitk through whatever we were loaded with. This
1941 # lets us bypass using shell process on Windows systems.
1943 set exe
[_which gitk
-script]
1944 set cmd
[list
[info nameofexecutable
] $exe]
1946 error_popup
[mc
"Couldn't find gitk in PATH"]
1950 if {[info exists env
(GIT_DIR
)]} {
1951 set old_GIT_DIR
$env(GIT_DIR
)
1957 cd [file dirname [gitdir
]]
1958 set env
(GIT_DIR
) [file tail [gitdir
]]
1960 eval exec $cmd $revs "--" "--" &
1962 if {$old_GIT_DIR eq
{}} {
1965 set env
(GIT_DIR
) $old_GIT_DIR
1969 ui_status $
::starting_gitk_msg
1971 ui_ready
$starting_gitk_msg
1976 proc do_explore
{} {
1978 if {[is_Cygwin
] ||
[is_Windows
]} {
1979 set explorer
"explorer.exe"
1980 } elseif
{[is_MacOSX
]} {
1983 # freedesktop.org-conforming system is our best shot
1984 set explorer
"xdg-open"
1986 eval exec $explorer [list
[file nativename
[file dirname [gitdir
]]]] &
1992 proc terminate_me
{win
} {
1994 if {$win ne
{.
}} return
1998 proc do_quit
{{rc
{1}}} {
1999 global ui_comm is_quitting repo_config commit_type
2000 global GITGUI_BCK_exists GITGUI_BCK_i
2001 global ui_comm_spell
2004 if {$is_quitting} return
2007 if {[winfo exists
$ui_comm]} {
2008 # -- Stash our current commit buffer.
2010 set save
[gitdir GITGUI_MSG
]
2011 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2012 file rename
-force [gitdir GITGUI_BCK
] $save
2013 set GITGUI_BCK_exists
0
2015 set msg
[string trim
[$ui_comm get
0.0 end
]]
2016 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2017 if {(![string match amend
* $commit_type]
2018 ||
[$ui_comm edit modified
])
2021 set fd
[open
$save w
]
2022 puts
-nonewline $fd $msg
2026 catch
{file delete
$save}
2030 # -- Cancel our spellchecker if its running.
2032 if {[info exists ui_comm_spell
]} {
2036 # -- Remove our editor backup, its not needed.
2038 after cancel
$GITGUI_BCK_i
2039 if {$GITGUI_BCK_exists} {
2040 catch
{file delete
[gitdir GITGUI_BCK
]}
2043 # -- Stash our current window geometry into this repository.
2045 set cfg_wmstate
[wm state .
]
2046 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2049 if {$cfg_wmstate ne
$rc_wmstate} {
2050 catch
{git config gui.wmstate
$cfg_wmstate}
2052 if {$cfg_wmstate eq
{zoomed
}} {
2053 # on Windows wm geometry will lie about window
2054 # position (but not size) when window is zoomed
2055 # restore the window before querying wm geometry
2058 set cfg_geometry
[list
]
2059 lappend cfg_geometry
[wm geometry .
]
2060 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2061 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2062 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2065 if {$cfg_geometry ne
$rc_geometry} {
2066 catch
{git config gui.geometry
$cfg_geometry}
2072 # Briefly enable send again, working around Tk bug
2073 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2074 tk appname
[appname
]
2083 proc ui_do_rescan
{} {
2084 rescan
{force_first_diff ui_ready
}
2091 proc next_diff
{{after
{}}} {
2092 global next_diff_p next_diff_w next_diff_i
2093 show_diff
$next_diff_p $next_diff_w {} {} $after
2096 proc find_anchor_pos
{lst name
} {
2097 set lid
[lsearch
-sorted -exact $lst $name]
2101 foreach lname
$lst {
2102 if {$lname >= $name} break
2110 proc find_file_from
{flist idx delta path mmask
} {
2113 set len
[llength
$flist]
2114 while {$idx >= 0 && $idx < $len} {
2115 set name
[lindex
$flist $idx]
2117 if {$name ne
$path && [info exists file_states
($name)]} {
2118 set state
[lindex
$file_states($name) 0]
2120 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2131 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2132 global next_diff_p next_diff_w next_diff_i
2133 global file_lists ui_index ui_workdir
2135 set flist
$file_lists($w)
2137 set lno
[find_anchor_pos
$flist $path]
2142 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2143 if {$w eq
$ui_index} {
2146 set mmask
"$mmask\$"
2150 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2153 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2158 set next_diff_p
[lindex
$flist $idx]
2159 set next_diff_i
[expr {$idx+1}]
2166 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2167 global current_diff_path
2169 if {$path ne
$current_diff_path} {
2171 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2174 return {reshow_diff
;}
2178 proc select_first_diff
{after
} {
2181 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2182 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2189 proc force_first_diff
{after
} {
2190 global ui_workdir current_diff_path file_states
2192 if {[info exists file_states
($current_diff_path)]} {
2193 set state
[lindex
$file_states($current_diff_path) 0]
2199 if {[string first
{U
} $state] >= 0} {
2200 # Already a conflict, do nothing
2201 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2203 } elseif
{[string index
$state 1] ne
{O
}} {
2204 # Already a diff & no conflicts, do nothing
2205 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2216 proc toggle_or_diff
{w x y
} {
2217 global file_states file_lists current_diff_path ui_index ui_workdir
2218 global last_clicked selected_paths
2220 set pos
[split [$w index @
$x,$y] .
]
2221 set lno
[lindex
$pos 0]
2222 set col [lindex
$pos 1]
2223 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2229 set last_clicked
[list
$w $lno]
2230 array
unset selected_paths
2231 $ui_index tag remove in_sel
0.0 end
2232 $ui_workdir tag remove in_sel
0.0 end
2234 # Determine the state of the file
2235 if {[info exists file_states
($path)]} {
2236 set state
[lindex
$file_states($path) 0]
2241 # Restage the file, or simply show the diff
2242 if {$col == 0 && $y > 1} {
2243 # Conflicts need special handling
2244 if {[string first
{U
} $state] >= 0} {
2245 # $w must always be $ui_workdir, but...
2246 if {$w ne
$ui_workdir} { set lno
{} }
2247 merge_stage_workdir
$path $lno
2251 if {[string index
$state 1] eq
{O
}} {
2257 set after
[next_diff_after_action
$w $path $lno $mmask]
2259 if {$w eq
$ui_index} {
2261 "Unstaging [short_path $path] from commit" \
2263 [concat
$after [list ui_ready
]]
2264 } elseif
{$w eq
$ui_workdir} {
2266 "Adding [short_path $path]" \
2268 [concat
$after [list ui_ready
]]
2271 show_diff
$path $w $lno
2275 proc add_one_to_selection
{w x y
} {
2276 global file_lists last_clicked selected_paths
2278 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2279 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2285 if {$last_clicked ne
{}
2286 && [lindex
$last_clicked 0] ne
$w} {
2287 array
unset selected_paths
2288 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2291 set last_clicked
[list
$w $lno]
2292 if {[catch
{set in_sel
$selected_paths($path)}]} {
2296 unset selected_paths
($path)
2297 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2299 set selected_paths
($path) 1
2300 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2304 proc add_range_to_selection
{w x y
} {
2305 global file_lists last_clicked selected_paths
2307 if {[lindex
$last_clicked 0] ne
$w} {
2308 toggle_or_diff
$w $x $y
2312 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2313 set lc
[lindex
$last_clicked 1]
2322 foreach path
[lrange
$file_lists($w) \
2323 [expr {$begin - 1}] \
2324 [expr {$end - 1}]] {
2325 set selected_paths
($path) 1
2327 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2330 proc show_more_context
{} {
2332 if {$repo_config(gui.diffcontext
) < 99} {
2333 incr repo_config
(gui.diffcontext
)
2338 proc show_less_context
{} {
2340 if {$repo_config(gui.diffcontext
) > 1} {
2341 incr repo_config
(gui.diffcontext
) -1
2346 ######################################################################
2356 menu .mbar
-tearoff 0
2358 # -- Apple Menu (Mac OS X only)
2360 .mbar add cascade
-label Apple
-menu .mbar.apple
2363 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2364 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2365 if {[is_enabled branch
]} {
2366 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2368 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2369 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2371 if {[is_enabled transport
]} {
2372 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2373 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2375 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2376 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2379 # -- Repository Menu
2381 menu .mbar.repository
2383 .mbar.repository add
command \
2384 -label [mc
"Explore Working Copy"] \
2385 -command {do_explore
}
2386 .mbar.repository add separator
2388 .mbar.repository add
command \
2389 -label [mc
"Browse Current Branch's Files"] \
2390 -command {browser
::new
$current_branch}
2391 set ui_browse_current
[.mbar.repository index last
]
2392 .mbar.repository add
command \
2393 -label [mc
"Browse Branch Files..."] \
2394 -command browser_open
::dialog
2395 .mbar.repository add separator
2397 .mbar.repository add
command \
2398 -label [mc
"Visualize Current Branch's History"] \
2399 -command {do_gitk
$current_branch}
2400 set ui_visualize_current
[.mbar.repository index last
]
2401 .mbar.repository add
command \
2402 -label [mc
"Visualize All Branch History"] \
2403 -command {do_gitk
--all}
2404 .mbar.repository add separator
2406 proc current_branch_write
{args
} {
2407 global current_branch
2408 .mbar.repository entryconf $
::ui_browse_current \
2409 -label [mc
"Browse %s's Files" $current_branch]
2410 .mbar.repository entryconf $
::ui_visualize_current \
2411 -label [mc
"Visualize %s's History" $current_branch]
2413 trace add variable current_branch
write current_branch_write
2415 if {[is_enabled multicommit
]} {
2416 .mbar.repository add
command -label [mc
"Database Statistics"] \
2419 .mbar.repository add
command -label [mc
"Compress Database"] \
2422 .mbar.repository add
command -label [mc
"Verify Database"] \
2423 -command do_fsck_objects
2425 .mbar.repository add separator
2428 .mbar.repository add
command \
2429 -label [mc
"Create Desktop Icon"] \
2430 -command do_cygwin_shortcut
2431 } elseif
{[is_Windows
]} {
2432 .mbar.repository add
command \
2433 -label [mc
"Create Desktop Icon"] \
2434 -command do_windows_shortcut
2435 } elseif
{[is_MacOSX
]} {
2436 .mbar.repository add
command \
2437 -label [mc
"Create Desktop Icon"] \
2438 -command do_macosx_app
2443 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2445 .mbar.repository add
command -label [mc Quit
] \
2453 .mbar.edit add
command -label [mc Undo
] \
2454 -command {catch
{[focus
] edit undo
}} \
2456 .mbar.edit add
command -label [mc Redo
] \
2457 -command {catch
{[focus
] edit redo
}} \
2459 .mbar.edit add separator
2460 .mbar.edit add
command -label [mc Cut
] \
2461 -command {catch
{tk_textCut
[focus
]}} \
2463 .mbar.edit add
command -label [mc Copy
] \
2464 -command {catch
{tk_textCopy
[focus
]}} \
2466 .mbar.edit add
command -label [mc Paste
] \
2467 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2469 .mbar.edit add
command -label [mc Delete
] \
2470 -command {catch
{[focus
] delete sel.first sel.last
}} \
2472 .mbar.edit add separator
2473 .mbar.edit add
command -label [mc
"Select All"] \
2474 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2479 if {[is_enabled branch
]} {
2482 .mbar.branch add
command -label [mc
"Create..."] \
2483 -command branch_create
::dialog \
2485 lappend disable_on_lock
[list .mbar.branch entryconf \
2486 [.mbar.branch index last
] -state]
2488 .mbar.branch add
command -label [mc
"Checkout..."] \
2489 -command branch_checkout
::dialog \
2491 lappend disable_on_lock
[list .mbar.branch entryconf \
2492 [.mbar.branch index last
] -state]
2494 .mbar.branch add
command -label [mc
"Rename..."] \
2495 -command branch_rename
::dialog
2496 lappend disable_on_lock
[list .mbar.branch entryconf \
2497 [.mbar.branch index last
] -state]
2499 .mbar.branch add
command -label [mc
"Delete..."] \
2500 -command branch_delete
::dialog
2501 lappend disable_on_lock
[list .mbar.branch entryconf \
2502 [.mbar.branch index last
] -state]
2504 .mbar.branch add
command -label [mc
"Reset..."] \
2505 -command merge
::reset_hard
2506 lappend disable_on_lock
[list .mbar.branch entryconf \
2507 [.mbar.branch index last
] -state]
2512 proc commit_btn_caption
{} {
2513 if {[is_enabled nocommit
]} {
2516 return [mc Commit@@verb
]
2520 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2523 if {![is_enabled nocommit
]} {
2524 .mbar.commit add radiobutton \
2525 -label [mc
"New Commit"] \
2526 -command do_select_commit_type \
2527 -variable selected_commit_type \
2529 lappend disable_on_lock \
2530 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2532 .mbar.commit add radiobutton \
2533 -label [mc
"Amend Last Commit"] \
2534 -command do_select_commit_type \
2535 -variable selected_commit_type \
2537 lappend disable_on_lock \
2538 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2540 .mbar.commit add separator
2543 .mbar.commit add
command -label [mc Rescan
] \
2544 -command ui_do_rescan \
2546 lappend disable_on_lock \
2547 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2549 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2550 -command do_add_selection \
2552 lappend disable_on_lock \
2553 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2555 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2556 -command do_add_all \
2558 lappend disable_on_lock \
2559 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2561 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2562 -command do_unstage_selection \
2564 lappend disable_on_lock \
2565 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2567 .mbar.commit add
command -label [mc
"Revert Changes"] \
2568 -command do_revert_selection \
2570 lappend disable_on_lock \
2571 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2573 .mbar.commit add separator
2575 .mbar.commit add
command -label [mc
"Show Less Context"] \
2576 -command show_less_context \
2577 -accelerator $M1T-\
-
2579 .mbar.commit add
command -label [mc
"Show More Context"] \
2580 -command show_more_context \
2583 .mbar.commit add separator
2585 if {![is_enabled nocommitmsg
]} {
2586 .mbar.commit add
command -label [mc
"Sign Off"] \
2587 -command do_signoff \
2591 .mbar.commit add
command -label [commit_btn_caption
] \
2592 -command do_commit \
2593 -accelerator $M1T-Return
2594 lappend disable_on_lock \
2595 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2600 if {[is_enabled branch
]} {
2602 .mbar.merge add
command -label [mc
"Local Merge..."] \
2603 -command merge
::dialog \
2605 lappend disable_on_lock \
2606 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2607 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2608 -command merge
::reset_hard
2609 lappend disable_on_lock \
2610 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2615 if {[is_enabled transport
]} {
2618 .mbar.remote add
command \
2619 -label [mc
"Add..."] \
2620 -command remote_add
::dialog \
2622 .mbar.remote add
command \
2623 -label [mc
"Push..."] \
2624 -command do_push_anywhere \
2626 .mbar.remote add
command \
2627 -label [mc
"Delete Branch..."] \
2628 -command remote_branch_delete
::dialog
2632 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2636 .mbar.edit add separator
2637 .mbar.edit add
command -label [mc
"Options..."] \
2643 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2644 set tools_menubar .mbar.tools
2646 $tools_menubar add separator
2647 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2648 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2650 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2657 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2661 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2663 .mbar.apple add separator
2665 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2668 . configure
-menu .mbar
2670 set doc_path
[githtmldir
]
2671 if {$doc_path ne
{}} {
2672 set doc_path
[file join $doc_path index.html
]
2675 set doc_path
[exec cygpath
--mixed $doc_path]
2679 if {[file isfile
$doc_path]} {
2680 set doc_url
"file:$doc_path"
2682 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2685 proc start_browser
{url
} {
2686 git
"web--browse" $url
2689 .mbar.
help add
command -label [mc
"Online Documentation"] \
2690 -command [list start_browser
$doc_url]
2692 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2695 unset doc_path doc_url
2697 # -- Standard bindings
2699 wm protocol . WM_DELETE_WINDOW do_quit
2700 bind all
<$M1B-Key-q> do_quit
2701 bind all
<$M1B-Key-Q> do_quit
2702 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2703 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2705 set subcommand_args
{}
2707 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2711 proc normalize_relpath
{path
} {
2713 foreach item
[file split $path] {
2714 if {$item eq
{.
}} continue
2715 if {$item eq
{..
} && [llength
$elements] > 0
2716 && [lindex
$elements end
] ne
{..
}} {
2717 set elements
[lrange
$elements 0 end-1
]
2720 lappend elements
$item
2722 return [eval file join $elements]
2725 # -- Not a normal commit type invocation? Do that instead!
2727 switch
-- $subcommand {
2730 if {$subcommand eq
"blame"} {
2731 set subcommand_args
{[--line=<num
>] rev? path
}
2733 set subcommand_args
{rev? path
}
2735 if {$argv eq
{}} usage
2741 if {$is_path ||
[file exists
$_prefix$a]} {
2742 if {$path ne
{}} usage
2743 set path
[normalize_relpath
$_prefix$a]
2745 } elseif
{$a eq
{--}} {
2747 if {$head ne
{}} usage
2752 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2753 if {$jump_spec ne
{} ||
$head ne
{}} usage
2754 set jump_spec
[list
$lnum]
2755 } elseif
{$head eq
{}} {
2756 if {$head ne
{}} usage
2765 if {$head ne
{} && $path eq
{}} {
2766 set path
[normalize_relpath
$_prefix$head]
2773 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2775 set head [git rev-parse
--verify $head]
2781 set current_branch
$head
2784 switch
-- $subcommand {
2786 if {$jump_spec ne
{}} usage
2788 if {$path ne
{} && [file isdirectory
$path]} {
2789 set head $current_branch
2795 browser
::new
$head $path
2798 if {$head eq
{} && ![file exists
$path]} {
2799 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2802 blame
::new
$head $path $jump_spec
2809 if {[llength
$argv] != 0} {
2810 puts
-nonewline stderr
"usage: $argv0"
2811 if {$subcommand ne
{gui
}
2812 && [file tail $argv0] ne
"git-$subcommand"} {
2813 puts
-nonewline stderr
" $subcommand"
2818 # fall through to setup UI for commits
2821 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2832 -text [mc
"Current Branch:"] \
2836 -textvariable current_branch \
2839 pack .branch.l1
-side left
2840 pack .branch.cb
-side left
-fill x
2841 pack .branch
-side top
-fill x
2843 # -- Main Window Layout
2845 panedwindow .vpane
-orient horizontal
2846 panedwindow .vpane.files
-orient vertical
2847 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2848 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2850 # -- Index File List
2852 frame .vpane.files.index
-height 100 -width 200
2853 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2854 -background lightgreen
-foreground black
2855 text
$ui_index -background white
-foreground black \
2857 -width 20 -height 10 \
2859 -cursor $cursor_ptr \
2860 -xscrollcommand {.vpane.files.index.sx
set} \
2861 -yscrollcommand {.vpane.files.index.sy
set} \
2863 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2864 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2865 pack .vpane.files.index.title
-side top
-fill x
2866 pack .vpane.files.index.sx
-side bottom
-fill x
2867 pack .vpane.files.index.sy
-side right
-fill y
2868 pack
$ui_index -side left
-fill both
-expand 1
2870 # -- Working Directory File List
2872 frame .vpane.files.workdir
-height 100 -width 200
2873 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2874 -background lightsalmon
-foreground black
2875 text
$ui_workdir -background white
-foreground black \
2877 -width 20 -height 10 \
2879 -cursor $cursor_ptr \
2880 -xscrollcommand {.vpane.files.workdir.sx
set} \
2881 -yscrollcommand {.vpane.files.workdir.sy
set} \
2883 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2884 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2885 pack .vpane.files.workdir.title
-side top
-fill x
2886 pack .vpane.files.workdir.sx
-side bottom
-fill x
2887 pack .vpane.files.workdir.sy
-side right
-fill y
2888 pack
$ui_workdir -side left
-fill both
-expand 1
2890 .vpane.files add .vpane.files.workdir
-sticky nsew
2891 .vpane.files add .vpane.files.index
-sticky nsew
2893 foreach i
[list
$ui_index $ui_workdir] {
2895 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2899 # -- Diff and Commit Area
2901 frame .vpane.lower
-height 300 -width 400
2902 frame .vpane.lower.commarea
2903 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2904 pack .vpane.lower.
diff -fill both
-expand 1
2905 pack .vpane.lower.commarea
-side bottom
-fill x
2906 .vpane add .vpane.lower
-sticky nsew
2908 # -- Commit Area Buttons
2910 frame .vpane.lower.commarea.buttons
2911 label .vpane.lower.commarea.buttons.l
-text {} \
2914 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2915 pack .vpane.lower.commarea.buttons
-side left
-fill y
2917 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2918 -command ui_do_rescan
2919 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2920 lappend disable_on_lock \
2921 {.vpane.lower.commarea.buttons.rescan conf
-state}
2923 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2925 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2926 lappend disable_on_lock \
2927 {.vpane.lower.commarea.buttons.incall conf
-state}
2929 if {![is_enabled nocommitmsg
]} {
2930 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2932 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2935 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2937 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2938 lappend disable_on_lock \
2939 {.vpane.lower.commarea.buttons.commit conf
-state}
2941 if {![is_enabled nocommit
]} {
2942 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2943 -command do_push_anywhere
2944 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2947 # -- Commit Message Buffer
2949 frame .vpane.lower.commarea.buffer
2950 frame .vpane.lower.commarea.buffer.header
2951 set ui_comm .vpane.lower.commarea.buffer.t
2952 set ui_coml .vpane.lower.commarea.buffer.header.l
2954 if {![is_enabled nocommit
]} {
2955 radiobutton .vpane.lower.commarea.buffer.header.new \
2956 -text [mc
"New Commit"] \
2957 -command do_select_commit_type \
2958 -variable selected_commit_type \
2960 lappend disable_on_lock \
2961 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2962 radiobutton .vpane.lower.commarea.buffer.header.amend \
2963 -text [mc
"Amend Last Commit"] \
2964 -command do_select_commit_type \
2965 -variable selected_commit_type \
2967 lappend disable_on_lock \
2968 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2974 proc trace_commit_type
{varname args
} {
2975 global ui_coml commit_type
2976 switch
-glob -- $commit_type {
2977 initial
{set txt
[mc
"Initial Commit Message:"]}
2978 amend
{set txt
[mc
"Amended Commit Message:"]}
2979 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2980 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2981 merge
{set txt
[mc
"Merge Commit Message:"]}
2982 * {set txt
[mc
"Commit Message:"]}
2984 $ui_coml conf
-text $txt
2986 trace add variable commit_type
write trace_commit_type
2987 pack
$ui_coml -side left
-fill x
2989 if {![is_enabled nocommit
]} {
2990 pack .vpane.lower.commarea.buffer.header.amend
-side right
2991 pack .vpane.lower.commarea.buffer.header.new
-side right
2994 text
$ui_comm -background white
-foreground black \
2998 -autoseparators true \
3000 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3002 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
3003 scrollbar .vpane.lower.commarea.buffer.sby \
3004 -command [list
$ui_comm yview
]
3005 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3006 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
3007 pack
$ui_comm -side left
-fill y
3008 pack .vpane.lower.commarea.buffer
-side left
-fill y
3010 # -- Commit Message Buffer Context Menu
3012 set ctxm .vpane.lower.commarea.buffer.ctxm
3013 menu
$ctxm -tearoff 0
3016 -command {tk_textCut
$ui_comm}
3019 -command {tk_textCopy
$ui_comm}
3022 -command {tk_textPaste
$ui_comm}
3024 -label [mc Delete
] \
3025 -command {catch
{$ui_comm delete sel.first sel.last
}}
3028 -label [mc
"Select All"] \
3029 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3031 -label [mc
"Copy All"] \
3033 $ui_comm tag add sel
0.0 end
3034 tk_textCopy
$ui_comm
3035 $ui_comm tag remove sel
0.0 end
3039 -label [mc
"Sign Off"] \
3041 set ui_comm_ctxm
$ctxm
3045 proc trace_current_diff_path
{varname args
} {
3046 global current_diff_path diff_actions file_states
3047 if {$current_diff_path eq
{}} {
3053 set p
$current_diff_path
3054 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3056 set p
[escape_path
$p]
3060 .vpane.lower.
diff.header.status configure
-text $s
3061 .vpane.lower.
diff.header.
file configure
-text $f
3062 .vpane.lower.
diff.header.path configure
-text $p
3063 foreach w
$diff_actions {
3067 trace add variable current_diff_path
write trace_current_diff_path
3069 frame .vpane.lower.
diff.header
-background gold
3070 label .vpane.lower.
diff.header.status \
3073 -width $max_status_desc \
3076 label .vpane.lower.
diff.header.
file \
3081 label .vpane.lower.
diff.header.path \
3086 pack .vpane.lower.
diff.header.status
-side left
3087 pack .vpane.lower.
diff.header.
file -side left
3088 pack .vpane.lower.
diff.header.path
-fill x
3089 set ctxm .vpane.lower.
diff.header.ctxm
3090 menu
$ctxm -tearoff 0
3098 -- $current_diff_path
3100 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3101 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3105 frame .vpane.lower.
diff.body
3106 set ui_diff .vpane.lower.
diff.body.t
3107 text
$ui_diff -background white
-foreground black \
3109 -width 80 -height 5 -wrap none \
3111 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3112 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3114 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3115 -command [list
$ui_diff xview
]
3116 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3117 -command [list
$ui_diff yview
]
3118 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3119 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3120 pack
$ui_diff -side left
-fill both
-expand 1
3121 pack .vpane.lower.
diff.header
-side top
-fill x
3122 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3124 $ui_diff tag conf d_cr
-elide true
3125 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3126 $ui_diff tag conf d_
+ -foreground {#00a000}
3127 $ui_diff tag conf d_-
-foreground red
3129 $ui_diff tag conf d_
++ -foreground {#00a000}
3130 $ui_diff tag conf d_--
-foreground red
3131 $ui_diff tag conf d_
+s \
3132 -foreground {#00a000} \
3133 -background {#e2effa}
3134 $ui_diff tag conf d_-s \
3136 -background {#e2effa}
3137 $ui_diff tag conf d_s
+ \
3138 -foreground {#00a000} \
3140 $ui_diff tag conf d_s- \
3144 $ui_diff tag conf d
<<<<<<< \
3145 -foreground orange \
3147 $ui_diff tag conf d
======= \
3148 -foreground orange \
3150 $ui_diff tag conf d
>>>>>>> \
3151 -foreground orange \
3154 $ui_diff tag raise sel
3156 # -- Diff Body Context Menu
3159 proc create_common_diff_popup
{ctxm
} {
3161 -label [mc
"Show Less Context"] \
3162 -command show_less_context
3163 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3165 -label [mc
"Show More Context"] \
3166 -command show_more_context
3167 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3170 -label [mc Refresh
] \
3171 -command reshow_diff
3172 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3175 -command {tk_textCopy
$ui_diff}
3176 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3178 -label [mc
"Select All"] \
3179 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3180 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3182 -label [mc
"Copy All"] \
3184 $ui_diff tag add sel
0.0 end
3185 tk_textCopy
$ui_diff
3186 $ui_diff tag remove sel
0.0 end
3188 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3191 -label [mc
"Decrease Font Size"] \
3192 -command {incr_font_size font_diff
-1}
3193 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3195 -label [mc
"Increase Font Size"] \
3196 -command {incr_font_size font_diff
1}
3197 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3201 build_encoding_menu
$emenu [list force_diff_encoding
]
3203 -label [mc
"Encoding"] \
3205 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3207 $ctxm add
command -label [mc
"Options..."] \
3211 set ctxm .vpane.lower.
diff.body.ctxm
3212 menu
$ctxm -tearoff 0
3214 -label [mc
"Apply/Reverse Hunk"] \
3215 -command {apply_hunk
$cursorX $cursorY}
3216 set ui_diff_applyhunk
[$ctxm index last
]
3217 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3219 -label [mc
"Apply/Reverse Line"] \
3220 -command {apply_line
$cursorX $cursorY; do_rescan
}
3221 set ui_diff_applyline
[$ctxm index last
]
3222 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3224 create_common_diff_popup
$ctxm
3226 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3227 menu
$ctxmmg -tearoff 0
3228 $ctxmmg add
command \
3229 -label [mc
"Run Merge Tool"] \
3230 -command {merge_resolve_tool
}
3231 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3232 $ctxmmg add separator
3233 $ctxmmg add
command \
3234 -label [mc
"Use Remote Version"] \
3235 -command {merge_resolve_one
3}
3236 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3237 $ctxmmg add
command \
3238 -label [mc
"Use Local Version"] \
3239 -command {merge_resolve_one
2}
3240 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3241 $ctxmmg add
command \
3242 -label [mc
"Revert To Base"] \
3243 -command {merge_resolve_one
1}
3244 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3245 $ctxmmg add separator
3246 create_common_diff_popup
$ctxmmg
3248 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3249 global current_diff_path file_states
3252 if {[info exists file_states
($current_diff_path)]} {
3253 set state
[lindex
$file_states($current_diff_path) 0]
3257 if {[string first
{U
} $state] >= 0} {
3258 tk_popup
$ctxmmg $X $Y
3260 if {$
::ui_index eq $
::current_diff_side
} {
3261 set l
[mc
"Unstage Hunk From Commit"]
3262 set t
[mc
"Unstage Line From Commit"]
3264 set l
[mc
"Stage Hunk For Commit"]
3265 set t
[mc
"Stage Line For Commit"]
3267 if {$
::is_3way_diff || $
::is_submodule_diff
3268 ||
$current_diff_path eq
{}
3272 ||
{T_
} eq
$state} {
3277 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3278 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3279 tk_popup
$ctxm $X $Y
3282 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3286 set main_status
[::status_bar
::new .status
]
3287 pack .status
-anchor w
-side bottom
-fill x
3288 $main_status show
[mc
"Initializing..."]
3293 set gm
$repo_config(gui.geometry
)
3294 wm geometry .
[lindex
$gm 0]
3295 .vpane sash place
0 \
3297 [lindex
[.vpane sash coord
0] 1]
3298 .vpane.files sash place
0 \
3299 [lindex
[.vpane.files sash coord
0] 0] \
3304 # -- Load window state
3307 set gws
$repo_config(gui.wmstate
)
3314 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3315 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3316 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3317 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3318 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3319 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3320 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3321 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3322 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3323 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3324 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3325 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3326 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3327 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3328 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3329 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3330 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3331 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3332 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3333 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3334 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3335 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3337 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3338 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3339 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3340 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3341 bind $ui_diff <$M1B-Key-v> {break}
3342 bind $ui_diff <$M1B-Key-V> {break}
3343 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3344 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3345 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3346 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3347 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3348 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3349 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3350 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3351 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3352 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3353 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3354 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3355 bind $ui_diff <Button-1
> {focus
%W
}
3357 if {[is_enabled branch
]} {
3358 bind .
<$M1B-Key-n> branch_create
::dialog
3359 bind .
<$M1B-Key-N> branch_create
::dialog
3360 bind .
<$M1B-Key-o> branch_checkout
::dialog
3361 bind .
<$M1B-Key-O> branch_checkout
::dialog
3362 bind .
<$M1B-Key-m> merge
::dialog
3363 bind .
<$M1B-Key-M> merge
::dialog
3365 if {[is_enabled transport
]} {
3366 bind .
<$M1B-Key-p> do_push_anywhere
3367 bind .
<$M1B-Key-P> do_push_anywhere
3370 bind .
<Key-F5
> ui_do_rescan
3371 bind .
<$M1B-Key-r> ui_do_rescan
3372 bind .
<$M1B-Key-R> ui_do_rescan
3373 bind .
<$M1B-Key-s> do_signoff
3374 bind .
<$M1B-Key-S> do_signoff
3375 bind .
<$M1B-Key-t> do_add_selection
3376 bind .
<$M1B-Key-T> do_add_selection
3377 bind .
<$M1B-Key-j> do_revert_selection
3378 bind .
<$M1B-Key-J> do_revert_selection
3379 bind .
<$M1B-Key-i> do_add_all
3380 bind .
<$M1B-Key-I> do_add_all
3381 bind .
<$M1B-Key-minus> {show_less_context
;break}
3382 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3383 bind .
<$M1B-Key-equal> {show_more_context
;break}
3384 bind .
<$M1B-Key-plus> {show_more_context
;break}
3385 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3386 bind .
<$M1B-Key-Return> do_commit
3387 foreach i
[list
$ui_index $ui_workdir] {
3388 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3389 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3390 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3394 set file_lists
($ui_index) [list
]
3395 set file_lists
($ui_workdir) [list
]
3397 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3398 focus
-force $ui_comm
3400 # -- Warn the user about environmental problems. Cygwin's Tcl
3401 # does *not* pass its env array onto any processes it spawns.
3402 # This means that git processes get none of our environment.
3407 set msg
[mc
"Possible environment issues exist.
3409 The following environment variables are probably
3410 going to be ignored by any Git subprocess run
3414 foreach name
[array names env
] {
3415 switch
-regexp -- $name {
3416 {^GIT_INDEX_FILE$
} -
3417 {^GIT_OBJECT_DIRECTORY$
} -
3418 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3420 {^GIT_EXTERNAL_DIFF$
} -
3424 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3425 append msg
" - $name\n"
3428 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3429 append msg
" - $name\n"
3431 set suggest_user
$name
3435 if {$ignored_env > 0} {
3437 This is due to a known issue with the
3438 Tcl binary distributed by Cygwin."]
3440 if {$suggest_user ne
{}} {
3443 A good replacement for %s
3444 is placing values for the user.name and
3445 user.email settings into your personal
3451 unset ignored_env msg suggest_user name
3454 # -- Only initialize complex UI if we are going to stay running.
3456 if {[is_enabled transport
]} {
3459 set n
[.mbar.remote index end
]
3460 populate_remotes_menu
3461 set n
[expr {[.mbar.remote index end
] - $n}]
3463 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3464 .mbar.remote insert
$n separator
3469 if {[winfo exists
$ui_comm]} {
3470 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3472 # -- If both our backup and message files exist use the
3473 # newer of the two files to initialize the buffer.
3475 if {$GITGUI_BCK_exists} {
3476 set m
[gitdir GITGUI_MSG
]
3477 if {[file isfile
$m]} {
3478 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3479 catch
{file delete
[gitdir GITGUI_MSG
]}
3481 $ui_comm delete
0.0 end
3483 $ui_comm edit modified false
3484 catch
{file delete
[gitdir GITGUI_BCK
]}
3485 set GITGUI_BCK_exists
0
3491 proc backup_commit_buffer
{} {
3492 global ui_comm GITGUI_BCK_exists
3494 set m
[$ui_comm edit modified
]
3495 if {$m ||
$GITGUI_BCK_exists} {
3496 set msg
[string trim
[$ui_comm get
0.0 end
]]
3497 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3500 if {$GITGUI_BCK_exists} {
3501 catch
{file delete
[gitdir GITGUI_BCK
]}
3502 set GITGUI_BCK_exists
0
3506 set fd
[open
[gitdir GITGUI_BCK
] w
]
3507 puts
-nonewline $fd $msg
3509 set GITGUI_BCK_exists
1
3513 $ui_comm edit modified false
3516 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3519 backup_commit_buffer
3521 # -- If the user has aspell available we can drive it
3522 # in pipe mode to spellcheck the commit message.
3524 set spell_cmd
[list |
]
3525 set spell_dict
[get_config gui.spellingdictionary
]
3526 lappend spell_cmd aspell
3527 if {$spell_dict ne
{}} {
3528 lappend spell_cmd
--master=$spell_dict
3530 lappend spell_cmd
--mode=none
3531 lappend spell_cmd
--encoding=utf-8
3532 lappend spell_cmd pipe
3533 if {$spell_dict eq
{none
}
3534 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3535 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3537 set ui_comm_spell
[spellcheck
::init \
3543 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3546 lock_index begin-read
3547 if {![winfo ismapped .
]} {
3551 if {[is_enabled initialamend
]} {
3557 if {[is_enabled nocommitmsg
]} {
3558 $ui_comm configure
-state disabled
-background gray
3561 if {[is_enabled multicommit
]} {
3564 if {[is_enabled retcode
]} {
3565 bind .
<Destroy
> {+terminate_me
%W
}
3567 if {$picked && [is_config_true gui.autoexplore
]} {