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