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