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