1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 argv0=$0; \
10 exec wish "$argv0" -- "$@"
11set appvers {@@GITGUI_VERSION@@}
13set copyright [string map [list (c) \u00a9] {
14Copyright (c) 2006-2010 Shawn Pearce, et. al.
15This program is free software; you can redistribute it and/or modify
17it under the terms of the GNU General Public License as published by
18the Free Software Foundation; either version 2 of the License, or
19(at your option) any later version.
20This program is distributed in the hope that it will be useful,
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24GNU General Public License for more details.
25You should have received a copy of the GNU General Public License
27along with this program; if not, write to the Free Software
28Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
29######################################################################
31##
32## Tcl/Tk sanity check
33if {[catch {package require Tcl 8.4} err]
35 || [catch {package require Tk 8.4} err]
36} {
37 catch {wm withdraw .}
38 tk_messageBox \
39 -icon error \
40 -type ok \
41 -title "git-gui: fatal error" \
42 -message $err
43 exit 1
44}
45catch {rename send {}} ; # What an evil concept...
47######################################################################
49##
50## locate our library
51set oguilib {@@GITGUI_LIBDIR@@}
53set oguirel {@@GITGUI_RELATIVE@@}
54if {$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]
58 }
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]
65} else {
66 set oguimsg [file join $oguilib msgs]
67}
68unset oguirel
69######################################################################
71##
72## enable verbose loading?
73if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
75 unset _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]
80 }
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
85 }
86 if {[tk windowingsystem] eq "win32"} { console show }
87}
88######################################################################
90##
91## Internationalization (i18n) through msgcat and gettext. See
92## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93package require msgcat
95# Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
97if {[tk windowingsystem] eq "win32"
98 && [package vcompare [package provide msgcat] 1.4.4] < 0
99} then {
100 proc _mc_update_locale {} {
101 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
102 if {![catch {
103 package require registry
104 set uilocale [registry get $key "PreferredUILanguages"]
105 msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
106 } uilocale]} {
107 if {[string length $uilocale] > 0} {
108 msgcat::mclocale $uilocale
109 }
110 }
111 }
112 _mc_update_locale
113}
114proc _mc_trim {fmt} {
116 set cmk [string first @@ $fmt]
117 if {$cmk > 0} {
118 return [string range $fmt 0 [expr {$cmk - 1}]]
119 }
120 return $fmt
121}
122proc mc {en_fmt args} {
124 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
125 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
126 set msg [eval [list format [_mc_trim $en_fmt]] $args]
127 }
128 return $msg
129}
130proc strcat {args} {
132 return [join $args {}]
133}
134::msgcat::mcload $oguimsg
136unset oguimsg
137######################################################################
139##
140## read only globals
141set _appname {Git Gui}
143set _gitdir {}
144set _gitworktree {}
145set _isbare {}
146set _gitexec {}
147set _githtmldir {}
148set _reponame {}
149set _iscygwin {}
150set _search_path {}
151set _shellpath {@@SHELL_PATH@@}
152set _trace [lsearch -exact $argv --trace]
154if {$_trace >= 0} {
155 set argv [lreplace $argv $_trace $_trace]
156 set _trace 1
157 if {[tk windowingsystem] eq "win32"} { console show }
158} else {
159 set _trace 0
160}
161# variable for the last merged branch (useful for a default when deleting
163# branches).
164set _last_merged_branch {}
165proc shellpath {} {
167 global _shellpath env
168 if {[string match @@* $_shellpath]} {
169 if {[info exists env(SHELL)]} {
170 return $env(SHELL)
171 } else {
172 return /bin/sh
173 }
174 }
175 return $_shellpath
176}
177proc appname {} {
179 global _appname
180 return $_appname
181}
182proc gitdir {args} {
184 global _gitdir
185 if {$args eq {}} {
186 return $_gitdir
187 }
188 return [eval [list file join $_gitdir] $args]
189}
190proc gitexec {args} {
192 global _gitexec
193 if {$_gitexec eq {}} {
194 if {[catch {set _gitexec [git --exec-path]} err]} {
195 error "Git not installed?\n\n$err"
196 }
197 if {[is_Cygwin]} {
198 set _gitexec [exec cygpath \
199 --windows \
200 --absolute \
201 $_gitexec]
202 } else {
203 set _gitexec [file normalize $_gitexec]
204 }
205 }
206 if {$args eq {}} {
207 return $_gitexec
208 }
209 return [eval [list file join $_gitexec] $args]
210}
211proc githtmldir {args} {
213 global _githtmldir
214 if {$_githtmldir eq {}} {
215 if {[catch {set _githtmldir [git --html-path]}]} {
216 # Git not installed or option not yet supported
217 return {}
218 }
219 if {[is_Cygwin]} {
220 set _githtmldir [exec cygpath \
221 --windows \
222 --absolute \
223 $_githtmldir]
224 } else {
225 set _githtmldir [file normalize $_githtmldir]
226 }
227 }
228 if {$args eq {}} {
229 return $_githtmldir
230 }
231 return [eval [list file join $_githtmldir] $args]
232}
233proc reponame {} {
235 return $::_reponame
236}
237proc is_MacOSX {} {
239 if {[tk windowingsystem] eq {aqua}} {
240 return 1
241 }
242 return 0
243}
244proc is_Windows {} {
246 if {$::tcl_platform(platform) eq {windows}} {
247 return 1
248 }
249 return 0
250}
251proc is_Cygwin {} {
253 global _iscygwin
254 if {$_iscygwin eq {}} {
255 if {$::tcl_platform(platform) eq {windows}} {
256 if {[catch {set p [exec cygpath --windir]} err]} {
257 set _iscygwin 0
258 } else {
259 set _iscygwin 1
260 }
261 } else {
262 set _iscygwin 0
263 }
264 }
265 return $_iscygwin
266}
267proc is_enabled {option} {
269 global enabled_options
270 if {[catch {set on $enabled_options($option)}]} {return 0}
271 return $on
272}
273proc enable_option {option} {
275 global enabled_options
276 set enabled_options($option) 1
277}
278proc disable_option {option} {
280 global enabled_options
281 set enabled_options($option) 0
282}
283######################################################################
285##
286## config
287proc is_many_config {name} {
289 switch -glob -- $name {
290 gui.recentrepo -
291 remote.*.fetch -
292 remote.*.push
293 {return 1}
294 *
295 {return 0}
296 }
297}
298proc is_config_true {name} {
300 global repo_config
301 if {[catch {set v $repo_config($name)}]} {
302 return 0
303 }
304 set v [string tolower $v]
305 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
306 return 1
307 } else {
308 return 0
309 }
310}
311proc is_config_false {name} {
313 global repo_config
314 if {[catch {set v $repo_config($name)}]} {
315 return 0
316 }
317 set v [string tolower $v]
318 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
319 return 1
320 } else {
321 return 0
322 }
323}
324proc get_config {name} {
326 global repo_config
327 if {[catch {set v $repo_config($name)}]} {
328 return {}
329 } else {
330 return $v
331 }
332}
333proc is_bare {} {
335 global _isbare
336 global _gitdir
337 global _gitworktree
338 if {$_isbare eq {}} {
340 if {[catch {
341 set _bare [git rev-parse --is-bare-repository]
342 switch -- $_bare {
343 true { set _isbare 1 }
344 false { set _isbare 0}
345 default { throw }
346 }
347 }]} {
348 if {[is_config_true core.bare]
349 || ($_gitworktree eq {}
350 && [lindex [file split $_gitdir] end] ne {.git})} {
351 set _isbare 1
352 } else {
353 set _isbare 0
354 }
355 }
356 }
357 return $_isbare
358}
359######################################################################
361##
362## handy utils
363proc _trace_exec {cmd} {
365 if {!$::_trace} return
366 set d {}
367 foreach v $cmd {
368 if {$d ne {}} {
369 append d { }
370 }
371 if {[regexp {[ \t\r\n'"$?*]} $v]} {
372 set v [sq $v]
373 }
374 append d $v
375 }
376 puts stderr $d
377}
378#'" fix poor old emacs font-lock mode
380proc _git_cmd {name} {
382 global _git_cmd_path
383 if {[catch {set v $_git_cmd_path($name)}]} {
385 switch -- $name {
386 version -
387 --version -
388 --exec-path { return [list $::_git $name] }
389 }
390 set p [gitexec git-$name$::_search_exe]
392 if {[file exists $p]} {
393 set v [list $p]
394 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
395 # Try to determine what sort of magic will make
396 # git-$name go and do its thing, because native
397 # Tcl on Windows doesn't know it.
398 #
399 set p [gitexec git-$name]
400 set f [open $p r]
401 set s [gets $f]
402 close $f
403 switch -glob -- [lindex $s 0] {
405 #!*sh { set i sh }
406 #!*perl { set i perl }
407 #!*python { set i python }
408 default { error "git-$name is not supported: $s" }
409 }
410 upvar #0 _$i interp
412 if {![info exists interp]} {
413 set interp [_which $i]
414 }
415 if {$interp eq {}} {
416 error "git-$name requires $i (not in PATH)"
417 }
418 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
419 } else {
420 # Assume it is builtin to git somehow and we
421 # aren't actually able to see a file for it.
422 #
423 set v [list $::_git $name]
424 }
425 set _git_cmd_path($name) $v
426 }
427 return $v
428}
429proc _which {what args} {
431 global env _search_exe _search_path
432 if {$_search_path eq {}} {
434 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
435 set _search_path [split [exec cygpath \
436 --windows \
437 --path \
438 --absolute \
439 $env(PATH)] {;}]
440 set _search_exe .exe
441 } elseif {[is_Windows]} {
442 set gitguidir [file dirname [info script]]
443 regsub -all ";" $gitguidir "\\;" gitguidir
444 set env(PATH) "$gitguidir;$env(PATH)"
445 set _search_path [split $env(PATH) {;}]
446 set _search_exe .exe
447 } else {
448 set _search_path [split $env(PATH) :]
449 set _search_exe {}
450 }
451 }
452 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
454 set suffix {}
455 } else {
456 set suffix $_search_exe
457 }
458 foreach p $_search_path {
460 set p [file join $p $what$suffix]
461 if {[file exists $p]} {
462 return [file normalize $p]
463 }
464 }
465 return {}
466}
467# Test a file for a hashbang to identify executable scripts on Windows.
469proc is_shellscript {filename} {
470 if {![file exists $filename]} {return 0}
471 set f [open $filename r]
472 fconfigure $f -encoding binary
473 set magic [read $f 2]
474 close $f
475 return [expr {$magic eq "#!"}]
476}
477# Run a command connected via pipes on stdout.
479# This is for use with textconv filters and uses sh -c "..." to allow it to
480# contain a command with arguments. On windows we must check for shell
481# scripts specifically otherwise just call the filter command.
482proc open_cmd_pipe {cmd path} {
483 global env
484 if {![file executable [shellpath]]} {
485 set exe [auto_execok [lindex $cmd 0]]
486 if {[is_shellscript [lindex $exe 0]]} {
487 set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
488 } else {
489 set run [concat $exe [lrange $cmd 1 end] $path]
490 }
491 } else {
492 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
493 }
494 return [open |$run r]
495}
496proc _lappend_nice {cmd_var} {
498 global _nice
499 upvar $cmd_var cmd
500 if {![info exists _nice]} {
502 set _nice [_which nice]
503 if {[catch {exec $_nice git version}]} {
504 set _nice {}
505 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
506 set _nice {}
507 }
508 }
509 if {$_nice ne {}} {
510 lappend cmd $_nice
511 }
512}
513proc git {args} {
515 set opt [list]
516 while {1} {
518 switch -- [lindex $args 0] {
519 --nice {
520 _lappend_nice opt
521 }
522 default {
524 break
525 }
526 }
528 set args [lrange $args 1 end]
530 }
531 set cmdp [_git_cmd [lindex $args 0]]
533 set args [lrange $args 1 end]
534 _trace_exec [concat $opt $cmdp $args]
536 set result [eval exec $opt $cmdp $args]
537 if {$::_trace} {
538 puts stderr "< $result"
539 }
540 return $result
541}
542proc _open_stdout_stderr {cmd} {
544 _trace_exec $cmd
545 if {[catch {
546 set fd [open [concat [list | ] $cmd] r]
547 } err]} {
548 if { [lindex $cmd end] eq {2>@1}
549 && $err eq {can not find channel named "1"}
550 } {
551 # Older versions of Tcl 8.4 don't have this 2>@1 IO
552 # redirect operator. Fallback to |& cat for those.
553 # The command was not actually started, so its safe
554 # to try to start it a second time.
555 #
556 set fd [open [concat \
557 [list | ] \
558 [lrange $cmd 0 end-1] \
559 [list |& cat] \
560 ] r]
561 } else {
562 error $err
563 }
564 }
565 fconfigure $fd -eofchar {}
566 return $fd
567}
568proc git_read {args} {
570 set opt [list]
571 while {1} {
573 switch -- [lindex $args 0] {
574 --nice {
575 _lappend_nice opt
576 }
577 --stderr {
579 lappend args 2>@1
580 }
581 default {
583 break
584 }
585 }
587 set args [lrange $args 1 end]
589 }
590 set cmdp [_git_cmd [lindex $args 0]]
592 set args [lrange $args 1 end]
593 return [_open_stdout_stderr [concat $opt $cmdp $args]]
595}
596proc git_write {args} {
598 set opt [list]
599 while {1} {
601 switch -- [lindex $args 0] {
602 --nice {
603 _lappend_nice opt
604 }
605 default {
607 break
608 }
609 }
611 set args [lrange $args 1 end]
613 }
614 set cmdp [_git_cmd [lindex $args 0]]
616 set args [lrange $args 1 end]
617 _trace_exec [concat $opt $cmdp $args]
619 return [open [concat [list | ] $opt $cmdp $args] w]
620}
621proc githook_read {hook_name args} {
623 set pchook [gitdir hooks $hook_name]
624 lappend args 2>@1
625 # On Windows [file executable] might lie so we need to ask
627 # the shell if the hook is executable. Yes that's annoying.
628 #
629 if {[is_Windows]} {
630 upvar #0 _sh interp
631 if {![info exists interp]} {
632 set interp [_which sh]
633 }
634 if {$interp eq {}} {
635 error "hook execution requires sh (not in PATH)"
636 }
637 set scr {if test -x "$1";then exec "$@";fi}
639 set sh_c [list $interp -c $scr $interp $pchook]
640 return [_open_stdout_stderr [concat $sh_c $args]]
641 }
642 if {[file executable $pchook]} {
644 return [_open_stdout_stderr [concat [list $pchook] $args]]
645 }
646 return {}
648}
649proc kill_file_process {fd} {
651 set process [pid $fd]
652 catch {
654 if {[is_Windows]} {
655 # Use a Cygwin-specific flag to allow killing
656 # native Windows processes
657 exec kill -f $process
658 } else {
659 exec kill $process
660 }
661 }
662}
663proc gitattr {path attr default} {
665 if {[catch {set r [git check-attr $attr -- $path]}]} {
666 set r unspecified
667 } else {
668 set r [join [lrange [split $r :] 2 end] :]
669 regsub {^ } $r {} r
670 }
671 if {$r eq {unspecified}} {
672 return $default
673 }
674 return $r
675}
676proc sq {value} {
678 regsub -all ' $value "'\\''" value
679 return "'$value'"
680}
681proc load_current_branch {} {
683 global current_branch is_detached
684 set fd [open [gitdir HEAD] r]
686 if {[gets $fd ref] < 1} {
687 set ref {}
688 }
689 close $fd
690 set pfx {ref: refs/heads/}
692 set len [string length $pfx]
693 if {[string equal -length $len $pfx $ref]} {
694 # We're on a branch. It might not exist. But
695 # HEAD looks good enough to be a branch.
696 #
697 set current_branch [string range $ref $len end]
698 set is_detached 0
699 } else {
700 # Assume this is a detached head.
701 #
702 set current_branch HEAD
703 set is_detached 1
704 }
705}
706auto_load tk_optionMenu
708rename tk_optionMenu real__tkOptionMenu
709proc tk_optionMenu {w varName args} {
710 set m [eval real__tkOptionMenu $w $varName $args]
711 $m configure -font font_ui
712 $w configure -font font_ui
713 return $m
714}
715proc rmsel_tag {text} {
717 $text tag conf sel \
718 -background [$text cget -background] \
719 -foreground [$text cget -foreground] \
720 -borderwidth 0
721 $text tag conf in_sel -background lightgray
722 bind $text <Motion> break
723 return $text
724}
725wm withdraw .
727set root_exists 0
728bind . <Visibility> {
729 bind . <Visibility> {}
730 set root_exists 1
731}
732if {[is_Windows]} {
734 wm iconbitmap . -default $oguilib/git-gui.ico
735 set ::tk::AlwaysShowSelection 1
736 bind . <Control-F2> {console show}
737 # Spoof an X11 display for SSH
739 if {![info exists env(DISPLAY)]} {
740 set env(DISPLAY) :9999
741 }
742} else {
743 catch {
744 image create photo gitlogo -width 16 -height 16
745 gitlogo put #33CC33 -to 7 0 9 2
747 gitlogo put #33CC33 -to 4 2 12 4
748 gitlogo put #33CC33 -to 7 4 9 6
749 gitlogo put #CC3333 -to 4 6 12 8
750 gitlogo put gray26 -to 4 9 6 10
751 gitlogo put gray26 -to 3 10 6 12
752 gitlogo put gray26 -to 8 9 13 11
753 gitlogo put gray26 -to 8 11 10 12
754 gitlogo put gray26 -to 11 11 13 14
755 gitlogo put gray26 -to 3 12 5 14
756 gitlogo put gray26 -to 5 13
757 gitlogo put gray26 -to 10 13
758 gitlogo put gray26 -to 4 14 12 15
759 gitlogo put gray26 -to 5 15 11 16
760 gitlogo redither
761 image create photo gitlogo32 -width 32 -height 32
763 gitlogo32 copy gitlogo -zoom 2 2
764 wm iconphoto . -default gitlogo gitlogo32
766 }
767}
768######################################################################
770##
771## config defaults
772set cursor_ptr arrow
774font create font_ui
775if {[lsearch -exact [font names] TkDefaultFont] != -1} {
776 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
777 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
778} else {
779 font create font_diff -family Courier -size 10
780 catch {
781 label .dummy
782 eval font configure font_ui [font actual [.dummy cget -font]]
783 destroy .dummy
784 }
785}
786font create font_uiitalic
788font create font_uibold
789font create font_diffbold
790font create font_diffitalic
791foreach class {Button Checkbutton Entry Label
793 Labelframe Listbox Message
794 Radiobutton Spinbox Text} {
795 option add *$class.font font_ui
796}
797if {![is_MacOSX]} {
798 option add *Menu.font font_ui
799 option add *Entry.borderWidth 1 startupFile
800 option add *Entry.relief sunken startupFile
801 option add *RadioButton.anchor w startupFile
802}
803unset class
804if {[is_Windows] || [is_MacOSX]} {
806 option add *Menu.tearOff 0
807}
808if {[is_MacOSX]} {
810 set M1B M1
811 set M1T Cmd
812} else {
813 set M1B Control
814 set M1T Ctrl
815}
816proc bind_button3 {w cmd} {
818 bind $w <Any-Button-3> $cmd
819 if {[is_MacOSX]} {
820 # Mac OS X sends Button-2 on right click through three-button mouse,
821 # or through trackpad right-clicking (two-finger touch + click).
822 bind $w <Any-Button-2> $cmd
823 bind $w <Control-Button-1> $cmd
824 }
825}
826proc apply_config {} {
828 global repo_config font_descs
829 foreach option $font_descs {
831 set name [lindex $option 0]
832 set font [lindex $option 1]
833 if {[catch {
834 set need_weight 1
835 foreach {cn cv} $repo_config(gui.$name) {
836 if {$cn eq {-weight}} {
837 set need_weight 0
838 }
839 font configure $font $cn $cv
840 }
841 if {$need_weight} {
842 font configure $font -weight normal
843 }
844 } err]} {
845 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
846 }
847 foreach {cn cv} [font configure $font] {
848 font configure ${font}bold $cn $cv
849 font configure ${font}italic $cn $cv
850 }
851 font configure ${font}bold -weight bold
852 font configure ${font}italic -slant italic
853 }
854 global use_ttk NS
856 set use_ttk 0
857 set NS {}
858 if {$repo_config(gui.usettk)} {
859 set use_ttk [package vsatisfies [package provide Tk] 8.5]
860 if {$use_ttk} {
861 set NS ttk
862 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
863 pave_toplevel .
864 }
865 }
866}
867set default_config(branch.autosetupmerge) true
869set default_config(merge.tool) {}
870set default_config(mergetool.keepbackup) true
871set default_config(merge.diffstat) true
872set default_config(merge.summary) false
873set default_config(merge.verbosity) 2
874set default_config(user.name) {}
875set default_config(user.email) {}
876set default_config(gui.encoding) [encoding system]
878set default_config(gui.matchtrackingbranch) false
879set default_config(gui.textconv) true
880set default_config(gui.pruneduringfetch) false
881set default_config(gui.trustmtime) false
882set default_config(gui.fastcopyblame) false
883set default_config(gui.copyblamethreshold) 40
884set default_config(gui.blamehistoryctx) 7
885set default_config(gui.diffcontext) 5
886set default_config(gui.diffopts) {}
887set default_config(gui.commitmsgwidth) 75
888set default_config(gui.newbranchtemplate) {}
889set default_config(gui.spellingdictionary) {}
890set default_config(gui.fontui) [font configure font_ui]
891set default_config(gui.fontdiff) [font configure font_diff]
892# TODO: this option should be added to the git-config documentation
893set default_config(gui.maxfilesdisplayed) 5000
894set default_config(gui.usettk) 1
895set default_config(gui.warndetachedcommit) 1
896set font_descs {
897 {fontui font_ui {mc "Main Font"}}
898 {fontdiff font_diff {mc "Diff/Console Font"}}
899}
900set default_config(gui.stageuntracked) ask
901######################################################################
903##
904## find git
905set _git [_which git]
907if {$_git eq {}} {
908 catch {wm withdraw .}
909 tk_messageBox \
910 -icon error \
911 -type ok \
912 -title [mc "git-gui: fatal error"] \
913 -message [mc "Cannot find git in PATH."]
914 exit 1
915}
916######################################################################
918##
919## version check
920if {[catch {set _git_version [git --version]} err]} {
922 catch {wm withdraw .}
923 tk_messageBox \
924 -icon error \
925 -type ok \
926 -title [mc "git-gui: fatal error"] \
927 -message "Cannot determine Git version:
928$err
930[appname] requires Git 1.5.0 or later."
932 exit 1
933}
934if {![regsub {^git version } $_git_version {} _git_version]} {
935 catch {wm withdraw .}
936 tk_messageBox \
937 -icon error \
938 -type ok \
939 -title [mc "git-gui: fatal error"] \
940 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
941 exit 1
942}
943proc get_trimmed_version {s} {
945 set r {}
946 foreach x [split $s -._] {
947 if {[string is integer -strict $x]} {
948 lappend r $x
949 } else {
950 break
951 }
952 }
953 return [join $r .]
954}
955set _real_git_version $_git_version
956set _git_version [get_trimmed_version $_git_version]
957if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
959 catch {wm withdraw .}
960 if {[tk_messageBox \
961 -icon warning \
962 -type yesno \
963 -default no \
964 -title "[appname]: warning" \
965 -message [mc "Git version cannot be determined.
966%s claims it is version '%s'.
968%s requires at least Git 1.5.0 or later.
970Assume '%s' is version 1.5.0?
972" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
973 set _git_version 1.5.0
974 } else {
975 exit 1
976 }
977}
978unset _real_git_version
979proc git-version {args} {
981 global _git_version
982 switch [llength $args] {
984 0 {
985 return $_git_version
986 }
987 2 {
989 set op [lindex $args 0]
990 set vr [lindex $args 1]
991 set cm [package vcompare $_git_version $vr]
992 return [expr $cm $op 0]
993 }
994 4 {
996 set type [lindex $args 0]
997 set name [lindex $args 1]
998 set parm [lindex $args 2]
999 set body [lindex $args 3]
1000 if {($type ne {proc} && $type ne {method})} {
1002 error "Invalid arguments to git-version"
1003 }
1004 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1005 error "Last arm of $type $name must be default"
1006 }
1007 foreach {op vr cb} [lrange $body 0 end-2] {
1009 if {[git-version $op $vr]} {
1010 return [uplevel [list $type $name $parm $cb]]
1011 }
1012 }
1013 return [uplevel [list $type $name $parm [lindex $body end]]]
1015 }
1016 default {
1018 error "git-version >= x"
1019 }
1020 }
1022}
1023if {[git-version < 1.5]} {
1025 catch {wm withdraw .}
1026 tk_messageBox \
1027 -icon error \
1028 -type ok \
1029 -title [mc "git-gui: fatal error"] \
1030 -message "[appname] requires Git 1.5.0 or later.
1031You are using [git-version]:
1033[git --version]"
1035 exit 1
1036}
1037######################################################################
1039##
1040## configure our library
1041set idx [file join $oguilib tclIndex]
1043if {[catch {set fd [open $idx r]} err]} {
1044 catch {wm withdraw .}
1045 tk_messageBox \
1046 -icon error \
1047 -type ok \
1048 -title [mc "git-gui: fatal error"] \
1049 -message $err
1050 exit 1
1051}
1052if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1053 set idx [list]
1054 while {[gets $fd n] >= 0} {
1055 if {$n ne {} && ![string match #* $n]} {
1056 lappend idx $n
1057 }
1058 }
1059} else {
1060 set idx {}
1061}
1062close $fd
1063if {$idx ne {}} {
1065 set loaded [list]
1066 foreach p $idx {
1067 if {[lsearch -exact $loaded $p] >= 0} continue
1068 source [file join $oguilib $p]
1069 lappend loaded $p
1070 }
1071 unset loaded p
1072} else {
1073 set auto_path [concat [list $oguilib] $auto_path]
1074}
1075unset -nocomplain idx fd
1076######################################################################
1078##
1079## config file parsing
1080git-version proc _parse_config {arr_name args} {
1082 >= 1.5.3 {
1083 upvar $arr_name arr
1084 array unset arr
1085 set buf {}
1086 catch {
1087 set fd_rc [eval \
1088 [list git_read config] \
1089 $args \
1090 [list --null --list]]
1091 fconfigure $fd_rc -translation binary
1092 set buf [read $fd_rc]
1093 close $fd_rc
1094 }
1095 foreach line [split $buf "\0"] {
1096 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1097 if {[is_many_config $name]} {
1098 lappend arr($name) $value
1099 } else {
1100 set arr($name) $value
1101 }
1102 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1103 # no value given, but interpreting them as
1104 # boolean will be handled as true
1105 set arr($name) {}
1106 }
1107 }
1108 }
1109 default {
1110 upvar $arr_name arr
1111 array unset arr
1112 catch {
1113 set fd_rc [eval [list git_read config --list] $args]
1114 while {[gets $fd_rc line] >= 0} {
1115 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1116 if {[is_many_config $name]} {
1117 lappend arr($name) $value
1118 } else {
1119 set arr($name) $value
1120 }
1121 } elseif {[regexp {^([^=]+)$} $line line name]} {
1122 # no value given, but interpreting them as
1123 # boolean will be handled as true
1124 set arr($name) {}
1125 }
1126 }
1127 close $fd_rc
1128 }
1129 }
1130}
1131proc load_config {include_global} {
1133 global repo_config global_config system_config default_config
1134 if {$include_global} {
1136 _parse_config system_config --system
1137 _parse_config global_config --global
1138 }
1139 _parse_config repo_config
1140 foreach name [array names default_config] {
1142 if {[catch {set v $system_config($name)}]} {
1143 set system_config($name) $default_config($name)
1144 }
1145 }
1146 foreach name [array names system_config] {
1147 if {[catch {set v $global_config($name)}]} {
1148 set global_config($name) $system_config($name)
1149 }
1150 if {[catch {set v $repo_config($name)}]} {
1151 set repo_config($name) $system_config($name)
1152 }
1153 }
1154}
1155######################################################################
1157##
1158## feature option selection
1159if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1161 unset _junk
1162} else {
1163 set subcommand gui
1164}
1165if {$subcommand eq {gui.sh}} {
1166 set subcommand gui
1167}
1168if {$subcommand eq {gui} && [llength $argv] > 0} {
1169 set subcommand [lindex $argv 0]
1170 set argv [lrange $argv 1 end]
1171}
1172enable_option multicommit
1174enable_option branch
1175enable_option transport
1176disable_option bare
1177switch -- $subcommand {
1179browser -
1180blame {
1181 enable_option bare
1182 disable_option multicommit
1184 disable_option branch
1185 disable_option transport
1186}
1187citool {
1188 enable_option singlecommit
1189 enable_option retcode
1190 disable_option multicommit
1192 disable_option branch
1193 disable_option transport
1194 while {[llength $argv] > 0} {
1196 set a [lindex $argv 0]
1197 switch -- $a {
1198 --amend {
1199 enable_option initialamend
1200 }
1201 --nocommit {
1202 enable_option nocommit
1203 enable_option nocommitmsg
1204 }
1205 --commitmsg {
1206 disable_option nocommitmsg
1207 }
1208 default {
1209 break
1210 }
1211 }
1212 set argv [lrange $argv 1 end]
1214 }
1215}
1216}
1217######################################################################
1219##
1220## execution environment
1221set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1223# Suggest our implementation of askpass, if none is set
1225if {![info exists env(SSH_ASKPASS)]} {
1226 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1227}
1228######################################################################
1230##
1231## repository setup
1232set picked 0
1234if {[catch {
1235 set _gitdir $env(GIT_DIR)
1236 set _prefix {}
1237 }]
1238 && [catch {
1239 # beware that from the .git dir this sets _gitdir to .
1240 # and _prefix to the empty string
1241 set _gitdir [git rev-parse --git-dir]
1242 set _prefix [git rev-parse --show-prefix]
1243 } err]} {
1244 load_config 1
1245 apply_config
1246 choose_repository::pick
1247 set picked 1
1248}
1249# we expand the _gitdir when it's just a single dot (i.e. when we're being
1251# run from the .git dir itself) lest the routines to find the worktree
1252# get confused
1253if {$_gitdir eq "."} {
1254 set _gitdir [pwd]
1255}
1256if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1258 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1259}
1260if {![file isdirectory $_gitdir]} {
1261 catch {wm withdraw .}
1262 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1263 exit 1
1264}
1265# _gitdir exists, so try loading the config
1266load_config 0
1267apply_config
1268# v1.7.0 introduced --show-toplevel to return the canonical work-tree
1270if {[package vsatisfies $_git_version 1.7.0]} {
1271 set _gitworktree [git rev-parse --show-toplevel]
1272} else {
1273 # try to set work tree from environment, core.worktree or use
1274 # cdup to obtain a relative path to the top of the worktree. If
1275 # run from the top, the ./ prefix ensures normalize expands pwd.
1276 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1277 set _gitworktree [get_config core.worktree]
1278 if {$_gitworktree eq ""} {
1279 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1280 }
1281 }
1282}
1283if {$_prefix ne {}} {
1285 if {$_gitworktree eq {}} {
1286 regsub -all {[^/]+/} $_prefix ../ cdup
1287 } else {
1288 set cdup $_gitworktree
1289 }
1290 if {[catch {cd $cdup} err]} {
1291 catch {wm withdraw .}
1292 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1293 exit 1
1294 }
1295 set _gitworktree [pwd]
1296 unset cdup
1297} elseif {![is_enabled bare]} {
1298 if {[is_bare]} {
1299 catch {wm withdraw .}
1300 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1301 exit 1
1302 }
1303 if {$_gitworktree eq {}} {
1304 set _gitworktree [file dirname $_gitdir]
1305 }
1306 if {[catch {cd $_gitworktree} err]} {
1307 catch {wm withdraw .}
1308 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1309 exit 1
1310 }
1311 set _gitworktree [pwd]
1312}
1313set _reponame [file split [file normalize $_gitdir]]
1314if {[lindex $_reponame end] eq {.git}} {
1315 set _reponame [lindex $_reponame end-1]
1316} else {
1317 set _reponame [lindex $_reponame end]
1318}
1319set env(GIT_DIR) $_gitdir
1321set env(GIT_WORK_TREE) $_gitworktree
1322######################################################################
1324##
1325## global init
1326set current_diff_path {}
1328set current_diff_side {}
1329set diff_actions [list]
1330set HEAD {}
1332set PARENT {}
1333set MERGE_HEAD [list]
1334set commit_type {}
1335set empty_tree {}
1336set current_branch {}
1337set is_detached 0
1338set current_diff_path {}
1339set is_3way_diff 0
1340set is_submodule_diff 0
1341set is_conflict_diff 0
1342set selected_commit_type new
1343set diff_empty_count 0
1344set nullid "0000000000000000000000000000000000000000"
1346set nullid2 "0000000000000000000000000000000000000001"
1347######################################################################
1349##
1350## task management
1351set rescan_active 0
1353set diff_active 0
1354set last_clicked {}
1355set disable_on_lock [list]
1357set index_lock_type none
1358proc lock_index {type} {
1360 global index_lock_type disable_on_lock
1361 if {$index_lock_type eq {none}} {
1363 set index_lock_type $type
1364 foreach w $disable_on_lock {
1365 uplevel #0 $w disabled
1366 }
1367 return 1
1368 } elseif {$index_lock_type eq "begin-$type"} {
1369 set index_lock_type $type
1370 return 1
1371 }
1372 return 0
1373}
1374proc unlock_index {} {
1376 global index_lock_type disable_on_lock
1377 set index_lock_type none
1379 foreach w $disable_on_lock {
1380 uplevel #0 $w normal
1381 }
1382}
1383######################################################################
1385##
1386## status
1387proc repository_state {ctvar hdvar mhvar} {
1389 global current_branch
1390 upvar $ctvar ct $hdvar hd $mhvar mh
1391 set mh [list]
1393 load_current_branch
1395 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1396 set hd {}
1397 set ct initial
1398 return
1399 }
1400 set merge_head [gitdir MERGE_HEAD]
1402 if {[file exists $merge_head]} {
1403 set ct merge
1404 set fd_mh [open $merge_head r]
1405 while {[gets $fd_mh line] >= 0} {
1406 lappend mh $line
1407 }
1408 close $fd_mh
1409 return
1410 }
1411 set ct normal
1413}
1414proc PARENT {} {
1416 global PARENT empty_tree
1417 set p [lindex $PARENT 0]
1419 if {$p ne {}} {
1420 return $p
1421 }
1422 if {$empty_tree eq {}} {
1423 set empty_tree [git mktree << {}]
1424 }
1425 return $empty_tree
1426}
1427proc force_amend {} {
1429 global selected_commit_type
1430 global HEAD PARENT MERGE_HEAD commit_type
1431 repository_state newType newHEAD newMERGE_HEAD
1433 set HEAD $newHEAD
1434 set PARENT $newHEAD
1435 set MERGE_HEAD $newMERGE_HEAD
1436 set commit_type $newType
1437 set selected_commit_type amend
1439 do_select_commit_type
1440}
1441proc rescan {after {honor_trustmtime 1}} {
1443 global HEAD PARENT MERGE_HEAD commit_type
1444 global ui_index ui_workdir ui_comm
1445 global rescan_active file_states
1446 global repo_config
1447 if {$rescan_active > 0 || ![lock_index read]} return
1449 repository_state newType newHEAD newMERGE_HEAD
1451 if {[string match amend* $commit_type]
1452 && $newType eq {normal}
1453 && $newHEAD eq $HEAD} {
1454 } else {
1455 set HEAD $newHEAD
1456 set PARENT $newHEAD
1457 set MERGE_HEAD $newMERGE_HEAD
1458 set commit_type $newType
1459 }
1460 array unset file_states
1462 if {!$::GITGUI_BCK_exists &&
1464 (![$ui_comm edit modified]
1465 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1466 if {[string match amend* $commit_type]} {
1467 } elseif {[load_message GITGUI_MSG utf-8]} {
1468 } elseif {[run_prepare_commit_msg_hook]} {
1469 } elseif {[load_message MERGE_MSG]} {
1470 } elseif {[load_message SQUASH_MSG]} {
1471 }
1472 $ui_comm edit reset
1473 $ui_comm edit modified false
1474 }
1475 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1477 rescan_stage2 {} $after
1478 } else {
1479 set rescan_active 1
1480 ui_status [mc "Refreshing file status..."]
1481 set fd_rf [git_read update-index \
1482 -q \
1483 --unmerged \
1484 --ignore-missing \
1485 --refresh \
1486 ]
1487 fconfigure $fd_rf -blocking 0 -translation binary
1488 fileevent $fd_rf readable \
1489 [list rescan_stage2 $fd_rf $after]
1490 }
1491}
1492if {[is_Cygwin]} {
1494 set is_git_info_exclude {}
1495 proc have_info_exclude {} {
1496 global is_git_info_exclude
1497 if {$is_git_info_exclude eq {}} {
1499 if {[catch {exec test -f [gitdir info exclude]}]} {
1500 set is_git_info_exclude 0
1501 } else {
1502 set is_git_info_exclude 1
1503 }
1504 }
1505 return $is_git_info_exclude
1506 }
1507} else {
1508 proc have_info_exclude {} {
1509 return [file readable [gitdir info exclude]]
1510 }
1511}
1512proc rescan_stage2 {fd after} {
1514 global rescan_active buf_rdi buf_rdf buf_rlo
1515 if {$fd ne {}} {
1517 read $fd
1518 if {![eof $fd]} return
1519 close $fd
1520 }
1521 if {[package vsatisfies $::_git_version 1.6.3]} {
1523 set ls_others [list --exclude-standard]
1524 } else {
1525 set ls_others [list --exclude-per-directory=.gitignore]
1526 if {[have_info_exclude]} {
1527 lappend ls_others "--exclude-from=[gitdir info exclude]"
1528 }
1529 set user_exclude [get_config core.excludesfile]
1530 if {$user_exclude ne {} && [file readable $user_exclude]} {
1531 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1532 }
1533 }
1534 set buf_rdi {}
1536 set buf_rdf {}
1537 set buf_rlo {}
1538 set rescan_active 3
1540 ui_status [mc "Scanning for modified files ..."]
1541 set fd_di [git_read diff-index --cached -z [PARENT]]
1542 set fd_df [git_read diff-files -z]
1543 set fd_lo [eval git_read ls-files --others -z $ls_others]
1544 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1546 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1547 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1548 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1549 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1550 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1551}
1552proc load_message {file {encoding {}}} {
1554 global ui_comm
1555 set f [gitdir $file]
1557 if {[file isfile $f]} {
1558 if {[catch {set fd [open $f r]}]} {
1559 return 0
1560 }
1561 fconfigure $fd -eofchar {}
1562 if {$encoding ne {}} {
1563 fconfigure $fd -encoding $encoding
1564 }
1565 set content [string trim [read $fd]]
1566 close $fd
1567 regsub -all -line {[ \r\t]+$} $content {} content
1568 $ui_comm delete 0.0 end
1569 $ui_comm insert end $content
1570 return 1
1571 }
1572 return 0
1573}
1574proc run_prepare_commit_msg_hook {} {
1576 global pch_error
1577 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1579 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1580 # empty file but existent file.
1581 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1583 if {[file isfile [gitdir MERGE_MSG]]} {
1585 set pcm_source "merge"
1586 set fd_mm [open [gitdir MERGE_MSG] r]
1587 puts -nonewline $fd_pcm [read $fd_mm]
1588 close $fd_mm
1589 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1590 set pcm_source "squash"
1591 set fd_sm [open [gitdir SQUASH_MSG] r]
1592 puts -nonewline $fd_pcm [read $fd_sm]
1593 close $fd_sm
1594 } else {
1595 set pcm_source ""
1596 }
1597 close $fd_pcm
1599 set fd_ph [githook_read prepare-commit-msg \
1601 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1602 if {$fd_ph eq {}} {
1603 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1604 return 0;
1605 }
1606 ui_status [mc "Calling prepare-commit-msg hook..."]
1608 set pch_error {}
1609 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1611 fileevent $fd_ph readable \
1612 [list prepare_commit_msg_hook_wait $fd_ph]
1613 return 1;
1615}
1616proc prepare_commit_msg_hook_wait {fd_ph} {
1618 global pch_error
1619 append pch_error [read $fd_ph]
1621 fconfigure $fd_ph -blocking 1
1622 if {[eof $fd_ph]} {
1623 if {[catch {close $fd_ph}]} {
1624 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1625 hook_failed_popup prepare-commit-msg $pch_error
1626 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1627 exit 1
1628 } else {
1629 load_message PREPARE_COMMIT_MSG
1630 }
1631 set pch_error {}
1632 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1633 return
1634 }
1635 fconfigure $fd_ph -blocking 0
1636 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1637}
1638proc read_diff_index {fd after} {
1640 global buf_rdi
1641 append buf_rdi [read $fd]
1643 set c 0
1644 set n [string length $buf_rdi]
1645 while {$c < $n} {
1646 set z1 [string first "\0" $buf_rdi $c]
1647 if {$z1 == -1} break
1648 incr z1
1649 set z2 [string first "\0" $buf_rdi $z1]
1650 if {$z2 == -1} break
1651 incr c
1653 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1654 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1655 merge_state \
1656 [encoding convertfrom $p] \
1657 [lindex $i 4]? \
1658 [list [lindex $i 0] [lindex $i 2]] \
1659 [list]
1660 set c $z2
1661 incr c
1662 }
1663 if {$c < $n} {
1664 set buf_rdi [string range $buf_rdi $c end]
1665 } else {
1666 set buf_rdi {}
1667 }
1668 rescan_done $fd buf_rdi $after
1670}
1671proc read_diff_files {fd after} {
1673 global buf_rdf
1674 append buf_rdf [read $fd]
1676 set c 0
1677 set n [string length $buf_rdf]
1678 while {$c < $n} {
1679 set z1 [string first "\0" $buf_rdf $c]
1680 if {$z1 == -1} break
1681 incr z1
1682 set z2 [string first "\0" $buf_rdf $z1]
1683 if {$z2 == -1} break
1684 incr c
1686 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1687 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1688 merge_state \
1689 [encoding convertfrom $p] \
1690 ?[lindex $i 4] \
1691 [list] \
1692 [list [lindex $i 0] [lindex $i 2]]
1693 set c $z2
1694 incr c
1695 }
1696 if {$c < $n} {
1697 set buf_rdf [string range $buf_rdf $c end]
1698 } else {
1699 set buf_rdf {}
1700 }
1701 rescan_done $fd buf_rdf $after
1703}
1704proc read_ls_others {fd after} {
1706 global buf_rlo
1707 append buf_rlo [read $fd]
1709 set pck [split $buf_rlo "\0"]
1710 set buf_rlo [lindex $pck end]
1711 foreach p [lrange $pck 0 end-1] {
1712 set p [encoding convertfrom $p]
1713 if {[string index $p end] eq {/}} {
1714 set p [string range $p 0 end-1]
1715 }
1716 merge_state $p ?O
1717 }
1718 rescan_done $fd buf_rlo $after
1719}
1720proc rescan_done {fd buf after} {
1722 global rescan_active current_diff_path
1723 global file_states repo_config
1724 upvar $buf to_clear
1725 if {![eof $fd]} return
1727 set to_clear {}
1728 close $fd
1729 if {[incr rescan_active -1] > 0} return
1730 prune_selection
1732 unlock_index
1733 display_all_files
1734 if {$current_diff_path ne {}} { reshow_diff $after }
1735 if {$current_diff_path eq {}} { select_first_diff $after }
1736}
1737proc prune_selection {} {
1739 global file_states selected_paths
1740 foreach path [array names selected_paths] {
1742 if {[catch {set still_here $file_states($path)}]} {
1743 unset selected_paths($path)
1744 }
1745 }
1746}
1747######################################################################
1749##
1750## ui helpers
1751proc mapicon {w state path} {
1753 global all_icons
1754 if {[catch {set r $all_icons($state$w)}]} {
1756 puts "error: no icon for $w state={$state} $path"
1757 return file_plain
1758 }
1759 return $r
1760}
1761proc mapdesc {state path} {
1763 global all_descs
1764 if {[catch {set r $all_descs($state)}]} {
1766 puts "error: no desc for state={$state} $path"
1767 return $state
1768 }
1769 return $r
1770}
1771proc ui_status {msg} {
1773 global main_status
1774 if {[info exists main_status]} {
1775 $main_status show $msg
1776 }
1777}
1778proc ui_ready {{test {}}} {
1780 global main_status
1781 if {[info exists main_status]} {
1782 $main_status show [mc "Ready."] $test
1783 }
1784}
1785proc escape_path {path} {
1787 regsub -all {\\} $path "\\\\" path
1788 regsub -all "\n" $path "\\n" path
1789 return $path
1790}
1791proc short_path {path} {
1793 return [escape_path [lindex [file split $path] end]]
1794}
1795set next_icon_id 0
1797set null_sha1 [string repeat 0 40]
1798proc merge_state {path new_state {head_info {}} {index_info {}}} {
1800 global file_states next_icon_id null_sha1
1801 set s0 [string index $new_state 0]
1803 set s1 [string index $new_state 1]
1804 if {[catch {set info $file_states($path)}]} {
1806 set state __
1807 set icon n[incr next_icon_id]
1808 } else {
1809 set state [lindex $info 0]
1810 set icon [lindex $info 1]
1811 if {$head_info eq {}} {set head_info [lindex $info 2]}
1812 if {$index_info eq {}} {set index_info [lindex $info 3]}
1813 }
1814 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1816 elseif {$s0 eq {_}} {set s0 _}
1817 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1819 elseif {$s1 eq {_}} {set s1 _}
1820 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1822 set head_info [list 0 $null_sha1]
1823 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1824 && $head_info eq {}} {
1825 set head_info $index_info
1826 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1827 set index_info $head_info
1828 set head_info {}
1829 }
1830 set file_states($path) [list $s0$s1 $icon \
1832 $head_info $index_info \
1833 ]
1834 return $state
1835}
1836proc display_file_helper {w path icon_name old_m new_m} {
1838 global file_lists
1839 if {$new_m eq {_}} {
1841 set lno [lsearch -sorted -exact $file_lists($w) $path]
1842 if {$lno >= 0} {
1843 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1844 incr lno
1845 $w conf -state normal
1846 $w delete $lno.0 [expr {$lno + 1}].0
1847 $w conf -state disabled
1848 }
1849 } elseif {$old_m eq {_} && $new_m ne {_}} {
1850 lappend file_lists($w) $path
1851 set file_lists($w) [lsort -unique $file_lists($w)]
1852 set lno [lsearch -sorted -exact $file_lists($w) $path]
1853 incr lno
1854 $w conf -state normal
1855 $w image create $lno.0 \
1856 -align center -padx 5 -pady 1 \
1857 -name $icon_name \
1858 -image [mapicon $w $new_m $path]
1859 $w insert $lno.1 "[escape_path $path]\n"
1860 $w conf -state disabled
1861 } elseif {$old_m ne $new_m} {
1862 $w conf -state normal
1863 $w image conf $icon_name -image [mapicon $w $new_m $path]
1864 $w conf -state disabled
1865 }
1866}
1867proc display_file {path state} {
1869 global file_states selected_paths
1870 global ui_index ui_workdir
1871 set old_m [merge_state $path $state]
1873 set s $file_states($path)
1874 set new_m [lindex $s 0]
1875 set icon_name [lindex $s 1]
1876 set o [string index $old_m 0]
1878 set n [string index $new_m 0]
1879 if {$o eq {U}} {
1880 set o _
1881 }
1882 if {$n eq {U}} {
1883 set n _
1884 }
1885 display_file_helper $ui_index $path $icon_name $o $n
1886 if {[string index $old_m 0] eq {U}} {
1888 set o U
1889 } else {
1890 set o [string index $old_m 1]
1891 }
1892 if {[string index $new_m 0] eq {U}} {
1893 set n U
1894 } else {
1895 set n [string index $new_m 1]
1896 }
1897 display_file_helper $ui_workdir $path $icon_name $o $n
1898 if {$new_m eq {__}} {
1900 unset file_states($path)
1901 catch {unset selected_paths($path)}
1902 }
1903}
1904proc display_all_files_helper {w path icon_name m} {
1906 global file_lists
1907 lappend file_lists($w) $path
1909 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1910 $w image create end \
1911 -align center -padx 5 -pady 1 \
1912 -name $icon_name \
1913 -image [mapicon $w $m $path]
1914 $w insert end "[escape_path $path]\n"
1915}
1916set files_warning 0
1918proc display_all_files {} {
1919 global ui_index ui_workdir
1920 global file_states file_lists
1921 global last_clicked
1922 global files_warning
1923 $ui_index conf -state normal
1925 $ui_workdir conf -state normal
1926 $ui_index delete 0.0 end
1928 $ui_workdir delete 0.0 end
1929 set last_clicked {}
1930 set file_lists($ui_index) [list]
1932 set file_lists($ui_workdir) [list]
1933 set to_display [lsort [array names file_states]]
1935 set display_limit [get_config gui.maxfilesdisplayed]
1936 if {[llength $to_display] > $display_limit} {
1937 if {!$files_warning} {
1938 # do not repeatedly warn:
1939 set files_warning 1
1940 info_popup [mc "Displaying only %s of %s files." \
1941 $display_limit [llength $to_display]]
1942 }
1943 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1944 }
1945 foreach path $to_display {
1946 set s $file_states($path)
1947 set m [lindex $s 0]
1948 set icon_name [lindex $s 1]
1949 set s [string index $m 0]
1951 if {$s ne {U} && $s ne {_}} {
1952 display_all_files_helper $ui_index $path \
1953 $icon_name $s
1954 }
1955 if {[string index $m 0] eq {U}} {
1957 set s U
1958 } else {
1959 set s [string index $m 1]
1960 }
1961 if {$s ne {_}} {
1962 display_all_files_helper $ui_workdir $path \
1963 $icon_name $s
1964 }
1965 }
1966 $ui_index conf -state disabled
1968 $ui_workdir conf -state disabled
1969}
1970######################################################################
1972##
1973## icons
1974set filemask {
1976#define mask_width 14
1977#define mask_height 15
1978static unsigned char mask_bits[] = {
1979 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1980 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1981 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1982}
1983image create bitmap file_plain -background white -foreground black -data {
1985#define plain_width 14
1986#define plain_height 15
1987static unsigned char plain_bits[] = {
1988 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1989 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1990 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1991} -maskdata $filemask
1992image create bitmap file_mod -background white -foreground blue -data {
1994#define mod_width 14
1995#define mod_height 15
1996static unsigned char mod_bits[] = {
1997 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1998 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1999 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2000} -maskdata $filemask
2001image create bitmap file_fulltick -background white -foreground "#007000" -data {
2003#define file_fulltick_width 14
2004#define file_fulltick_height 15
2005static unsigned char file_fulltick_bits[] = {
2006 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2007 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2008 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2009} -maskdata $filemask
2010image create bitmap file_question -background white -foreground black -data {
2012#define file_question_width 14
2013#define file_question_height 15
2014static unsigned char file_question_bits[] = {
2015 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2016 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2017 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2018} -maskdata $filemask
2019image create bitmap file_removed -background white -foreground red -data {
2021#define file_removed_width 14
2022#define file_removed_height 15
2023static unsigned char file_removed_bits[] = {
2024 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2025 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2026 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2027} -maskdata $filemask
2028image create bitmap file_merge -background white -foreground blue -data {
2030#define file_merge_width 14
2031#define file_merge_height 15
2032static unsigned char file_merge_bits[] = {
2033 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2034 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2035 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2036} -maskdata $filemask
2037image create bitmap file_statechange -background white -foreground green -data {
2039#define file_statechange_width 14
2040#define file_statechange_height 15
2041static unsigned char file_statechange_bits[] = {
2042 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2043 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2044 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2045} -maskdata $filemask
2046set ui_index .vpane.files.index.list
2048set ui_workdir .vpane.files.workdir.list
2049set all_icons(_$ui_index) file_plain
2051set all_icons(A$ui_index) file_plain
2052set all_icons(M$ui_index) file_fulltick
2053set all_icons(D$ui_index) file_removed
2054set all_icons(U$ui_index) file_merge
2055set all_icons(T$ui_index) file_statechange
2056set all_icons(_$ui_workdir) file_plain
2058set all_icons(M$ui_workdir) file_mod
2059set all_icons(D$ui_workdir) file_question
2060set all_icons(U$ui_workdir) file_merge
2061set all_icons(O$ui_workdir) file_plain
2062set all_icons(T$ui_workdir) file_statechange
2063set max_status_desc 0
2065foreach i {
2066 {__ {mc "Unmodified"}}
2067 {_M {mc "Modified, not staged"}}
2069 {M_ {mc "Staged for commit"}}
2070 {MM {mc "Portions staged for commit"}}
2071 {MD {mc "Staged for commit, missing"}}
2072 {_T {mc "File type changed, not staged"}}
2074 {MT {mc "File type changed, old type staged for commit"}}
2075 {AT {mc "File type changed, old type staged for commit"}}
2076 {T_ {mc "File type changed, staged"}}
2077 {TM {mc "File type change staged, modification not staged"}}
2078 {TD {mc "File type change staged, file missing"}}
2079 {_O {mc "Untracked, not staged"}}
2081 {A_ {mc "Staged for commit"}}
2082 {AM {mc "Portions staged for commit"}}
2083 {AD {mc "Staged for commit, missing"}}
2084 {_D {mc "Missing"}}
2086 {D_ {mc "Staged for removal"}}
2087 {DO {mc "Staged for removal, still present"}}
2088 {_U {mc "Requires merge resolution"}}
2090 {U_ {mc "Requires merge resolution"}}
2091 {UU {mc "Requires merge resolution"}}
2092 {UM {mc "Requires merge resolution"}}
2093 {UD {mc "Requires merge resolution"}}
2094 {UT {mc "Requires merge resolution"}}
2095 } {
2096 set text [eval [lindex $i 1]]
2097 if {$max_status_desc < [string length $text]} {
2098 set max_status_desc [string length $text]
2099 }
2100 set all_descs([lindex $i 0]) $text
2101}
2102unset i
2103######################################################################
2105##
2106## util
2107proc scrollbar2many {list mode args} {
2109 foreach w $list {eval $w $mode $args}
2110}
2111proc many2scrollbar {list mode sb top bottom} {
2113 $sb set $top $bottom
2114 foreach w $list {$w $mode moveto $top}
2115}
2116proc incr_font_size {font {amt 1}} {
2118 set sz [font configure $font -size]
2119 incr sz $amt
2120 font configure $font -size $sz
2121 font configure ${font}bold -size $sz
2122 font configure ${font}italic -size $sz
2123}
2124######################################################################
2126##
2127## ui commands
2128set starting_gitk_msg [mc "Starting gitk... please wait..."]
2130proc do_gitk {revs {is_submodule false}} {
2132 global current_diff_path file_states current_diff_side ui_index
2133 global _gitdir _gitworktree
2134 # -- Always start gitk through whatever we were loaded with. This
2136 # lets us bypass using shell process on Windows systems.
2137 #
2138 set exe [_which gitk -script]
2139 set cmd [list [info nameofexecutable] $exe]
2140 if {$exe eq {}} {
2141 error_popup [mc "Couldn't find gitk in PATH"]
2142 } else {
2143 global env
2144 set pwd [pwd]
2146 if {!$is_submodule} {
2148 if {![is_bare]} {
2149 cd $_gitworktree
2150 }
2151 } else {
2152 cd $current_diff_path
2153 if {$revs eq {--}} {
2154 set s $file_states($current_diff_path)
2155 set old_sha1 {}
2156 set new_sha1 {}
2157 switch -glob -- [lindex $s 0] {
2158 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2159 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2160 MM {
2161 if {$current_diff_side eq $ui_index} {
2162 set old_sha1 [lindex [lindex $s 2] 1]
2163 set new_sha1 [lindex [lindex $s 3] 1]
2164 } else {
2165 set old_sha1 [lindex [lindex $s 3] 1]
2166 }
2167 }
2168 }
2169 set revs $old_sha1...$new_sha1
2170 }
2171 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2172 # we've been using for the main repository, so unset them.
2173 # TODO we could make life easier (start up faster?) for gitk
2174 # by setting these to the appropriate values to allow gitk
2175 # to skip the heuristics to find their proper value
2176 unset env(GIT_DIR)
2177 unset env(GIT_WORK_TREE)
2178 }
2179 eval exec $cmd $revs "--" "--" &
2180 set env(GIT_DIR) $_gitdir
2182 set env(GIT_WORK_TREE) $_gitworktree
2183 cd $pwd
2184 ui_status $::starting_gitk_msg
2186 after 10000 {
2187 ui_ready $starting_gitk_msg
2188 }
2189 }
2190}
2191proc do_git_gui {} {
2193 global current_diff_path
2194 # -- Always start git gui through whatever we were loaded with. This
2196 # lets us bypass using shell process on Windows systems.
2197 #
2198 set exe [list [_which git]]
2199 if {$exe eq {}} {
2200 error_popup [mc "Couldn't find git gui in PATH"]
2201 } else {
2202 global env
2203 global _gitdir _gitworktree
2204 # see note in do_gitk about unsetting these vars when
2206 # running tools in a submodule
2207 unset env(GIT_DIR)
2208 unset env(GIT_WORK_TREE)
2209 set pwd [pwd]
2211 cd $current_diff_path
2212 eval exec $exe gui &
2214 set env(GIT_DIR) $_gitdir
2216 set env(GIT_WORK_TREE) $_gitworktree
2217 cd $pwd
2218 ui_status $::starting_gitk_msg
2220 after 10000 {
2221 ui_ready $starting_gitk_msg
2222 }
2223 }
2224}
2225proc do_explore {} {
2227 global _gitworktree
2228 set explorer {}
2229 if {[is_Cygwin] || [is_Windows]} {
2230 set explorer "explorer.exe"
2231 } elseif {[is_MacOSX]} {
2232 set explorer "open"
2233 } else {
2234 # freedesktop.org-conforming system is our best shot
2235 set explorer "xdg-open"
2236 }
2237 eval exec $explorer [list [file nativename $_gitworktree]] &
2238}
2239set is_quitting 0
2241set ret_code 1
2242proc terminate_me {win} {
2244 global ret_code
2245 if {$win ne {.}} return
2246 exit $ret_code
2247}
2248proc do_quit {{rc {1}}} {
2250 global ui_comm is_quitting repo_config commit_type
2251 global GITGUI_BCK_exists GITGUI_BCK_i
2252 global ui_comm_spell
2253 global ret_code use_ttk
2254 if {$is_quitting} return
2256 set is_quitting 1
2257 if {[winfo exists $ui_comm]} {
2259 # -- Stash our current commit buffer.
2260 #
2261 set save [gitdir GITGUI_MSG]
2262 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2263 file rename -force [gitdir GITGUI_BCK] $save
2264 set GITGUI_BCK_exists 0
2265 } else {
2266 set msg [string trim [$ui_comm get 0.0 end]]
2267 regsub -all -line {[ \r\t]+$} $msg {} msg
2268 if {(![string match amend* $commit_type]
2269 || [$ui_comm edit modified])
2270 && $msg ne {}} {
2271 catch {
2272 set fd [open $save w]
2273 fconfigure $fd -encoding utf-8
2274 puts -nonewline $fd $msg
2275 close $fd
2276 }
2277 } else {
2278 catch {file delete $save}
2279 }
2280 }
2281 # -- Cancel our spellchecker if its running.
2283 #
2284 if {[info exists ui_comm_spell]} {
2285 $ui_comm_spell stop
2286 }
2287 # -- Remove our editor backup, its not needed.
2289 #
2290 after cancel $GITGUI_BCK_i
2291 if {$GITGUI_BCK_exists} {
2292 catch {file delete [gitdir GITGUI_BCK]}
2293 }
2294 # -- Stash our current window geometry into this repository.
2296 #
2297 set cfg_wmstate [wm state .]
2298 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2299 set rc_wmstate {}
2300 }
2301 if {$cfg_wmstate ne $rc_wmstate} {
2302 catch {git config gui.wmstate $cfg_wmstate}
2303 }
2304 if {$cfg_wmstate eq {zoomed}} {
2305 # on Windows wm geometry will lie about window
2306 # position (but not size) when window is zoomed
2307 # restore the window before querying wm geometry
2308 wm state . normal
2309 }
2310 set cfg_geometry [list]
2311 lappend cfg_geometry [wm geometry .]
2312 if {$use_ttk} {
2313 lappend cfg_geometry [.vpane sashpos 0]
2314 lappend cfg_geometry [.vpane.files sashpos 0]
2315 } else {
2316 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2317 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2318 }
2319 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2320 set rc_geometry {}
2321 }
2322 if {$cfg_geometry ne $rc_geometry} {
2323 catch {git config gui.geometry $cfg_geometry}
2324 }
2325 }
2326 set ret_code $rc
2328 # Briefly enable send again, working around Tk bug
2330 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2331 tk appname [appname]
2332 destroy .
2334}
2335proc do_rescan {} {
2337 rescan ui_ready
2338}
2339proc ui_do_rescan {} {
2341 rescan {force_first_diff ui_ready}
2342}
2343proc do_commit {} {
2345 commit_tree
2346}
2347proc next_diff {{after {}}} {
2349 global next_diff_p next_diff_w next_diff_i
2350 show_diff $next_diff_p $next_diff_w {} {} $after
2351}
2352proc find_anchor_pos {lst name} {
2354 set lid [lsearch -sorted -exact $lst $name]
2355 if {$lid == -1} {
2357 set lid 0
2358 foreach lname $lst {
2359 if {$lname >= $name} break
2360 incr lid
2361 }
2362 }
2363 return $lid
2365}
2366proc find_file_from {flist idx delta path mmask} {
2368 global file_states
2369 set len [llength $flist]
2371 while {$idx >= 0 && $idx < $len} {
2372 set name [lindex $flist $idx]
2373 if {$name ne $path && [info exists file_states($name)]} {
2375 set state [lindex $file_states($name) 0]
2376 if {$mmask eq {} || [regexp $mmask $state]} {
2378 return $idx
2379 }
2380 }
2381 incr idx $delta
2383 }
2384 return {}
2386}
2387proc find_next_diff {w path {lno {}} {mmask {}}} {
2389 global next_diff_p next_diff_w next_diff_i
2390 global file_lists ui_index ui_workdir
2391 set flist $file_lists($w)
2393 if {$lno eq {}} {
2394 set lno [find_anchor_pos $flist $path]
2395 } else {
2396 incr lno -1
2397 }
2398 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2400 if {$w eq $ui_index} {
2401 set mmask "^$mmask"
2402 } else {
2403 set mmask "$mmask\$"
2404 }
2405 }
2406 set idx [find_file_from $flist $lno 1 $path $mmask]
2408 if {$idx eq {}} {
2409 incr lno -1
2410 set idx [find_file_from $flist $lno -1 $path $mmask]
2411 }
2412 if {$idx ne {}} {
2414 set next_diff_w $w
2415 set next_diff_p [lindex $flist $idx]
2416 set next_diff_i [expr {$idx+1}]
2417 return 1
2418 } else {
2419 return 0
2420 }
2421}
2422proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2424 global current_diff_path
2425 if {$path ne $current_diff_path} {
2427 return {}
2428 } elseif {[find_next_diff $w $path $lno $mmask]} {
2429 return {next_diff;}
2430 } else {
2431 return {reshow_diff;}
2432 }
2433}
2434proc select_first_diff {after} {
2436 global ui_workdir
2437 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2439 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2440 next_diff $after
2441 } else {
2442 uplevel #0 $after
2443 }
2444}
2445proc force_first_diff {after} {
2447 global ui_workdir current_diff_path file_states
2448 if {[info exists file_states($current_diff_path)]} {
2450 set state [lindex $file_states($current_diff_path) 0]
2451 } else {
2452 set state {OO}
2453 }
2454 set reselect 0
2456 if {[string first {U} $state] >= 0} {
2457 # Already a conflict, do nothing
2458 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2459 set reselect 1
2460 } elseif {[string index $state 1] ne {O}} {
2461 # Already a diff & no conflicts, do nothing
2462 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2463 set reselect 1
2464 }
2465 if {$reselect} {
2467 next_diff $after
2468 } else {
2469 uplevel #0 $after
2470 }
2471}
2472proc toggle_or_diff {w x y} {
2474 global file_states file_lists current_diff_path ui_index ui_workdir
2475 global last_clicked selected_paths
2476 set pos [split [$w index @$x,$y] .]
2478 set lno [lindex $pos 0]
2479 set col [lindex $pos 1]
2480 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2481 if {$path eq {}} {
2482 set last_clicked {}
2483 return
2484 }
2485 set last_clicked [list $w $lno]
2487 array unset selected_paths
2488 $ui_index tag remove in_sel 0.0 end
2489 $ui_workdir tag remove in_sel 0.0 end
2490 # Determine the state of the file
2492 if {[info exists file_states($path)]} {
2493 set state [lindex $file_states($path) 0]
2494 } else {
2495 set state {__}
2496 }
2497 # Restage the file, or simply show the diff
2499 if {$col == 0 && $y > 1} {
2500 # Conflicts need special handling
2501 if {[string first {U} $state] >= 0} {
2502 # $w must always be $ui_workdir, but...
2503 if {$w ne $ui_workdir} { set lno {} }
2504 merge_stage_workdir $path $lno
2505 return
2506 }
2507 if {[string index $state 1] eq {O}} {
2509 set mmask {}
2510 } else {
2511 set mmask {[^O]}
2512 }
2513 set after [next_diff_after_action $w $path $lno $mmask]
2515 if {$w eq $ui_index} {
2517 update_indexinfo \
2518 "Unstaging [short_path $path] from commit" \
2519 [list $path] \
2520 [concat $after [list ui_ready]]
2521 } elseif {$w eq $ui_workdir} {
2522 update_index \
2523 "Adding [short_path $path]" \
2524 [list $path] \
2525 [concat $after [list ui_ready]]
2526 }
2527 } else {
2528 set selected_paths($path) 1
2529 show_diff $path $w $lno
2530 }
2531}
2532proc add_one_to_selection {w x y} {
2534 global file_lists last_clicked selected_paths
2535 set lno [lindex [split [$w index @$x,$y] .] 0]
2537 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2538 if {$path eq {}} {
2539 set last_clicked {}
2540 return
2541 }
2542 if {$last_clicked ne {}
2544 && [lindex $last_clicked 0] ne $w} {
2545 array unset selected_paths
2546 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2547 }
2548 set last_clicked [list $w $lno]
2550 if {[catch {set in_sel $selected_paths($path)}]} {
2551 set in_sel 0
2552 }
2553 if {$in_sel} {
2554 unset selected_paths($path)
2555 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2556 } else {
2557 set selected_paths($path) 1
2558 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2559 }
2560}
2561proc add_range_to_selection {w x y} {
2563 global file_lists last_clicked selected_paths
2564 if {[lindex $last_clicked 0] ne $w} {
2566 toggle_or_diff $w $x $y
2567 return
2568 }
2569 set lno [lindex [split [$w index @$x,$y] .] 0]
2571 set lc [lindex $last_clicked 1]
2572 if {$lc < $lno} {
2573 set begin $lc
2574 set end $lno
2575 } else {
2576 set begin $lno
2577 set end $lc
2578 }
2579 foreach path [lrange $file_lists($w) \
2581 [expr {$begin - 1}] \
2582 [expr {$end - 1}]] {
2583 set selected_paths($path) 1
2584 }
2585 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2586}
2587proc show_more_context {} {
2589 global repo_config
2590 if {$repo_config(gui.diffcontext) < 99} {
2591 incr repo_config(gui.diffcontext)
2592 reshow_diff
2593 }
2594}
2595proc show_less_context {} {
2597 global repo_config
2598 if {$repo_config(gui.diffcontext) > 1} {
2599 incr repo_config(gui.diffcontext) -1
2600 reshow_diff
2601 }
2602}
2603######################################################################
2605##
2606## ui construction
2607set ui_comm {}
2609# -- Menu Bar
2611#
2612menu .mbar -tearoff 0
2613if {[is_MacOSX]} {
2614 # -- Apple Menu (Mac OS X only)
2615 #
2616 .mbar add cascade -label Apple -menu .mbar.apple
2617 menu .mbar.apple
2618}
2619.mbar add cascade -label [mc Repository] -menu .mbar.repository
2620.mbar add cascade -label [mc Edit] -menu .mbar.edit
2621if {[is_enabled branch]} {
2622 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2623}
2624if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2625 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2626}
2627if {[is_enabled transport]} {
2628 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2629 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2630}
2631if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2632 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2633}
2634# -- Repository Menu
2636#
2637menu .mbar.repository
2638if {![is_bare]} {
2640 .mbar.repository add command \
2641 -label [mc "Explore Working Copy"] \
2642 -command {do_explore}
2643 .mbar.repository add separator
2644}
2645.mbar.repository add command \
2647 -label [mc "Browse Current Branch's Files"] \
2648 -command {browser::new $current_branch}
2649set ui_browse_current [.mbar.repository index last]
2650.mbar.repository add command \
2651 -label [mc "Browse Branch Files..."] \
2652 -command browser_open::dialog
2653.mbar.repository add separator
2654.mbar.repository add command \
2656 -label [mc "Visualize Current Branch's History"] \
2657 -command {do_gitk $current_branch}
2658set ui_visualize_current [.mbar.repository index last]
2659.mbar.repository add command \
2660 -label [mc "Visualize All Branch History"] \
2661 -command {do_gitk --all}
2662.mbar.repository add separator
2663proc current_branch_write {args} {
2665 global current_branch
2666 .mbar.repository entryconf $::ui_browse_current \
2667 -label [mc "Browse %s's Files" $current_branch]
2668 .mbar.repository entryconf $::ui_visualize_current \
2669 -label [mc "Visualize %s's History" $current_branch]
2670}
2671trace add variable current_branch write current_branch_write
2672if {[is_enabled multicommit]} {
2674 .mbar.repository add command -label [mc "Database Statistics"] \
2675 -command do_stats
2676 .mbar.repository add command -label [mc "Compress Database"] \
2678 -command do_gc
2679 .mbar.repository add command -label [mc "Verify Database"] \
2681 -command do_fsck_objects
2682 .mbar.repository add separator
2684 if {[is_Cygwin]} {
2686 .mbar.repository add command \
2687 -label [mc "Create Desktop Icon"] \
2688 -command do_cygwin_shortcut
2689 } elseif {[is_Windows]} {
2690 .mbar.repository add command \
2691 -label [mc "Create Desktop Icon"] \
2692 -command do_windows_shortcut
2693 } elseif {[is_MacOSX]} {
2694 .mbar.repository add command \
2695 -label [mc "Create Desktop Icon"] \
2696 -command do_macosx_app
2697 }
2698}
2699if {[is_MacOSX]} {
2701 proc ::tk::mac::Quit {args} { do_quit }
2702} else {
2703 .mbar.repository add command -label [mc Quit] \
2704 -command do_quit \
2705 -accelerator $M1T-Q
2706}
2707# -- Edit Menu
2709#
2710menu .mbar.edit
2711.mbar.edit add command -label [mc Undo] \
2712 -command {catch {[focus] edit undo}} \
2713 -accelerator $M1T-Z
2714.mbar.edit add command -label [mc Redo] \
2715 -command {catch {[focus] edit redo}} \
2716 -accelerator $M1T-Y
2717.mbar.edit add separator
2718.mbar.edit add command -label [mc Cut] \
2719 -command {catch {tk_textCut [focus]}} \
2720 -accelerator $M1T-X
2721.mbar.edit add command -label [mc Copy] \
2722 -command {catch {tk_textCopy [focus]}} \
2723 -accelerator $M1T-C
2724.mbar.edit add command -label [mc Paste] \
2725 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2726 -accelerator $M1T-V
2727.mbar.edit add command -label [mc Delete] \
2728 -command {catch {[focus] delete sel.first sel.last}} \
2729 -accelerator Del
2730.mbar.edit add separator
2731.mbar.edit add command -label [mc "Select All"] \
2732 -command {catch {[focus] tag add sel 0.0 end}} \
2733 -accelerator $M1T-A
2734# -- Branch Menu
2736#
2737if {[is_enabled branch]} {
2738 menu .mbar.branch
2739 .mbar.branch add command -label [mc "Create..."] \
2741 -command branch_create::dialog \
2742 -accelerator $M1T-N
2743 lappend disable_on_lock [list .mbar.branch entryconf \
2744 [.mbar.branch index last] -state]
2745 .mbar.branch add command -label [mc "Checkout..."] \
2747 -command branch_checkout::dialog \
2748 -accelerator $M1T-O
2749 lappend disable_on_lock [list .mbar.branch entryconf \
2750 [.mbar.branch index last] -state]
2751 .mbar.branch add command -label [mc "Rename..."] \
2753 -command branch_rename::dialog
2754 lappend disable_on_lock [list .mbar.branch entryconf \
2755 [.mbar.branch index last] -state]
2756 .mbar.branch add command -label [mc "Delete..."] \
2758 -command branch_delete::dialog
2759 lappend disable_on_lock [list .mbar.branch entryconf \
2760 [.mbar.branch index last] -state]
2761 .mbar.branch add command -label [mc "Reset..."] \
2763 -command merge::reset_hard
2764 lappend disable_on_lock [list .mbar.branch entryconf \
2765 [.mbar.branch index last] -state]
2766}
2767# -- Commit Menu
2769#
2770proc commit_btn_caption {} {
2771 if {[is_enabled nocommit]} {
2772 return [mc "Done"]
2773 } else {
2774 return [mc Commit@@verb]
2775 }
2776}
2777if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2779 menu .mbar.commit
2780 if {![is_enabled nocommit]} {
2782 .mbar.commit add radiobutton \
2783 -label [mc "New Commit"] \
2784 -command do_select_commit_type \
2785 -variable selected_commit_type \
2786 -value new
2787 lappend disable_on_lock \
2788 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2789 .mbar.commit add radiobutton \
2791 -label [mc "Amend Last Commit"] \
2792 -command do_select_commit_type \
2793 -variable selected_commit_type \
2794 -value amend
2795 lappend disable_on_lock \
2796 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2797 .mbar.commit add separator
2799 }
2800 .mbar.commit add command -label [mc Rescan] \
2802 -command ui_do_rescan \
2803 -accelerator F5
2804 lappend disable_on_lock \
2805 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2806 .mbar.commit add command -label [mc "Stage To Commit"] \
2808 -command do_add_selection \
2809 -accelerator $M1T-T
2810 lappend disable_on_lock \
2811 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2812 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2814 -command do_add_all \
2815 -accelerator $M1T-I
2816 lappend disable_on_lock \
2817 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2818 .mbar.commit add command -label [mc "Unstage From Commit"] \
2820 -command do_unstage_selection \
2821 -accelerator $M1T-U
2822 lappend disable_on_lock \
2823 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2824 .mbar.commit add command -label [mc "Revert Changes"] \
2826 -command do_revert_selection \
2827 -accelerator $M1T-J
2828 lappend disable_on_lock \
2829 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2830 .mbar.commit add separator
2832 .mbar.commit add command -label [mc "Show Less Context"] \
2834 -command show_less_context \
2835 -accelerator $M1T-\-
2836 .mbar.commit add command -label [mc "Show More Context"] \
2838 -command show_more_context \
2839 -accelerator $M1T-=
2840 .mbar.commit add separator
2842 if {![is_enabled nocommitmsg]} {
2844 .mbar.commit add command -label [mc "Sign Off"] \
2845 -command do_signoff \
2846 -accelerator $M1T-S
2847 }
2848 .mbar.commit add command -label [commit_btn_caption] \
2850 -command do_commit \
2851 -accelerator $M1T-Return
2852 lappend disable_on_lock \
2853 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2854}
2855# -- Merge Menu
2857#
2858if {[is_enabled branch]} {
2859 menu .mbar.merge
2860 .mbar.merge add command -label [mc "Local Merge..."] \
2861 -command merge::dialog \
2862 -accelerator $M1T-M
2863 lappend disable_on_lock \
2864 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2865 .mbar.merge add command -label [mc "Abort Merge..."] \
2866 -command merge::reset_hard
2867 lappend disable_on_lock \
2868 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2869}
2870# -- Transport Menu
2872#
2873if {[is_enabled transport]} {
2874 menu .mbar.remote
2875 .mbar.remote add command \
2877 -label [mc "Add..."] \
2878 -command remote_add::dialog \
2879 -accelerator $M1T-A
2880 .mbar.remote add command \
2881 -label [mc "Push..."] \
2882 -command do_push_anywhere \
2883 -accelerator $M1T-P
2884 .mbar.remote add command \
2885 -label [mc "Delete Branch..."] \
2886 -command remote_branch_delete::dialog
2887}
2888if {[is_MacOSX]} {
2890 proc ::tk::mac::ShowPreferences {} {do_options}
2891} else {
2892 # -- Edit Menu
2893 #
2894 .mbar.edit add separator
2895 .mbar.edit add command -label [mc "Options..."] \
2896 -command do_options
2897}
2898# -- Tools Menu
2900#
2901if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2902 set tools_menubar .mbar.tools
2903 menu $tools_menubar
2904 $tools_menubar add separator
2905 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2906 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2907 set tools_tailcnt 3
2908 if {[array names repo_config guitool.*.cmd] ne {}} {
2909 tools_populate_all
2910 }
2911}
2912# -- Help Menu
2914#
2915.mbar add cascade -label [mc Help] -menu .mbar.help
2916menu .mbar.help
2917if {[is_MacOSX]} {
2919 .mbar.apple add command -label [mc "About %s" [appname]] \
2920 -command do_about
2921 .mbar.apple add separator
2922} else {
2923 .mbar.help add command -label [mc "About %s" [appname]] \
2924 -command do_about
2925}
2926. configure -menu .mbar
2927set doc_path [githtmldir]
2929if {$doc_path ne {}} {
2930 set doc_path [file join $doc_path index.html]
2931 if {[is_Cygwin]} {
2933 set doc_path [exec cygpath --mixed $doc_path]
2934 }
2935}
2936if {[file isfile $doc_path]} {
2938 set doc_url "file:$doc_path"
2939} else {
2940 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2941}
2942proc start_browser {url} {
2944 git "web--browse" $url
2945}
2946.mbar.help add command -label [mc "Online Documentation"] \
2948 -command [list start_browser $doc_url]
2949.mbar.help add command -label [mc "Show SSH Key"] \
2951 -command do_ssh_key
2952unset doc_path doc_url
2954# -- Standard bindings
2956#
2957wm protocol . WM_DELETE_WINDOW do_quit
2958bind all <$M1B-Key-q> do_quit
2959bind all <$M1B-Key-Q> do_quit
2960bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2961bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2962set subcommand_args {}
2964proc usage {} {
2965 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2966 if {[tk windowingsystem] eq "win32"} {
2967 wm withdraw .
2968 tk_messageBox -icon info -message $s \
2969 -title [mc "Usage"]
2970 } else {
2971 puts stderr $s
2972 }
2973 exit 1
2974}
2975proc normalize_relpath {path} {
2977 set elements {}
2978 foreach item [file split $path] {
2979 if {$item eq {.}} continue
2980 if {$item eq {..} && [llength $elements] > 0
2981 && [lindex $elements end] ne {..}} {
2982 set elements [lrange $elements 0 end-1]
2983 continue
2984 }
2985 lappend elements $item
2986 }
2987 return [eval file join $elements]
2988}
2989# -- Not a normal commit type invocation? Do that instead!
2991#
2992switch -- $subcommand {
2993browser -
2994blame {
2995 if {$subcommand eq "blame"} {
2996 set subcommand_args {[--line=<num>] rev? path}
2997 } else {
2998 set subcommand_args {rev? path}
2999 }
3000 if {$argv eq {}} usage
3001 set head {}
3002 set path {}
3003 set jump_spec {}
3004 set is_path 0
3005 foreach a $argv {
3006 if {[file exists $a]} {
3007 if {$path ne {}} usage
3008 set path [normalize_relpath $a]
3009 break
3010 } elseif {[file exists $_prefix$a]} {
3011 if {$path ne {}} usage
3012 set path [normalize_relpath $_prefix$a]
3013 break
3014 }
3015 if {$is_path} {
3017 if {$path ne {}} usage
3018 break
3019 } elseif {$a eq {--}} {
3020 if {$path ne {}} {
3021 if {$head ne {}} usage
3022 set head $path
3023 set path {}
3024 }
3025 set is_path 1
3026 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3027 if {$jump_spec ne {} || $head ne {}} usage
3028 set jump_spec [list $lnum]
3029 } elseif {$head eq {}} {
3030 if {$head ne {}} usage
3031 set head $a
3032 set is_path 1
3033 } else {
3034 usage
3035 }
3036 }
3037 unset is_path
3038 if {$head ne {} && $path eq {}} {
3040 if {[string index $head 0] eq {/}} {
3041 set path [normalize_relpath $head]
3042 set head {}
3043 } else {
3044 set path [normalize_relpath $_prefix$head]
3045 set head {}
3046 }
3047 }
3048 if {$head eq {}} {
3050 load_current_branch
3051 } else {
3052 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3053 if {[catch {
3054 set head [git rev-parse --verify $head]
3055 } err]} {
3056 if {[tk windowingsystem] eq "win32"} {
3057 tk_messageBox -icon error -title [mc Error] -message $err
3058 } else {
3059 puts stderr $err
3060 }
3061 exit 1
3062 }
3063 }
3064 set current_branch $head
3065 }
3066 wm deiconify .
3068 switch -- $subcommand {
3069 browser {
3070 if {$jump_spec ne {}} usage
3071 if {$head eq {}} {
3072 if {$path ne {} && [file isdirectory $path]} {
3073 set head $current_branch
3074 } else {
3075 set head $path
3076 set path {}
3077 }
3078 }
3079 browser::new $head $path
3080 }
3081 blame {
3082 if {$head eq {} && ![file exists $path]} {
3083 catch {wm withdraw .}
3084 tk_messageBox \
3085 -icon error \
3086 -type ok \
3087 -title [mc "git-gui: fatal error"] \
3088 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3089 exit 1
3090 }
3091 blame::new $head $path $jump_spec
3092 }
3093 }
3094 return
3095}
3096citool -
3097gui {
3098 if {[llength $argv] != 0} {
3099 usage
3100 }
3101 # fall through to setup UI for commits
3102}
3103default {
3104 set err "usage: $argv0 \[{blame|browser|citool}\]"
3105 if {[tk windowingsystem] eq "win32"} {
3106 wm withdraw .
3107 tk_messageBox -icon error -message $err \
3108 -title [mc "Usage"]
3109 } else {
3110 puts stderr $err
3111 }
3112 exit 1
3113}
3114}
3115# -- Branch Control
3117#
3118${NS}::frame .branch
3119if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3120${NS}::label .branch.l1 \
3121 -text [mc "Current Branch:"] \
3122 -anchor w \
3123 -justify left
3124${NS}::label .branch.cb \
3125 -textvariable current_branch \
3126 -anchor w \
3127 -justify left
3128pack .branch.l1 -side left
3129pack .branch.cb -side left -fill x
3130pack .branch -side top -fill x
3131# -- Main Window Layout
3133#
3134${NS}::panedwindow .vpane -orient horizontal
3135${NS}::panedwindow .vpane.files -orient vertical
3136if {$use_ttk} {
3137 .vpane add .vpane.files
3138} else {
3139 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3140}
3141pack .vpane -anchor n -side top -fill both -expand 1
3142# -- Index File List
3144#
3145${NS}::frame .vpane.files.index -height 100 -width 200
3146tlabel .vpane.files.index.title \
3147 -text [mc "Staged Changes (Will Commit)"] \
3148 -background lightgreen -foreground black
3149text $ui_index -background white -foreground black \
3150 -borderwidth 0 \
3151 -width 20 -height 10 \
3152 -wrap none \
3153 -cursor $cursor_ptr \
3154 -xscrollcommand {.vpane.files.index.sx set} \
3155 -yscrollcommand {.vpane.files.index.sy set} \
3156 -state disabled
3157${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3158${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3159pack .vpane.files.index.title -side top -fill x
3160pack .vpane.files.index.sx -side bottom -fill x
3161pack .vpane.files.index.sy -side right -fill y
3162pack $ui_index -side left -fill both -expand 1
3163# -- Working Directory File List
3165#
3166${NS}::frame .vpane.files.workdir -height 100 -width 200
3167tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3168 -background lightsalmon -foreground black
3169text $ui_workdir -background white -foreground black \
3170 -borderwidth 0 \
3171 -width 20 -height 10 \
3172 -wrap none \
3173 -cursor $cursor_ptr \
3174 -xscrollcommand {.vpane.files.workdir.sx set} \
3175 -yscrollcommand {.vpane.files.workdir.sy set} \
3176 -state disabled
3177${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3178${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3179pack .vpane.files.workdir.title -side top -fill x
3180pack .vpane.files.workdir.sx -side bottom -fill x
3181pack .vpane.files.workdir.sy -side right -fill y
3182pack $ui_workdir -side left -fill both -expand 1
3183.vpane.files add .vpane.files.workdir
3185.vpane.files add .vpane.files.index
3186if {!$use_ttk} {
3187 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3188 .vpane.files paneconfigure .vpane.files.index -sticky news
3189}
3190foreach i [list $ui_index $ui_workdir] {
3192 rmsel_tag $i
3193 $i tag conf in_diff -background [$i tag cget in_sel -background]
3194}
3195unset i
3196# -- Diff and Commit Area
3198#
3199${NS}::frame .vpane.lower -height 300 -width 400
3200${NS}::frame .vpane.lower.commarea
3201${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3202pack .vpane.lower.diff -fill both -expand 1
3203pack .vpane.lower.commarea -side bottom -fill x
3204.vpane add .vpane.lower
3205if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3206# -- Commit Area Buttons
3208#
3209${NS}::frame .vpane.lower.commarea.buttons
3210${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3211 -anchor w \
3212 -justify left
3213pack .vpane.lower.commarea.buttons.l -side top -fill x
3214pack .vpane.lower.commarea.buttons -side left -fill y
3215${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3217 -command ui_do_rescan
3218pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3219lappend disable_on_lock \
3220 {.vpane.lower.commarea.buttons.rescan conf -state}
3221${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3223 -command do_add_all
3224pack .vpane.lower.commarea.buttons.incall -side top -fill x
3225lappend disable_on_lock \
3226 {.vpane.lower.commarea.buttons.incall conf -state}
3227if {![is_enabled nocommitmsg]} {
3229 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3230 -command do_signoff
3231 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3232}
3233${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3235 -command do_commit
3236pack .vpane.lower.commarea.buttons.commit -side top -fill x
3237lappend disable_on_lock \
3238 {.vpane.lower.commarea.buttons.commit conf -state}
3239if {![is_enabled nocommit]} {
3241 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3242 -command do_push_anywhere
3243 pack .vpane.lower.commarea.buttons.push -side top -fill x
3244}
3245# -- Commit Message Buffer
3247#
3248${NS}::frame .vpane.lower.commarea.buffer
3249${NS}::frame .vpane.lower.commarea.buffer.header
3250set ui_comm .vpane.lower.commarea.buffer.t
3251set ui_coml .vpane.lower.commarea.buffer.header.l
3252if {![is_enabled nocommit]} {
3254 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3255 -text [mc "New Commit"] \
3256 -command do_select_commit_type \
3257 -variable selected_commit_type \
3258 -value new
3259 lappend disable_on_lock \
3260 [list .vpane.lower.commarea.buffer.header.new conf -state]
3261 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3262 -text [mc "Amend Last Commit"] \
3263 -command do_select_commit_type \
3264 -variable selected_commit_type \
3265 -value amend
3266 lappend disable_on_lock \
3267 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3268}
3269${NS}::label $ui_coml \
3271 -anchor w \
3272 -justify left
3273proc trace_commit_type {varname args} {
3274 global ui_coml commit_type
3275 switch -glob -- $commit_type {
3276 initial {set txt [mc "Initial Commit Message:"]}
3277 amend {set txt [mc "Amended Commit Message:"]}
3278 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3279 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3280 merge {set txt [mc "Merge Commit Message:"]}
3281 * {set txt [mc "Commit Message:"]}
3282 }
3283 $ui_coml conf -text $txt
3284}
3285trace add variable commit_type write trace_commit_type
3286pack $ui_coml -side left -fill x
3287if {![is_enabled nocommit]} {
3289 pack .vpane.lower.commarea.buffer.header.amend -side right
3290 pack .vpane.lower.commarea.buffer.header.new -side right
3291}
3292text $ui_comm -background white -foreground black \
3294 -borderwidth 1 \
3295 -undo true \
3296 -maxundo 20 \
3297 -autoseparators true \
3298 -relief sunken \
3299 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3300 -font font_diff \
3301 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3302${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3303 -command [list $ui_comm yview]
3304pack .vpane.lower.commarea.buffer.header -side top -fill x
3305pack .vpane.lower.commarea.buffer.sby -side right -fill y
3306pack $ui_comm -side left -fill y
3307pack .vpane.lower.commarea.buffer -side left -fill y
3308# -- Commit Message Buffer Context Menu
3310#
3311set ctxm .vpane.lower.commarea.buffer.ctxm
3312menu $ctxm -tearoff 0
3313$ctxm add command \
3314 -label [mc Cut] \
3315 -command {tk_textCut $ui_comm}
3316$ctxm add command \
3317 -label [mc Copy] \
3318 -command {tk_textCopy $ui_comm}
3319$ctxm add command \
3320 -label [mc Paste] \
3321 -command {tk_textPaste $ui_comm}
3322$ctxm add command \
3323 -label [mc Delete] \
3324 -command {catch {$ui_comm delete sel.first sel.last}}
3325$ctxm add separator
3326$ctxm add command \
3327 -label [mc "Select All"] \
3328 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3329$ctxm add command \
3330 -label [mc "Copy All"] \
3331 -command {
3332 $ui_comm tag add sel 0.0 end
3333 tk_textCopy $ui_comm
3334 $ui_comm tag remove sel 0.0 end
3335 }
3336$ctxm add separator
3337$ctxm add command \
3338 -label [mc "Sign Off"] \
3339 -command do_signoff
3340set ui_comm_ctxm $ctxm
3341# -- Diff Header
3343#
3344proc trace_current_diff_path {varname args} {
3345 global current_diff_path diff_actions file_states
3346 if {$current_diff_path eq {}} {
3347 set s {}
3348 set f {}
3349 set p {}
3350 set o disabled
3351 } else {
3352 set p $current_diff_path
3353 set s [mapdesc [lindex $file_states($p) 0] $p]
3354 set f [mc "File:"]
3355 set p [escape_path $p]
3356 set o normal
3357 }
3358 .vpane.lower.diff.header.status configure -text $s
3360 .vpane.lower.diff.header.file configure -text $f
3361 .vpane.lower.diff.header.path configure -text $p
3362 foreach w $diff_actions {
3363 uplevel #0 $w $o
3364 }
3365}
3366trace add variable current_diff_path write trace_current_diff_path
3367gold_frame .vpane.lower.diff.header
3369tlabel .vpane.lower.diff.header.status \
3370 -background gold \
3371 -foreground black \
3372 -width $max_status_desc \
3373 -anchor w \
3374 -justify left
3375tlabel .vpane.lower.diff.header.file \
3376 -background gold \
3377 -foreground black \
3378 -anchor w \
3379 -justify left
3380tlabel .vpane.lower.diff.header.path \
3381 -background gold \
3382 -foreground black \
3383 -anchor w \
3384 -justify left
3385pack .vpane.lower.diff.header.status -side left
3386pack .vpane.lower.diff.header.file -side left
3387pack .vpane.lower.diff.header.path -fill x
3388set ctxm .vpane.lower.diff.header.ctxm
3389menu $ctxm -tearoff 0
3390$ctxm add command \
3391 -label [mc Copy] \
3392 -command {
3393 clipboard clear
3394 clipboard append \
3395 -format STRING \
3396 -type STRING \
3397 -- $current_diff_path
3398 }
3399lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3400bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3401# -- Diff Body
3403#
3404${NS}::frame .vpane.lower.diff.body
3405set ui_diff .vpane.lower.diff.body.t
3406text $ui_diff -background white -foreground black \
3407 -borderwidth 0 \
3408 -width 80 -height 5 -wrap none \
3409 -font font_diff \
3410 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3411 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3412 -state disabled
3413catch {$ui_diff configure -tabstyle wordprocessor}
3414${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3415 -command [list $ui_diff xview]
3416${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3417 -command [list $ui_diff yview]
3418pack .vpane.lower.diff.body.sbx -side bottom -fill x
3419pack .vpane.lower.diff.body.sby -side right -fill y
3420pack $ui_diff -side left -fill both -expand 1
3421pack .vpane.lower.diff.header -side top -fill x
3422pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3423foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3425 $ui_diff tag configure clr4$n -background $c
3426 $ui_diff tag configure clri4$n -foreground $c
3427 $ui_diff tag configure clr3$n -foreground $c
3428 $ui_diff tag configure clri3$n -background $c
3429}
3430$ui_diff tag configure clr1 -font font_diffbold
3431$ui_diff tag configure clr4 -underline 1
3432$ui_diff tag conf d_info -foreground blue -font font_diffbold
3434$ui_diff tag conf d_cr -elide true
3436$ui_diff tag conf d_@ -font font_diffbold
3437$ui_diff tag conf d_+ -foreground {#00a000}
3438$ui_diff tag conf d_- -foreground red
3439$ui_diff tag conf d_++ -foreground {#00a000}
3441$ui_diff tag conf d_-- -foreground red
3442$ui_diff tag conf d_+s \
3443 -foreground {#00a000} \
3444 -background {#e2effa}
3445$ui_diff tag conf d_-s \
3446 -foreground red \
3447 -background {#e2effa}
3448$ui_diff tag conf d_s+ \
3449 -foreground {#00a000} \
3450 -background ivory1
3451$ui_diff tag conf d_s- \
3452 -foreground red \
3453 -background ivory1
3454$ui_diff tag conf d< \
3456 -foreground orange \
3457 -font font_diffbold
3458$ui_diff tag conf d= \
3459 -foreground orange \
3460 -font font_diffbold
3461$ui_diff tag conf d> \
3462 -foreground orange \
3463 -font font_diffbold
3464$ui_diff tag raise sel
3466# -- Diff Body Context Menu
3468#
3469proc create_common_diff_popup {ctxm} {
3471 $ctxm add command \
3472 -label [mc Refresh] \
3473 -command reshow_diff
3474 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3475 $ctxm add command \
3476 -label [mc Copy] \
3477 -command {tk_textCopy $ui_diff}
3478 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3479 $ctxm add command \
3480 -label [mc "Select All"] \
3481 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3482 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3483 $ctxm add command \
3484 -label [mc "Copy All"] \
3485 -command {
3486 $ui_diff tag add sel 0.0 end
3487 tk_textCopy $ui_diff
3488 $ui_diff tag remove sel 0.0 end
3489 }
3490 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3491 $ctxm add separator
3492 $ctxm add command \
3493 -label [mc "Decrease Font Size"] \
3494 -command {incr_font_size font_diff -1}
3495 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3496 $ctxm add command \
3497 -label [mc "Increase Font Size"] \
3498 -command {incr_font_size font_diff 1}
3499 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3500 $ctxm add separator
3501 set emenu $ctxm.enc
3502 menu $emenu
3503 build_encoding_menu $emenu [list force_diff_encoding]
3504 $ctxm add cascade \
3505 -label [mc "Encoding"] \
3506 -menu $emenu
3507 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3508 $ctxm add separator
3509 $ctxm add command -label [mc "Options..."] \
3510 -command do_options
3511}
3512set ctxm .vpane.lower.diff.body.ctxm
3514menu $ctxm -tearoff 0
3515$ctxm add command \
3516 -label [mc "Apply/Reverse Hunk"] \
3517 -command {apply_hunk $cursorX $cursorY}
3518set ui_diff_applyhunk [$ctxm index last]
3519lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3520$ctxm add command \
3521 -label [mc "Apply/Reverse Line"] \
3522 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3523set ui_diff_applyline [$ctxm index last]
3524lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3525$ctxm add separator
3526$ctxm add command \
3527 -label [mc "Show Less Context"] \
3528 -command show_less_context
3529lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3530$ctxm add command \
3531 -label [mc "Show More Context"] \
3532 -command show_more_context
3533lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3534$ctxm add separator
3535create_common_diff_popup $ctxm
3536set ctxmmg .vpane.lower.diff.body.ctxmmg
3538menu $ctxmmg -tearoff 0
3539$ctxmmg add command \
3540 -label [mc "Run Merge Tool"] \
3541 -command {merge_resolve_tool}
3542lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3543$ctxmmg add separator
3544$ctxmmg add command \
3545 -label [mc "Use Remote Version"] \
3546 -command {merge_resolve_one 3}
3547lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3548$ctxmmg add command \
3549 -label [mc "Use Local Version"] \
3550 -command {merge_resolve_one 2}
3551lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3552$ctxmmg add command \
3553 -label [mc "Revert To Base"] \
3554 -command {merge_resolve_one 1}
3555lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3556$ctxmmg add separator
3557$ctxmmg add command \
3558 -label [mc "Show Less Context"] \
3559 -command show_less_context
3560lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3561$ctxmmg add command \
3562 -label [mc "Show More Context"] \
3563 -command show_more_context
3564lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3565$ctxmmg add separator
3566create_common_diff_popup $ctxmmg
3567set ctxmsm .vpane.lower.diff.body.ctxmsm
3569menu $ctxmsm -tearoff 0
3570$ctxmsm add command \
3571 -label [mc "Visualize These Changes In The Submodule"] \
3572 -command {do_gitk -- true}
3573lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3574$ctxmsm add command \
3575 -label [mc "Visualize Current Branch History In The Submodule"] \
3576 -command {do_gitk {} true}
3577lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3578$ctxmsm add command \
3579 -label [mc "Visualize All Branch History In The Submodule"] \
3580 -command {do_gitk --all true}
3581lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3582$ctxmsm add separator
3583$ctxmsm add command \
3584 -label [mc "Start git gui In The Submodule"] \
3585 -command {do_git_gui}
3586lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3587$ctxmsm add separator
3588create_common_diff_popup $ctxmsm
3589proc has_textconv {path} {
3591 if {[is_config_false gui.textconv]} {
3592 return 0
3593 }
3594 set filter [gitattr $path diff set]
3595 set textconv [get_config [join [list diff $filter textconv] .]]
3596 if {$filter ne {set} && $textconv ne {}} {
3597 return 1
3598 } else {
3599 return 0
3600 }
3601}
3602proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3604 global current_diff_path file_states
3605 set ::cursorX $x
3606 set ::cursorY $y
3607 if {[info exists file_states($current_diff_path)]} {
3608 set state [lindex $file_states($current_diff_path) 0]
3609 } else {
3610 set state {__}
3611 }
3612 if {[string first {U} $state] >= 0} {
3613 tk_popup $ctxmmg $X $Y
3614 } elseif {$::is_submodule_diff} {
3615 tk_popup $ctxmsm $X $Y
3616 } else {
3617 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3618 if {$::ui_index eq $::current_diff_side} {
3619 set l [mc "Unstage Hunk From Commit"]
3620 if {$has_range} {
3621 set t [mc "Unstage Lines From Commit"]
3622 } else {
3623 set t [mc "Unstage Line From Commit"]
3624 }
3625 } else {
3626 set l [mc "Stage Hunk For Commit"]
3627 if {$has_range} {
3628 set t [mc "Stage Lines For Commit"]
3629 } else {
3630 set t [mc "Stage Line For Commit"]
3631 }
3632 }
3633 if {$::is_3way_diff
3634 || $current_diff_path eq {}
3635 || {__} eq $state
3636 || {_O} eq $state
3637 || [string match {?T} $state]
3638 || [string match {T?} $state]
3639 || [has_textconv $current_diff_path]} {
3640 set s disabled
3641 } else {
3642 set s normal
3643 }
3644 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3645 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3646 tk_popup $ctxm $X $Y
3647 }
3648}
3649bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3650# -- Status Bar
3652#
3653set main_status [::status_bar::new .status]
3654pack .status -anchor w -side bottom -fill x
3655$main_status show [mc "Initializing..."]
3656# -- Load geometry
3658#
3659proc on_ttk_pane_mapped {w pane pos} {
3660 bind $w <Map> {}
3661 after 0 [list after idle [list $w sashpos $pane $pos]]
3662}
3663proc on_tk_pane_mapped {w pane x y} {
3664 bind $w <Map> {}
3665 after 0 [list after idle [list $w sash place $pane $x $y]]
3666}
3667proc on_application_mapped {} {
3668 global repo_config use_ttk
3669 bind . <Map> {}
3670 set gm $repo_config(gui.geometry)
3671 if {$use_ttk} {
3672 bind .vpane <Map> \
3673 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3674 bind .vpane.files <Map> \
3675 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3676 } else {
3677 bind .vpane <Map> \
3678 [list on_tk_pane_mapped %W 0 \
3679 [lindex $gm 1] \
3680 [lindex [.vpane sash coord 0] 1]]
3681 bind .vpane.files <Map> \
3682 [list on_tk_pane_mapped %W 0 \
3683 [lindex [.vpane.files sash coord 0] 0] \
3684 [lindex $gm 2]]
3685 }
3686 wm geometry . [lindex $gm 0]
3687}
3688if {[info exists repo_config(gui.geometry)]} {
3689 bind . <Map> [list on_application_mapped]
3690 wm geometry . [lindex $repo_config(gui.geometry) 0]
3691}
3692# -- Load window state
3694#
3695if {[info exists repo_config(gui.wmstate)]} {
3696 catch {wm state . $repo_config(gui.wmstate)}
3697}
3698# -- Key Bindings
3700#
3701bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3702bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3703bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3704bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3705bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3706bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3707bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3708bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3709bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3710bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3711bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3712bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3713bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3714bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3715bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3716bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3717bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3718bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3719bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3720bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3721bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3722bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3723bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3725bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3726bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3727bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3728bind $ui_diff <$M1B-Key-v> {break}
3729bind $ui_diff <$M1B-Key-V> {break}
3730bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3731bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3732bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3733bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3734bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3735bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3736bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3737bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3738bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3739bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3740bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3741bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3742bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3743bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3744bind $ui_diff <Button-1> {focus %W}
3745if {[is_enabled branch]} {
3747 bind . <$M1B-Key-n> branch_create::dialog
3748 bind . <$M1B-Key-N> branch_create::dialog
3749 bind . <$M1B-Key-o> branch_checkout::dialog
3750 bind . <$M1B-Key-O> branch_checkout::dialog
3751 bind . <$M1B-Key-m> merge::dialog
3752 bind . <$M1B-Key-M> merge::dialog
3753}
3754if {[is_enabled transport]} {
3755 bind . <$M1B-Key-p> do_push_anywhere
3756 bind . <$M1B-Key-P> do_push_anywhere
3757}
3758bind . <Key-F5> ui_do_rescan
3760bind . <$M1B-Key-r> ui_do_rescan
3761bind . <$M1B-Key-R> ui_do_rescan
3762bind . <$M1B-Key-s> do_signoff
3763bind . <$M1B-Key-S> do_signoff
3764bind . <$M1B-Key-t> do_add_selection
3765bind . <$M1B-Key-T> do_add_selection
3766bind . <$M1B-Key-u> do_unstage_selection
3767bind . <$M1B-Key-U> do_unstage_selection
3768bind . <$M1B-Key-j> do_revert_selection
3769bind . <$M1B-Key-J> do_revert_selection
3770bind . <$M1B-Key-i> do_add_all
3771bind . <$M1B-Key-I> do_add_all
3772bind . <$M1B-Key-minus> {show_less_context;break}
3773bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3774bind . <$M1B-Key-equal> {show_more_context;break}
3775bind . <$M1B-Key-plus> {show_more_context;break}
3776bind . <$M1B-Key-KP_Add> {show_more_context;break}
3777bind . <$M1B-Key-Return> do_commit
3778foreach i [list $ui_index $ui_workdir] {
3779 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3780 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3781 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3782}
3783unset i
3784set file_lists($ui_index) [list]
3786set file_lists($ui_workdir) [list]
3787wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3789focus -force $ui_comm
3790# -- Warn the user about environmental problems. Cygwin's Tcl
3792# does *not* pass its env array onto any processes it spawns.
3793# This means that git processes get none of our environment.
3794#
3795if {[is_Cygwin]} {
3796 set ignored_env 0
3797 set suggest_user {}
3798 set msg [mc "Possible environment issues exist.
3799The following environment variables are probably
3801going to be ignored by any Git subprocess run
3802by %s:
3803" [appname]]
3805 foreach name [array names env] {
3806 switch -regexp -- $name {
3807 {^GIT_INDEX_FILE$} -
3808 {^GIT_OBJECT_DIRECTORY$} -
3809 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3810 {^GIT_DIFF_OPTS$} -
3811 {^GIT_EXTERNAL_DIFF$} -
3812 {^GIT_PAGER$} -
3813 {^GIT_TRACE$} -
3814 {^GIT_CONFIG$} -
3815 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3816 append msg " - $name\n"
3817 incr ignored_env
3818 }
3819 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3820 append msg " - $name\n"
3821 incr ignored_env
3822 set suggest_user $name
3823 }
3824 }
3825 }
3826 if {$ignored_env > 0} {
3827 append msg [mc "
3828This is due to a known issue with the
3829Tcl binary distributed by Cygwin."]
3830 if {$suggest_user ne {}} {
3832 append msg [mc "
3833A good replacement for %s
3835is placing values for the user.name and
3836user.email settings into your personal
3837~/.gitconfig file.
3838" $suggest_user]
3839 }
3840 warn_popup $msg
3841 }
3842 unset ignored_env msg suggest_user name
3843}
3844# -- Only initialize complex UI if we are going to stay running.
3846#
3847if {[is_enabled transport]} {
3848 load_all_remotes
3849 set n [.mbar.remote index end]
3851 populate_remotes_menu
3852 set n [expr {[.mbar.remote index end] - $n}]
3853 if {$n > 0} {
3854 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3855 .mbar.remote insert $n separator
3856 }
3857 unset n
3858}
3859if {[winfo exists $ui_comm]} {
3861 set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
3862 # -- If both our backup and message files exist use the
3864 # newer of the two files to initialize the buffer.
3865 #
3866 if {$GITGUI_BCK_exists} {
3867 set m [gitdir GITGUI_MSG]
3868 if {[file isfile $m]} {
3869 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3870 catch {file delete [gitdir GITGUI_MSG]}
3871 } else {
3872 $ui_comm delete 0.0 end
3873 $ui_comm edit reset
3874 $ui_comm edit modified false
3875 catch {file delete [gitdir GITGUI_BCK]}
3876 set GITGUI_BCK_exists 0
3877 }
3878 }
3879 unset m
3880 }
3881 proc backup_commit_buffer {} {
3883 global ui_comm GITGUI_BCK_exists
3884 set m [$ui_comm edit modified]
3886 if {$m || $GITGUI_BCK_exists} {
3887 set msg [string trim [$ui_comm get 0.0 end]]
3888 regsub -all -line {[ \r\t]+$} $msg {} msg
3889 if {$msg eq {}} {
3891 if {$GITGUI_BCK_exists} {
3892 catch {file delete [gitdir GITGUI_BCK]}
3893 set GITGUI_BCK_exists 0
3894 }
3895 } elseif {$m} {
3896 catch {
3897 set fd [open [gitdir GITGUI_BCK] w]
3898 fconfigure $fd -encoding utf-8
3899 puts -nonewline $fd $msg
3900 close $fd
3901 set GITGUI_BCK_exists 1
3902 }
3903 }
3904 $ui_comm edit modified false
3906 }
3907 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3909 }
3910 backup_commit_buffer
3912 # -- If the user has aspell available we can drive it
3914 # in pipe mode to spellcheck the commit message.
3915 #
3916 set spell_cmd [list |]
3917 set spell_dict [get_config gui.spellingdictionary]
3918 lappend spell_cmd aspell
3919 if {$spell_dict ne {}} {
3920 lappend spell_cmd --master=$spell_dict
3921 }
3922 lappend spell_cmd --mode=none
3923 lappend spell_cmd --encoding=utf-8
3924 lappend spell_cmd pipe
3925 if {$spell_dict eq {none}
3926 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3927 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3928 } else {
3929 set ui_comm_spell [spellcheck::init \
3930 $spell_fd \
3931 $ui_comm \
3932 $ui_comm_ctxm \
3933 ]
3934 }
3935 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3936}
3937lock_index begin-read
3939if {![winfo ismapped .]} {
3940 wm deiconify .
3941}
3942after 1 {
3943 if {[is_enabled initialamend]} {
3944 force_amend
3945 } else {
3946 do_rescan
3947 }
3948 if {[is_enabled nocommitmsg]} {
3950 $ui_comm configure -state disabled -background gray
3951 }
3952}
3953if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
3954 after 1000 hint_gc
3955}
3956if {[is_enabled retcode]} {
3957 bind . <Destroy> {+terminate_me %W}
3958}
3959if {$picked && [is_config_true gui.autoexplore]} {
3960 do_explore
3961}
3962# Local variables:
3964# mode: tcl
3965# indent-tabs-mode: t
3966# tab-width: 4
3967# End: