Code

git-gui: Let the user continue even if we cannot understand git version
[git.git] / git-gui.sh
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3  if test "z$*" = zversion \
4  || test "z$*" = z--version; \
5  then \
6         echo 'git-gui version @@GITGUI_VERSION@@'; \
7         exit; \
8  fi; \
9  exec wish "$0" -- "$@"
11 set appvers {@@GITGUI_VERSION@@}
12 set copyright {
13 Copyright © 2006, 2007 Shawn Pearce, et. al.
15 This program is free software; you can redistribute it and/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation; either version 2 of the License, or
18 (at your option) any later version.
20 This program is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23 GNU General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
29 ######################################################################
30 ##
31 ## Tcl/Tk sanity check
33 if {[catch {package require Tcl 8.4} err]
34  || [catch {package require Tk  8.4} err]
35 } {
36         catch {wm withdraw .}
37         tk_messageBox \
38                 -icon error \
39                 -type ok \
40                 -title "git-gui: fatal error" \
41                 -message $err
42         exit 1
43 }
45 ######################################################################
46 ##
47 ## enable verbose loading?
49 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
50         unset _verbose
51         rename auto_load real__auto_load
52         proc auto_load {name args} {
53                 puts stderr "auto_load $name"
54                 return [uplevel 1 real__auto_load $name $args]
55         }
56         rename source real__source
57         proc source {name} {
58                 puts stderr "source    $name"
59                 uplevel 1 real__source $name
60         }
61 }
63 ######################################################################
64 ##
65 ## configure our library
67 set oguilib {@@GITGUI_LIBDIR@@}
68 set oguirel {@@GITGUI_RELATIVE@@}
69 if {$oguirel eq {1}} {
70         set oguilib [file dirname [file dirname [file normalize $argv0]]]
71         set oguilib [file join $oguilib share git-gui lib]
72 } elseif {[string match @@* $oguirel]} {
73         set oguilib [file join [file dirname [file normalize $argv0]] lib]
74 }
76 set idx [file join $oguilib tclIndex]
77 if {[catch {set fd [open $idx r]} err]} {
78         catch {wm withdraw .}
79         tk_messageBox \
80                 -icon error \
81                 -type ok \
82                 -title "git-gui: fatal error" \
83                 -message $err
84         exit 1
85 }
86 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
87         set idx [list]
88         while {[gets $fd n] >= 0} {
89                 if {$n ne {} && ![string match #* $n]} {
90                         lappend idx $n
91                 }
92         }
93 } else {
94         set idx {}
95 }
96 close $fd
98 if {$idx ne {}} {
99         set loaded [list]
100         foreach p $idx {
101                 if {[lsearch -exact $loaded $p] >= 0} continue
102                 source [file join $oguilib $p]
103                 lappend loaded $p
104         }
105         unset loaded p
106 } else {
107         set auto_path [concat [list $oguilib] $auto_path]
109 unset -nocomplain oguirel idx fd
111 ######################################################################
112 ##
113 ## read only globals
115 set _appname [lindex [file split $argv0] end]
116 set _gitdir {}
117 set _gitexec {}
118 set _reponame {}
119 set _iscygwin {}
120 set _search_path {}
122 proc appname {} {
123         global _appname
124         return $_appname
127 proc gitdir {args} {
128         global _gitdir
129         if {$args eq {}} {
130                 return $_gitdir
131         }
132         return [eval [list file join $_gitdir] $args]
135 proc gitexec {args} {
136         global _gitexec
137         if {$_gitexec eq {}} {
138                 if {[catch {set _gitexec [git --exec-path]} err]} {
139                         error "Git not installed?\n\n$err"
140                 }
141                 if {[is_Cygwin]} {
142                         set _gitexec [exec cygpath \
143                                 --windows \
144                                 --absolute \
145                                 $_gitexec]
146                 } else {
147                         set _gitexec [file normalize $_gitexec]
148                 }
149         }
150         if {$args eq {}} {
151                 return $_gitexec
152         }
153         return [eval [list file join $_gitexec] $args]
156 proc reponame {} {
157         global _reponame
158         return $_reponame
161 proc is_MacOSX {} {
162         global tcl_platform tk_library
163         if {[tk windowingsystem] eq {aqua}} {
164                 return 1
165         }
166         return 0
169 proc is_Windows {} {
170         global tcl_platform
171         if {$tcl_platform(platform) eq {windows}} {
172                 return 1
173         }
174         return 0
177 proc is_Cygwin {} {
178         global tcl_platform _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         remote.*.fetch -
216         remote.*.push
217                 {return 1}
218         *
219                 {return 0}
220         }
223 proc is_config_true {name} {
224         global repo_config
225         if {[catch {set v $repo_config($name)}]} {
226                 return 0
227         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
228                 return 1
229         } else {
230                 return 0
231         }
234 proc get_config {name} {
235         global repo_config
236         if {[catch {set v $repo_config($name)}]} {
237                 return {}
238         } else {
239                 return $v
240         }
243 proc load_config {include_global} {
244         global repo_config global_config default_config
246         array unset global_config
247         if {$include_global} {
248                 catch {
249                         set fd_rc [git_read config --global --list]
250                         while {[gets $fd_rc line] >= 0} {
251                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
252                                         if {[is_many_config $name]} {
253                                                 lappend global_config($name) $value
254                                         } else {
255                                                 set global_config($name) $value
256                                         }
257                                 }
258                         }
259                         close $fd_rc
260                 }
261         }
263         array unset repo_config
264         catch {
265                 set fd_rc [git_read config --list]
266                 while {[gets $fd_rc line] >= 0} {
267                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
268                                 if {[is_many_config $name]} {
269                                         lappend repo_config($name) $value
270                                 } else {
271                                         set repo_config($name) $value
272                                 }
273                         }
274                 }
275                 close $fd_rc
276         }
278         foreach name [array names default_config] {
279                 if {[catch {set v $global_config($name)}]} {
280                         set global_config($name) $default_config($name)
281                 }
282                 if {[catch {set v $repo_config($name)}]} {
283                         set repo_config($name) $default_config($name)
284                 }
285         }
288 ######################################################################
289 ##
290 ## handy utils
292 proc _git_cmd {name} {
293         global _git_cmd_path
295         if {[catch {set v $_git_cmd_path($name)}]} {
296                 switch -- $name {
297                   version   -
298                 --version   -
299                 --exec-path { return [list $::_git $name] }
300                 }
302                 set p [gitexec git-$name$::_search_exe]
303                 if {[file exists $p]} {
304                         set v [list $p]
305                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
306                         # Try to determine what sort of magic will make
307                         # git-$name go and do its thing, because native
308                         # Tcl on Windows doesn't know it.
309                         #
310                         set p [gitexec git-$name]
311                         set f [open $p r]
312                         set s [gets $f]
313                         close $f
315                         switch -glob -- $s {
316                         #!*sh     { set i sh     }
317                         #!*perl   { set i perl   }
318                         #!*python { set i python }
319                         default   { error "git-$name is not supported: $s" }
320                         }
322                         upvar #0 _$i interp
323                         if {![info exists interp]} {
324                                 set interp [_which $i]
325                         }
326                         if {$interp eq {}} {
327                                 error "git-$name requires $i (not in PATH)"
328                         }
329                         set v [list $interp $p]
330                 } else {
331                         # Assume it is builtin to git somehow and we
332                         # aren't actually able to see a file for it.
333                         #
334                         set v [list $::_git $name]
335                 }
336                 set _git_cmd_path($name) $v
337         }
338         return $v
341 proc _which {what} {
342         global env _search_exe _search_path
344         if {$_search_path eq {}} {
345                 if {[is_Cygwin]} {
346                         set _search_path [split [exec cygpath \
347                                 --windows \
348                                 --path \
349                                 --absolute \
350                                 $env(PATH)] {;}]
351                         set _search_exe .exe
352                 } elseif {[is_Windows]} {
353                         set _search_path [split $env(PATH) {;}]
354                         set _search_exe .exe
355                 } else {
356                         set _search_path [split $env(PATH) :]
357                         set _search_exe {}
358                 }
359         }
361         foreach p $_search_path {
362                 set p [file join $p $what$_search_exe]
363                 if {[file exists $p]} {
364                         return [file normalize $p]
365                 }
366         }
367         return {}
370 proc _lappend_nice {cmd_var} {
371         global _nice
372         upvar $cmd_var cmd
374         if {![info exists _nice]} {
375                 set _nice [_which nice]
376         }
377         if {$_nice ne {}} {
378                 lappend cmd $_nice
379         }
382 proc git {args} {
383         set opt [list exec]
385         while {1} {
386                 switch -- [lindex $args 0] {
387                 --nice {
388                         _lappend_nice opt
389                 }
391                 default {
392                         break
393                 }
395                 }
397                 set args [lrange $args 1 end]
398         }
400         set cmdp [_git_cmd [lindex $args 0]]
401         set args [lrange $args 1 end]
403         return [eval $opt $cmdp $args]
406 proc _open_stdout_stderr {cmd} {
407         if {[catch {
408                         set fd [open $cmd r]
409                 } err]} {
410                 if {   [lindex $cmd end] eq {2>@1}
411                     && $err eq {can not find channel named "1"}
412                         } {
413                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
414                         # redirect operator.  Fallback to |& cat for those.
415                         # The command was not actually started, so its safe
416                         # to try to start it a second time.
417                         #
418                         set fd [open [concat \
419                                 [lrange $cmd 0 end-1] \
420                                 [list |& cat] \
421                                 ] r]
422                 } else {
423                         error $err
424                 }
425         }
426         fconfigure $fd -eofchar {}
427         return $fd
430 proc git_read {args} {
431         set opt [list |]
433         while {1} {
434                 switch -- [lindex $args 0] {
435                 --nice {
436                         _lappend_nice opt
437                 }
439                 --stderr {
440                         lappend args 2>@1
441                 }
443                 default {
444                         break
445                 }
447                 }
449                 set args [lrange $args 1 end]
450         }
452         set cmdp [_git_cmd [lindex $args 0]]
453         set args [lrange $args 1 end]
455         return [_open_stdout_stderr [concat $opt $cmdp $args]]
458 proc git_write {args} {
459         set opt [list |]
461         while {1} {
462                 switch -- [lindex $args 0] {
463                 --nice {
464                         _lappend_nice opt
465                 }
467                 default {
468                         break
469                 }
471                 }
473                 set args [lrange $args 1 end]
474         }
476         set cmdp [_git_cmd [lindex $args 0]]
477         set args [lrange $args 1 end]
479         return [open [concat $opt $cmdp $args] w]
482 proc sq {value} {
483         regsub -all ' $value "'\\''" value
484         return "'$value'"
487 proc load_current_branch {} {
488         global current_branch is_detached
490         set fd [open [gitdir HEAD] r]
491         if {[gets $fd ref] < 1} {
492                 set ref {}
493         }
494         close $fd
496         set pfx {ref: refs/heads/}
497         set len [string length $pfx]
498         if {[string equal -length $len $pfx $ref]} {
499                 # We're on a branch.  It might not exist.  But
500                 # HEAD looks good enough to be a branch.
501                 #
502                 set current_branch [string range $ref $len end]
503                 set is_detached 0
504         } else {
505                 # Assume this is a detached head.
506                 #
507                 set current_branch HEAD
508                 set is_detached 1
509         }
512 auto_load tk_optionMenu
513 rename tk_optionMenu real__tkOptionMenu
514 proc tk_optionMenu {w varName args} {
515         set m [eval real__tkOptionMenu $w $varName $args]
516         $m configure -font font_ui
517         $w configure -font font_ui
518         return $m
521 ######################################################################
522 ##
523 ## find git
525 set _git  [_which git]
526 if {$_git eq {}} {
527         catch {wm withdraw .}
528         error_popup "Cannot find git in PATH."
529         exit 1
532 ######################################################################
533 ##
534 ## version check
536 if {[catch {set _git_version [git --version]} err]} {
537         catch {wm withdraw .}
538         error_popup "Cannot determine Git version:
540 $err
542 [appname] requires Git 1.5.0 or later."
543         exit 1
545 if {![regsub {^git version } $_git_version {} _git_version]} {
546         catch {wm withdraw .}
547         error_popup "Cannot parse Git version string:\n\n$_git_version"
548         exit 1
551 set _real_git_version $_git_version
552 regsub -- {-dirty$} $_git_version {} _git_version
553 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
554 regsub {\.rc[0-9]+$} $_git_version {} _git_version
555 regsub {\.GIT$} $_git_version {} _git_version
557 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
558         catch {wm withdraw .}
559         if {[tk_messageBox \
560                 -icon warning \
561                 -type yesno \
562                 -default no \
563                 -title "[appname]: warning" \
564                 -message "Git version cannot be determined.
566 $_git claims it is version '$_real_git_version'.
568 [appname] requires at least Git 1.5.0 or later.
570 Assume '$_real_git_version' is version 1.5.0?
571 "] eq {yes}} {
572                 set _git_version 1.5.0
573         } else {
574                 exit 1
575         }
577 unset _real_git_version
579 proc git-version {args} {
580         global _git_version
582         switch [llength $args] {
583         0 {
584                 return $_git_version
585         }
587         2 {
588                 set op [lindex $args 0]
589                 set vr [lindex $args 1]
590                 set cm [package vcompare $_git_version $vr]
591                 return [expr $cm $op 0]
592         }
594         4 {
595                 set type [lindex $args 0]
596                 set name [lindex $args 1]
597                 set parm [lindex $args 2]
598                 set body [lindex $args 3]
600                 if {($type ne {proc} && $type ne {method})} {
601                         error "Invalid arguments to git-version"
602                 }
603                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
604                         error "Last arm of $type $name must be default"
605                 }
607                 foreach {op vr cb} [lrange $body 0 end-2] {
608                         if {[git-version $op $vr]} {
609                                 return [uplevel [list $type $name $parm $cb]]
610                         }
611                 }
613                 return [uplevel [list $type $name $parm [lindex $body end]]]
614         }
616         default {
617                 error "git-version >= x"
618         }
620         }
623 if {[git-version < 1.5]} {
624         catch {wm withdraw .}
625         error_popup "[appname] requires Git 1.5.0 or later.
627 You are using [git-version]:
629 [git --version]"
630         exit 1
633 ######################################################################
634 ##
635 ## repository setup
637 if {[catch {
638                 set _gitdir $env(GIT_DIR)
639                 set _prefix {}
640                 }]
641         && [catch {
642                 set _gitdir [git rev-parse --git-dir]
643                 set _prefix [git rev-parse --show-prefix]
644         } err]} {
645         catch {wm withdraw .}
646         error_popup "Cannot find the git directory:\n\n$err"
647         exit 1
649 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
650         catch {set _gitdir [exec cygpath --unix $_gitdir]}
652 if {![file isdirectory $_gitdir]} {
653         catch {wm withdraw .}
654         error_popup "Git directory not found:\n\n$_gitdir"
655         exit 1
657 if {[lindex [file split $_gitdir] end] ne {.git}} {
658         catch {wm withdraw .}
659         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
660         exit 1
662 if {[catch {cd [file dirname $_gitdir]} err]} {
663         catch {wm withdraw .}
664         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
665         exit 1
667 set _reponame [lindex [file split \
668         [file normalize [file dirname $_gitdir]]] \
669         end]
671 ######################################################################
672 ##
673 ## global init
675 set current_diff_path {}
676 set current_diff_side {}
677 set diff_actions [list]
679 set HEAD {}
680 set PARENT {}
681 set MERGE_HEAD [list]
682 set commit_type {}
683 set empty_tree {}
684 set current_branch {}
685 set is_detached 0
686 set current_diff_path {}
687 set selected_commit_type new
689 ######################################################################
690 ##
691 ## task management
693 set rescan_active 0
694 set diff_active 0
695 set last_clicked {}
697 set disable_on_lock [list]
698 set index_lock_type none
700 proc lock_index {type} {
701         global index_lock_type disable_on_lock
703         if {$index_lock_type eq {none}} {
704                 set index_lock_type $type
705                 foreach w $disable_on_lock {
706                         uplevel #0 $w disabled
707                 }
708                 return 1
709         } elseif {$index_lock_type eq "begin-$type"} {
710                 set index_lock_type $type
711                 return 1
712         }
713         return 0
716 proc unlock_index {} {
717         global index_lock_type disable_on_lock
719         set index_lock_type none
720         foreach w $disable_on_lock {
721                 uplevel #0 $w normal
722         }
725 ######################################################################
726 ##
727 ## status
729 proc repository_state {ctvar hdvar mhvar} {
730         global current_branch
731         upvar $ctvar ct $hdvar hd $mhvar mh
733         set mh [list]
735         load_current_branch
736         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
737                 set hd {}
738                 set ct initial
739                 return
740         }
742         set merge_head [gitdir MERGE_HEAD]
743         if {[file exists $merge_head]} {
744                 set ct merge
745                 set fd_mh [open $merge_head r]
746                 while {[gets $fd_mh line] >= 0} {
747                         lappend mh $line
748                 }
749                 close $fd_mh
750                 return
751         }
753         set ct normal
756 proc PARENT {} {
757         global PARENT empty_tree
759         set p [lindex $PARENT 0]
760         if {$p ne {}} {
761                 return $p
762         }
763         if {$empty_tree eq {}} {
764                 set empty_tree [git mktree << {}]
765         }
766         return $empty_tree
769 proc rescan {after {honor_trustmtime 1}} {
770         global HEAD PARENT MERGE_HEAD commit_type
771         global ui_index ui_workdir ui_comm
772         global rescan_active file_states
773         global repo_config
775         if {$rescan_active > 0 || ![lock_index read]} return
777         repository_state newType newHEAD newMERGE_HEAD
778         if {[string match amend* $commit_type]
779                 && $newType eq {normal}
780                 && $newHEAD eq $HEAD} {
781         } else {
782                 set HEAD $newHEAD
783                 set PARENT $newHEAD
784                 set MERGE_HEAD $newMERGE_HEAD
785                 set commit_type $newType
786         }
788         array unset file_states
790         if {![$ui_comm edit modified]
791                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
792                 if {[string match amend* $commit_type]} {
793                 } elseif {[load_message GITGUI_MSG]} {
794                 } elseif {[load_message MERGE_MSG]} {
795                 } elseif {[load_message SQUASH_MSG]} {
796                 }
797                 $ui_comm edit reset
798                 $ui_comm edit modified false
799         }
801         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
802                 rescan_stage2 {} $after
803         } else {
804                 set rescan_active 1
805                 ui_status {Refreshing file status...}
806                 set fd_rf [git_read update-index \
807                         -q \
808                         --unmerged \
809                         --ignore-missing \
810                         --refresh \
811                         ]
812                 fconfigure $fd_rf -blocking 0 -translation binary
813                 fileevent $fd_rf readable \
814                         [list rescan_stage2 $fd_rf $after]
815         }
818 proc rescan_stage2 {fd after} {
819         global rescan_active buf_rdi buf_rdf buf_rlo
821         if {$fd ne {}} {
822                 read $fd
823                 if {![eof $fd]} return
824                 close $fd
825         }
827         set ls_others [list --exclude-per-directory=.gitignore]
828         set info_exclude [gitdir info exclude]
829         if {[file readable $info_exclude]} {
830                 lappend ls_others "--exclude-from=$info_exclude"
831         }
833         set buf_rdi {}
834         set buf_rdf {}
835         set buf_rlo {}
837         set rescan_active 3
838         ui_status {Scanning for modified files ...}
839         set fd_di [git_read diff-index --cached -z [PARENT]]
840         set fd_df [git_read diff-files -z]
841         set fd_lo [eval git_read ls-files --others -z $ls_others]
843         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
844         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
845         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
846         fileevent $fd_di readable [list read_diff_index $fd_di $after]
847         fileevent $fd_df readable [list read_diff_files $fd_df $after]
848         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
851 proc load_message {file} {
852         global ui_comm
854         set f [gitdir $file]
855         if {[file isfile $f]} {
856                 if {[catch {set fd [open $f r]}]} {
857                         return 0
858                 }
859                 fconfigure $fd -eofchar {}
860                 set content [string trim [read $fd]]
861                 close $fd
862                 regsub -all -line {[ \r\t]+$} $content {} content
863                 $ui_comm delete 0.0 end
864                 $ui_comm insert end $content
865                 return 1
866         }
867         return 0
870 proc read_diff_index {fd after} {
871         global buf_rdi
873         append buf_rdi [read $fd]
874         set c 0
875         set n [string length $buf_rdi]
876         while {$c < $n} {
877                 set z1 [string first "\0" $buf_rdi $c]
878                 if {$z1 == -1} break
879                 incr z1
880                 set z2 [string first "\0" $buf_rdi $z1]
881                 if {$z2 == -1} break
883                 incr c
884                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
885                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
886                 merge_state \
887                         [encoding convertfrom $p] \
888                         [lindex $i 4]? \
889                         [list [lindex $i 0] [lindex $i 2]] \
890                         [list]
891                 set c $z2
892                 incr c
893         }
894         if {$c < $n} {
895                 set buf_rdi [string range $buf_rdi $c end]
896         } else {
897                 set buf_rdi {}
898         }
900         rescan_done $fd buf_rdi $after
903 proc read_diff_files {fd after} {
904         global buf_rdf
906         append buf_rdf [read $fd]
907         set c 0
908         set n [string length $buf_rdf]
909         while {$c < $n} {
910                 set z1 [string first "\0" $buf_rdf $c]
911                 if {$z1 == -1} break
912                 incr z1
913                 set z2 [string first "\0" $buf_rdf $z1]
914                 if {$z2 == -1} break
916                 incr c
917                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
918                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
919                 merge_state \
920                         [encoding convertfrom $p] \
921                         ?[lindex $i 4] \
922                         [list] \
923                         [list [lindex $i 0] [lindex $i 2]]
924                 set c $z2
925                 incr c
926         }
927         if {$c < $n} {
928                 set buf_rdf [string range $buf_rdf $c end]
929         } else {
930                 set buf_rdf {}
931         }
933         rescan_done $fd buf_rdf $after
936 proc read_ls_others {fd after} {
937         global buf_rlo
939         append buf_rlo [read $fd]
940         set pck [split $buf_rlo "\0"]
941         set buf_rlo [lindex $pck end]
942         foreach p [lrange $pck 0 end-1] {
943                 merge_state [encoding convertfrom $p] ?O
944         }
945         rescan_done $fd buf_rlo $after
948 proc rescan_done {fd buf after} {
949         global rescan_active current_diff_path
950         global file_states repo_config
951         upvar $buf to_clear
953         if {![eof $fd]} return
954         set to_clear {}
955         close $fd
956         if {[incr rescan_active -1] > 0} return
958         prune_selection
959         unlock_index
960         display_all_files
961         if {$current_diff_path ne {}} reshow_diff
962         uplevel #0 $after
965 proc prune_selection {} {
966         global file_states selected_paths
968         foreach path [array names selected_paths] {
969                 if {[catch {set still_here $file_states($path)}]} {
970                         unset selected_paths($path)
971                 }
972         }
975 ######################################################################
976 ##
977 ## ui helpers
979 proc mapicon {w state path} {
980         global all_icons
982         if {[catch {set r $all_icons($state$w)}]} {
983                 puts "error: no icon for $w state={$state} $path"
984                 return file_plain
985         }
986         return $r
989 proc mapdesc {state path} {
990         global all_descs
992         if {[catch {set r $all_descs($state)}]} {
993                 puts "error: no desc for state={$state} $path"
994                 return $state
995         }
996         return $r
999 proc ui_status {msg} {
1000         $::main_status show $msg
1003 proc ui_ready {{test {}}} {
1004         $::main_status show {Ready.} $test
1007 proc escape_path {path} {
1008         regsub -all {\\} $path "\\\\" path
1009         regsub -all "\n" $path "\\n" path
1010         return $path
1013 proc short_path {path} {
1014         return [escape_path [lindex [file split $path] end]]
1017 set next_icon_id 0
1018 set null_sha1 [string repeat 0 40]
1020 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1021         global file_states next_icon_id null_sha1
1023         set s0 [string index $new_state 0]
1024         set s1 [string index $new_state 1]
1026         if {[catch {set info $file_states($path)}]} {
1027                 set state __
1028                 set icon n[incr next_icon_id]
1029         } else {
1030                 set state [lindex $info 0]
1031                 set icon [lindex $info 1]
1032                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1033                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1034         }
1036         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1037         elseif {$s0 eq {_}} {set s0 _}
1039         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1040         elseif {$s1 eq {_}} {set s1 _}
1042         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1043                 set head_info [list 0 $null_sha1]
1044         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1045                 && $head_info eq {}} {
1046                 set head_info $index_info
1047         }
1049         set file_states($path) [list $s0$s1 $icon \
1050                 $head_info $index_info \
1051                 ]
1052         return $state
1055 proc display_file_helper {w path icon_name old_m new_m} {
1056         global file_lists
1058         if {$new_m eq {_}} {
1059                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1060                 if {$lno >= 0} {
1061                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1062                         incr lno
1063                         $w conf -state normal
1064                         $w delete $lno.0 [expr {$lno + 1}].0
1065                         $w conf -state disabled
1066                 }
1067         } elseif {$old_m eq {_} && $new_m ne {_}} {
1068                 lappend file_lists($w) $path
1069                 set file_lists($w) [lsort -unique $file_lists($w)]
1070                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1071                 incr lno
1072                 $w conf -state normal
1073                 $w image create $lno.0 \
1074                         -align center -padx 5 -pady 1 \
1075                         -name $icon_name \
1076                         -image [mapicon $w $new_m $path]
1077                 $w insert $lno.1 "[escape_path $path]\n"
1078                 $w conf -state disabled
1079         } elseif {$old_m ne $new_m} {
1080                 $w conf -state normal
1081                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1082                 $w conf -state disabled
1083         }
1086 proc display_file {path state} {
1087         global file_states selected_paths
1088         global ui_index ui_workdir
1090         set old_m [merge_state $path $state]
1091         set s $file_states($path)
1092         set new_m [lindex $s 0]
1093         set icon_name [lindex $s 1]
1095         set o [string index $old_m 0]
1096         set n [string index $new_m 0]
1097         if {$o eq {U}} {
1098                 set o _
1099         }
1100         if {$n eq {U}} {
1101                 set n _
1102         }
1103         display_file_helper     $ui_index $path $icon_name $o $n
1105         if {[string index $old_m 0] eq {U}} {
1106                 set o U
1107         } else {
1108                 set o [string index $old_m 1]
1109         }
1110         if {[string index $new_m 0] eq {U}} {
1111                 set n U
1112         } else {
1113                 set n [string index $new_m 1]
1114         }
1115         display_file_helper     $ui_workdir $path $icon_name $o $n
1117         if {$new_m eq {__}} {
1118                 unset file_states($path)
1119                 catch {unset selected_paths($path)}
1120         }
1123 proc display_all_files_helper {w path icon_name m} {
1124         global file_lists
1126         lappend file_lists($w) $path
1127         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1128         $w image create end \
1129                 -align center -padx 5 -pady 1 \
1130                 -name $icon_name \
1131                 -image [mapicon $w $m $path]
1132         $w insert end "[escape_path $path]\n"
1135 proc display_all_files {} {
1136         global ui_index ui_workdir
1137         global file_states file_lists
1138         global last_clicked
1140         $ui_index conf -state normal
1141         $ui_workdir conf -state normal
1143         $ui_index delete 0.0 end
1144         $ui_workdir delete 0.0 end
1145         set last_clicked {}
1147         set file_lists($ui_index) [list]
1148         set file_lists($ui_workdir) [list]
1150         foreach path [lsort [array names file_states]] {
1151                 set s $file_states($path)
1152                 set m [lindex $s 0]
1153                 set icon_name [lindex $s 1]
1155                 set s [string index $m 0]
1156                 if {$s ne {U} && $s ne {_}} {
1157                         display_all_files_helper $ui_index $path \
1158                                 $icon_name $s
1159                 }
1161                 if {[string index $m 0] eq {U}} {
1162                         set s U
1163                 } else {
1164                         set s [string index $m 1]
1165                 }
1166                 if {$s ne {_}} {
1167                         display_all_files_helper $ui_workdir $path \
1168                                 $icon_name $s
1169                 }
1170         }
1172         $ui_index conf -state disabled
1173         $ui_workdir conf -state disabled
1176 ######################################################################
1177 ##
1178 ## icons
1180 set filemask {
1181 #define mask_width 14
1182 #define mask_height 15
1183 static unsigned char mask_bits[] = {
1184    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1185    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1186    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1189 image create bitmap file_plain -background white -foreground black -data {
1190 #define plain_width 14
1191 #define plain_height 15
1192 static unsigned char plain_bits[] = {
1193    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1194    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1195    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1196 } -maskdata $filemask
1198 image create bitmap file_mod -background white -foreground blue -data {
1199 #define mod_width 14
1200 #define mod_height 15
1201 static unsigned char mod_bits[] = {
1202    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1203    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1204    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1205 } -maskdata $filemask
1207 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1208 #define file_fulltick_width 14
1209 #define file_fulltick_height 15
1210 static unsigned char file_fulltick_bits[] = {
1211    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1212    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1213    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1214 } -maskdata $filemask
1216 image create bitmap file_parttick -background white -foreground "#005050" -data {
1217 #define parttick_width 14
1218 #define parttick_height 15
1219 static unsigned char parttick_bits[] = {
1220    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1221    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1222    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1223 } -maskdata $filemask
1225 image create bitmap file_question -background white -foreground black -data {
1226 #define file_question_width 14
1227 #define file_question_height 15
1228 static unsigned char file_question_bits[] = {
1229    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1230    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1231    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1232 } -maskdata $filemask
1234 image create bitmap file_removed -background white -foreground red -data {
1235 #define file_removed_width 14
1236 #define file_removed_height 15
1237 static unsigned char file_removed_bits[] = {
1238    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1239    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1240    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1241 } -maskdata $filemask
1243 image create bitmap file_merge -background white -foreground blue -data {
1244 #define file_merge_width 14
1245 #define file_merge_height 15
1246 static unsigned char file_merge_bits[] = {
1247    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1248    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1249    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1250 } -maskdata $filemask
1252 set file_dir_data {
1253 #define file_width 18
1254 #define file_height 18
1255 static unsigned char file_bits[] = {
1256   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1257   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1258   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1259   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1260   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1262 image create bitmap file_dir -background white -foreground blue \
1263         -data $file_dir_data -maskdata $file_dir_data
1264 unset file_dir_data
1266 set file_uplevel_data {
1267 #define up_width 15
1268 #define up_height 15
1269 static unsigned char up_bits[] = {
1270   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1271   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1272   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1274 image create bitmap file_uplevel -background white -foreground red \
1275         -data $file_uplevel_data -maskdata $file_uplevel_data
1276 unset file_uplevel_data
1278 set ui_index .vpane.files.index.list
1279 set ui_workdir .vpane.files.workdir.list
1281 set all_icons(_$ui_index)   file_plain
1282 set all_icons(A$ui_index)   file_fulltick
1283 set all_icons(M$ui_index)   file_fulltick
1284 set all_icons(D$ui_index)   file_removed
1285 set all_icons(U$ui_index)   file_merge
1287 set all_icons(_$ui_workdir) file_plain
1288 set all_icons(M$ui_workdir) file_mod
1289 set all_icons(D$ui_workdir) file_question
1290 set all_icons(U$ui_workdir) file_merge
1291 set all_icons(O$ui_workdir) file_plain
1293 set max_status_desc 0
1294 foreach i {
1295                 {__ "Unmodified"}
1297                 {_M "Modified, not staged"}
1298                 {M_ "Staged for commit"}
1299                 {MM "Portions staged for commit"}
1300                 {MD "Staged for commit, missing"}
1302                 {_O "Untracked, not staged"}
1303                 {A_ "Staged for commit"}
1304                 {AM "Portions staged for commit"}
1305                 {AD "Staged for commit, missing"}
1307                 {_D "Missing"}
1308                 {D_ "Staged for removal"}
1309                 {DO "Staged for removal, still present"}
1311                 {U_ "Requires merge resolution"}
1312                 {UU "Requires merge resolution"}
1313                 {UM "Requires merge resolution"}
1314                 {UD "Requires merge resolution"}
1315         } {
1316         if {$max_status_desc < [string length [lindex $i 1]]} {
1317                 set max_status_desc [string length [lindex $i 1]]
1318         }
1319         set all_descs([lindex $i 0]) [lindex $i 1]
1321 unset i
1323 ######################################################################
1324 ##
1325 ## util
1327 proc bind_button3 {w cmd} {
1328         bind $w <Any-Button-3> $cmd
1329         if {[is_MacOSX]} {
1330                 bind $w <Control-Button-1> $cmd
1331         }
1334 proc scrollbar2many {list mode args} {
1335         foreach w $list {eval $w $mode $args}
1338 proc many2scrollbar {list mode sb top bottom} {
1339         $sb set $top $bottom
1340         foreach w $list {$w $mode moveto $top}
1343 proc incr_font_size {font {amt 1}} {
1344         set sz [font configure $font -size]
1345         incr sz $amt
1346         font configure $font -size $sz
1347         font configure ${font}bold -size $sz
1348         font configure ${font}italic -size $sz
1351 ######################################################################
1352 ##
1353 ## ui commands
1355 set starting_gitk_msg {Starting gitk... please wait...}
1357 proc do_gitk {revs} {
1358         # -- Always start gitk through whatever we were loaded with.  This
1359         #    lets us bypass using shell process on Windows systems.
1360         #
1361         set exe [file join [file dirname $::_git] gitk]
1362         set cmd [list [info nameofexecutable] $exe]
1363         if {! [file exists $exe]} {
1364                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1365         } else {
1366                 eval exec $cmd $revs &
1367                 ui_status $::starting_gitk_msg
1368                 after 10000 {
1369                         ui_ready $starting_gitk_msg
1370                 }
1371         }
1374 set is_quitting 0
1376 proc do_quit {} {
1377         global ui_comm is_quitting repo_config commit_type
1379         if {$is_quitting} return
1380         set is_quitting 1
1382         if {[winfo exists $ui_comm]} {
1383                 # -- Stash our current commit buffer.
1384                 #
1385                 set save [gitdir GITGUI_MSG]
1386                 set msg [string trim [$ui_comm get 0.0 end]]
1387                 regsub -all -line {[ \r\t]+$} $msg {} msg
1388                 if {(![string match amend* $commit_type]
1389                         || [$ui_comm edit modified])
1390                         && $msg ne {}} {
1391                         catch {
1392                                 set fd [open $save w]
1393                                 puts -nonewline $fd $msg
1394                                 close $fd
1395                         }
1396                 } else {
1397                         catch {file delete $save}
1398                 }
1400                 # -- Stash our current window geometry into this repository.
1401                 #
1402                 set cfg_geometry [list]
1403                 lappend cfg_geometry [wm geometry .]
1404                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1405                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1406                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1407                         set rc_geometry {}
1408                 }
1409                 if {$cfg_geometry ne $rc_geometry} {
1410                         catch {git config gui.geometry $cfg_geometry}
1411                 }
1412         }
1414         destroy .
1417 proc do_rescan {} {
1418         rescan ui_ready
1421 proc do_commit {} {
1422         commit_tree
1425 proc toggle_or_diff {w x y} {
1426         global file_states file_lists current_diff_path ui_index ui_workdir
1427         global last_clicked selected_paths
1429         set pos [split [$w index @$x,$y] .]
1430         set lno [lindex $pos 0]
1431         set col [lindex $pos 1]
1432         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1433         if {$path eq {}} {
1434                 set last_clicked {}
1435                 return
1436         }
1438         set last_clicked [list $w $lno]
1439         array unset selected_paths
1440         $ui_index tag remove in_sel 0.0 end
1441         $ui_workdir tag remove in_sel 0.0 end
1443         if {$col == 0} {
1444                 if {$current_diff_path eq $path} {
1445                         set after {reshow_diff;}
1446                 } else {
1447                         set after {}
1448                 }
1449                 if {$w eq $ui_index} {
1450                         update_indexinfo \
1451                                 "Unstaging [short_path $path] from commit" \
1452                                 [list $path] \
1453                                 [concat $after [list ui_ready]]
1454                 } elseif {$w eq $ui_workdir} {
1455                         update_index \
1456                                 "Adding [short_path $path]" \
1457                                 [list $path] \
1458                                 [concat $after [list ui_ready]]
1459                 }
1460         } else {
1461                 show_diff $path $w $lno
1462         }
1465 proc add_one_to_selection {w x y} {
1466         global file_lists last_clicked selected_paths
1468         set lno [lindex [split [$w index @$x,$y] .] 0]
1469         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1470         if {$path eq {}} {
1471                 set last_clicked {}
1472                 return
1473         }
1475         if {$last_clicked ne {}
1476                 && [lindex $last_clicked 0] ne $w} {
1477                 array unset selected_paths
1478                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1479         }
1481         set last_clicked [list $w $lno]
1482         if {[catch {set in_sel $selected_paths($path)}]} {
1483                 set in_sel 0
1484         }
1485         if {$in_sel} {
1486                 unset selected_paths($path)
1487                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1488         } else {
1489                 set selected_paths($path) 1
1490                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1491         }
1494 proc add_range_to_selection {w x y} {
1495         global file_lists last_clicked selected_paths
1497         if {[lindex $last_clicked 0] ne $w} {
1498                 toggle_or_diff $w $x $y
1499                 return
1500         }
1502         set lno [lindex [split [$w index @$x,$y] .] 0]
1503         set lc [lindex $last_clicked 1]
1504         if {$lc < $lno} {
1505                 set begin $lc
1506                 set end $lno
1507         } else {
1508                 set begin $lno
1509                 set end $lc
1510         }
1512         foreach path [lrange $file_lists($w) \
1513                 [expr {$begin - 1}] \
1514                 [expr {$end - 1}]] {
1515                 set selected_paths($path) 1
1516         }
1517         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1520 ######################################################################
1521 ##
1522 ## config defaults
1524 set cursor_ptr arrow
1525 font create font_diff -family Courier -size 10
1526 font create font_ui
1527 catch {
1528         label .dummy
1529         eval font configure font_ui [font actual [.dummy cget -font]]
1530         destroy .dummy
1533 font create font_uiitalic
1534 font create font_uibold
1535 font create font_diffbold
1536 font create font_diffitalic
1538 foreach class {Button Checkbutton Entry Label
1539                 Labelframe Listbox Menu Message
1540                 Radiobutton Spinbox Text} {
1541         option add *$class.font font_ui
1543 unset class
1545 if {[is_Windows] || [is_MacOSX]} {
1546         option add *Menu.tearOff 0
1549 if {[is_MacOSX]} {
1550         set M1B M1
1551         set M1T Cmd
1552 } else {
1553         set M1B Control
1554         set M1T Ctrl
1557 proc apply_config {} {
1558         global repo_config font_descs
1560         foreach option $font_descs {
1561                 set name [lindex $option 0]
1562                 set font [lindex $option 1]
1563                 if {[catch {
1564                         foreach {cn cv} $repo_config(gui.$name) {
1565                                 font configure $font $cn $cv
1566                         }
1567                         } err]} {
1568                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1569                 }
1570                 foreach {cn cv} [font configure $font] {
1571                         font configure ${font}bold $cn $cv
1572                         font configure ${font}italic $cn $cv
1573                 }
1574                 font configure ${font}bold -weight bold
1575                 font configure ${font}italic -slant italic
1576         }
1579 set default_config(merge.diffstat) true
1580 set default_config(merge.summary) false
1581 set default_config(merge.verbosity) 2
1582 set default_config(user.name) {}
1583 set default_config(user.email) {}
1585 set default_config(gui.matchtrackingbranch) false
1586 set default_config(gui.pruneduringfetch) false
1587 set default_config(gui.trustmtime) false
1588 set default_config(gui.diffcontext) 5
1589 set default_config(gui.newbranchtemplate) {}
1590 set default_config(gui.fontui) [font configure font_ui]
1591 set default_config(gui.fontdiff) [font configure font_diff]
1592 set font_descs {
1593         {fontui   font_ui   {Main Font}}
1594         {fontdiff font_diff {Diff/Console Font}}
1596 load_config 0
1597 apply_config
1599 ######################################################################
1600 ##
1601 ## feature option selection
1603 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1604         unset _junk
1605 } else {
1606         set subcommand gui
1608 if {$subcommand eq {gui.sh}} {
1609         set subcommand gui
1611 if {$subcommand eq {gui} && [llength $argv] > 0} {
1612         set subcommand [lindex $argv 0]
1613         set argv [lrange $argv 1 end]
1616 enable_option multicommit
1617 enable_option branch
1618 enable_option transport
1620 switch -- $subcommand {
1621 browser -
1622 blame {
1623         disable_option multicommit
1624         disable_option branch
1625         disable_option transport
1627 citool {
1628         enable_option singlecommit
1630         disable_option multicommit
1631         disable_option branch
1632         disable_option transport
1636 ######################################################################
1637 ##
1638 ## ui construction
1640 set ui_comm {}
1642 # -- Menu Bar
1644 menu .mbar -tearoff 0
1645 .mbar add cascade -label Repository -menu .mbar.repository
1646 .mbar add cascade -label Edit -menu .mbar.edit
1647 if {[is_enabled branch]} {
1648         .mbar add cascade -label Branch -menu .mbar.branch
1650 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1651         .mbar add cascade -label Commit -menu .mbar.commit
1653 if {[is_enabled transport]} {
1654         .mbar add cascade -label Merge -menu .mbar.merge
1655         .mbar add cascade -label Fetch -menu .mbar.fetch
1656         .mbar add cascade -label Push -menu .mbar.push
1658 . configure -menu .mbar
1660 # -- Repository Menu
1662 menu .mbar.repository
1664 .mbar.repository add command \
1665         -label {Browse Current Branch} \
1666         -command {browser::new $current_branch}
1667 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1668 .mbar.repository add separator
1670 .mbar.repository add command \
1671         -label {Visualize Current Branch} \
1672         -command {do_gitk $current_branch}
1673 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1674 .mbar.repository add command \
1675         -label {Visualize All Branches} \
1676         -command {do_gitk --all}
1677 .mbar.repository add separator
1679 if {[is_enabled multicommit]} {
1680         .mbar.repository add command -label {Database Statistics} \
1681                 -command do_stats
1683         .mbar.repository add command -label {Compress Database} \
1684                 -command do_gc
1686         .mbar.repository add command -label {Verify Database} \
1687                 -command do_fsck_objects
1689         .mbar.repository add separator
1691         if {[is_Cygwin]} {
1692                 .mbar.repository add command \
1693                         -label {Create Desktop Icon} \
1694                         -command do_cygwin_shortcut
1695         } elseif {[is_Windows]} {
1696                 .mbar.repository add command \
1697                         -label {Create Desktop Icon} \
1698                         -command do_windows_shortcut
1699         } elseif {[is_MacOSX]} {
1700                 .mbar.repository add command \
1701                         -label {Create Desktop Icon} \
1702                         -command do_macosx_app
1703         }
1706 .mbar.repository add command -label Quit \
1707         -command do_quit \
1708         -accelerator $M1T-Q
1710 # -- Edit Menu
1712 menu .mbar.edit
1713 .mbar.edit add command -label Undo \
1714         -command {catch {[focus] edit undo}} \
1715         -accelerator $M1T-Z
1716 .mbar.edit add command -label Redo \
1717         -command {catch {[focus] edit redo}} \
1718         -accelerator $M1T-Y
1719 .mbar.edit add separator
1720 .mbar.edit add command -label Cut \
1721         -command {catch {tk_textCut [focus]}} \
1722         -accelerator $M1T-X
1723 .mbar.edit add command -label Copy \
1724         -command {catch {tk_textCopy [focus]}} \
1725         -accelerator $M1T-C
1726 .mbar.edit add command -label Paste \
1727         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1728         -accelerator $M1T-V
1729 .mbar.edit add command -label Delete \
1730         -command {catch {[focus] delete sel.first sel.last}} \
1731         -accelerator Del
1732 .mbar.edit add separator
1733 .mbar.edit add command -label {Select All} \
1734         -command {catch {[focus] tag add sel 0.0 end}} \
1735         -accelerator $M1T-A
1737 # -- Branch Menu
1739 if {[is_enabled branch]} {
1740         menu .mbar.branch
1742         .mbar.branch add command -label {Create...} \
1743                 -command branch_create::dialog \
1744                 -accelerator $M1T-N
1745         lappend disable_on_lock [list .mbar.branch entryconf \
1746                 [.mbar.branch index last] -state]
1748         .mbar.branch add command -label {Checkout...} \
1749                 -command branch_checkout::dialog \
1750                 -accelerator $M1T-O
1751         lappend disable_on_lock [list .mbar.branch entryconf \
1752                 [.mbar.branch index last] -state]
1754         .mbar.branch add command -label {Rename...} \
1755                 -command branch_rename::dialog
1756         lappend disable_on_lock [list .mbar.branch entryconf \
1757                 [.mbar.branch index last] -state]
1759         .mbar.branch add command -label {Delete...} \
1760                 -command branch_delete::dialog
1761         lappend disable_on_lock [list .mbar.branch entryconf \
1762                 [.mbar.branch index last] -state]
1764         .mbar.branch add command -label {Reset...} \
1765                 -command merge::reset_hard
1766         lappend disable_on_lock [list .mbar.branch entryconf \
1767                 [.mbar.branch index last] -state]
1770 # -- Commit Menu
1772 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1773         menu .mbar.commit
1775         .mbar.commit add radiobutton \
1776                 -label {New Commit} \
1777                 -command do_select_commit_type \
1778                 -variable selected_commit_type \
1779                 -value new
1780         lappend disable_on_lock \
1781                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1783         .mbar.commit add radiobutton \
1784                 -label {Amend Last Commit} \
1785                 -command do_select_commit_type \
1786                 -variable selected_commit_type \
1787                 -value amend
1788         lappend disable_on_lock \
1789                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1791         .mbar.commit add separator
1793         .mbar.commit add command -label Rescan \
1794                 -command do_rescan \
1795                 -accelerator F5
1796         lappend disable_on_lock \
1797                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1799         .mbar.commit add command -label {Add To Commit} \
1800                 -command do_add_selection
1801         lappend disable_on_lock \
1802                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1804         .mbar.commit add command -label {Add Existing To Commit} \
1805                 -command do_add_all \
1806                 -accelerator $M1T-I
1807         lappend disable_on_lock \
1808                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1810         .mbar.commit add command -label {Unstage From Commit} \
1811                 -command do_unstage_selection
1812         lappend disable_on_lock \
1813                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1815         .mbar.commit add command -label {Revert Changes} \
1816                 -command do_revert_selection
1817         lappend disable_on_lock \
1818                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1820         .mbar.commit add separator
1822         .mbar.commit add command -label {Sign Off} \
1823                 -command do_signoff \
1824                 -accelerator $M1T-S
1826         .mbar.commit add command -label Commit \
1827                 -command do_commit \
1828                 -accelerator $M1T-Return
1829         lappend disable_on_lock \
1830                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1833 # -- Merge Menu
1835 if {[is_enabled branch]} {
1836         menu .mbar.merge
1837         .mbar.merge add command -label {Local Merge...} \
1838                 -command merge::dialog
1839         lappend disable_on_lock \
1840                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1841         .mbar.merge add command -label {Abort Merge...} \
1842                 -command merge::reset_hard
1843         lappend disable_on_lock \
1844                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1848 # -- Transport Menu
1850 if {[is_enabled transport]} {
1851         menu .mbar.fetch
1853         menu .mbar.push
1854         .mbar.push add command -label {Push...} \
1855                 -command do_push_anywhere \
1856                 -accelerator $M1T-P
1857         .mbar.push add command -label {Delete...} \
1858                 -command remote_branch_delete::dialog
1861 if {[is_MacOSX]} {
1862         # -- Apple Menu (Mac OS X only)
1863         #
1864         .mbar add cascade -label Apple -menu .mbar.apple
1865         menu .mbar.apple
1867         .mbar.apple add command -label "About [appname]" \
1868                 -command do_about
1869         .mbar.apple add command -label "Options..." \
1870                 -command do_options
1871 } else {
1872         # -- Edit Menu
1873         #
1874         .mbar.edit add separator
1875         .mbar.edit add command -label {Options...} \
1876                 -command do_options
1878         # -- Tools Menu
1879         #
1880         if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1881         proc do_miga {} {
1882                 if {![lock_index update]} return
1883                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1884                 set miga_fd [open "|$cmd" r]
1885                 fconfigure $miga_fd -blocking 0
1886                 fileevent $miga_fd readable [list miga_done $miga_fd]
1887                 ui_status {Running miga...}
1888         }
1889         proc miga_done {fd} {
1890                 read $fd 512
1891                 if {[eof $fd]} {
1892                         close $fd
1893                         unlock_index
1894                         rescan ui_ready
1895                 }
1896         }
1897         .mbar add cascade -label Tools -menu .mbar.tools
1898         menu .mbar.tools
1899         .mbar.tools add command -label "Migrate" \
1900                 -command do_miga
1901         lappend disable_on_lock \
1902                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1903         }
1906 # -- Help Menu
1908 .mbar add cascade -label Help -menu .mbar.help
1909 menu .mbar.help
1911 if {![is_MacOSX]} {
1912         .mbar.help add command -label "About [appname]" \
1913                 -command do_about
1916 set browser {}
1917 catch {set browser $repo_config(instaweb.browser)}
1918 set doc_path [file dirname [gitexec]]
1919 set doc_path [file join $doc_path Documentation index.html]
1921 if {[is_Cygwin]} {
1922         set doc_path [exec cygpath --mixed $doc_path]
1925 if {$browser eq {}} {
1926         if {[is_MacOSX]} {
1927                 set browser open
1928         } elseif {[is_Cygwin]} {
1929                 set program_files [file dirname [exec cygpath --windir]]
1930                 set program_files [file join $program_files {Program Files}]
1931                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1932                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1933                 if {[file exists $firefox]} {
1934                         set browser $firefox
1935                 } elseif {[file exists $ie]} {
1936                         set browser $ie
1937                 }
1938                 unset program_files firefox ie
1939         }
1942 if {[file isfile $doc_path]} {
1943         set doc_url "file:$doc_path"
1944 } else {
1945         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1948 if {$browser ne {}} {
1949         .mbar.help add command -label {Online Documentation} \
1950                 -command [list exec $browser $doc_url &]
1952 unset browser doc_path doc_url
1954 # -- Standard bindings
1956 wm protocol . WM_DELETE_WINDOW do_quit
1957 bind all <$M1B-Key-q> do_quit
1958 bind all <$M1B-Key-Q> do_quit
1959 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1960 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1962 set subcommand_args {}
1963 proc usage {} {
1964         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1965         exit 1
1968 # -- Not a normal commit type invocation?  Do that instead!
1970 switch -- $subcommand {
1971 browser {
1972         set subcommand_args {rev?}
1973         switch [llength $argv] {
1974         0 { load_current_branch }
1975         1 {
1976                 set current_branch [lindex $argv 0]
1977                 if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1978                         if {[catch {
1979                                         set current_branch \
1980                                         [git rev-parse --verify $current_branch]
1981                                 } err]} {
1982                                 puts stderr $err
1983                                 exit 1
1984                         }
1985                 }
1986         }
1987         default usage
1988         }
1989         browser::new $current_branch
1990         return
1992 blame {
1993         set subcommand_args {rev? path?}
1994         set head {}
1995         set path {}
1996         set is_path 0
1997         foreach a $argv {
1998                 if {$is_path || [file exists $_prefix$a]} {
1999                         if {$path ne {}} usage
2000                         set path $_prefix$a
2001                         break
2002                 } elseif {$a eq {--}} {
2003                         if {$path ne {}} {
2004                                 if {$head ne {}} usage
2005                                 set head $path
2006                                 set path {}
2007                         }
2008                         set is_path 1
2009                 } elseif {$head eq {}} {
2010                         if {$head ne {}} usage
2011                         set head $a
2012                 } else {
2013                         usage
2014                 }
2015         }
2016         unset is_path
2018         if {$head eq {}} {
2019                 load_current_branch
2020         } else {
2021                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2022                         if {[catch {
2023                                         set head [git rev-parse --verify $head]
2024                                 } err]} {
2025                                 puts stderr $err
2026                                 exit 1
2027                         }
2028                 }
2029                 set current_branch $head
2030         }
2032         if {$path eq {}} usage
2033         blame::new $head $path
2034         return
2036 citool -
2037 gui {
2038         if {[llength $argv] != 0} {
2039                 puts -nonewline stderr "usage: $argv0"
2040                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2041                         puts -nonewline stderr " $subcommand"
2042                 }
2043                 puts stderr {}
2044                 exit 1
2045         }
2046         # fall through to setup UI for commits
2048 default {
2049         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2050         exit 1
2054 # -- Branch Control
2056 frame .branch \
2057         -borderwidth 1 \
2058         -relief sunken
2059 label .branch.l1 \
2060         -text {Current Branch:} \
2061         -anchor w \
2062         -justify left
2063 label .branch.cb \
2064         -textvariable current_branch \
2065         -anchor w \
2066         -justify left
2067 pack .branch.l1 -side left
2068 pack .branch.cb -side left -fill x
2069 pack .branch -side top -fill x
2071 # -- Main Window Layout
2073 panedwindow .vpane -orient vertical
2074 panedwindow .vpane.files -orient horizontal
2075 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2076 pack .vpane -anchor n -side top -fill both -expand 1
2078 # -- Index File List
2080 frame .vpane.files.index -height 100 -width 200
2081 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2082         -background lightgreen
2083 text $ui_index -background white -borderwidth 0 \
2084         -width 20 -height 10 \
2085         -wrap none \
2086         -cursor $cursor_ptr \
2087         -xscrollcommand {.vpane.files.index.sx set} \
2088         -yscrollcommand {.vpane.files.index.sy set} \
2089         -state disabled
2090 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2091 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2092 pack .vpane.files.index.title -side top -fill x
2093 pack .vpane.files.index.sx -side bottom -fill x
2094 pack .vpane.files.index.sy -side right -fill y
2095 pack $ui_index -side left -fill both -expand 1
2096 .vpane.files add .vpane.files.index -sticky nsew
2098 # -- Working Directory File List
2100 frame .vpane.files.workdir -height 100 -width 200
2101 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2102         -background lightsalmon
2103 text $ui_workdir -background white -borderwidth 0 \
2104         -width 20 -height 10 \
2105         -wrap none \
2106         -cursor $cursor_ptr \
2107         -xscrollcommand {.vpane.files.workdir.sx set} \
2108         -yscrollcommand {.vpane.files.workdir.sy set} \
2109         -state disabled
2110 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2111 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2112 pack .vpane.files.workdir.title -side top -fill x
2113 pack .vpane.files.workdir.sx -side bottom -fill x
2114 pack .vpane.files.workdir.sy -side right -fill y
2115 pack $ui_workdir -side left -fill both -expand 1
2116 .vpane.files add .vpane.files.workdir -sticky nsew
2118 foreach i [list $ui_index $ui_workdir] {
2119         $i tag conf in_diff -background lightgray
2120         $i tag conf in_sel  -background lightgray
2122 unset i
2124 # -- Diff and Commit Area
2126 frame .vpane.lower -height 300 -width 400
2127 frame .vpane.lower.commarea
2128 frame .vpane.lower.diff -relief sunken -borderwidth 1
2129 pack .vpane.lower.commarea -side top -fill x
2130 pack .vpane.lower.diff -side bottom -fill both -expand 1
2131 .vpane add .vpane.lower -sticky nsew
2133 # -- Commit Area Buttons
2135 frame .vpane.lower.commarea.buttons
2136 label .vpane.lower.commarea.buttons.l -text {} \
2137         -anchor w \
2138         -justify left
2139 pack .vpane.lower.commarea.buttons.l -side top -fill x
2140 pack .vpane.lower.commarea.buttons -side left -fill y
2142 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2143         -command do_rescan
2144 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2145 lappend disable_on_lock \
2146         {.vpane.lower.commarea.buttons.rescan conf -state}
2148 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2149         -command do_add_all
2150 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2151 lappend disable_on_lock \
2152         {.vpane.lower.commarea.buttons.incall conf -state}
2154 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2155         -command do_signoff
2156 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2158 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2159         -command do_commit
2160 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2161 lappend disable_on_lock \
2162         {.vpane.lower.commarea.buttons.commit conf -state}
2164 button .vpane.lower.commarea.buttons.push -text {Push} \
2165         -command do_push_anywhere
2166 pack .vpane.lower.commarea.buttons.push -side top -fill x
2168 # -- Commit Message Buffer
2170 frame .vpane.lower.commarea.buffer
2171 frame .vpane.lower.commarea.buffer.header
2172 set ui_comm .vpane.lower.commarea.buffer.t
2173 set ui_coml .vpane.lower.commarea.buffer.header.l
2174 radiobutton .vpane.lower.commarea.buffer.header.new \
2175         -text {New Commit} \
2176         -command do_select_commit_type \
2177         -variable selected_commit_type \
2178         -value new
2179 lappend disable_on_lock \
2180         [list .vpane.lower.commarea.buffer.header.new conf -state]
2181 radiobutton .vpane.lower.commarea.buffer.header.amend \
2182         -text {Amend Last Commit} \
2183         -command do_select_commit_type \
2184         -variable selected_commit_type \
2185         -value amend
2186 lappend disable_on_lock \
2187         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2188 label $ui_coml \
2189         -anchor w \
2190         -justify left
2191 proc trace_commit_type {varname args} {
2192         global ui_coml commit_type
2193         switch -glob -- $commit_type {
2194         initial       {set txt {Initial Commit Message:}}
2195         amend         {set txt {Amended Commit Message:}}
2196         amend-initial {set txt {Amended Initial Commit Message:}}
2197         amend-merge   {set txt {Amended Merge Commit Message:}}
2198         merge         {set txt {Merge Commit Message:}}
2199         *             {set txt {Commit Message:}}
2200         }
2201         $ui_coml conf -text $txt
2203 trace add variable commit_type write trace_commit_type
2204 pack $ui_coml -side left -fill x
2205 pack .vpane.lower.commarea.buffer.header.amend -side right
2206 pack .vpane.lower.commarea.buffer.header.new -side right
2208 text $ui_comm -background white -borderwidth 1 \
2209         -undo true \
2210         -maxundo 20 \
2211         -autoseparators true \
2212         -relief sunken \
2213         -width 75 -height 9 -wrap none \
2214         -font font_diff \
2215         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2216 scrollbar .vpane.lower.commarea.buffer.sby \
2217         -command [list $ui_comm yview]
2218 pack .vpane.lower.commarea.buffer.header -side top -fill x
2219 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2220 pack $ui_comm -side left -fill y
2221 pack .vpane.lower.commarea.buffer -side left -fill y
2223 # -- Commit Message Buffer Context Menu
2225 set ctxm .vpane.lower.commarea.buffer.ctxm
2226 menu $ctxm -tearoff 0
2227 $ctxm add command \
2228         -label {Cut} \
2229         -command {tk_textCut $ui_comm}
2230 $ctxm add command \
2231         -label {Copy} \
2232         -command {tk_textCopy $ui_comm}
2233 $ctxm add command \
2234         -label {Paste} \
2235         -command {tk_textPaste $ui_comm}
2236 $ctxm add command \
2237         -label {Delete} \
2238         -command {$ui_comm delete sel.first sel.last}
2239 $ctxm add separator
2240 $ctxm add command \
2241         -label {Select All} \
2242         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2243 $ctxm add command \
2244         -label {Copy All} \
2245         -command {
2246                 $ui_comm tag add sel 0.0 end
2247                 tk_textCopy $ui_comm
2248                 $ui_comm tag remove sel 0.0 end
2249         }
2250 $ctxm add separator
2251 $ctxm add command \
2252         -label {Sign Off} \
2253         -command do_signoff
2254 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2256 # -- Diff Header
2258 proc trace_current_diff_path {varname args} {
2259         global current_diff_path diff_actions file_states
2260         if {$current_diff_path eq {}} {
2261                 set s {}
2262                 set f {}
2263                 set p {}
2264                 set o disabled
2265         } else {
2266                 set p $current_diff_path
2267                 set s [mapdesc [lindex $file_states($p) 0] $p]
2268                 set f {File:}
2269                 set p [escape_path $p]
2270                 set o normal
2271         }
2273         .vpane.lower.diff.header.status configure -text $s
2274         .vpane.lower.diff.header.file configure -text $f
2275         .vpane.lower.diff.header.path configure -text $p
2276         foreach w $diff_actions {
2277                 uplevel #0 $w $o
2278         }
2280 trace add variable current_diff_path write trace_current_diff_path
2282 frame .vpane.lower.diff.header -background gold
2283 label .vpane.lower.diff.header.status \
2284         -background gold \
2285         -width $max_status_desc \
2286         -anchor w \
2287         -justify left
2288 label .vpane.lower.diff.header.file \
2289         -background gold \
2290         -anchor w \
2291         -justify left
2292 label .vpane.lower.diff.header.path \
2293         -background gold \
2294         -anchor w \
2295         -justify left
2296 pack .vpane.lower.diff.header.status -side left
2297 pack .vpane.lower.diff.header.file -side left
2298 pack .vpane.lower.diff.header.path -fill x
2299 set ctxm .vpane.lower.diff.header.ctxm
2300 menu $ctxm -tearoff 0
2301 $ctxm add command \
2302         -label {Copy} \
2303         -command {
2304                 clipboard clear
2305                 clipboard append \
2306                         -format STRING \
2307                         -type STRING \
2308                         -- $current_diff_path
2309         }
2310 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2311 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2313 # -- Diff Body
2315 frame .vpane.lower.diff.body
2316 set ui_diff .vpane.lower.diff.body.t
2317 text $ui_diff -background white -borderwidth 0 \
2318         -width 80 -height 15 -wrap none \
2319         -font font_diff \
2320         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2321         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2322         -state disabled
2323 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2324         -command [list $ui_diff xview]
2325 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2326         -command [list $ui_diff yview]
2327 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2328 pack .vpane.lower.diff.body.sby -side right -fill y
2329 pack $ui_diff -side left -fill both -expand 1
2330 pack .vpane.lower.diff.header -side top -fill x
2331 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2333 $ui_diff tag conf d_cr -elide true
2334 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2335 $ui_diff tag conf d_+ -foreground {#00a000}
2336 $ui_diff tag conf d_- -foreground red
2338 $ui_diff tag conf d_++ -foreground {#00a000}
2339 $ui_diff tag conf d_-- -foreground red
2340 $ui_diff tag conf d_+s \
2341         -foreground {#00a000} \
2342         -background {#e2effa}
2343 $ui_diff tag conf d_-s \
2344         -foreground red \
2345         -background {#e2effa}
2346 $ui_diff tag conf d_s+ \
2347         -foreground {#00a000} \
2348         -background ivory1
2349 $ui_diff tag conf d_s- \
2350         -foreground red \
2351         -background ivory1
2353 $ui_diff tag conf d<<<<<<< \
2354         -foreground orange \
2355         -font font_diffbold
2356 $ui_diff tag conf d======= \
2357         -foreground orange \
2358         -font font_diffbold
2359 $ui_diff tag conf d>>>>>>> \
2360         -foreground orange \
2361         -font font_diffbold
2363 $ui_diff tag raise sel
2365 # -- Diff Body Context Menu
2367 set ctxm .vpane.lower.diff.body.ctxm
2368 menu $ctxm -tearoff 0
2369 $ctxm add command \
2370         -label {Refresh} \
2371         -command reshow_diff
2372 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2373 $ctxm add command \
2374         -label {Copy} \
2375         -command {tk_textCopy $ui_diff}
2376 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2377 $ctxm add command \
2378         -label {Select All} \
2379         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2380 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2381 $ctxm add command \
2382         -label {Copy All} \
2383         -command {
2384                 $ui_diff tag add sel 0.0 end
2385                 tk_textCopy $ui_diff
2386                 $ui_diff tag remove sel 0.0 end
2387         }
2388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2389 $ctxm add separator
2390 $ctxm add command \
2391         -label {Apply/Reverse Hunk} \
2392         -command {apply_hunk $cursorX $cursorY}
2393 set ui_diff_applyhunk [$ctxm index last]
2394 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2395 $ctxm add separator
2396 $ctxm add command \
2397         -label {Decrease Font Size} \
2398         -command {incr_font_size font_diff -1}
2399 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2400 $ctxm add command \
2401         -label {Increase Font Size} \
2402         -command {incr_font_size font_diff 1}
2403 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2404 $ctxm add separator
2405 $ctxm add command \
2406         -label {Show Less Context} \
2407         -command {if {$repo_config(gui.diffcontext) >= 1} {
2408                 incr repo_config(gui.diffcontext) -1
2409                 reshow_diff
2410         }}
2411 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2412 $ctxm add command \
2413         -label {Show More Context} \
2414         -command {if {$repo_config(gui.diffcontext) < 99} {
2415                 incr repo_config(gui.diffcontext)
2416                 reshow_diff
2417         }}
2418 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2419 $ctxm add separator
2420 $ctxm add command -label {Options...} \
2421         -command do_options
2422 bind_button3 $ui_diff "
2423         set cursorX %x
2424         set cursorY %y
2425         if {\$ui_index eq \$current_diff_side} {
2426                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2427         } else {
2428                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2429         }
2430         tk_popup $ctxm %X %Y
2432 unset ui_diff_applyhunk
2434 # -- Status Bar
2436 set main_status [::status_bar::new .status]
2437 pack .status -anchor w -side bottom -fill x
2438 $main_status show {Initializing...}
2440 # -- Load geometry
2442 catch {
2443 set gm $repo_config(gui.geometry)
2444 wm geometry . [lindex $gm 0]
2445 .vpane sash place 0 \
2446         [lindex [.vpane sash coord 0] 0] \
2447         [lindex $gm 1]
2448 .vpane.files sash place 0 \
2449         [lindex $gm 2] \
2450         [lindex [.vpane.files sash coord 0] 1]
2451 unset gm
2454 # -- Key Bindings
2456 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2457 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2458 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2459 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2460 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2461 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2462 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2463 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2464 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2465 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2466 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2468 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2469 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2470 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2471 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2472 bind $ui_diff <$M1B-Key-v> {break}
2473 bind $ui_diff <$M1B-Key-V> {break}
2474 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2475 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2476 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2477 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2478 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2479 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2480 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2481 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2482 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2483 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2484 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2485 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2486 bind $ui_diff <Button-1>   {focus %W}
2488 if {[is_enabled branch]} {
2489         bind . <$M1B-Key-n> branch_create::dialog
2490         bind . <$M1B-Key-N> branch_create::dialog
2491         bind . <$M1B-Key-o> branch_checkout::dialog
2492         bind . <$M1B-Key-O> branch_checkout::dialog
2494 if {[is_enabled transport]} {
2495         bind . <$M1B-Key-p> do_push_anywhere
2496         bind . <$M1B-Key-P> do_push_anywhere
2499 bind .   <Key-F5>     do_rescan
2500 bind .   <$M1B-Key-r> do_rescan
2501 bind .   <$M1B-Key-R> do_rescan
2502 bind .   <$M1B-Key-s> do_signoff
2503 bind .   <$M1B-Key-S> do_signoff
2504 bind .   <$M1B-Key-i> do_add_all
2505 bind .   <$M1B-Key-I> do_add_all
2506 bind .   <$M1B-Key-Return> do_commit
2507 foreach i [list $ui_index $ui_workdir] {
2508         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2509         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2510         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2512 unset i
2514 set file_lists($ui_index) [list]
2515 set file_lists($ui_workdir) [list]
2517 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2518 focus -force $ui_comm
2520 # -- Warn the user about environmental problems.  Cygwin's Tcl
2521 #    does *not* pass its env array onto any processes it spawns.
2522 #    This means that git processes get none of our environment.
2524 if {[is_Cygwin]} {
2525         set ignored_env 0
2526         set suggest_user {}
2527         set msg "Possible environment issues exist.
2529 The following environment variables are probably
2530 going to be ignored by any Git subprocess run
2531 by [appname]:
2534         foreach name [array names env] {
2535                 switch -regexp -- $name {
2536                 {^GIT_INDEX_FILE$} -
2537                 {^GIT_OBJECT_DIRECTORY$} -
2538                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2539                 {^GIT_DIFF_OPTS$} -
2540                 {^GIT_EXTERNAL_DIFF$} -
2541                 {^GIT_PAGER$} -
2542                 {^GIT_TRACE$} -
2543                 {^GIT_CONFIG$} -
2544                 {^GIT_CONFIG_LOCAL$} -
2545                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2546                         append msg " - $name\n"
2547                         incr ignored_env
2548                 }
2549                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2550                         append msg " - $name\n"
2551                         incr ignored_env
2552                         set suggest_user $name
2553                 }
2554                 }
2555         }
2556         if {$ignored_env > 0} {
2557                 append msg "
2558 This is due to a known issue with the
2559 Tcl binary distributed by Cygwin."
2561                 if {$suggest_user ne {}} {
2562                         append msg "
2564 A good replacement for $suggest_user
2565 is placing values for the user.name and
2566 user.email settings into your personal
2567 ~/.gitconfig file.
2569                 }
2570                 warn_popup $msg
2571         }
2572         unset ignored_env msg suggest_user name
2575 # -- Only initialize complex UI if we are going to stay running.
2577 if {[is_enabled transport]} {
2578         load_all_remotes
2580         populate_fetch_menu
2581         populate_push_menu
2584 # -- Only suggest a gc run if we are going to stay running.
2586 if {[is_enabled multicommit]} {
2587         set object_limit 8
2588         if {[is_Windows]} {
2589                 set object_limit 1
2590         }
2591         set objects_current [llength [glob \
2592                 -directory [gitdir objects 42] \
2593                 -nocomplain \
2594                 -tails \
2595                 -- \
2596                 *]]
2597         if {$objects_current >= $object_limit} {
2598                 set objects_current [expr {$objects_current * 256}]
2599                 set object_limit    [expr {$object_limit    * 256}]
2600                 if {[ask_popup \
2601                         "This repository currently has approximately $objects_current loose objects.
2603 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2605 Compress the database now?"] eq yes} {
2606                         do_gc
2607                 }
2608         }
2609         unset object_limit objects_current
2612 lock_index begin-read
2613 if {![winfo ismapped .]} {
2614         wm deiconify .
2616 after 1 do_rescan