Code

git-gui: Improve the Windows and Mac OS X shortcut creators
[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 git {args} {
371         set opt [list exec]
373         while {1} {
374                 switch -- [lindex $args 0] {
375                 --nice {
376                         global _nice
377                         if {$_nice ne {}} {
378                                 lappend opt $_nice
379                         }
380                 }
382                 default {
383                         break
384                 }
386                 }
388                 set args [lrange $args 1 end]
389         }
391         set cmdp [_git_cmd [lindex $args 0]]
392         set args [lrange $args 1 end]
394         return [eval $opt $cmdp $args]
397 proc _open_stdout_stderr {cmd} {
398         if {[catch {
399                         set fd [open $cmd r]
400                 } err]} {
401                 if {   [lindex $cmd end] eq {2>@1}
402                     && $err eq {can not find channel named "1"}
403                         } {
404                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
405                         # redirect operator.  Fallback to |& cat for those.
406                         # The command was not actually started, so its safe
407                         # to try to start it a second time.
408                         #
409                         set fd [open [concat \
410                                 [lrange $cmd 0 end-1] \
411                                 [list |& cat] \
412                                 ] r]
413                 } else {
414                         error $err
415                 }
416         }
417         return $fd
420 proc git_read {args} {
421         set opt [list |]
423         while {1} {
424                 switch -- [lindex $args 0] {
425                 --nice {
426                         global _nice
427                         if {$_nice ne {}} {
428                                 lappend opt $_nice
429                         }
430                 }
432                 --stderr {
433                         lappend args 2>@1
434                 }
436                 default {
437                         break
438                 }
440                 }
442                 set args [lrange $args 1 end]
443         }
445         set cmdp [_git_cmd [lindex $args 0]]
446         set args [lrange $args 1 end]
448         return [_open_stdout_stderr [concat $opt $cmdp $args]]
451 proc git_write {args} {
452         set opt [list |]
454         while {1} {
455                 switch -- [lindex $args 0] {
456                 --nice {
457                         global _nice
458                         if {$_nice ne {}} {
459                                 lappend opt $_nice
460                         }
461                 }
463                 default {
464                         break
465                 }
467                 }
469                 set args [lrange $args 1 end]
470         }
472         set cmdp [_git_cmd [lindex $args 0]]
473         set args [lrange $args 1 end]
475         return [open [concat $opt $cmdp $args] w]
478 proc sq {value} {
479         regsub -all ' $value "'\\''" value
480         return "'$value'"
483 proc load_current_branch {} {
484         global current_branch is_detached
486         set fd [open [gitdir HEAD] r]
487         if {[gets $fd ref] < 1} {
488                 set ref {}
489         }
490         close $fd
492         set pfx {ref: refs/heads/}
493         set len [string length $pfx]
494         if {[string equal -length $len $pfx $ref]} {
495                 # We're on a branch.  It might not exist.  But
496                 # HEAD looks good enough to be a branch.
497                 #
498                 set current_branch [string range $ref $len end]
499                 set is_detached 0
500         } else {
501                 # Assume this is a detached head.
502                 #
503                 set current_branch HEAD
504                 set is_detached 1
505         }
508 auto_load tk_optionMenu
509 rename tk_optionMenu real__tkOptionMenu
510 proc tk_optionMenu {w varName args} {
511         set m [eval real__tkOptionMenu $w $varName $args]
512         $m configure -font font_ui
513         $w configure -font font_ui
514         return $m
517 ######################################################################
518 ##
519 ## find git
521 set _git  [_which git]
522 if {$_git eq {}} {
523         catch {wm withdraw .}
524         error_popup "Cannot find git in PATH."
525         exit 1
527 set _nice [_which nice]
529 ######################################################################
530 ##
531 ## version check
533 if {[catch {set _git_version [git --version]} err]} {
534         catch {wm withdraw .}
535         error_popup "Cannot determine Git version:
537 $err
539 [appname] requires Git 1.5.0 or later."
540         exit 1
542 if {![regsub {^git version } $_git_version {} _git_version]} {
543         catch {wm withdraw .}
544         error_popup "Cannot parse Git version string:\n\n$_git_version"
545         exit 1
547 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
548 regsub {\.rc[0-9]+$} $_git_version {} _git_version
550 proc git-version {args} {
551         global _git_version
553         switch [llength $args] {
554         0 {
555                 return $_git_version
556         }
558         2 {
559                 set op [lindex $args 0]
560                 set vr [lindex $args 1]
561                 set cm [package vcompare $_git_version $vr]
562                 return [expr $cm $op 0]
563         }
565         4 {
566                 set type [lindex $args 0]
567                 set name [lindex $args 1]
568                 set parm [lindex $args 2]
569                 set body [lindex $args 3]
571                 if {($type ne {proc} && $type ne {method})} {
572                         error "Invalid arguments to git-version"
573                 }
574                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
575                         error "Last arm of $type $name must be default"
576                 }
578                 foreach {op vr cb} [lrange $body 0 end-2] {
579                         if {[git-version $op $vr]} {
580                                 return [uplevel [list $type $name $parm $cb]]
581                         }
582                 }
584                 return [uplevel [list $type $name $parm [lindex $body end]]]
585         }
587         default {
588                 error "git-version >= x"
589         }
591         }
594 if {[git-version < 1.5]} {
595         catch {wm withdraw .}
596         error_popup "[appname] requires Git 1.5.0 or later.
598 You are using [git-version]:
600 [git --version]"
601         exit 1
604 ######################################################################
605 ##
606 ## repository setup
608 if {[catch {
609                 set _gitdir $env(GIT_DIR)
610                 set _prefix {}
611                 }]
612         && [catch {
613                 set _gitdir [git rev-parse --git-dir]
614                 set _prefix [git rev-parse --show-prefix]
615         } err]} {
616         catch {wm withdraw .}
617         error_popup "Cannot find the git directory:\n\n$err"
618         exit 1
620 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
621         catch {set _gitdir [exec cygpath --unix $_gitdir]}
623 if {![file isdirectory $_gitdir]} {
624         catch {wm withdraw .}
625         error_popup "Git directory not found:\n\n$_gitdir"
626         exit 1
628 if {[lindex [file split $_gitdir] end] ne {.git}} {
629         catch {wm withdraw .}
630         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
631         exit 1
633 if {[catch {cd [file dirname $_gitdir]} err]} {
634         catch {wm withdraw .}
635         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
636         exit 1
638 set _reponame [lindex [file split \
639         [file normalize [file dirname $_gitdir]]] \
640         end]
642 ######################################################################
643 ##
644 ## global init
646 set current_diff_path {}
647 set current_diff_side {}
648 set diff_actions [list]
650 set HEAD {}
651 set PARENT {}
652 set MERGE_HEAD [list]
653 set commit_type {}
654 set empty_tree {}
655 set current_branch {}
656 set is_detached 0
657 set current_diff_path {}
658 set selected_commit_type new
660 ######################################################################
661 ##
662 ## task management
664 set rescan_active 0
665 set diff_active 0
666 set last_clicked {}
668 set disable_on_lock [list]
669 set index_lock_type none
671 proc lock_index {type} {
672         global index_lock_type disable_on_lock
674         if {$index_lock_type eq {none}} {
675                 set index_lock_type $type
676                 foreach w $disable_on_lock {
677                         uplevel #0 $w disabled
678                 }
679                 return 1
680         } elseif {$index_lock_type eq "begin-$type"} {
681                 set index_lock_type $type
682                 return 1
683         }
684         return 0
687 proc unlock_index {} {
688         global index_lock_type disable_on_lock
690         set index_lock_type none
691         foreach w $disable_on_lock {
692                 uplevel #0 $w normal
693         }
696 ######################################################################
697 ##
698 ## status
700 proc repository_state {ctvar hdvar mhvar} {
701         global current_branch
702         upvar $ctvar ct $hdvar hd $mhvar mh
704         set mh [list]
706         load_current_branch
707         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
708                 set hd {}
709                 set ct initial
710                 return
711         }
713         set merge_head [gitdir MERGE_HEAD]
714         if {[file exists $merge_head]} {
715                 set ct merge
716                 set fd_mh [open $merge_head r]
717                 while {[gets $fd_mh line] >= 0} {
718                         lappend mh $line
719                 }
720                 close $fd_mh
721                 return
722         }
724         set ct normal
727 proc PARENT {} {
728         global PARENT empty_tree
730         set p [lindex $PARENT 0]
731         if {$p ne {}} {
732                 return $p
733         }
734         if {$empty_tree eq {}} {
735                 set empty_tree [git mktree << {}]
736         }
737         return $empty_tree
740 proc rescan {after {honor_trustmtime 1}} {
741         global HEAD PARENT MERGE_HEAD commit_type
742         global ui_index ui_workdir ui_comm
743         global rescan_active file_states
744         global repo_config
746         if {$rescan_active > 0 || ![lock_index read]} return
748         repository_state newType newHEAD newMERGE_HEAD
749         if {[string match amend* $commit_type]
750                 && $newType eq {normal}
751                 && $newHEAD eq $HEAD} {
752         } else {
753                 set HEAD $newHEAD
754                 set PARENT $newHEAD
755                 set MERGE_HEAD $newMERGE_HEAD
756                 set commit_type $newType
757         }
759         array unset file_states
761         if {![$ui_comm edit modified]
762                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
763                 if {[string match amend* $commit_type]} {
764                 } elseif {[load_message GITGUI_MSG]} {
765                 } elseif {[load_message MERGE_MSG]} {
766                 } elseif {[load_message SQUASH_MSG]} {
767                 }
768                 $ui_comm edit reset
769                 $ui_comm edit modified false
770         }
772         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
773                 rescan_stage2 {} $after
774         } else {
775                 set rescan_active 1
776                 ui_status {Refreshing file status...}
777                 set fd_rf [git_read update-index \
778                         -q \
779                         --unmerged \
780                         --ignore-missing \
781                         --refresh \
782                         ]
783                 fconfigure $fd_rf -blocking 0 -translation binary
784                 fileevent $fd_rf readable \
785                         [list rescan_stage2 $fd_rf $after]
786         }
789 proc rescan_stage2 {fd after} {
790         global rescan_active buf_rdi buf_rdf buf_rlo
792         if {$fd ne {}} {
793                 read $fd
794                 if {![eof $fd]} return
795                 close $fd
796         }
798         set ls_others [list --exclude-per-directory=.gitignore]
799         set info_exclude [gitdir info exclude]
800         if {[file readable $info_exclude]} {
801                 lappend ls_others "--exclude-from=$info_exclude"
802         }
804         set buf_rdi {}
805         set buf_rdf {}
806         set buf_rlo {}
808         set rescan_active 3
809         ui_status {Scanning for modified files ...}
810         set fd_di [git_read diff-index --cached -z [PARENT]]
811         set fd_df [git_read diff-files -z]
812         set fd_lo [eval git_read ls-files --others -z $ls_others]
814         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
815         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
816         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
817         fileevent $fd_di readable [list read_diff_index $fd_di $after]
818         fileevent $fd_df readable [list read_diff_files $fd_df $after]
819         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
822 proc load_message {file} {
823         global ui_comm
825         set f [gitdir $file]
826         if {[file isfile $f]} {
827                 if {[catch {set fd [open $f r]}]} {
828                         return 0
829                 }
830                 set content [string trim [read $fd]]
831                 close $fd
832                 regsub -all -line {[ \r\t]+$} $content {} content
833                 $ui_comm delete 0.0 end
834                 $ui_comm insert end $content
835                 return 1
836         }
837         return 0
840 proc read_diff_index {fd after} {
841         global buf_rdi
843         append buf_rdi [read $fd]
844         set c 0
845         set n [string length $buf_rdi]
846         while {$c < $n} {
847                 set z1 [string first "\0" $buf_rdi $c]
848                 if {$z1 == -1} break
849                 incr z1
850                 set z2 [string first "\0" $buf_rdi $z1]
851                 if {$z2 == -1} break
853                 incr c
854                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
855                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
856                 merge_state \
857                         [encoding convertfrom $p] \
858                         [lindex $i 4]? \
859                         [list [lindex $i 0] [lindex $i 2]] \
860                         [list]
861                 set c $z2
862                 incr c
863         }
864         if {$c < $n} {
865                 set buf_rdi [string range $buf_rdi $c end]
866         } else {
867                 set buf_rdi {}
868         }
870         rescan_done $fd buf_rdi $after
873 proc read_diff_files {fd after} {
874         global buf_rdf
876         append buf_rdf [read $fd]
877         set c 0
878         set n [string length $buf_rdf]
879         while {$c < $n} {
880                 set z1 [string first "\0" $buf_rdf $c]
881                 if {$z1 == -1} break
882                 incr z1
883                 set z2 [string first "\0" $buf_rdf $z1]
884                 if {$z2 == -1} break
886                 incr c
887                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
888                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
889                 merge_state \
890                         [encoding convertfrom $p] \
891                         ?[lindex $i 4] \
892                         [list] \
893                         [list [lindex $i 0] [lindex $i 2]]
894                 set c $z2
895                 incr c
896         }
897         if {$c < $n} {
898                 set buf_rdf [string range $buf_rdf $c end]
899         } else {
900                 set buf_rdf {}
901         }
903         rescan_done $fd buf_rdf $after
906 proc read_ls_others {fd after} {
907         global buf_rlo
909         append buf_rlo [read $fd]
910         set pck [split $buf_rlo "\0"]
911         set buf_rlo [lindex $pck end]
912         foreach p [lrange $pck 0 end-1] {
913                 merge_state [encoding convertfrom $p] ?O
914         }
915         rescan_done $fd buf_rlo $after
918 proc rescan_done {fd buf after} {
919         global rescan_active current_diff_path
920         global file_states repo_config
921         upvar $buf to_clear
923         if {![eof $fd]} return
924         set to_clear {}
925         close $fd
926         if {[incr rescan_active -1] > 0} return
928         prune_selection
929         unlock_index
930         display_all_files
931         if {$current_diff_path ne {}} reshow_diff
932         uplevel #0 $after
935 proc prune_selection {} {
936         global file_states selected_paths
938         foreach path [array names selected_paths] {
939                 if {[catch {set still_here $file_states($path)}]} {
940                         unset selected_paths($path)
941                 }
942         }
945 ######################################################################
946 ##
947 ## ui helpers
949 proc mapicon {w state path} {
950         global all_icons
952         if {[catch {set r $all_icons($state$w)}]} {
953                 puts "error: no icon for $w state={$state} $path"
954                 return file_plain
955         }
956         return $r
959 proc mapdesc {state path} {
960         global all_descs
962         if {[catch {set r $all_descs($state)}]} {
963                 puts "error: no desc for state={$state} $path"
964                 return $state
965         }
966         return $r
969 proc ui_status {msg} {
970         $::main_status show $msg
973 proc ui_ready {{test {}}} {
974         $::main_status show {Ready.} $test
977 proc escape_path {path} {
978         regsub -all {\\} $path "\\\\" path
979         regsub -all "\n" $path "\\n" path
980         return $path
983 proc short_path {path} {
984         return [escape_path [lindex [file split $path] end]]
987 set next_icon_id 0
988 set null_sha1 [string repeat 0 40]
990 proc merge_state {path new_state {head_info {}} {index_info {}}} {
991         global file_states next_icon_id null_sha1
993         set s0 [string index $new_state 0]
994         set s1 [string index $new_state 1]
996         if {[catch {set info $file_states($path)}]} {
997                 set state __
998                 set icon n[incr next_icon_id]
999         } else {
1000                 set state [lindex $info 0]
1001                 set icon [lindex $info 1]
1002                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1003                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1004         }
1006         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1007         elseif {$s0 eq {_}} {set s0 _}
1009         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1010         elseif {$s1 eq {_}} {set s1 _}
1012         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1013                 set head_info [list 0 $null_sha1]
1014         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1015                 && $head_info eq {}} {
1016                 set head_info $index_info
1017         }
1019         set file_states($path) [list $s0$s1 $icon \
1020                 $head_info $index_info \
1021                 ]
1022         return $state
1025 proc display_file_helper {w path icon_name old_m new_m} {
1026         global file_lists
1028         if {$new_m eq {_}} {
1029                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1030                 if {$lno >= 0} {
1031                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1032                         incr lno
1033                         $w conf -state normal
1034                         $w delete $lno.0 [expr {$lno + 1}].0
1035                         $w conf -state disabled
1036                 }
1037         } elseif {$old_m eq {_} && $new_m ne {_}} {
1038                 lappend file_lists($w) $path
1039                 set file_lists($w) [lsort -unique $file_lists($w)]
1040                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1041                 incr lno
1042                 $w conf -state normal
1043                 $w image create $lno.0 \
1044                         -align center -padx 5 -pady 1 \
1045                         -name $icon_name \
1046                         -image [mapicon $w $new_m $path]
1047                 $w insert $lno.1 "[escape_path $path]\n"
1048                 $w conf -state disabled
1049         } elseif {$old_m ne $new_m} {
1050                 $w conf -state normal
1051                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1052                 $w conf -state disabled
1053         }
1056 proc display_file {path state} {
1057         global file_states selected_paths
1058         global ui_index ui_workdir
1060         set old_m [merge_state $path $state]
1061         set s $file_states($path)
1062         set new_m [lindex $s 0]
1063         set icon_name [lindex $s 1]
1065         set o [string index $old_m 0]
1066         set n [string index $new_m 0]
1067         if {$o eq {U}} {
1068                 set o _
1069         }
1070         if {$n eq {U}} {
1071                 set n _
1072         }
1073         display_file_helper     $ui_index $path $icon_name $o $n
1075         if {[string index $old_m 0] eq {U}} {
1076                 set o U
1077         } else {
1078                 set o [string index $old_m 1]
1079         }
1080         if {[string index $new_m 0] eq {U}} {
1081                 set n U
1082         } else {
1083                 set n [string index $new_m 1]
1084         }
1085         display_file_helper     $ui_workdir $path $icon_name $o $n
1087         if {$new_m eq {__}} {
1088                 unset file_states($path)
1089                 catch {unset selected_paths($path)}
1090         }
1093 proc display_all_files_helper {w path icon_name m} {
1094         global file_lists
1096         lappend file_lists($w) $path
1097         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1098         $w image create end \
1099                 -align center -padx 5 -pady 1 \
1100                 -name $icon_name \
1101                 -image [mapicon $w $m $path]
1102         $w insert end "[escape_path $path]\n"
1105 proc display_all_files {} {
1106         global ui_index ui_workdir
1107         global file_states file_lists
1108         global last_clicked
1110         $ui_index conf -state normal
1111         $ui_workdir conf -state normal
1113         $ui_index delete 0.0 end
1114         $ui_workdir delete 0.0 end
1115         set last_clicked {}
1117         set file_lists($ui_index) [list]
1118         set file_lists($ui_workdir) [list]
1120         foreach path [lsort [array names file_states]] {
1121                 set s $file_states($path)
1122                 set m [lindex $s 0]
1123                 set icon_name [lindex $s 1]
1125                 set s [string index $m 0]
1126                 if {$s ne {U} && $s ne {_}} {
1127                         display_all_files_helper $ui_index $path \
1128                                 $icon_name $s
1129                 }
1131                 if {[string index $m 0] eq {U}} {
1132                         set s U
1133                 } else {
1134                         set s [string index $m 1]
1135                 }
1136                 if {$s ne {_}} {
1137                         display_all_files_helper $ui_workdir $path \
1138                                 $icon_name $s
1139                 }
1140         }
1142         $ui_index conf -state disabled
1143         $ui_workdir conf -state disabled
1146 ######################################################################
1147 ##
1148 ## icons
1150 set filemask {
1151 #define mask_width 14
1152 #define mask_height 15
1153 static unsigned char mask_bits[] = {
1154    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1155    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1156    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1159 image create bitmap file_plain -background white -foreground black -data {
1160 #define plain_width 14
1161 #define plain_height 15
1162 static unsigned char plain_bits[] = {
1163    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1164    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1165    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1166 } -maskdata $filemask
1168 image create bitmap file_mod -background white -foreground blue -data {
1169 #define mod_width 14
1170 #define mod_height 15
1171 static unsigned char mod_bits[] = {
1172    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1173    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1174    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1175 } -maskdata $filemask
1177 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1178 #define file_fulltick_width 14
1179 #define file_fulltick_height 15
1180 static unsigned char file_fulltick_bits[] = {
1181    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1182    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1183    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1184 } -maskdata $filemask
1186 image create bitmap file_parttick -background white -foreground "#005050" -data {
1187 #define parttick_width 14
1188 #define parttick_height 15
1189 static unsigned char parttick_bits[] = {
1190    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1191    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1192    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1193 } -maskdata $filemask
1195 image create bitmap file_question -background white -foreground black -data {
1196 #define file_question_width 14
1197 #define file_question_height 15
1198 static unsigned char file_question_bits[] = {
1199    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1200    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1201    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1202 } -maskdata $filemask
1204 image create bitmap file_removed -background white -foreground red -data {
1205 #define file_removed_width 14
1206 #define file_removed_height 15
1207 static unsigned char file_removed_bits[] = {
1208    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1209    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1210    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1211 } -maskdata $filemask
1213 image create bitmap file_merge -background white -foreground blue -data {
1214 #define file_merge_width 14
1215 #define file_merge_height 15
1216 static unsigned char file_merge_bits[] = {
1217    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1218    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1219    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1220 } -maskdata $filemask
1222 set file_dir_data {
1223 #define file_width 18
1224 #define file_height 18
1225 static unsigned char file_bits[] = {
1226   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1227   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1228   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1229   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1230   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1232 image create bitmap file_dir -background white -foreground blue \
1233         -data $file_dir_data -maskdata $file_dir_data
1234 unset file_dir_data
1236 set file_uplevel_data {
1237 #define up_width 15
1238 #define up_height 15
1239 static unsigned char up_bits[] = {
1240   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1241   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1242   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1244 image create bitmap file_uplevel -background white -foreground red \
1245         -data $file_uplevel_data -maskdata $file_uplevel_data
1246 unset file_uplevel_data
1248 set ui_index .vpane.files.index.list
1249 set ui_workdir .vpane.files.workdir.list
1251 set all_icons(_$ui_index)   file_plain
1252 set all_icons(A$ui_index)   file_fulltick
1253 set all_icons(M$ui_index)   file_fulltick
1254 set all_icons(D$ui_index)   file_removed
1255 set all_icons(U$ui_index)   file_merge
1257 set all_icons(_$ui_workdir) file_plain
1258 set all_icons(M$ui_workdir) file_mod
1259 set all_icons(D$ui_workdir) file_question
1260 set all_icons(U$ui_workdir) file_merge
1261 set all_icons(O$ui_workdir) file_plain
1263 set max_status_desc 0
1264 foreach i {
1265                 {__ "Unmodified"}
1267                 {_M "Modified, not staged"}
1268                 {M_ "Staged for commit"}
1269                 {MM "Portions staged for commit"}
1270                 {MD "Staged for commit, missing"}
1272                 {_O "Untracked, not staged"}
1273                 {A_ "Staged for commit"}
1274                 {AM "Portions staged for commit"}
1275                 {AD "Staged for commit, missing"}
1277                 {_D "Missing"}
1278                 {D_ "Staged for removal"}
1279                 {DO "Staged for removal, still present"}
1281                 {U_ "Requires merge resolution"}
1282                 {UU "Requires merge resolution"}
1283                 {UM "Requires merge resolution"}
1284                 {UD "Requires merge resolution"}
1285         } {
1286         if {$max_status_desc < [string length [lindex $i 1]]} {
1287                 set max_status_desc [string length [lindex $i 1]]
1288         }
1289         set all_descs([lindex $i 0]) [lindex $i 1]
1291 unset i
1293 ######################################################################
1294 ##
1295 ## util
1297 proc bind_button3 {w cmd} {
1298         bind $w <Any-Button-3> $cmd
1299         if {[is_MacOSX]} {
1300                 bind $w <Control-Button-1> $cmd
1301         }
1304 proc scrollbar2many {list mode args} {
1305         foreach w $list {eval $w $mode $args}
1308 proc many2scrollbar {list mode sb top bottom} {
1309         $sb set $top $bottom
1310         foreach w $list {$w $mode moveto $top}
1313 proc incr_font_size {font {amt 1}} {
1314         set sz [font configure $font -size]
1315         incr sz $amt
1316         font configure $font -size $sz
1317         font configure ${font}bold -size $sz
1318         font configure ${font}italic -size $sz
1321 ######################################################################
1322 ##
1323 ## ui commands
1325 set starting_gitk_msg {Starting gitk... please wait...}
1327 proc do_gitk {revs} {
1328         # -- Always start gitk through whatever we were loaded with.  This
1329         #    lets us bypass using shell process on Windows systems.
1330         #
1331         set exe [file join [file dirname $::_git] gitk]
1332         set cmd [list [info nameofexecutable] $exe]
1333         if {! [file exists $exe]} {
1334                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1335         } else {
1336                 eval exec $cmd $revs &
1337                 ui_status $::starting_gitk_msg
1338                 after 10000 {
1339                         ui_ready $starting_gitk_msg
1340                 }
1341         }
1344 set is_quitting 0
1346 proc do_quit {} {
1347         global ui_comm is_quitting repo_config commit_type
1349         if {$is_quitting} return
1350         set is_quitting 1
1352         if {[winfo exists $ui_comm]} {
1353                 # -- Stash our current commit buffer.
1354                 #
1355                 set save [gitdir GITGUI_MSG]
1356                 set msg [string trim [$ui_comm get 0.0 end]]
1357                 regsub -all -line {[ \r\t]+$} $msg {} msg
1358                 if {(![string match amend* $commit_type]
1359                         || [$ui_comm edit modified])
1360                         && $msg ne {}} {
1361                         catch {
1362                                 set fd [open $save w]
1363                                 puts -nonewline $fd $msg
1364                                 close $fd
1365                         }
1366                 } else {
1367                         catch {file delete $save}
1368                 }
1370                 # -- Stash our current window geometry into this repository.
1371                 #
1372                 set cfg_geometry [list]
1373                 lappend cfg_geometry [wm geometry .]
1374                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1375                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1376                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1377                         set rc_geometry {}
1378                 }
1379                 if {$cfg_geometry ne $rc_geometry} {
1380                         catch {git config gui.geometry $cfg_geometry}
1381                 }
1382         }
1384         destroy .
1387 proc do_rescan {} {
1388         rescan ui_ready
1391 proc do_commit {} {
1392         commit_tree
1395 proc toggle_or_diff {w x y} {
1396         global file_states file_lists current_diff_path ui_index ui_workdir
1397         global last_clicked selected_paths
1399         set pos [split [$w index @$x,$y] .]
1400         set lno [lindex $pos 0]
1401         set col [lindex $pos 1]
1402         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1403         if {$path eq {}} {
1404                 set last_clicked {}
1405                 return
1406         }
1408         set last_clicked [list $w $lno]
1409         array unset selected_paths
1410         $ui_index tag remove in_sel 0.0 end
1411         $ui_workdir tag remove in_sel 0.0 end
1413         if {$col == 0} {
1414                 if {$current_diff_path eq $path} {
1415                         set after {reshow_diff;}
1416                 } else {
1417                         set after {}
1418                 }
1419                 if {$w eq $ui_index} {
1420                         update_indexinfo \
1421                                 "Unstaging [short_path $path] from commit" \
1422                                 [list $path] \
1423                                 [concat $after [list ui_ready]]
1424                 } elseif {$w eq $ui_workdir} {
1425                         update_index \
1426                                 "Adding [short_path $path]" \
1427                                 [list $path] \
1428                                 [concat $after [list ui_ready]]
1429                 }
1430         } else {
1431                 show_diff $path $w $lno
1432         }
1435 proc add_one_to_selection {w x y} {
1436         global file_lists last_clicked selected_paths
1438         set lno [lindex [split [$w index @$x,$y] .] 0]
1439         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1440         if {$path eq {}} {
1441                 set last_clicked {}
1442                 return
1443         }
1445         if {$last_clicked ne {}
1446                 && [lindex $last_clicked 0] ne $w} {
1447                 array unset selected_paths
1448                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1449         }
1451         set last_clicked [list $w $lno]
1452         if {[catch {set in_sel $selected_paths($path)}]} {
1453                 set in_sel 0
1454         }
1455         if {$in_sel} {
1456                 unset selected_paths($path)
1457                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1458         } else {
1459                 set selected_paths($path) 1
1460                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1461         }
1464 proc add_range_to_selection {w x y} {
1465         global file_lists last_clicked selected_paths
1467         if {[lindex $last_clicked 0] ne $w} {
1468                 toggle_or_diff $w $x $y
1469                 return
1470         }
1472         set lno [lindex [split [$w index @$x,$y] .] 0]
1473         set lc [lindex $last_clicked 1]
1474         if {$lc < $lno} {
1475                 set begin $lc
1476                 set end $lno
1477         } else {
1478                 set begin $lno
1479                 set end $lc
1480         }
1482         foreach path [lrange $file_lists($w) \
1483                 [expr {$begin - 1}] \
1484                 [expr {$end - 1}]] {
1485                 set selected_paths($path) 1
1486         }
1487         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1490 ######################################################################
1491 ##
1492 ## config defaults
1494 set cursor_ptr arrow
1495 font create font_diff -family Courier -size 10
1496 font create font_ui
1497 catch {
1498         label .dummy
1499         eval font configure font_ui [font actual [.dummy cget -font]]
1500         destroy .dummy
1503 font create font_uiitalic
1504 font create font_uibold
1505 font create font_diffbold
1506 font create font_diffitalic
1508 foreach class {Button Checkbutton Entry Label
1509                 Labelframe Listbox Menu Message
1510                 Radiobutton Spinbox Text} {
1511         option add *$class.font font_ui
1513 unset class
1515 if {[is_Windows] || [is_MacOSX]} {
1516         option add *Menu.tearOff 0
1519 if {[is_MacOSX]} {
1520         set M1B M1
1521         set M1T Cmd
1522 } else {
1523         set M1B Control
1524         set M1T Ctrl
1527 proc apply_config {} {
1528         global repo_config font_descs
1530         foreach option $font_descs {
1531                 set name [lindex $option 0]
1532                 set font [lindex $option 1]
1533                 if {[catch {
1534                         foreach {cn cv} $repo_config(gui.$name) {
1535                                 font configure $font $cn $cv
1536                         }
1537                         } err]} {
1538                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1539                 }
1540                 foreach {cn cv} [font configure $font] {
1541                         font configure ${font}bold $cn $cv
1542                         font configure ${font}italic $cn $cv
1543                 }
1544                 font configure ${font}bold -weight bold
1545                 font configure ${font}italic -slant italic
1546         }
1549 set default_config(merge.diffstat) true
1550 set default_config(merge.summary) false
1551 set default_config(merge.verbosity) 2
1552 set default_config(user.name) {}
1553 set default_config(user.email) {}
1555 set default_config(gui.matchtrackingbranch) false
1556 set default_config(gui.pruneduringfetch) false
1557 set default_config(gui.trustmtime) false
1558 set default_config(gui.diffcontext) 5
1559 set default_config(gui.newbranchtemplate) {}
1560 set default_config(gui.fontui) [font configure font_ui]
1561 set default_config(gui.fontdiff) [font configure font_diff]
1562 set font_descs {
1563         {fontui   font_ui   {Main Font}}
1564         {fontdiff font_diff {Diff/Console Font}}
1566 load_config 0
1567 apply_config
1569 ######################################################################
1570 ##
1571 ## feature option selection
1573 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1574         unset _junk
1575 } else {
1576         set subcommand gui
1578 if {$subcommand eq {gui.sh}} {
1579         set subcommand gui
1581 if {$subcommand eq {gui} && [llength $argv] > 0} {
1582         set subcommand [lindex $argv 0]
1583         set argv [lrange $argv 1 end]
1586 enable_option multicommit
1587 enable_option branch
1588 enable_option transport
1590 switch -- $subcommand {
1591 browser -
1592 blame {
1593         disable_option multicommit
1594         disable_option branch
1595         disable_option transport
1597 citool {
1598         enable_option singlecommit
1600         disable_option multicommit
1601         disable_option branch
1602         disable_option transport
1606 ######################################################################
1607 ##
1608 ## ui construction
1610 set ui_comm {}
1612 # -- Menu Bar
1614 menu .mbar -tearoff 0
1615 .mbar add cascade -label Repository -menu .mbar.repository
1616 .mbar add cascade -label Edit -menu .mbar.edit
1617 if {[is_enabled branch]} {
1618         .mbar add cascade -label Branch -menu .mbar.branch
1620 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1621         .mbar add cascade -label Commit -menu .mbar.commit
1623 if {[is_enabled transport]} {
1624         .mbar add cascade -label Merge -menu .mbar.merge
1625         .mbar add cascade -label Fetch -menu .mbar.fetch
1626         .mbar add cascade -label Push -menu .mbar.push
1628 . configure -menu .mbar
1630 # -- Repository Menu
1632 menu .mbar.repository
1634 .mbar.repository add command \
1635         -label {Browse Current Branch} \
1636         -command {browser::new $current_branch}
1637 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1638 .mbar.repository add separator
1640 .mbar.repository add command \
1641         -label {Visualize Current Branch} \
1642         -command {do_gitk $current_branch}
1643 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1644 .mbar.repository add command \
1645         -label {Visualize All Branches} \
1646         -command {do_gitk --all}
1647 .mbar.repository add separator
1649 if {[is_enabled multicommit]} {
1650         .mbar.repository add command -label {Database Statistics} \
1651                 -command do_stats
1653         .mbar.repository add command -label {Compress Database} \
1654                 -command do_gc
1656         .mbar.repository add command -label {Verify Database} \
1657                 -command do_fsck_objects
1659         .mbar.repository add separator
1661         if {[is_Cygwin]} {
1662                 .mbar.repository add command \
1663                         -label {Create Desktop Icon} \
1664                         -command do_cygwin_shortcut
1665         } elseif {[is_Windows]} {
1666                 .mbar.repository add command \
1667                         -label {Create Desktop Icon} \
1668                         -command do_windows_shortcut
1669         } elseif {[is_MacOSX]} {
1670                 .mbar.repository add command \
1671                         -label {Create Desktop Icon} \
1672                         -command do_macosx_app
1673         }
1676 .mbar.repository add command -label Quit \
1677         -command do_quit \
1678         -accelerator $M1T-Q
1680 # -- Edit Menu
1682 menu .mbar.edit
1683 .mbar.edit add command -label Undo \
1684         -command {catch {[focus] edit undo}} \
1685         -accelerator $M1T-Z
1686 .mbar.edit add command -label Redo \
1687         -command {catch {[focus] edit redo}} \
1688         -accelerator $M1T-Y
1689 .mbar.edit add separator
1690 .mbar.edit add command -label Cut \
1691         -command {catch {tk_textCut [focus]}} \
1692         -accelerator $M1T-X
1693 .mbar.edit add command -label Copy \
1694         -command {catch {tk_textCopy [focus]}} \
1695         -accelerator $M1T-C
1696 .mbar.edit add command -label Paste \
1697         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1698         -accelerator $M1T-V
1699 .mbar.edit add command -label Delete \
1700         -command {catch {[focus] delete sel.first sel.last}} \
1701         -accelerator Del
1702 .mbar.edit add separator
1703 .mbar.edit add command -label {Select All} \
1704         -command {catch {[focus] tag add sel 0.0 end}} \
1705         -accelerator $M1T-A
1707 # -- Branch Menu
1709 if {[is_enabled branch]} {
1710         menu .mbar.branch
1712         .mbar.branch add command -label {Create...} \
1713                 -command branch_create::dialog \
1714                 -accelerator $M1T-N
1715         lappend disable_on_lock [list .mbar.branch entryconf \
1716                 [.mbar.branch index last] -state]
1718         .mbar.branch add command -label {Checkout...} \
1719                 -command branch_checkout::dialog \
1720                 -accelerator $M1T-O
1721         lappend disable_on_lock [list .mbar.branch entryconf \
1722                 [.mbar.branch index last] -state]
1724         .mbar.branch add command -label {Rename...} \
1725                 -command branch_rename::dialog
1726         lappend disable_on_lock [list .mbar.branch entryconf \
1727                 [.mbar.branch index last] -state]
1729         .mbar.branch add command -label {Delete...} \
1730                 -command branch_delete::dialog
1731         lappend disable_on_lock [list .mbar.branch entryconf \
1732                 [.mbar.branch index last] -state]
1734         .mbar.branch add command -label {Reset...} \
1735                 -command merge::reset_hard
1736         lappend disable_on_lock [list .mbar.branch entryconf \
1737                 [.mbar.branch index last] -state]
1740 # -- Commit Menu
1742 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1743         menu .mbar.commit
1745         .mbar.commit add radiobutton \
1746                 -label {New Commit} \
1747                 -command do_select_commit_type \
1748                 -variable selected_commit_type \
1749                 -value new
1750         lappend disable_on_lock \
1751                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1753         .mbar.commit add radiobutton \
1754                 -label {Amend Last Commit} \
1755                 -command do_select_commit_type \
1756                 -variable selected_commit_type \
1757                 -value amend
1758         lappend disable_on_lock \
1759                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1761         .mbar.commit add separator
1763         .mbar.commit add command -label Rescan \
1764                 -command do_rescan \
1765                 -accelerator F5
1766         lappend disable_on_lock \
1767                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1769         .mbar.commit add command -label {Add To Commit} \
1770                 -command do_add_selection
1771         lappend disable_on_lock \
1772                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1774         .mbar.commit add command -label {Add Existing To Commit} \
1775                 -command do_add_all \
1776                 -accelerator $M1T-I
1777         lappend disable_on_lock \
1778                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1780         .mbar.commit add command -label {Unstage From Commit} \
1781                 -command do_unstage_selection
1782         lappend disable_on_lock \
1783                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1785         .mbar.commit add command -label {Revert Changes} \
1786                 -command do_revert_selection
1787         lappend disable_on_lock \
1788                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1790         .mbar.commit add separator
1792         .mbar.commit add command -label {Sign Off} \
1793                 -command do_signoff \
1794                 -accelerator $M1T-S
1796         .mbar.commit add command -label Commit \
1797                 -command do_commit \
1798                 -accelerator $M1T-Return
1799         lappend disable_on_lock \
1800                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1803 # -- Merge Menu
1805 if {[is_enabled branch]} {
1806         menu .mbar.merge
1807         .mbar.merge add command -label {Local Merge...} \
1808                 -command merge::dialog
1809         lappend disable_on_lock \
1810                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1811         .mbar.merge add command -label {Abort Merge...} \
1812                 -command merge::reset_hard
1813         lappend disable_on_lock \
1814                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1818 # -- Transport Menu
1820 if {[is_enabled transport]} {
1821         menu .mbar.fetch
1823         menu .mbar.push
1824         .mbar.push add command -label {Push...} \
1825                 -command do_push_anywhere \
1826                 -accelerator $M1T-P
1827         .mbar.push add command -label {Delete...} \
1828                 -command remote_branch_delete::dialog
1831 if {[is_MacOSX]} {
1832         # -- Apple Menu (Mac OS X only)
1833         #
1834         .mbar add cascade -label Apple -menu .mbar.apple
1835         menu .mbar.apple
1837         .mbar.apple add command -label "About [appname]" \
1838                 -command do_about
1839         .mbar.apple add command -label "Options..." \
1840                 -command do_options
1841 } else {
1842         # -- Edit Menu
1843         #
1844         .mbar.edit add separator
1845         .mbar.edit add command -label {Options...} \
1846                 -command do_options
1848         # -- Tools Menu
1849         #
1850         if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1851         proc do_miga {} {
1852                 if {![lock_index update]} return
1853                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1854                 set miga_fd [open "|$cmd" r]
1855                 fconfigure $miga_fd -blocking 0
1856                 fileevent $miga_fd readable [list miga_done $miga_fd]
1857                 ui_status {Running miga...}
1858         }
1859         proc miga_done {fd} {
1860                 read $fd 512
1861                 if {[eof $fd]} {
1862                         close $fd
1863                         unlock_index
1864                         rescan ui_ready
1865                 }
1866         }
1867         .mbar add cascade -label Tools -menu .mbar.tools
1868         menu .mbar.tools
1869         .mbar.tools add command -label "Migrate" \
1870                 -command do_miga
1871         lappend disable_on_lock \
1872                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1873         }
1876 # -- Help Menu
1878 .mbar add cascade -label Help -menu .mbar.help
1879 menu .mbar.help
1881 if {![is_MacOSX]} {
1882         .mbar.help add command -label "About [appname]" \
1883                 -command do_about
1886 set browser {}
1887 catch {set browser $repo_config(instaweb.browser)}
1888 set doc_path [file dirname [gitexec]]
1889 set doc_path [file join $doc_path Documentation index.html]
1891 if {[is_Cygwin]} {
1892         set doc_path [exec cygpath --mixed $doc_path]
1895 if {$browser eq {}} {
1896         if {[is_MacOSX]} {
1897                 set browser open
1898         } elseif {[is_Cygwin]} {
1899                 set program_files [file dirname [exec cygpath --windir]]
1900                 set program_files [file join $program_files {Program Files}]
1901                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1902                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1903                 if {[file exists $firefox]} {
1904                         set browser $firefox
1905                 } elseif {[file exists $ie]} {
1906                         set browser $ie
1907                 }
1908                 unset program_files firefox ie
1909         }
1912 if {[file isfile $doc_path]} {
1913         set doc_url "file:$doc_path"
1914 } else {
1915         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1918 if {$browser ne {}} {
1919         .mbar.help add command -label {Online Documentation} \
1920                 -command [list exec $browser $doc_url &]
1922 unset browser doc_path doc_url
1924 # -- Standard bindings
1926 wm protocol . WM_DELETE_WINDOW do_quit
1927 bind all <$M1B-Key-q> do_quit
1928 bind all <$M1B-Key-Q> do_quit
1929 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1930 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1932 set subcommand_args {}
1933 proc usage {} {
1934         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1935         exit 1
1938 # -- Not a normal commit type invocation?  Do that instead!
1940 switch -- $subcommand {
1941 browser {
1942         set subcommand_args {rev?}
1943         switch [llength $argv] {
1944         0 { load_current_branch }
1945         1 {
1946                 set current_branch [lindex $argv 0]
1947                 if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1948                         if {[catch {
1949                                         set current_branch \
1950                                         [git rev-parse --verify $current_branch]
1951                                 } err]} {
1952                                 puts stderr $err
1953                                 exit 1
1954                         }
1955                 }
1956         }
1957         default usage
1958         }
1959         browser::new $current_branch
1960         return
1962 blame {
1963         set subcommand_args {rev? path?}
1964         set head {}
1965         set path {}
1966         set is_path 0
1967         foreach a $argv {
1968                 if {$is_path || [file exists $_prefix$a]} {
1969                         if {$path ne {}} usage
1970                         set path $_prefix$a
1971                         break
1972                 } elseif {$a eq {--}} {
1973                         if {$path ne {}} {
1974                                 if {$head ne {}} usage
1975                                 set head $path
1976                                 set path {}
1977                         }
1978                         set is_path 1
1979                 } elseif {$head eq {}} {
1980                         if {$head ne {}} usage
1981                         set head $a
1982                 } else {
1983                         usage
1984                 }
1985         }
1986         unset is_path
1988         if {$head eq {}} {
1989                 load_current_branch
1990         } else {
1991                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
1992                         if {[catch {
1993                                         set head [git rev-parse --verify $head]
1994                                 } err]} {
1995                                 puts stderr $err
1996                                 exit 1
1997                         }
1998                 }
1999                 set current_branch $head
2000         }
2002         if {$path eq {}} usage
2003         blame::new $head $path
2004         return
2006 citool -
2007 gui {
2008         if {[llength $argv] != 0} {
2009                 puts -nonewline stderr "usage: $argv0"
2010                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2011                         puts -nonewline stderr " $subcommand"
2012                 }
2013                 puts stderr {}
2014                 exit 1
2015         }
2016         # fall through to setup UI for commits
2018 default {
2019         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2020         exit 1
2024 # -- Branch Control
2026 frame .branch \
2027         -borderwidth 1 \
2028         -relief sunken
2029 label .branch.l1 \
2030         -text {Current Branch:} \
2031         -anchor w \
2032         -justify left
2033 label .branch.cb \
2034         -textvariable current_branch \
2035         -anchor w \
2036         -justify left
2037 pack .branch.l1 -side left
2038 pack .branch.cb -side left -fill x
2039 pack .branch -side top -fill x
2041 # -- Main Window Layout
2043 panedwindow .vpane -orient vertical
2044 panedwindow .vpane.files -orient horizontal
2045 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2046 pack .vpane -anchor n -side top -fill both -expand 1
2048 # -- Index File List
2050 frame .vpane.files.index -height 100 -width 200
2051 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2052         -background lightgreen
2053 text $ui_index -background white -borderwidth 0 \
2054         -width 20 -height 10 \
2055         -wrap none \
2056         -cursor $cursor_ptr \
2057         -xscrollcommand {.vpane.files.index.sx set} \
2058         -yscrollcommand {.vpane.files.index.sy set} \
2059         -state disabled
2060 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2061 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2062 pack .vpane.files.index.title -side top -fill x
2063 pack .vpane.files.index.sx -side bottom -fill x
2064 pack .vpane.files.index.sy -side right -fill y
2065 pack $ui_index -side left -fill both -expand 1
2066 .vpane.files add .vpane.files.index -sticky nsew
2068 # -- Working Directory File List
2070 frame .vpane.files.workdir -height 100 -width 200
2071 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2072         -background lightsalmon
2073 text $ui_workdir -background white -borderwidth 0 \
2074         -width 20 -height 10 \
2075         -wrap none \
2076         -cursor $cursor_ptr \
2077         -xscrollcommand {.vpane.files.workdir.sx set} \
2078         -yscrollcommand {.vpane.files.workdir.sy set} \
2079         -state disabled
2080 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2081 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2082 pack .vpane.files.workdir.title -side top -fill x
2083 pack .vpane.files.workdir.sx -side bottom -fill x
2084 pack .vpane.files.workdir.sy -side right -fill y
2085 pack $ui_workdir -side left -fill both -expand 1
2086 .vpane.files add .vpane.files.workdir -sticky nsew
2088 foreach i [list $ui_index $ui_workdir] {
2089         $i tag conf in_diff -background lightgray
2090         $i tag conf in_sel  -background lightgray
2092 unset i
2094 # -- Diff and Commit Area
2096 frame .vpane.lower -height 300 -width 400
2097 frame .vpane.lower.commarea
2098 frame .vpane.lower.diff -relief sunken -borderwidth 1
2099 pack .vpane.lower.commarea -side top -fill x
2100 pack .vpane.lower.diff -side bottom -fill both -expand 1
2101 .vpane add .vpane.lower -sticky nsew
2103 # -- Commit Area Buttons
2105 frame .vpane.lower.commarea.buttons
2106 label .vpane.lower.commarea.buttons.l -text {} \
2107         -anchor w \
2108         -justify left
2109 pack .vpane.lower.commarea.buttons.l -side top -fill x
2110 pack .vpane.lower.commarea.buttons -side left -fill y
2112 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2113         -command do_rescan
2114 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2115 lappend disable_on_lock \
2116         {.vpane.lower.commarea.buttons.rescan conf -state}
2118 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2119         -command do_add_all
2120 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2121 lappend disable_on_lock \
2122         {.vpane.lower.commarea.buttons.incall conf -state}
2124 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2125         -command do_signoff
2126 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2128 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2129         -command do_commit
2130 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2131 lappend disable_on_lock \
2132         {.vpane.lower.commarea.buttons.commit conf -state}
2134 button .vpane.lower.commarea.buttons.push -text {Push} \
2135         -command do_push_anywhere
2136 pack .vpane.lower.commarea.buttons.push -side top -fill x
2138 # -- Commit Message Buffer
2140 frame .vpane.lower.commarea.buffer
2141 frame .vpane.lower.commarea.buffer.header
2142 set ui_comm .vpane.lower.commarea.buffer.t
2143 set ui_coml .vpane.lower.commarea.buffer.header.l
2144 radiobutton .vpane.lower.commarea.buffer.header.new \
2145         -text {New Commit} \
2146         -command do_select_commit_type \
2147         -variable selected_commit_type \
2148         -value new
2149 lappend disable_on_lock \
2150         [list .vpane.lower.commarea.buffer.header.new conf -state]
2151 radiobutton .vpane.lower.commarea.buffer.header.amend \
2152         -text {Amend Last Commit} \
2153         -command do_select_commit_type \
2154         -variable selected_commit_type \
2155         -value amend
2156 lappend disable_on_lock \
2157         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2158 label $ui_coml \
2159         -anchor w \
2160         -justify left
2161 proc trace_commit_type {varname args} {
2162         global ui_coml commit_type
2163         switch -glob -- $commit_type {
2164         initial       {set txt {Initial Commit Message:}}
2165         amend         {set txt {Amended Commit Message:}}
2166         amend-initial {set txt {Amended Initial Commit Message:}}
2167         amend-merge   {set txt {Amended Merge Commit Message:}}
2168         merge         {set txt {Merge Commit Message:}}
2169         *             {set txt {Commit Message:}}
2170         }
2171         $ui_coml conf -text $txt
2173 trace add variable commit_type write trace_commit_type
2174 pack $ui_coml -side left -fill x
2175 pack .vpane.lower.commarea.buffer.header.amend -side right
2176 pack .vpane.lower.commarea.buffer.header.new -side right
2178 text $ui_comm -background white -borderwidth 1 \
2179         -undo true \
2180         -maxundo 20 \
2181         -autoseparators true \
2182         -relief sunken \
2183         -width 75 -height 9 -wrap none \
2184         -font font_diff \
2185         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2186 scrollbar .vpane.lower.commarea.buffer.sby \
2187         -command [list $ui_comm yview]
2188 pack .vpane.lower.commarea.buffer.header -side top -fill x
2189 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2190 pack $ui_comm -side left -fill y
2191 pack .vpane.lower.commarea.buffer -side left -fill y
2193 # -- Commit Message Buffer Context Menu
2195 set ctxm .vpane.lower.commarea.buffer.ctxm
2196 menu $ctxm -tearoff 0
2197 $ctxm add command \
2198         -label {Cut} \
2199         -command {tk_textCut $ui_comm}
2200 $ctxm add command \
2201         -label {Copy} \
2202         -command {tk_textCopy $ui_comm}
2203 $ctxm add command \
2204         -label {Paste} \
2205         -command {tk_textPaste $ui_comm}
2206 $ctxm add command \
2207         -label {Delete} \
2208         -command {$ui_comm delete sel.first sel.last}
2209 $ctxm add separator
2210 $ctxm add command \
2211         -label {Select All} \
2212         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2213 $ctxm add command \
2214         -label {Copy All} \
2215         -command {
2216                 $ui_comm tag add sel 0.0 end
2217                 tk_textCopy $ui_comm
2218                 $ui_comm tag remove sel 0.0 end
2219         }
2220 $ctxm add separator
2221 $ctxm add command \
2222         -label {Sign Off} \
2223         -command do_signoff
2224 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2226 # -- Diff Header
2228 proc trace_current_diff_path {varname args} {
2229         global current_diff_path diff_actions file_states
2230         if {$current_diff_path eq {}} {
2231                 set s {}
2232                 set f {}
2233                 set p {}
2234                 set o disabled
2235         } else {
2236                 set p $current_diff_path
2237                 set s [mapdesc [lindex $file_states($p) 0] $p]
2238                 set f {File:}
2239                 set p [escape_path $p]
2240                 set o normal
2241         }
2243         .vpane.lower.diff.header.status configure -text $s
2244         .vpane.lower.diff.header.file configure -text $f
2245         .vpane.lower.diff.header.path configure -text $p
2246         foreach w $diff_actions {
2247                 uplevel #0 $w $o
2248         }
2250 trace add variable current_diff_path write trace_current_diff_path
2252 frame .vpane.lower.diff.header -background gold
2253 label .vpane.lower.diff.header.status \
2254         -background gold \
2255         -width $max_status_desc \
2256         -anchor w \
2257         -justify left
2258 label .vpane.lower.diff.header.file \
2259         -background gold \
2260         -anchor w \
2261         -justify left
2262 label .vpane.lower.diff.header.path \
2263         -background gold \
2264         -anchor w \
2265         -justify left
2266 pack .vpane.lower.diff.header.status -side left
2267 pack .vpane.lower.diff.header.file -side left
2268 pack .vpane.lower.diff.header.path -fill x
2269 set ctxm .vpane.lower.diff.header.ctxm
2270 menu $ctxm -tearoff 0
2271 $ctxm add command \
2272         -label {Copy} \
2273         -command {
2274                 clipboard clear
2275                 clipboard append \
2276                         -format STRING \
2277                         -type STRING \
2278                         -- $current_diff_path
2279         }
2280 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2281 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2283 # -- Diff Body
2285 frame .vpane.lower.diff.body
2286 set ui_diff .vpane.lower.diff.body.t
2287 text $ui_diff -background white -borderwidth 0 \
2288         -width 80 -height 15 -wrap none \
2289         -font font_diff \
2290         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2291         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2292         -state disabled
2293 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2294         -command [list $ui_diff xview]
2295 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2296         -command [list $ui_diff yview]
2297 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2298 pack .vpane.lower.diff.body.sby -side right -fill y
2299 pack $ui_diff -side left -fill both -expand 1
2300 pack .vpane.lower.diff.header -side top -fill x
2301 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2303 $ui_diff tag conf d_cr -elide true
2304 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2305 $ui_diff tag conf d_+ -foreground {#00a000}
2306 $ui_diff tag conf d_- -foreground red
2308 $ui_diff tag conf d_++ -foreground {#00a000}
2309 $ui_diff tag conf d_-- -foreground red
2310 $ui_diff tag conf d_+s \
2311         -foreground {#00a000} \
2312         -background {#e2effa}
2313 $ui_diff tag conf d_-s \
2314         -foreground red \
2315         -background {#e2effa}
2316 $ui_diff tag conf d_s+ \
2317         -foreground {#00a000} \
2318         -background ivory1
2319 $ui_diff tag conf d_s- \
2320         -foreground red \
2321         -background ivory1
2323 $ui_diff tag conf d<<<<<<< \
2324         -foreground orange \
2325         -font font_diffbold
2326 $ui_diff tag conf d======= \
2327         -foreground orange \
2328         -font font_diffbold
2329 $ui_diff tag conf d>>>>>>> \
2330         -foreground orange \
2331         -font font_diffbold
2333 $ui_diff tag raise sel
2335 # -- Diff Body Context Menu
2337 set ctxm .vpane.lower.diff.body.ctxm
2338 menu $ctxm -tearoff 0
2339 $ctxm add command \
2340         -label {Refresh} \
2341         -command reshow_diff
2342 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2343 $ctxm add command \
2344         -label {Copy} \
2345         -command {tk_textCopy $ui_diff}
2346 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2347 $ctxm add command \
2348         -label {Select All} \
2349         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2351 $ctxm add command \
2352         -label {Copy All} \
2353         -command {
2354                 $ui_diff tag add sel 0.0 end
2355                 tk_textCopy $ui_diff
2356                 $ui_diff tag remove sel 0.0 end
2357         }
2358 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2359 $ctxm add separator
2360 $ctxm add command \
2361         -label {Apply/Reverse Hunk} \
2362         -command {apply_hunk $cursorX $cursorY}
2363 set ui_diff_applyhunk [$ctxm index last]
2364 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2365 $ctxm add separator
2366 $ctxm add command \
2367         -label {Decrease Font Size} \
2368         -command {incr_font_size font_diff -1}
2369 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2370 $ctxm add command \
2371         -label {Increase Font Size} \
2372         -command {incr_font_size font_diff 1}
2373 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2374 $ctxm add separator
2375 $ctxm add command \
2376         -label {Show Less Context} \
2377         -command {if {$repo_config(gui.diffcontext) >= 1} {
2378                 incr repo_config(gui.diffcontext) -1
2379                 reshow_diff
2380         }}
2381 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2382 $ctxm add command \
2383         -label {Show More Context} \
2384         -command {if {$repo_config(gui.diffcontext) < 99} {
2385                 incr repo_config(gui.diffcontext)
2386                 reshow_diff
2387         }}
2388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2389 $ctxm add separator
2390 $ctxm add command -label {Options...} \
2391         -command do_options
2392 bind_button3 $ui_diff "
2393         set cursorX %x
2394         set cursorY %y
2395         if {\$ui_index eq \$current_diff_side} {
2396                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2397         } else {
2398                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2399         }
2400         tk_popup $ctxm %X %Y
2402 unset ui_diff_applyhunk
2404 # -- Status Bar
2406 set main_status [::status_bar::new .status]
2407 pack .status -anchor w -side bottom -fill x
2408 $main_status show {Initializing...}
2410 # -- Load geometry
2412 catch {
2413 set gm $repo_config(gui.geometry)
2414 wm geometry . [lindex $gm 0]
2415 .vpane sash place 0 \
2416         [lindex [.vpane sash coord 0] 0] \
2417         [lindex $gm 1]
2418 .vpane.files sash place 0 \
2419         [lindex $gm 2] \
2420         [lindex [.vpane.files sash coord 0] 1]
2421 unset gm
2424 # -- Key Bindings
2426 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2427 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2428 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2429 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2430 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2431 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2432 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2433 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2434 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2435 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2436 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2438 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2439 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2440 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2441 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2442 bind $ui_diff <$M1B-Key-v> {break}
2443 bind $ui_diff <$M1B-Key-V> {break}
2444 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2445 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2446 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2447 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2448 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2449 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2450 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2451 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2452 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2453 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2454 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2455 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2456 bind $ui_diff <Button-1>   {focus %W}
2458 if {[is_enabled branch]} {
2459         bind . <$M1B-Key-n> branch_create::dialog
2460         bind . <$M1B-Key-N> branch_create::dialog
2461         bind . <$M1B-Key-o> branch_checkout::dialog
2462         bind . <$M1B-Key-O> branch_checkout::dialog
2464 if {[is_enabled transport]} {
2465         bind . <$M1B-Key-p> do_push_anywhere
2466         bind . <$M1B-Key-P> do_push_anywhere
2469 bind .   <Key-F5>     do_rescan
2470 bind .   <$M1B-Key-r> do_rescan
2471 bind .   <$M1B-Key-R> do_rescan
2472 bind .   <$M1B-Key-s> do_signoff
2473 bind .   <$M1B-Key-S> do_signoff
2474 bind .   <$M1B-Key-i> do_add_all
2475 bind .   <$M1B-Key-I> do_add_all
2476 bind .   <$M1B-Key-Return> do_commit
2477 foreach i [list $ui_index $ui_workdir] {
2478         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2479         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2480         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2482 unset i
2484 set file_lists($ui_index) [list]
2485 set file_lists($ui_workdir) [list]
2487 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2488 focus -force $ui_comm
2490 # -- Warn the user about environmental problems.  Cygwin's Tcl
2491 #    does *not* pass its env array onto any processes it spawns.
2492 #    This means that git processes get none of our environment.
2494 if {[is_Cygwin]} {
2495         set ignored_env 0
2496         set suggest_user {}
2497         set msg "Possible environment issues exist.
2499 The following environment variables are probably
2500 going to be ignored by any Git subprocess run
2501 by [appname]:
2504         foreach name [array names env] {
2505                 switch -regexp -- $name {
2506                 {^GIT_INDEX_FILE$} -
2507                 {^GIT_OBJECT_DIRECTORY$} -
2508                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2509                 {^GIT_DIFF_OPTS$} -
2510                 {^GIT_EXTERNAL_DIFF$} -
2511                 {^GIT_PAGER$} -
2512                 {^GIT_TRACE$} -
2513                 {^GIT_CONFIG$} -
2514                 {^GIT_CONFIG_LOCAL$} -
2515                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2516                         append msg " - $name\n"
2517                         incr ignored_env
2518                 }
2519                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2520                         append msg " - $name\n"
2521                         incr ignored_env
2522                         set suggest_user $name
2523                 }
2524                 }
2525         }
2526         if {$ignored_env > 0} {
2527                 append msg "
2528 This is due to a known issue with the
2529 Tcl binary distributed by Cygwin."
2531                 if {$suggest_user ne {}} {
2532                         append msg "
2534 A good replacement for $suggest_user
2535 is placing values for the user.name and
2536 user.email settings into your personal
2537 ~/.gitconfig file.
2539                 }
2540                 warn_popup $msg
2541         }
2542         unset ignored_env msg suggest_user name
2545 # -- Only initialize complex UI if we are going to stay running.
2547 if {[is_enabled transport]} {
2548         load_all_remotes
2550         populate_fetch_menu
2551         populate_push_menu
2554 # -- Only suggest a gc run if we are going to stay running.
2556 if {[is_enabled multicommit]} {
2557         set object_limit 2000
2558         if {[is_Windows]} {set object_limit 200}
2559         regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2560         if {$objects_current >= $object_limit} {
2561                 if {[ask_popup \
2562                         "This repository currently has $objects_current loose objects.
2564 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2566 Compress the database now?"] eq yes} {
2567                         do_gc
2568                 }
2569         }
2570         unset object_limit _junk objects_current
2573 lock_index begin-read
2574 after 1 do_rescan