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