530fee866f07adc22f13c8d12d709fa903bf93ba
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 {
14Copyright © 2006, 2007 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 [mc "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
52set oguilib {@@GITGUI_LIBDIR@@}
53set oguirel {@@GITGUI_RELATIVE@@}
54if {$oguirel eq {1}} {
55 set oguilib [file dirname [file dirname [file normalize $argv0]]]
56 set oguilib [file join $oguilib share git-gui lib]
57 set oguimsg [file join $oguilib msgs]
58} elseif {[string match @@* $oguirel]} {
59 set oguilib [file join [file dirname [file normalize $argv0]] lib]
60 set oguimsg [file join [file dirname [file normalize $argv0]] po]
61} else {
62 set oguimsg [file join $oguilib msgs]
63}
64unset oguirel
65
66######################################################################
67##
68## enable verbose loading?
69
70if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
71 unset _verbose
72 rename auto_load real__auto_load
73 proc auto_load {name args} {
74 puts stderr "auto_load $name"
75 return [uplevel 1 real__auto_load $name $args]
76 }
77 rename source real__source
78 proc source {name} {
79 puts stderr "source $name"
80 uplevel 1 real__source $name
81 }
82}
83
84######################################################################
85##
86## Internationalization (i18n) through msgcat and gettext. See
87## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
88
89package require msgcat
90
91proc mc {fmt args} {
92 set fmt [::msgcat::mc $fmt]
93 set cmk [string first @@ $fmt]
94 if {$cmk > 0} {
95 set fmt [string range $fmt 0 [expr {$cmk - 1}]]
96 }
97 return [eval [list format $fmt] $args]
98}
99
100proc strcat {args} {
101 return [join $args {}]
102}
103
104::msgcat::mcload $oguimsg
105unset oguimsg
106
107######################################################################
108##
109## read only globals
110
111set _appname {Git Gui}
112set _gitdir {}
113set _gitexec {}
114set _reponame {}
115set _iscygwin {}
116set _search_path {}
117
118proc appname {} {
119 global _appname
120 return $_appname
121}
122
123proc gitdir {args} {
124 global _gitdir
125 if {$args eq {}} {
126 return $_gitdir
127 }
128 return [eval [list file join $_gitdir] $args]
129}
130
131proc gitexec {args} {
132 global _gitexec
133 if {$_gitexec eq {}} {
134 if {[catch {set _gitexec [git --exec-path]} err]} {
135 error "Git not installed?\n\n$err"
136 }
137 if {[is_Cygwin]} {
138 set _gitexec [exec cygpath \
139 --windows \
140 --absolute \
141 $_gitexec]
142 } else {
143 set _gitexec [file normalize $_gitexec]
144 }
145 }
146 if {$args eq {}} {
147 return $_gitexec
148 }
149 return [eval [list file join $_gitexec] $args]
150}
151
152proc reponame {} {
153 return $::_reponame
154}
155
156proc is_MacOSX {} {
157 if {[tk windowingsystem] eq {aqua}} {
158 return 1
159 }
160 return 0
161}
162
163proc is_Windows {} {
164 if {$::tcl_platform(platform) eq {windows}} {
165 return 1
166 }
167 return 0
168}
169
170proc is_Cygwin {} {
171 global _iscygwin
172 if {$_iscygwin eq {}} {
173 if {$::tcl_platform(platform) eq {windows}} {
174 if {[catch {set p [exec cygpath --windir]} err]} {
175 set _iscygwin 0
176 } else {
177 set _iscygwin 1
178 }
179 } else {
180 set _iscygwin 0
181 }
182 }
183 return $_iscygwin
184}
185
186proc is_enabled {option} {
187 global enabled_options
188 if {[catch {set on $enabled_options($option)}]} {return 0}
189 return $on
190}
191
192proc enable_option {option} {
193 global enabled_options
194 set enabled_options($option) 1
195}
196
197proc disable_option {option} {
198 global enabled_options
199 set enabled_options($option) 0
200}
201
202######################################################################
203##
204## config
205
206proc is_many_config {name} {
207 switch -glob -- $name {
208 remote.*.fetch -
209 remote.*.push
210 {return 1}
211 *
212 {return 0}
213 }
214}
215
216proc is_config_true {name} {
217 global repo_config
218 if {[catch {set v $repo_config($name)}]} {
219 return 0
220 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
221 return 1
222 } else {
223 return 0
224 }
225}
226
227proc get_config {name} {
228 global repo_config
229 if {[catch {set v $repo_config($name)}]} {
230 return {}
231 } else {
232 return $v
233 }
234}
235
236######################################################################
237##
238## handy utils
239
240proc _git_cmd {name} {
241 global _git_cmd_path
242
243 if {[catch {set v $_git_cmd_path($name)}]} {
244 switch -- $name {
245 version -
246 --version -
247 --exec-path { return [list $::_git $name] }
248 }
249
250 set p [gitexec git-$name$::_search_exe]
251 if {[file exists $p]} {
252 set v [list $p]
253 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
254 # Try to determine what sort of magic will make
255 # git-$name go and do its thing, because native
256 # Tcl on Windows doesn't know it.
257 #
258 set p [gitexec git-$name]
259 set f [open $p r]
260 set s [gets $f]
261 close $f
262
263 switch -glob -- [lindex $s 0] {
264 #!*sh { set i sh }
265 #!*perl { set i perl }
266 #!*python { set i python }
267 default { error "git-$name is not supported: $s" }
268 }
269
270 upvar #0 _$i interp
271 if {![info exists interp]} {
272 set interp [_which $i]
273 }
274 if {$interp eq {}} {
275 error "git-$name requires $i (not in PATH)"
276 }
277 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
278 } else {
279 # Assume it is builtin to git somehow and we
280 # aren't actually able to see a file for it.
281 #
282 set v [list $::_git $name]
283 }
284 set _git_cmd_path($name) $v
285 }
286 return $v
287}
288
289proc _which {what} {
290 global env _search_exe _search_path
291
292 if {$_search_path eq {}} {
293 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
294 set _search_path [split [exec cygpath \
295 --windows \
296 --path \
297 --absolute \
298 $env(PATH)] {;}]
299 set _search_exe .exe
300 } elseif {[is_Windows]} {
301 set gitguidir [file dirname [info script]]
302 regsub -all ";" $gitguidir "\\;" gitguidir
303 set env(PATH) "$gitguidir;$env(PATH)"
304 set _search_path [split $env(PATH) {;}]
305 set _search_exe .exe
306 } else {
307 set _search_path [split $env(PATH) :]
308 set _search_exe {}
309 }
310 }
311
312 foreach p $_search_path {
313 set p [file join $p $what$_search_exe]
314 if {[file exists $p]} {
315 return [file normalize $p]
316 }
317 }
318 return {}
319}
320
321proc _lappend_nice {cmd_var} {
322 global _nice
323 upvar $cmd_var cmd
324
325 if {![info exists _nice]} {
326 set _nice [_which nice]
327 }
328 if {$_nice ne {}} {
329 lappend cmd $_nice
330 }
331}
332
333proc git {args} {
334 set opt [list exec]
335
336 while {1} {
337 switch -- [lindex $args 0] {
338 --nice {
339 _lappend_nice opt
340 }
341
342 default {
343 break
344 }
345
346 }
347
348 set args [lrange $args 1 end]
349 }
350
351 set cmdp [_git_cmd [lindex $args 0]]
352 set args [lrange $args 1 end]
353
354 return [eval $opt $cmdp $args]
355}
356
357proc _open_stdout_stderr {cmd} {
358 if {[catch {
359 set fd [open $cmd r]
360 } err]} {
361 if { [lindex $cmd end] eq {2>@1}
362 && $err eq {can not find channel named "1"}
363 } {
364 # Older versions of Tcl 8.4 don't have this 2>@1 IO
365 # redirect operator. Fallback to |& cat for those.
366 # The command was not actually started, so its safe
367 # to try to start it a second time.
368 #
369 set fd [open [concat \
370 [lrange $cmd 0 end-1] \
371 [list |& cat] \
372 ] r]
373 } else {
374 error $err
375 }
376 }
377 fconfigure $fd -eofchar {}
378 return $fd
379}
380
381proc git_read {args} {
382 set opt [list |]
383
384 while {1} {
385 switch -- [lindex $args 0] {
386 --nice {
387 _lappend_nice opt
388 }
389
390 --stderr {
391 lappend args 2>@1
392 }
393
394 default {
395 break
396 }
397
398 }
399
400 set args [lrange $args 1 end]
401 }
402
403 set cmdp [_git_cmd [lindex $args 0]]
404 set args [lrange $args 1 end]
405
406 return [_open_stdout_stderr [concat $opt $cmdp $args]]
407}
408
409proc git_write {args} {
410 set opt [list |]
411
412 while {1} {
413 switch -- [lindex $args 0] {
414 --nice {
415 _lappend_nice opt
416 }
417
418 default {
419 break
420 }
421
422 }
423
424 set args [lrange $args 1 end]
425 }
426
427 set cmdp [_git_cmd [lindex $args 0]]
428 set args [lrange $args 1 end]
429
430 return [open [concat $opt $cmdp $args] w]
431}
432
433proc sq {value} {
434 regsub -all ' $value "'\\''" value
435 return "'$value'"
436}
437
438proc load_current_branch {} {
439 global current_branch is_detached
440
441 set fd [open [gitdir HEAD] r]
442 if {[gets $fd ref] < 1} {
443 set ref {}
444 }
445 close $fd
446
447 set pfx {ref: refs/heads/}
448 set len [string length $pfx]
449 if {[string equal -length $len $pfx $ref]} {
450 # We're on a branch. It might not exist. But
451 # HEAD looks good enough to be a branch.
452 #
453 set current_branch [string range $ref $len end]
454 set is_detached 0
455 } else {
456 # Assume this is a detached head.
457 #
458 set current_branch HEAD
459 set is_detached 1
460 }
461}
462
463auto_load tk_optionMenu
464rename tk_optionMenu real__tkOptionMenu
465proc tk_optionMenu {w varName args} {
466 set m [eval real__tkOptionMenu $w $varName $args]
467 $m configure -font font_ui
468 $w configure -font font_ui
469 return $m
470}
471
472proc rmsel_tag {text} {
473 $text tag conf sel \
474 -background [$text cget -background] \
475 -foreground [$text cget -foreground] \
476 -borderwidth 0
477 $text tag conf in_sel -background lightgray
478 bind $text <Motion> break
479 return $text
480}
481
482set root_exists 0
483bind . <Visibility> {
484 bind . <Visibility> {}
485 set root_exists 1
486}
487
488if {[is_Windows]} {
489 wm iconbitmap . -default $oguilib/git-gui.ico
490}
491
492######################################################################
493##
494## config defaults
495
496set cursor_ptr arrow
497font create font_diff -family Courier -size 10
498font create font_ui
499catch {
500 label .dummy
501 eval font configure font_ui [font actual [.dummy cget -font]]
502 destroy .dummy
503}
504
505font create font_uiitalic
506font create font_uibold
507font create font_diffbold
508font create font_diffitalic
509
510foreach class {Button Checkbutton Entry Label
511 Labelframe Listbox Menu Message
512 Radiobutton Spinbox Text} {
513 option add *$class.font font_ui
514}
515unset class
516
517if {[is_Windows] || [is_MacOSX]} {
518 option add *Menu.tearOff 0
519}
520
521if {[is_MacOSX]} {
522 set M1B M1
523 set M1T Cmd
524} else {
525 set M1B Control
526 set M1T Ctrl
527}
528
529proc bind_button3 {w cmd} {
530 bind $w <Any-Button-3> $cmd
531 if {[is_MacOSX]} {
532 # Mac OS X sends Button-2 on right click through three-button mouse,
533 # or through trackpad right-clicking (two-finger touch + click).
534 bind $w <Any-Button-2> $cmd
535 bind $w <Control-Button-1> $cmd
536 }
537}
538
539proc apply_config {} {
540 global repo_config font_descs
541
542 foreach option $font_descs {
543 set name [lindex $option 0]
544 set font [lindex $option 1]
545 if {[catch {
546 foreach {cn cv} $repo_config(gui.$name) {
547 font configure $font $cn $cv -weight normal
548 }
549 } err]} {
550 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
551 }
552 foreach {cn cv} [font configure $font] {
553 font configure ${font}bold $cn $cv
554 font configure ${font}italic $cn $cv
555 }
556 font configure ${font}bold -weight bold
557 font configure ${font}italic -slant italic
558 }
559}
560
561set default_config(merge.diffstat) true
562set default_config(merge.summary) false
563set default_config(merge.verbosity) 2
564set default_config(user.name) {}
565set default_config(user.email) {}
566
567set default_config(gui.matchtrackingbranch) false
568set default_config(gui.pruneduringfetch) false
569set default_config(gui.trustmtime) false
570set default_config(gui.diffcontext) 5
571set default_config(gui.newbranchtemplate) {}
572set default_config(gui.fontui) [font configure font_ui]
573set default_config(gui.fontdiff) [font configure font_diff]
574set font_descs {
575 {fontui font_ui {mc "Main Font"}}
576 {fontdiff font_diff {mc "Diff/Console Font"}}
577}
578
579######################################################################
580##
581## find git
582
583set _git [_which git]
584if {$_git eq {}} {
585 catch {wm withdraw .}
586 tk_messageBox \
587 -icon error \
588 -type ok \
589 -title [mc "git-gui: fatal error"] \
590 -message [mc "Cannot find git in PATH."]
591 exit 1
592}
593
594######################################################################
595##
596## version check
597
598if {[catch {set _git_version [git --version]} err]} {
599 catch {wm withdraw .}
600 tk_messageBox \
601 -icon error \
602 -type ok \
603 -title [mc "git-gui: fatal error"] \
604 -message "Cannot determine Git version:
605
606$err
607
608[appname] requires Git 1.5.0 or later."
609 exit 1
610}
611if {![regsub {^git version } $_git_version {} _git_version]} {
612 catch {wm withdraw .}
613 tk_messageBox \
614 -icon error \
615 -type ok \
616 -title [mc "git-gui: fatal error"] \
617 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
618 exit 1
619}
620
621set _real_git_version $_git_version
622regsub -- {-dirty$} $_git_version {} _git_version
623regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
624regsub {\.rc[0-9]+$} $_git_version {} _git_version
625regsub {\.GIT$} $_git_version {} _git_version
626regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
627
628if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
629 catch {wm withdraw .}
630 if {[tk_messageBox \
631 -icon warning \
632 -type yesno \
633 -default no \
634 -title "[appname]: warning" \
635 -message [mc "Git version cannot be determined.
636
637%s claims it is version '%s'.
638
639%s requires at least Git 1.5.0 or later.
640
641Assume '%s' is version 1.5.0?
642" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
643 set _git_version 1.5.0
644 } else {
645 exit 1
646 }
647}
648unset _real_git_version
649
650proc git-version {args} {
651 global _git_version
652
653 switch [llength $args] {
654 0 {
655 return $_git_version
656 }
657
658 2 {
659 set op [lindex $args 0]
660 set vr [lindex $args 1]
661 set cm [package vcompare $_git_version $vr]
662 return [expr $cm $op 0]
663 }
664
665 4 {
666 set type [lindex $args 0]
667 set name [lindex $args 1]
668 set parm [lindex $args 2]
669 set body [lindex $args 3]
670
671 if {($type ne {proc} && $type ne {method})} {
672 error "Invalid arguments to git-version"
673 }
674 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
675 error "Last arm of $type $name must be default"
676 }
677
678 foreach {op vr cb} [lrange $body 0 end-2] {
679 if {[git-version $op $vr]} {
680 return [uplevel [list $type $name $parm $cb]]
681 }
682 }
683
684 return [uplevel [list $type $name $parm [lindex $body end]]]
685 }
686
687 default {
688 error "git-version >= x"
689 }
690
691 }
692}
693
694if {[git-version < 1.5]} {
695 catch {wm withdraw .}
696 tk_messageBox \
697 -icon error \
698 -type ok \
699 -title [mc "git-gui: fatal error"] \
700 -message "[appname] requires Git 1.5.0 or later.
701
702You are using [git-version]:
703
704[git --version]"
705 exit 1
706}
707
708######################################################################
709##
710## configure our library
711
712set idx [file join $oguilib tclIndex]
713if {[catch {set fd [open $idx r]} err]} {
714 catch {wm withdraw .}
715 tk_messageBox \
716 -icon error \
717 -type ok \
718 -title [mc "git-gui: fatal error"] \
719 -message $err
720 exit 1
721}
722if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
723 set idx [list]
724 while {[gets $fd n] >= 0} {
725 if {$n ne {} && ![string match #* $n]} {
726 lappend idx $n
727 }
728 }
729} else {
730 set idx {}
731}
732close $fd
733
734if {$idx ne {}} {
735 set loaded [list]
736 foreach p $idx {
737 if {[lsearch -exact $loaded $p] >= 0} continue
738 source [file join $oguilib $p]
739 lappend loaded $p
740 }
741 unset loaded p
742} else {
743 set auto_path [concat [list $oguilib] $auto_path]
744}
745unset -nocomplain idx fd
746
747######################################################################
748##
749## config file parsing
750
751proc load_config {include_global} {
752 global repo_config global_config default_config
753
754 array unset global_config
755 if {$include_global} {
756 catch {
757 set fd_rc [git_read config --global --list]
758 while {[gets $fd_rc line] >= 0} {
759 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
760 if {[is_many_config $name]} {
761 lappend global_config($name) $value
762 } else {
763 set global_config($name) $value
764 }
765 }
766 }
767 close $fd_rc
768 }
769 }
770
771 array unset repo_config
772 catch {
773 set fd_rc [git_read config --list]
774 while {[gets $fd_rc line] >= 0} {
775 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
776 if {[is_many_config $name]} {
777 lappend repo_config($name) $value
778 } else {
779 set repo_config($name) $value
780 }
781 }
782 }
783 close $fd_rc
784 }
785
786 foreach name [array names default_config] {
787 if {[catch {set v $global_config($name)}]} {
788 set global_config($name) $default_config($name)
789 }
790 if {[catch {set v $repo_config($name)}]} {
791 set repo_config($name) $default_config($name)
792 }
793 }
794}
795
796######################################################################
797##
798## feature option selection
799
800if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
801 unset _junk
802} else {
803 set subcommand gui
804}
805if {$subcommand eq {gui.sh}} {
806 set subcommand gui
807}
808if {$subcommand eq {gui} && [llength $argv] > 0} {
809 set subcommand [lindex $argv 0]
810 set argv [lrange $argv 1 end]
811}
812
813enable_option multicommit
814enable_option branch
815enable_option transport
816disable_option bare
817
818switch -- $subcommand {
819browser -
820blame {
821 enable_option bare
822
823 disable_option multicommit
824 disable_option branch
825 disable_option transport
826}
827citool {
828 enable_option singlecommit
829
830 disable_option multicommit
831 disable_option branch
832 disable_option transport
833}
834}
835
836######################################################################
837##
838## repository setup
839
840if {[catch {
841 set _gitdir $env(GIT_DIR)
842 set _prefix {}
843 }]
844 && [catch {
845 set _gitdir [git rev-parse --git-dir]
846 set _prefix [git rev-parse --show-prefix]
847 } err]} {
848 load_config 1
849 apply_config
850 choose_repository::pick
851}
852if {![file isdirectory $_gitdir] && [is_Cygwin]} {
853 catch {set _gitdir [exec cygpath --windows $_gitdir]}
854}
855if {![file isdirectory $_gitdir]} {
856 catch {wm withdraw .}
857 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
858 exit 1
859}
860if {$_prefix ne {}} {
861 regsub -all {[^/]+/} $_prefix ../ cdup
862 if {[catch {cd $cdup} err]} {
863 catch {wm withdraw .}
864 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
865 exit 1
866 }
867 unset cdup
868} elseif {![is_enabled bare]} {
869 if {[lindex [file split $_gitdir] end] ne {.git}} {
870 catch {wm withdraw .}
871 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
872 exit 1
873 }
874 if {[catch {cd [file dirname $_gitdir]} err]} {
875 catch {wm withdraw .}
876 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
877 exit 1
878 }
879}
880set _reponame [file split [file normalize $_gitdir]]
881if {[lindex $_reponame end] eq {.git}} {
882 set _reponame [lindex $_reponame end-1]
883} else {
884 set _reponame [lindex $_reponame end]
885}
886
887######################################################################
888##
889## global init
890
891set current_diff_path {}
892set current_diff_side {}
893set diff_actions [list]
894
895set HEAD {}
896set PARENT {}
897set MERGE_HEAD [list]
898set commit_type {}
899set empty_tree {}
900set current_branch {}
901set is_detached 0
902set current_diff_path {}
903set is_3way_diff 0
904set selected_commit_type new
905
906######################################################################
907##
908## task management
909
910set rescan_active 0
911set diff_active 0
912set last_clicked {}
913
914set disable_on_lock [list]
915set index_lock_type none
916
917proc lock_index {type} {
918 global index_lock_type disable_on_lock
919
920 if {$index_lock_type eq {none}} {
921 set index_lock_type $type
922 foreach w $disable_on_lock {
923 uplevel #0 $w disabled
924 }
925 return 1
926 } elseif {$index_lock_type eq "begin-$type"} {
927 set index_lock_type $type
928 return 1
929 }
930 return 0
931}
932
933proc unlock_index {} {
934 global index_lock_type disable_on_lock
935
936 set index_lock_type none
937 foreach w $disable_on_lock {
938 uplevel #0 $w normal
939 }
940}
941
942######################################################################
943##
944## status
945
946proc repository_state {ctvar hdvar mhvar} {
947 global current_branch
948 upvar $ctvar ct $hdvar hd $mhvar mh
949
950 set mh [list]
951
952 load_current_branch
953 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
954 set hd {}
955 set ct initial
956 return
957 }
958
959 set merge_head [gitdir MERGE_HEAD]
960 if {[file exists $merge_head]} {
961 set ct merge
962 set fd_mh [open $merge_head r]
963 while {[gets $fd_mh line] >= 0} {
964 lappend mh $line
965 }
966 close $fd_mh
967 return
968 }
969
970 set ct normal
971}
972
973proc PARENT {} {
974 global PARENT empty_tree
975
976 set p [lindex $PARENT 0]
977 if {$p ne {}} {
978 return $p
979 }
980 if {$empty_tree eq {}} {
981 set empty_tree [git mktree << {}]
982 }
983 return $empty_tree
984}
985
986proc rescan {after {honor_trustmtime 1}} {
987 global HEAD PARENT MERGE_HEAD commit_type
988 global ui_index ui_workdir ui_comm
989 global rescan_active file_states
990 global repo_config
991
992 if {$rescan_active > 0 || ![lock_index read]} return
993
994 repository_state newType newHEAD newMERGE_HEAD
995 if {[string match amend* $commit_type]
996 && $newType eq {normal}
997 && $newHEAD eq $HEAD} {
998 } else {
999 set HEAD $newHEAD
1000 set PARENT $newHEAD
1001 set MERGE_HEAD $newMERGE_HEAD
1002 set commit_type $newType
1003 }
1004
1005 array unset file_states
1006
1007 if {!$::GITGUI_BCK_exists &&
1008 (![$ui_comm edit modified]
1009 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1010 if {[string match amend* $commit_type]} {
1011 } elseif {[load_message GITGUI_MSG]} {
1012 } elseif {[load_message MERGE_MSG]} {
1013 } elseif {[load_message SQUASH_MSG]} {
1014 }
1015 $ui_comm edit reset
1016 $ui_comm edit modified false
1017 }
1018
1019 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1020 rescan_stage2 {} $after
1021 } else {
1022 set rescan_active 1
1023 ui_status [mc "Refreshing file status..."]
1024 set fd_rf [git_read update-index \
1025 -q \
1026 --unmerged \
1027 --ignore-missing \
1028 --refresh \
1029 ]
1030 fconfigure $fd_rf -blocking 0 -translation binary
1031 fileevent $fd_rf readable \
1032 [list rescan_stage2 $fd_rf $after]
1033 }
1034}
1035
1036if {[is_Cygwin]} {
1037 set is_git_info_link {}
1038 set is_git_info_exclude {}
1039 proc have_info_exclude {} {
1040 global is_git_info_link is_git_info_exclude
1041
1042 if {$is_git_info_link eq {}} {
1043 set is_git_info_link [file isfile [gitdir info.lnk]]
1044 }
1045
1046 if {$is_git_info_link} {
1047 if {$is_git_info_exclude eq {}} {
1048 if {[catch {exec test -f [gitdir info exclude]}]} {
1049 set is_git_info_exclude 0
1050 } else {
1051 set is_git_info_exclude 1
1052 }
1053 }
1054 return $is_git_info_exclude
1055 } else {
1056 return [file readable [gitdir info exclude]]
1057 }
1058 }
1059} else {
1060 proc have_info_exclude {} {
1061 return [file readable [gitdir info exclude]]
1062 }
1063}
1064
1065proc rescan_stage2 {fd after} {
1066 global rescan_active buf_rdi buf_rdf buf_rlo
1067
1068 if {$fd ne {}} {
1069 read $fd
1070 if {![eof $fd]} return
1071 close $fd
1072 }
1073
1074 set ls_others [list --exclude-per-directory=.gitignore]
1075 if {[have_info_exclude]} {
1076 lappend ls_others "--exclude-from=[gitdir info exclude]"
1077 }
1078 set user_exclude [get_config core.excludesfile]
1079 if {$user_exclude ne {} && [file readable $user_exclude]} {
1080 lappend ls_others "--exclude-from=$user_exclude"
1081 }
1082
1083 set buf_rdi {}
1084 set buf_rdf {}
1085 set buf_rlo {}
1086
1087 set rescan_active 3
1088 ui_status [mc "Scanning for modified files ..."]
1089 set fd_di [git_read diff-index --cached -z [PARENT]]
1090 set fd_df [git_read diff-files -z]
1091 set fd_lo [eval git_read ls-files --others -z $ls_others]
1092
1093 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1094 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1095 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1096 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1097 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1098 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1099}
1100
1101proc load_message {file} {
1102 global ui_comm
1103
1104 set f [gitdir $file]
1105 if {[file isfile $f]} {
1106 if {[catch {set fd [open $f r]}]} {
1107 return 0
1108 }
1109 fconfigure $fd -eofchar {}
1110 set content [string trim [read $fd]]
1111 close $fd
1112 regsub -all -line {[ \r\t]+$} $content {} content
1113 $ui_comm delete 0.0 end
1114 $ui_comm insert end $content
1115 return 1
1116 }
1117 return 0
1118}
1119
1120proc read_diff_index {fd after} {
1121 global buf_rdi
1122
1123 append buf_rdi [read $fd]
1124 set c 0
1125 set n [string length $buf_rdi]
1126 while {$c < $n} {
1127 set z1 [string first "\0" $buf_rdi $c]
1128 if {$z1 == -1} break
1129 incr z1
1130 set z2 [string first "\0" $buf_rdi $z1]
1131 if {$z2 == -1} break
1132
1133 incr c
1134 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1135 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1136 merge_state \
1137 [encoding convertfrom $p] \
1138 [lindex $i 4]? \
1139 [list [lindex $i 0] [lindex $i 2]] \
1140 [list]
1141 set c $z2
1142 incr c
1143 }
1144 if {$c < $n} {
1145 set buf_rdi [string range $buf_rdi $c end]
1146 } else {
1147 set buf_rdi {}
1148 }
1149
1150 rescan_done $fd buf_rdi $after
1151}
1152
1153proc read_diff_files {fd after} {
1154 global buf_rdf
1155
1156 append buf_rdf [read $fd]
1157 set c 0
1158 set n [string length $buf_rdf]
1159 while {$c < $n} {
1160 set z1 [string first "\0" $buf_rdf $c]
1161 if {$z1 == -1} break
1162 incr z1
1163 set z2 [string first "\0" $buf_rdf $z1]
1164 if {$z2 == -1} break
1165
1166 incr c
1167 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1168 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1169 merge_state \
1170 [encoding convertfrom $p] \
1171 ?[lindex $i 4] \
1172 [list] \
1173 [list [lindex $i 0] [lindex $i 2]]
1174 set c $z2
1175 incr c
1176 }
1177 if {$c < $n} {
1178 set buf_rdf [string range $buf_rdf $c end]
1179 } else {
1180 set buf_rdf {}
1181 }
1182
1183 rescan_done $fd buf_rdf $after
1184}
1185
1186proc read_ls_others {fd after} {
1187 global buf_rlo
1188
1189 append buf_rlo [read $fd]
1190 set pck [split $buf_rlo "\0"]
1191 set buf_rlo [lindex $pck end]
1192 foreach p [lrange $pck 0 end-1] {
1193 set p [encoding convertfrom $p]
1194 if {[string index $p end] eq {/}} {
1195 set p [string range $p 0 end-1]
1196 }
1197 merge_state $p ?O
1198 }
1199 rescan_done $fd buf_rlo $after
1200}
1201
1202proc rescan_done {fd buf after} {
1203 global rescan_active current_diff_path
1204 global file_states repo_config
1205 upvar $buf to_clear
1206
1207 if {![eof $fd]} return
1208 set to_clear {}
1209 close $fd
1210 if {[incr rescan_active -1] > 0} return
1211
1212 prune_selection
1213 unlock_index
1214 display_all_files
1215 if {$current_diff_path ne {}} reshow_diff
1216 uplevel #0 $after
1217}
1218
1219proc prune_selection {} {
1220 global file_states selected_paths
1221
1222 foreach path [array names selected_paths] {
1223 if {[catch {set still_here $file_states($path)}]} {
1224 unset selected_paths($path)
1225 }
1226 }
1227}
1228
1229######################################################################
1230##
1231## ui helpers
1232
1233proc mapicon {w state path} {
1234 global all_icons
1235
1236 if {[catch {set r $all_icons($state$w)}]} {
1237 puts "error: no icon for $w state={$state} $path"
1238 return file_plain
1239 }
1240 return $r
1241}
1242
1243proc mapdesc {state path} {
1244 global all_descs
1245
1246 if {[catch {set r $all_descs($state)}]} {
1247 puts "error: no desc for state={$state} $path"
1248 return $state
1249 }
1250 return $r
1251}
1252
1253proc ui_status {msg} {
1254 global main_status
1255 if {[info exists main_status]} {
1256 $main_status show $msg
1257 }
1258}
1259
1260proc ui_ready {{test {}}} {
1261 global main_status
1262 if {[info exists main_status]} {
1263 $main_status show [mc "Ready."] $test
1264 }
1265}
1266
1267proc escape_path {path} {
1268 regsub -all {\\} $path "\\\\" path
1269 regsub -all "\n" $path "\\n" path
1270 return $path
1271}
1272
1273proc short_path {path} {
1274 return [escape_path [lindex [file split $path] end]]
1275}
1276
1277set next_icon_id 0
1278set null_sha1 [string repeat 0 40]
1279
1280proc merge_state {path new_state {head_info {}} {index_info {}}} {
1281 global file_states next_icon_id null_sha1
1282
1283 set s0 [string index $new_state 0]
1284 set s1 [string index $new_state 1]
1285
1286 if {[catch {set info $file_states($path)}]} {
1287 set state __
1288 set icon n[incr next_icon_id]
1289 } else {
1290 set state [lindex $info 0]
1291 set icon [lindex $info 1]
1292 if {$head_info eq {}} {set head_info [lindex $info 2]}
1293 if {$index_info eq {}} {set index_info [lindex $info 3]}
1294 }
1295
1296 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1297 elseif {$s0 eq {_}} {set s0 _}
1298
1299 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1300 elseif {$s1 eq {_}} {set s1 _}
1301
1302 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1303 set head_info [list 0 $null_sha1]
1304 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1305 && $head_info eq {}} {
1306 set head_info $index_info
1307 }
1308
1309 set file_states($path) [list $s0$s1 $icon \
1310 $head_info $index_info \
1311 ]
1312 return $state
1313}
1314
1315proc display_file_helper {w path icon_name old_m new_m} {
1316 global file_lists
1317
1318 if {$new_m eq {_}} {
1319 set lno [lsearch -sorted -exact $file_lists($w) $path]
1320 if {$lno >= 0} {
1321 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1322 incr lno
1323 $w conf -state normal
1324 $w delete $lno.0 [expr {$lno + 1}].0
1325 $w conf -state disabled
1326 }
1327 } elseif {$old_m eq {_} && $new_m ne {_}} {
1328 lappend file_lists($w) $path
1329 set file_lists($w) [lsort -unique $file_lists($w)]
1330 set lno [lsearch -sorted -exact $file_lists($w) $path]
1331 incr lno
1332 $w conf -state normal
1333 $w image create $lno.0 \
1334 -align center -padx 5 -pady 1 \
1335 -name $icon_name \
1336 -image [mapicon $w $new_m $path]
1337 $w insert $lno.1 "[escape_path $path]\n"
1338 $w conf -state disabled
1339 } elseif {$old_m ne $new_m} {
1340 $w conf -state normal
1341 $w image conf $icon_name -image [mapicon $w $new_m $path]
1342 $w conf -state disabled
1343 }
1344}
1345
1346proc display_file {path state} {
1347 global file_states selected_paths
1348 global ui_index ui_workdir
1349
1350 set old_m [merge_state $path $state]
1351 set s $file_states($path)
1352 set new_m [lindex $s 0]
1353 set icon_name [lindex $s 1]
1354
1355 set o [string index $old_m 0]
1356 set n [string index $new_m 0]
1357 if {$o eq {U}} {
1358 set o _
1359 }
1360 if {$n eq {U}} {
1361 set n _
1362 }
1363 display_file_helper $ui_index $path $icon_name $o $n
1364
1365 if {[string index $old_m 0] eq {U}} {
1366 set o U
1367 } else {
1368 set o [string index $old_m 1]
1369 }
1370 if {[string index $new_m 0] eq {U}} {
1371 set n U
1372 } else {
1373 set n [string index $new_m 1]
1374 }
1375 display_file_helper $ui_workdir $path $icon_name $o $n
1376
1377 if {$new_m eq {__}} {
1378 unset file_states($path)
1379 catch {unset selected_paths($path)}
1380 }
1381}
1382
1383proc display_all_files_helper {w path icon_name m} {
1384 global file_lists
1385
1386 lappend file_lists($w) $path
1387 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1388 $w image create end \
1389 -align center -padx 5 -pady 1 \
1390 -name $icon_name \
1391 -image [mapicon $w $m $path]
1392 $w insert end "[escape_path $path]\n"
1393}
1394
1395proc display_all_files {} {
1396 global ui_index ui_workdir
1397 global file_states file_lists
1398 global last_clicked
1399
1400 $ui_index conf -state normal
1401 $ui_workdir conf -state normal
1402
1403 $ui_index delete 0.0 end
1404 $ui_workdir delete 0.0 end
1405 set last_clicked {}
1406
1407 set file_lists($ui_index) [list]
1408 set file_lists($ui_workdir) [list]
1409
1410 foreach path [lsort [array names file_states]] {
1411 set s $file_states($path)
1412 set m [lindex $s 0]
1413 set icon_name [lindex $s 1]
1414
1415 set s [string index $m 0]
1416 if {$s ne {U} && $s ne {_}} {
1417 display_all_files_helper $ui_index $path \
1418 $icon_name $s
1419 }
1420
1421 if {[string index $m 0] eq {U}} {
1422 set s U
1423 } else {
1424 set s [string index $m 1]
1425 }
1426 if {$s ne {_}} {
1427 display_all_files_helper $ui_workdir $path \
1428 $icon_name $s
1429 }
1430 }
1431
1432 $ui_index conf -state disabled
1433 $ui_workdir conf -state disabled
1434}
1435
1436######################################################################
1437##
1438## icons
1439
1440set filemask {
1441#define mask_width 14
1442#define mask_height 15
1443static unsigned char mask_bits[] = {
1444 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1445 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1446 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1447}
1448
1449image create bitmap file_plain -background white -foreground black -data {
1450#define plain_width 14
1451#define plain_height 15
1452static unsigned char plain_bits[] = {
1453 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1454 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1455 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1456} -maskdata $filemask
1457
1458image create bitmap file_mod -background white -foreground blue -data {
1459#define mod_width 14
1460#define mod_height 15
1461static unsigned char mod_bits[] = {
1462 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1463 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1464 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1465} -maskdata $filemask
1466
1467image create bitmap file_fulltick -background white -foreground "#007000" -data {
1468#define file_fulltick_width 14
1469#define file_fulltick_height 15
1470static unsigned char file_fulltick_bits[] = {
1471 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1472 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1473 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1474} -maskdata $filemask
1475
1476image create bitmap file_parttick -background white -foreground "#005050" -data {
1477#define parttick_width 14
1478#define parttick_height 15
1479static unsigned char parttick_bits[] = {
1480 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1481 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1482 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1483} -maskdata $filemask
1484
1485image create bitmap file_question -background white -foreground black -data {
1486#define file_question_width 14
1487#define file_question_height 15
1488static unsigned char file_question_bits[] = {
1489 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1490 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1491 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1492} -maskdata $filemask
1493
1494image create bitmap file_removed -background white -foreground red -data {
1495#define file_removed_width 14
1496#define file_removed_height 15
1497static unsigned char file_removed_bits[] = {
1498 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1499 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1500 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1501} -maskdata $filemask
1502
1503image create bitmap file_merge -background white -foreground blue -data {
1504#define file_merge_width 14
1505#define file_merge_height 15
1506static unsigned char file_merge_bits[] = {
1507 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1508 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1509 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1510} -maskdata $filemask
1511
1512set ui_index .vpane.files.index.list
1513set ui_workdir .vpane.files.workdir.list
1514
1515set all_icons(_$ui_index) file_plain
1516set all_icons(A$ui_index) file_fulltick
1517set all_icons(M$ui_index) file_fulltick
1518set all_icons(D$ui_index) file_removed
1519set all_icons(U$ui_index) file_merge
1520
1521set all_icons(_$ui_workdir) file_plain
1522set all_icons(M$ui_workdir) file_mod
1523set all_icons(D$ui_workdir) file_question
1524set all_icons(U$ui_workdir) file_merge
1525set all_icons(O$ui_workdir) file_plain
1526
1527set max_status_desc 0
1528foreach i {
1529 {__ {mc "Unmodified"}}
1530
1531 {_M {mc "Modified, not staged"}}
1532 {M_ {mc "Staged for commit"}}
1533 {MM {mc "Portions staged for commit"}}
1534 {MD {mc "Staged for commit, missing"}}
1535
1536 {_O {mc "Untracked, not staged"}}
1537 {A_ {mc "Staged for commit"}}
1538 {AM {mc "Portions staged for commit"}}
1539 {AD {mc "Staged for commit, missing"}}
1540
1541 {_D {mc "Missing"}}
1542 {D_ {mc "Staged for removal"}}
1543 {DO {mc "Staged for removal, still present"}}
1544
1545 {U_ {mc "Requires merge resolution"}}
1546 {UU {mc "Requires merge resolution"}}
1547 {UM {mc "Requires merge resolution"}}
1548 {UD {mc "Requires merge resolution"}}
1549 } {
1550 set text [eval [lindex $i 1]]
1551 if {$max_status_desc < [string length $text]} {
1552 set max_status_desc [string length $text]
1553 }
1554 set all_descs([lindex $i 0]) $text
1555}
1556unset i
1557
1558######################################################################
1559##
1560## util
1561
1562proc scrollbar2many {list mode args} {
1563 foreach w $list {eval $w $mode $args}
1564}
1565
1566proc many2scrollbar {list mode sb top bottom} {
1567 $sb set $top $bottom
1568 foreach w $list {$w $mode moveto $top}
1569}
1570
1571proc incr_font_size {font {amt 1}} {
1572 set sz [font configure $font -size]
1573 incr sz $amt
1574 font configure $font -size $sz
1575 font configure ${font}bold -size $sz
1576 font configure ${font}italic -size $sz
1577}
1578
1579######################################################################
1580##
1581## ui commands
1582
1583set starting_gitk_msg [mc "Starting gitk... please wait..."]
1584
1585proc do_gitk {revs} {
1586 # -- Always start gitk through whatever we were loaded with. This
1587 # lets us bypass using shell process on Windows systems.
1588 #
1589 set exe [file join [file dirname $::_git] gitk]
1590 set cmd [list [info nameofexecutable] $exe]
1591 if {! [file exists $exe]} {
1592 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1593 } else {
1594 global env
1595
1596 if {[info exists env(GIT_DIR)]} {
1597 set old_GIT_DIR $env(GIT_DIR)
1598 } else {
1599 set old_GIT_DIR {}
1600 }
1601
1602 set pwd [pwd]
1603 cd [file dirname [gitdir]]
1604 set env(GIT_DIR) [file tail [gitdir]]
1605
1606 eval exec $cmd $revs &
1607
1608 if {$old_GIT_DIR eq {}} {
1609 unset env(GIT_DIR)
1610 } else {
1611 set env(GIT_DIR) $old_GIT_DIR
1612 }
1613 cd $pwd
1614
1615 ui_status $::starting_gitk_msg
1616 after 10000 {
1617 ui_ready $starting_gitk_msg
1618 }
1619 }
1620}
1621
1622set is_quitting 0
1623
1624proc do_quit {} {
1625 global ui_comm is_quitting repo_config commit_type
1626 global GITGUI_BCK_exists GITGUI_BCK_i
1627
1628 if {$is_quitting} return
1629 set is_quitting 1
1630
1631 if {[winfo exists $ui_comm]} {
1632 # -- Stash our current commit buffer.
1633 #
1634 set save [gitdir GITGUI_MSG]
1635 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1636 file rename -force [gitdir GITGUI_BCK] $save
1637 set GITGUI_BCK_exists 0
1638 } else {
1639 set msg [string trim [$ui_comm get 0.0 end]]
1640 regsub -all -line {[ \r\t]+$} $msg {} msg
1641 if {(![string match amend* $commit_type]
1642 || [$ui_comm edit modified])
1643 && $msg ne {}} {
1644 catch {
1645 set fd [open $save w]
1646 puts -nonewline $fd $msg
1647 close $fd
1648 }
1649 } else {
1650 catch {file delete $save}
1651 }
1652 }
1653
1654 # -- Remove our editor backup, its not needed.
1655 #
1656 after cancel $GITGUI_BCK_i
1657 if {$GITGUI_BCK_exists} {
1658 catch {file delete [gitdir GITGUI_BCK]}
1659 }
1660
1661 # -- Stash our current window geometry into this repository.
1662 #
1663 set cfg_geometry [list]
1664 lappend cfg_geometry [wm geometry .]
1665 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1666 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1667 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1668 set rc_geometry {}
1669 }
1670 if {$cfg_geometry ne $rc_geometry} {
1671 catch {git config gui.geometry $cfg_geometry}
1672 }
1673 }
1674
1675 destroy .
1676}
1677
1678proc do_rescan {} {
1679 rescan ui_ready
1680}
1681
1682proc do_commit {} {
1683 commit_tree
1684}
1685
1686proc toggle_or_diff {w x y} {
1687 global file_states file_lists current_diff_path ui_index ui_workdir
1688 global last_clicked selected_paths
1689
1690 set pos [split [$w index @$x,$y] .]
1691 set lno [lindex $pos 0]
1692 set col [lindex $pos 1]
1693 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1694 if {$path eq {}} {
1695 set last_clicked {}
1696 return
1697 }
1698
1699 set last_clicked [list $w $lno]
1700 array unset selected_paths
1701 $ui_index tag remove in_sel 0.0 end
1702 $ui_workdir tag remove in_sel 0.0 end
1703
1704 if {$col == 0} {
1705 if {$current_diff_path eq $path} {
1706 set after {reshow_diff;}
1707 } else {
1708 set after {}
1709 }
1710 if {$w eq $ui_index} {
1711 update_indexinfo \
1712 "Unstaging [short_path $path] from commit" \
1713 [list $path] \
1714 [concat $after [list ui_ready]]
1715 } elseif {$w eq $ui_workdir} {
1716 update_index \
1717 "Adding [short_path $path]" \
1718 [list $path] \
1719 [concat $after [list ui_ready]]
1720 }
1721 } else {
1722 show_diff $path $w $lno
1723 }
1724}
1725
1726proc add_one_to_selection {w x y} {
1727 global file_lists last_clicked selected_paths
1728
1729 set lno [lindex [split [$w index @$x,$y] .] 0]
1730 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1731 if {$path eq {}} {
1732 set last_clicked {}
1733 return
1734 }
1735
1736 if {$last_clicked ne {}
1737 && [lindex $last_clicked 0] ne $w} {
1738 array unset selected_paths
1739 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1740 }
1741
1742 set last_clicked [list $w $lno]
1743 if {[catch {set in_sel $selected_paths($path)}]} {
1744 set in_sel 0
1745 }
1746 if {$in_sel} {
1747 unset selected_paths($path)
1748 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1749 } else {
1750 set selected_paths($path) 1
1751 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1752 }
1753}
1754
1755proc add_range_to_selection {w x y} {
1756 global file_lists last_clicked selected_paths
1757
1758 if {[lindex $last_clicked 0] ne $w} {
1759 toggle_or_diff $w $x $y
1760 return
1761 }
1762
1763 set lno [lindex [split [$w index @$x,$y] .] 0]
1764 set lc [lindex $last_clicked 1]
1765 if {$lc < $lno} {
1766 set begin $lc
1767 set end $lno
1768 } else {
1769 set begin $lno
1770 set end $lc
1771 }
1772
1773 foreach path [lrange $file_lists($w) \
1774 [expr {$begin - 1}] \
1775 [expr {$end - 1}]] {
1776 set selected_paths($path) 1
1777 }
1778 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1779}
1780
1781######################################################################
1782##
1783## ui construction
1784
1785load_config 0
1786apply_config
1787set ui_comm {}
1788
1789# -- Menu Bar
1790#
1791menu .mbar -tearoff 0
1792.mbar add cascade -label [mc Repository] -menu .mbar.repository
1793.mbar add cascade -label [mc Edit] -menu .mbar.edit
1794if {[is_enabled branch]} {
1795 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1796}
1797if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1798 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1799}
1800if {[is_enabled transport]} {
1801 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1802 .mbar add cascade -label [mc Remote] -menu .mbar.remote
1803}
1804. configure -menu .mbar
1805
1806# -- Repository Menu
1807#
1808menu .mbar.repository
1809
1810.mbar.repository add command \
1811 -label [mc "Browse Current Branch's Files"] \
1812 -command {browser::new $current_branch}
1813set ui_browse_current [.mbar.repository index last]
1814.mbar.repository add command \
1815 -label [mc "Browse Branch Files..."] \
1816 -command browser_open::dialog
1817.mbar.repository add separator
1818
1819.mbar.repository add command \
1820 -label [mc "Visualize Current Branch's History"] \
1821 -command {do_gitk $current_branch}
1822set ui_visualize_current [.mbar.repository index last]
1823.mbar.repository add command \
1824 -label [mc "Visualize All Branch History"] \
1825 -command {do_gitk --all}
1826.mbar.repository add separator
1827
1828proc current_branch_write {args} {
1829 global current_branch
1830 .mbar.repository entryconf $::ui_browse_current \
1831 -label [mc "Browse %s's Files" $current_branch]
1832 .mbar.repository entryconf $::ui_visualize_current \
1833 -label [mc "Visualize %s's History" $current_branch]
1834}
1835trace add variable current_branch write current_branch_write
1836
1837if {[is_enabled multicommit]} {
1838 .mbar.repository add command -label [mc "Database Statistics"] \
1839 -command do_stats
1840
1841 .mbar.repository add command -label [mc "Compress Database"] \
1842 -command do_gc
1843
1844 .mbar.repository add command -label [mc "Verify Database"] \
1845 -command do_fsck_objects
1846
1847 .mbar.repository add separator
1848
1849 if {[is_Cygwin]} {
1850 .mbar.repository add command \
1851 -label [mc "Create Desktop Icon"] \
1852 -command do_cygwin_shortcut
1853 } elseif {[is_Windows]} {
1854 .mbar.repository add command \
1855 -label [mc "Create Desktop Icon"] \
1856 -command do_windows_shortcut
1857 } elseif {[is_MacOSX]} {
1858 .mbar.repository add command \
1859 -label [mc "Create Desktop Icon"] \
1860 -command do_macosx_app
1861 }
1862}
1863
1864.mbar.repository add command -label [mc Quit] \
1865 -command do_quit \
1866 -accelerator $M1T-Q
1867
1868# -- Edit Menu
1869#
1870menu .mbar.edit
1871.mbar.edit add command -label [mc Undo] \
1872 -command {catch {[focus] edit undo}} \
1873 -accelerator $M1T-Z
1874.mbar.edit add command -label [mc Redo] \
1875 -command {catch {[focus] edit redo}} \
1876 -accelerator $M1T-Y
1877.mbar.edit add separator
1878.mbar.edit add command -label [mc Cut] \
1879 -command {catch {tk_textCut [focus]}} \
1880 -accelerator $M1T-X
1881.mbar.edit add command -label [mc Copy] \
1882 -command {catch {tk_textCopy [focus]}} \
1883 -accelerator $M1T-C
1884.mbar.edit add command -label [mc Paste] \
1885 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1886 -accelerator $M1T-V
1887.mbar.edit add command -label [mc Delete] \
1888 -command {catch {[focus] delete sel.first sel.last}} \
1889 -accelerator Del
1890.mbar.edit add separator
1891.mbar.edit add command -label [mc "Select All"] \
1892 -command {catch {[focus] tag add sel 0.0 end}} \
1893 -accelerator $M1T-A
1894
1895# -- Branch Menu
1896#
1897if {[is_enabled branch]} {
1898 menu .mbar.branch
1899
1900 .mbar.branch add command -label [mc "Create..."] \
1901 -command branch_create::dialog \
1902 -accelerator $M1T-N
1903 lappend disable_on_lock [list .mbar.branch entryconf \
1904 [.mbar.branch index last] -state]
1905
1906 .mbar.branch add command -label [mc "Checkout..."] \
1907 -command branch_checkout::dialog \
1908 -accelerator $M1T-O
1909 lappend disable_on_lock [list .mbar.branch entryconf \
1910 [.mbar.branch index last] -state]
1911
1912 .mbar.branch add command -label [mc "Rename..."] \
1913 -command branch_rename::dialog
1914 lappend disable_on_lock [list .mbar.branch entryconf \
1915 [.mbar.branch index last] -state]
1916
1917 .mbar.branch add command -label [mc "Delete..."] \
1918 -command branch_delete::dialog
1919 lappend disable_on_lock [list .mbar.branch entryconf \
1920 [.mbar.branch index last] -state]
1921
1922 .mbar.branch add command -label [mc "Reset..."] \
1923 -command merge::reset_hard
1924 lappend disable_on_lock [list .mbar.branch entryconf \
1925 [.mbar.branch index last] -state]
1926}
1927
1928# -- Commit Menu
1929#
1930if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1931 menu .mbar.commit
1932
1933 .mbar.commit add radiobutton \
1934 -label [mc "New Commit"] \
1935 -command do_select_commit_type \
1936 -variable selected_commit_type \
1937 -value new
1938 lappend disable_on_lock \
1939 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1940
1941 .mbar.commit add radiobutton \
1942 -label [mc "Amend Last Commit"] \
1943 -command do_select_commit_type \
1944 -variable selected_commit_type \
1945 -value amend
1946 lappend disable_on_lock \
1947 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1948
1949 .mbar.commit add separator
1950
1951 .mbar.commit add command -label [mc Rescan] \
1952 -command do_rescan \
1953 -accelerator F5
1954 lappend disable_on_lock \
1955 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1956
1957 .mbar.commit add command -label [mc "Stage To Commit"] \
1958 -command do_add_selection
1959 lappend disable_on_lock \
1960 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1961
1962 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1963 -command do_add_all \
1964 -accelerator $M1T-I
1965 lappend disable_on_lock \
1966 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1967
1968 .mbar.commit add command -label [mc "Unstage From Commit"] \
1969 -command do_unstage_selection
1970 lappend disable_on_lock \
1971 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1972
1973 .mbar.commit add command -label [mc "Revert Changes"] \
1974 -command do_revert_selection
1975 lappend disable_on_lock \
1976 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1977
1978 .mbar.commit add separator
1979
1980 .mbar.commit add command -label [mc "Sign Off"] \
1981 -command do_signoff \
1982 -accelerator $M1T-S
1983
1984 .mbar.commit add command -label [mc Commit@@verb] \
1985 -command do_commit \
1986 -accelerator $M1T-Return
1987 lappend disable_on_lock \
1988 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1989}
1990
1991# -- Merge Menu
1992#
1993if {[is_enabled branch]} {
1994 menu .mbar.merge
1995 .mbar.merge add command -label [mc "Local Merge..."] \
1996 -command merge::dialog \
1997 -accelerator $M1T-M
1998 lappend disable_on_lock \
1999 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2000 .mbar.merge add command -label [mc "Abort Merge..."] \
2001 -command merge::reset_hard
2002 lappend disable_on_lock \
2003 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2004}
2005
2006# -- Transport Menu
2007#
2008if {[is_enabled transport]} {
2009 menu .mbar.remote
2010
2011 .mbar.remote add command \
2012 -label [mc "Push..."] \
2013 -command do_push_anywhere \
2014 -accelerator $M1T-P
2015 .mbar.remote add command \
2016 -label [mc "Delete..."] \
2017 -command remote_branch_delete::dialog
2018}
2019
2020if {[is_MacOSX]} {
2021 # -- Apple Menu (Mac OS X only)
2022 #
2023 .mbar add cascade -label [mc Apple] -menu .mbar.apple
2024 menu .mbar.apple
2025
2026 .mbar.apple add command -label [mc "About %s" [appname]] \
2027 -command do_about
2028 .mbar.apple add separator
2029 .mbar.apple add command \
2030 -label [mc "Preferences..."] \
2031 -command do_options \
2032 -accelerator $M1T-,
2033 bind . <$M1B-,> do_options
2034} else {
2035 # -- Edit Menu
2036 #
2037 .mbar.edit add separator
2038 .mbar.edit add command -label [mc "Options..."] \
2039 -command do_options
2040}
2041
2042# -- Help Menu
2043#
2044.mbar add cascade -label [mc Help] -menu .mbar.help
2045menu .mbar.help
2046
2047if {![is_MacOSX]} {
2048 .mbar.help add command -label [mc "About %s" [appname]] \
2049 -command do_about
2050}
2051
2052set browser {}
2053catch {set browser $repo_config(instaweb.browser)}
2054set doc_path [file dirname [gitexec]]
2055set doc_path [file join $doc_path Documentation index.html]
2056
2057if {[is_Cygwin]} {
2058 set doc_path [exec cygpath --mixed $doc_path]
2059}
2060
2061if {$browser eq {}} {
2062 if {[is_MacOSX]} {
2063 set browser open
2064 } elseif {[is_Cygwin]} {
2065 set program_files [file dirname [exec cygpath --windir]]
2066 set program_files [file join $program_files {Program Files}]
2067 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2068 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2069 if {[file exists $firefox]} {
2070 set browser $firefox
2071 } elseif {[file exists $ie]} {
2072 set browser $ie
2073 }
2074 unset program_files firefox ie
2075 }
2076}
2077
2078if {[file isfile $doc_path]} {
2079 set doc_url "file:$doc_path"
2080} else {
2081 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2082}
2083
2084if {$browser ne {}} {
2085 .mbar.help add command -label [mc "Online Documentation"] \
2086 -command [list exec $browser $doc_url &]
2087}
2088unset browser doc_path doc_url
2089
2090# -- Standard bindings
2091#
2092wm protocol . WM_DELETE_WINDOW do_quit
2093bind all <$M1B-Key-q> do_quit
2094bind all <$M1B-Key-Q> do_quit
2095bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2096bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2097
2098set subcommand_args {}
2099proc usage {} {
2100 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2101 exit 1
2102}
2103
2104# -- Not a normal commit type invocation? Do that instead!
2105#
2106switch -- $subcommand {
2107browser -
2108blame {
2109 set subcommand_args {rev? path}
2110 if {$argv eq {}} usage
2111 set head {}
2112 set path {}
2113 set is_path 0
2114 foreach a $argv {
2115 if {$is_path || [file exists $_prefix$a]} {
2116 if {$path ne {}} usage
2117 set path $_prefix$a
2118 break
2119 } elseif {$a eq {--}} {
2120 if {$path ne {}} {
2121 if {$head ne {}} usage
2122 set head $path
2123 set path {}
2124 }
2125 set is_path 1
2126 } elseif {$head eq {}} {
2127 if {$head ne {}} usage
2128 set head $a
2129 set is_path 1
2130 } else {
2131 usage
2132 }
2133 }
2134 unset is_path
2135
2136 if {$head ne {} && $path eq {}} {
2137 set path $_prefix$head
2138 set head {}
2139 }
2140
2141 if {$head eq {}} {
2142 load_current_branch
2143 } else {
2144 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2145 if {[catch {
2146 set head [git rev-parse --verify $head]
2147 } err]} {
2148 puts stderr $err
2149 exit 1
2150 }
2151 }
2152 set current_branch $head
2153 }
2154
2155 switch -- $subcommand {
2156 browser {
2157 if {$head eq {}} {
2158 if {$path ne {} && [file isdirectory $path]} {
2159 set head $current_branch
2160 } else {
2161 set head $path
2162 set path {}
2163 }
2164 }
2165 browser::new $head $path
2166 }
2167 blame {
2168 if {$head eq {} && ![file exists $path]} {
2169 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2170 exit 1
2171 }
2172 blame::new $head $path
2173 }
2174 }
2175 return
2176}
2177citool -
2178gui {
2179 if {[llength $argv] != 0} {
2180 puts -nonewline stderr "usage: $argv0"
2181 if {$subcommand ne {gui}
2182 && [file tail $argv0] ne "git-$subcommand"} {
2183 puts -nonewline stderr " $subcommand"
2184 }
2185 puts stderr {}
2186 exit 1
2187 }
2188 # fall through to setup UI for commits
2189}
2190default {
2191 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2192 exit 1
2193}
2194}
2195
2196# -- Branch Control
2197#
2198frame .branch \
2199 -borderwidth 1 \
2200 -relief sunken
2201label .branch.l1 \
2202 -text [mc "Current Branch:"] \
2203 -anchor w \
2204 -justify left
2205label .branch.cb \
2206 -textvariable current_branch \
2207 -anchor w \
2208 -justify left
2209pack .branch.l1 -side left
2210pack .branch.cb -side left -fill x
2211pack .branch -side top -fill x
2212
2213# -- Main Window Layout
2214#
2215panedwindow .vpane -orient horizontal
2216panedwindow .vpane.files -orient vertical
2217.vpane add .vpane.files -sticky nsew -height 100 -width 200
2218pack .vpane -anchor n -side top -fill both -expand 1
2219
2220# -- Index File List
2221#
2222frame .vpane.files.index -height 100 -width 200
2223label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2224 -background lightgreen
2225text $ui_index -background white -borderwidth 0 \
2226 -width 20 -height 10 \
2227 -wrap none \
2228 -cursor $cursor_ptr \
2229 -xscrollcommand {.vpane.files.index.sx set} \
2230 -yscrollcommand {.vpane.files.index.sy set} \
2231 -state disabled
2232scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2233scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2234pack .vpane.files.index.title -side top -fill x
2235pack .vpane.files.index.sx -side bottom -fill x
2236pack .vpane.files.index.sy -side right -fill y
2237pack $ui_index -side left -fill both -expand 1
2238
2239# -- Working Directory File List
2240#
2241frame .vpane.files.workdir -height 100 -width 200
2242label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2243 -background lightsalmon
2244text $ui_workdir -background white -borderwidth 0 \
2245 -width 20 -height 10 \
2246 -wrap none \
2247 -cursor $cursor_ptr \
2248 -xscrollcommand {.vpane.files.workdir.sx set} \
2249 -yscrollcommand {.vpane.files.workdir.sy set} \
2250 -state disabled
2251scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2252scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2253pack .vpane.files.workdir.title -side top -fill x
2254pack .vpane.files.workdir.sx -side bottom -fill x
2255pack .vpane.files.workdir.sy -side right -fill y
2256pack $ui_workdir -side left -fill both -expand 1
2257
2258.vpane.files add .vpane.files.workdir -sticky nsew
2259.vpane.files add .vpane.files.index -sticky nsew
2260
2261foreach i [list $ui_index $ui_workdir] {
2262 rmsel_tag $i
2263 $i tag conf in_diff -background [$i tag cget in_sel -background]
2264}
2265unset i
2266
2267# -- Diff and Commit Area
2268#
2269frame .vpane.lower -height 300 -width 400
2270frame .vpane.lower.commarea
2271frame .vpane.lower.diff -relief sunken -borderwidth 1
2272pack .vpane.lower.diff -fill both -expand 1
2273pack .vpane.lower.commarea -side bottom -fill x
2274.vpane add .vpane.lower -sticky nsew
2275
2276# -- Commit Area Buttons
2277#
2278frame .vpane.lower.commarea.buttons
2279label .vpane.lower.commarea.buttons.l -text {} \
2280 -anchor w \
2281 -justify left
2282pack .vpane.lower.commarea.buttons.l -side top -fill x
2283pack .vpane.lower.commarea.buttons -side left -fill y
2284
2285button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2286 -command do_rescan
2287pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2288lappend disable_on_lock \
2289 {.vpane.lower.commarea.buttons.rescan conf -state}
2290
2291button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2292 -command do_add_all
2293pack .vpane.lower.commarea.buttons.incall -side top -fill x
2294lappend disable_on_lock \
2295 {.vpane.lower.commarea.buttons.incall conf -state}
2296
2297button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2298 -command do_signoff
2299pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2300
2301button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2302 -command do_commit
2303pack .vpane.lower.commarea.buttons.commit -side top -fill x
2304lappend disable_on_lock \
2305 {.vpane.lower.commarea.buttons.commit conf -state}
2306
2307button .vpane.lower.commarea.buttons.push -text [mc Push] \
2308 -command do_push_anywhere
2309pack .vpane.lower.commarea.buttons.push -side top -fill x
2310
2311# -- Commit Message Buffer
2312#
2313frame .vpane.lower.commarea.buffer
2314frame .vpane.lower.commarea.buffer.header
2315set ui_comm .vpane.lower.commarea.buffer.t
2316set ui_coml .vpane.lower.commarea.buffer.header.l
2317radiobutton .vpane.lower.commarea.buffer.header.new \
2318 -text [mc "New Commit"] \
2319 -command do_select_commit_type \
2320 -variable selected_commit_type \
2321 -value new
2322lappend disable_on_lock \
2323 [list .vpane.lower.commarea.buffer.header.new conf -state]
2324radiobutton .vpane.lower.commarea.buffer.header.amend \
2325 -text [mc "Amend Last Commit"] \
2326 -command do_select_commit_type \
2327 -variable selected_commit_type \
2328 -value amend
2329lappend disable_on_lock \
2330 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2331label $ui_coml \
2332 -anchor w \
2333 -justify left
2334proc trace_commit_type {varname args} {
2335 global ui_coml commit_type
2336 switch -glob -- $commit_type {
2337 initial {set txt [mc "Initial Commit Message:"]}
2338 amend {set txt [mc "Amended Commit Message:"]}
2339 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2340 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2341 merge {set txt [mc "Merge Commit Message:"]}
2342 * {set txt [mc "Commit Message:"]}
2343 }
2344 $ui_coml conf -text $txt
2345}
2346trace add variable commit_type write trace_commit_type
2347pack $ui_coml -side left -fill x
2348pack .vpane.lower.commarea.buffer.header.amend -side right
2349pack .vpane.lower.commarea.buffer.header.new -side right
2350
2351text $ui_comm -background white -borderwidth 1 \
2352 -undo true \
2353 -maxundo 20 \
2354 -autoseparators true \
2355 -relief sunken \
2356 -width 75 -height 9 -wrap none \
2357 -font font_diff \
2358 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2359scrollbar .vpane.lower.commarea.buffer.sby \
2360 -command [list $ui_comm yview]
2361pack .vpane.lower.commarea.buffer.header -side top -fill x
2362pack .vpane.lower.commarea.buffer.sby -side right -fill y
2363pack $ui_comm -side left -fill y
2364pack .vpane.lower.commarea.buffer -side left -fill y
2365
2366# -- Commit Message Buffer Context Menu
2367#
2368set ctxm .vpane.lower.commarea.buffer.ctxm
2369menu $ctxm -tearoff 0
2370$ctxm add command \
2371 -label [mc Cut] \
2372 -command {tk_textCut $ui_comm}
2373$ctxm add command \
2374 -label [mc Copy] \
2375 -command {tk_textCopy $ui_comm}
2376$ctxm add command \
2377 -label [mc Paste] \
2378 -command {tk_textPaste $ui_comm}
2379$ctxm add command \
2380 -label [mc Delete] \
2381 -command {$ui_comm delete sel.first sel.last}
2382$ctxm add separator
2383$ctxm add command \
2384 -label [mc "Select All"] \
2385 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2386$ctxm add command \
2387 -label [mc "Copy All"] \
2388 -command {
2389 $ui_comm tag add sel 0.0 end
2390 tk_textCopy $ui_comm
2391 $ui_comm tag remove sel 0.0 end
2392 }
2393$ctxm add separator
2394$ctxm add command \
2395 -label [mc "Sign Off"] \
2396 -command do_signoff
2397bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2398
2399# -- Diff Header
2400#
2401proc trace_current_diff_path {varname args} {
2402 global current_diff_path diff_actions file_states
2403 if {$current_diff_path eq {}} {
2404 set s {}
2405 set f {}
2406 set p {}
2407 set o disabled
2408 } else {
2409 set p $current_diff_path
2410 set s [mapdesc [lindex $file_states($p) 0] $p]
2411 set f [mc "File:"]
2412 set p [escape_path $p]
2413 set o normal
2414 }
2415
2416 .vpane.lower.diff.header.status configure -text $s
2417 .vpane.lower.diff.header.file configure -text $f
2418 .vpane.lower.diff.header.path configure -text $p
2419 foreach w $diff_actions {
2420 uplevel #0 $w $o
2421 }
2422}
2423trace add variable current_diff_path write trace_current_diff_path
2424
2425frame .vpane.lower.diff.header -background gold
2426label .vpane.lower.diff.header.status \
2427 -background gold \
2428 -width $max_status_desc \
2429 -anchor w \
2430 -justify left
2431label .vpane.lower.diff.header.file \
2432 -background gold \
2433 -anchor w \
2434 -justify left
2435label .vpane.lower.diff.header.path \
2436 -background gold \
2437 -anchor w \
2438 -justify left
2439pack .vpane.lower.diff.header.status -side left
2440pack .vpane.lower.diff.header.file -side left
2441pack .vpane.lower.diff.header.path -fill x
2442set ctxm .vpane.lower.diff.header.ctxm
2443menu $ctxm -tearoff 0
2444$ctxm add command \
2445 -label [mc Copy] \
2446 -command {
2447 clipboard clear
2448 clipboard append \
2449 -format STRING \
2450 -type STRING \
2451 -- $current_diff_path
2452 }
2453lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2454bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2455
2456# -- Diff Body
2457#
2458frame .vpane.lower.diff.body
2459set ui_diff .vpane.lower.diff.body.t
2460text $ui_diff -background white -borderwidth 0 \
2461 -width 80 -height 15 -wrap none \
2462 -font font_diff \
2463 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2464 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2465 -state disabled
2466scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2467 -command [list $ui_diff xview]
2468scrollbar .vpane.lower.diff.body.sby -orient vertical \
2469 -command [list $ui_diff yview]
2470pack .vpane.lower.diff.body.sbx -side bottom -fill x
2471pack .vpane.lower.diff.body.sby -side right -fill y
2472pack $ui_diff -side left -fill both -expand 1
2473pack .vpane.lower.diff.header -side top -fill x
2474pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2475
2476$ui_diff tag conf d_cr -elide true
2477$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2478$ui_diff tag conf d_+ -foreground {#00a000}
2479$ui_diff tag conf d_- -foreground red
2480
2481$ui_diff tag conf d_++ -foreground {#00a000}
2482$ui_diff tag conf d_-- -foreground red
2483$ui_diff tag conf d_+s \
2484 -foreground {#00a000} \
2485 -background {#e2effa}
2486$ui_diff tag conf d_-s \
2487 -foreground red \
2488 -background {#e2effa}
2489$ui_diff tag conf d_s+ \
2490 -foreground {#00a000} \
2491 -background ivory1
2492$ui_diff tag conf d_s- \
2493 -foreground red \
2494 -background ivory1
2495
2496$ui_diff tag conf d<<<<<<< \
2497 -foreground orange \
2498 -font font_diffbold
2499$ui_diff tag conf d======= \
2500 -foreground orange \
2501 -font font_diffbold
2502$ui_diff tag conf d>>>>>>> \
2503 -foreground orange \
2504 -font font_diffbold
2505
2506$ui_diff tag raise sel
2507
2508# -- Diff Body Context Menu
2509#
2510set ctxm .vpane.lower.diff.body.ctxm
2511menu $ctxm -tearoff 0
2512$ctxm add command \
2513 -label [mc Refresh] \
2514 -command reshow_diff
2515lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2516$ctxm add command \
2517 -label [mc Copy] \
2518 -command {tk_textCopy $ui_diff}
2519lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2520$ctxm add command \
2521 -label [mc "Select All"] \
2522 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2523lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2524$ctxm add command \
2525 -label [mc "Copy All"] \
2526 -command {
2527 $ui_diff tag add sel 0.0 end
2528 tk_textCopy $ui_diff
2529 $ui_diff tag remove sel 0.0 end
2530 }
2531lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2532$ctxm add separator
2533$ctxm add command \
2534 -label [mc "Apply/Reverse Hunk"] \
2535 -command {apply_hunk $cursorX $cursorY}
2536set ui_diff_applyhunk [$ctxm index last]
2537lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2538$ctxm add separator
2539$ctxm add command \
2540 -label [mc "Decrease Font Size"] \
2541 -command {incr_font_size font_diff -1}
2542lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2543$ctxm add command \
2544 -label [mc "Increase Font Size"] \
2545 -command {incr_font_size font_diff 1}
2546lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2547$ctxm add separator
2548$ctxm add command \
2549 -label [mc "Show Less Context"] \
2550 -command {if {$repo_config(gui.diffcontext) >= 1} {
2551 incr repo_config(gui.diffcontext) -1
2552 reshow_diff
2553 }}
2554lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2555$ctxm add command \
2556 -label [mc "Show More Context"] \
2557 -command {if {$repo_config(gui.diffcontext) < 99} {
2558 incr repo_config(gui.diffcontext)
2559 reshow_diff
2560 }}
2561lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2562$ctxm add separator
2563$ctxm add command -label [mc "Options..."] \
2564 -command do_options
2565proc popup_diff_menu {ctxm x y X Y} {
2566 global current_diff_path file_states
2567 set ::cursorX $x
2568 set ::cursorY $y
2569 if {$::ui_index eq $::current_diff_side} {
2570 set l [mc "Unstage Hunk From Commit"]
2571 } else {
2572 set l [mc "Stage Hunk For Commit"]
2573 }
2574 if {$::is_3way_diff
2575 || $current_diff_path eq {}
2576 || ![info exists file_states($current_diff_path)]
2577 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2578 set s disabled
2579 } else {
2580 set s normal
2581 }
2582 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2583 tk_popup $ctxm $X $Y
2584}
2585bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2586
2587# -- Status Bar
2588#
2589set main_status [::status_bar::new .status]
2590pack .status -anchor w -side bottom -fill x
2591$main_status show [mc "Initializing..."]
2592
2593# -- Load geometry
2594#
2595catch {
2596set gm $repo_config(gui.geometry)
2597wm geometry . [lindex $gm 0]
2598.vpane sash place 0 \
2599 [lindex $gm 1] \
2600 [lindex [.vpane sash coord 0] 1]
2601.vpane.files sash place 0 \
2602 [lindex [.vpane.files sash coord 0] 0] \
2603 [lindex $gm 2]
2604unset gm
2605}
2606
2607# -- Key Bindings
2608#
2609bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2610bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2611bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2612bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2613bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2614bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2615bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2616bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2617bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2618bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2619bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2620
2621bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2622bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2623bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2624bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2625bind $ui_diff <$M1B-Key-v> {break}
2626bind $ui_diff <$M1B-Key-V> {break}
2627bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2628bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2629bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2630bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2631bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2632bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2633bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2634bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2635bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2636bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2637bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2638bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2639bind $ui_diff <Button-1> {focus %W}
2640
2641if {[is_enabled branch]} {
2642 bind . <$M1B-Key-n> branch_create::dialog
2643 bind . <$M1B-Key-N> branch_create::dialog
2644 bind . <$M1B-Key-o> branch_checkout::dialog
2645 bind . <$M1B-Key-O> branch_checkout::dialog
2646 bind . <$M1B-Key-m> merge::dialog
2647 bind . <$M1B-Key-M> merge::dialog
2648}
2649if {[is_enabled transport]} {
2650 bind . <$M1B-Key-p> do_push_anywhere
2651 bind . <$M1B-Key-P> do_push_anywhere
2652}
2653
2654bind . <Key-F5> do_rescan
2655bind . <$M1B-Key-r> do_rescan
2656bind . <$M1B-Key-R> do_rescan
2657bind . <$M1B-Key-s> do_signoff
2658bind . <$M1B-Key-S> do_signoff
2659bind . <$M1B-Key-i> do_add_all
2660bind . <$M1B-Key-I> do_add_all
2661bind . <$M1B-Key-Return> do_commit
2662foreach i [list $ui_index $ui_workdir] {
2663 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2664 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2665 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2666}
2667unset i
2668
2669set file_lists($ui_index) [list]
2670set file_lists($ui_workdir) [list]
2671
2672wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2673focus -force $ui_comm
2674
2675# -- Warn the user about environmental problems. Cygwin's Tcl
2676# does *not* pass its env array onto any processes it spawns.
2677# This means that git processes get none of our environment.
2678#
2679if {[is_Cygwin]} {
2680 set ignored_env 0
2681 set suggest_user {}
2682 set msg [mc "Possible environment issues exist.
2683
2684The following environment variables are probably
2685going to be ignored by any Git subprocess run
2686by %s:
2687
2688" [appname]]
2689 foreach name [array names env] {
2690 switch -regexp -- $name {
2691 {^GIT_INDEX_FILE$} -
2692 {^GIT_OBJECT_DIRECTORY$} -
2693 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2694 {^GIT_DIFF_OPTS$} -
2695 {^GIT_EXTERNAL_DIFF$} -
2696 {^GIT_PAGER$} -
2697 {^GIT_TRACE$} -
2698 {^GIT_CONFIG$} -
2699 {^GIT_CONFIG_LOCAL$} -
2700 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2701 append msg " - $name\n"
2702 incr ignored_env
2703 }
2704 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2705 append msg " - $name\n"
2706 incr ignored_env
2707 set suggest_user $name
2708 }
2709 }
2710 }
2711 if {$ignored_env > 0} {
2712 append msg [mc "
2713This is due to a known issue with the
2714Tcl binary distributed by Cygwin."]
2715
2716 if {$suggest_user ne {}} {
2717 append msg [mc "
2718
2719A good replacement for %s
2720is placing values for the user.name and
2721user.email settings into your personal
2722~/.gitconfig file.
2723" $suggest_user]
2724 }
2725 warn_popup $msg
2726 }
2727 unset ignored_env msg suggest_user name
2728}
2729
2730# -- Only initialize complex UI if we are going to stay running.
2731#
2732if {[is_enabled transport]} {
2733 load_all_remotes
2734
2735 set n [.mbar.remote index end]
2736 populate_push_menu
2737 populate_fetch_menu
2738 set n [expr {[.mbar.remote index end] - $n}]
2739 if {$n > 0} {
2740 .mbar.remote insert $n separator
2741 }
2742 unset n
2743}
2744
2745if {[winfo exists $ui_comm]} {
2746 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2747
2748 # -- If both our backup and message files exist use the
2749 # newer of the two files to initialize the buffer.
2750 #
2751 if {$GITGUI_BCK_exists} {
2752 set m [gitdir GITGUI_MSG]
2753 if {[file isfile $m]} {
2754 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2755 catch {file delete [gitdir GITGUI_MSG]}
2756 } else {
2757 $ui_comm delete 0.0 end
2758 $ui_comm edit reset
2759 $ui_comm edit modified false
2760 catch {file delete [gitdir GITGUI_BCK]}
2761 set GITGUI_BCK_exists 0
2762 }
2763 }
2764 unset m
2765 }
2766
2767 proc backup_commit_buffer {} {
2768 global ui_comm GITGUI_BCK_exists
2769
2770 set m [$ui_comm edit modified]
2771 if {$m || $GITGUI_BCK_exists} {
2772 set msg [string trim [$ui_comm get 0.0 end]]
2773 regsub -all -line {[ \r\t]+$} $msg {} msg
2774
2775 if {$msg eq {}} {
2776 if {$GITGUI_BCK_exists} {
2777 catch {file delete [gitdir GITGUI_BCK]}
2778 set GITGUI_BCK_exists 0
2779 }
2780 } elseif {$m} {
2781 catch {
2782 set fd [open [gitdir GITGUI_BCK] w]
2783 puts -nonewline $fd $msg
2784 close $fd
2785 set GITGUI_BCK_exists 1
2786 }
2787 }
2788
2789 $ui_comm edit modified false
2790 }
2791
2792 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2793 }
2794
2795 backup_commit_buffer
2796}
2797
2798lock_index begin-read
2799if {![winfo ismapped .]} {
2800 wm deiconify .
2801}
2802after 1 do_rescan
2803if {[is_enabled multicommit]} {
2804 after 1000 hint_gc
2805}