Code

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