2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
11 set appvers
{@@GITGUI_VERSION@@
}
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 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch
{package require Tcl
8.4} err
]
34 ||
[catch
{package require Tk
8.4} err
]
40 -title "git-gui: fatal error" \
45 ######################################################################
47 ## configure our library
49 set oguilib
{@@GITGUI_LIBDIR@@
}
50 set oguirel
{@@GITGUI_RELATIVE@@
}
51 if {$oguirel eq
{1}} {
52 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
53 set oguilib
[file join $oguilib share git-gui lib
]
54 } elseif
{[string match @@
* $oguirel]} {
55 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
57 set idx
[file join $oguilib tclIndex
]
60 if {[gets
$fd] eq
{# Autogenerated by git-gui Makefile}} {
62 while {[gets
$fd n
] >= 0} {
63 if {$n ne
{} && ![string match
#* $n]} {
75 if {[lsearch
-exact $loaded $p] >= 0} continue
77 source [file join $oguilib $p]
82 set auto_path
[concat
[list
$oguilib] $auto_path]
84 unset -nocomplain oguilib oguirel idx fd
86 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
88 rename auto_load real__auto_load
89 proc auto_load
{name args
} {
90 puts stderr
"auto_load $name"
91 return [uplevel
1 real__auto_load
$name $args]
93 rename
source real__source
95 puts stderr
"source $name"
96 uplevel
1 real__source
$name
100 ######################################################################
104 set _appname
[lindex
[file split $argv0] end
]
120 return [eval [concat
[list
file join $_gitdir] $args]]
123 proc gitexec
{args
} {
125 if {$_gitexec eq
{}} {
126 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
127 error
"Git not installed?\n\n$err"
133 return [eval [concat
[list
file join $_gitexec] $args]]
142 global tcl_platform tk_library
143 if {[tk windowingsystem
] eq
{aqua
}} {
151 if {$tcl_platform(platform
) eq
{windows
}} {
158 global tcl_platform _iscygwin
159 if {$_iscygwin eq
{}} {
160 if {$tcl_platform(platform
) eq
{windows
}} {
161 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
173 proc is_enabled
{option
} {
174 global enabled_options
175 if {[catch
{set on
$enabled_options($option)}]} {return 0}
179 proc enable_option
{option
} {
180 global enabled_options
181 set enabled_options
($option) 1
184 proc disable_option
{option
} {
185 global enabled_options
186 set enabled_options
($option) 0
189 ######################################################################
193 proc is_many_config
{name
} {
194 switch
-glob -- $name {
203 proc is_config_true
{name
} {
205 if {[catch
{set v
$repo_config($name)}]} {
207 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
214 proc load_config
{include_global
} {
215 global repo_config global_config default_config
217 array
unset global_config
218 if {$include_global} {
220 set fd_rc
[open
"| git config --global --list" r
]
221 while {[gets
$fd_rc line
] >= 0} {
222 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
223 if {[is_many_config
$name]} {
224 lappend global_config
($name) $value
226 set global_config
($name) $value
234 array
unset repo_config
236 set fd_rc
[open
"| git config --list" r
]
237 while {[gets
$fd_rc line
] >= 0} {
238 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
239 if {[is_many_config
$name]} {
240 lappend repo_config
($name) $value
242 set repo_config
($name) $value
249 foreach name
[array names default_config
] {
250 if {[catch
{set v
$global_config($name)}]} {
251 set global_config
($name) $default_config($name)
253 if {[catch
{set v
$repo_config($name)}]} {
254 set repo_config
($name) $default_config($name)
259 ######################################################################
264 return [eval exec git
$args]
267 auto_load tk_optionMenu
268 rename tk_optionMenu real__tkOptionMenu
269 proc tk_optionMenu
{w varName args
} {
270 set m
[eval real__tkOptionMenu
$w $varName $args]
271 $m configure
-font font_ui
272 $w configure
-font font_ui
276 ######################################################################
283 if {[catch
{set v
[git
--version]} err
]} {
284 catch
{wm withdraw .
}
285 error_popup
"Cannot determine Git version:
289 [appname] requires Git $req_maj.$req_min or later."
292 if {[regexp
{^git version
(\d
+)\.
(\d
+)} $v _junk act_maj act_min
]} {
293 if {$act_maj < $req_maj
294 ||
($act_maj == $req_maj && $act_min < $req_min)} {
295 catch
{wm withdraw .
}
296 error_popup
"[appname] requires Git $req_maj.$req_min or later.
302 catch
{wm withdraw .
}
303 error_popup
"Cannot parse Git version string:\n\n$v"
306 unset -nocomplain v _junk act_maj act_min req_maj req_min
308 ######################################################################
313 set _gitdir
$env(GIT_DIR
)
317 set _gitdir
[git rev-parse
--git-dir]
318 set _prefix
[git rev-parse
--show-prefix]
320 catch
{wm withdraw .
}
321 error_popup
"Cannot find the git directory:\n\n$err"
324 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
325 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
327 if {![file isdirectory
$_gitdir]} {
328 catch
{wm withdraw .
}
329 error_popup
"Git directory not found:\n\n$_gitdir"
332 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
333 catch
{wm withdraw .
}
334 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
337 if {[catch
{cd [file dirname $_gitdir]} err
]} {
338 catch
{wm withdraw .
}
339 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
342 set _reponame
[lindex
[file split \
343 [file normalize
[file dirname $_gitdir]]] \
346 ######################################################################
350 set current_diff_path
{}
351 set current_diff_side
{}
352 set diff_actions
[list
]
353 set ui_status_value
{Initializing...
}
357 set MERGE_HEAD
[list
]
360 set current_branch
{}
361 set current_diff_path
{}
362 set selected_commit_type new
364 ######################################################################
372 set disable_on_lock
[list
]
373 set index_lock_type none
375 proc lock_index
{type} {
376 global index_lock_type disable_on_lock
378 if {$index_lock_type eq
{none
}} {
379 set index_lock_type
$type
380 foreach w
$disable_on_lock {
381 uplevel
#0 $w disabled
384 } elseif
{$index_lock_type eq
"begin-$type"} {
385 set index_lock_type
$type
391 proc unlock_index
{} {
392 global index_lock_type disable_on_lock
394 set index_lock_type none
395 foreach w
$disable_on_lock {
400 ######################################################################
404 proc repository_state
{ctvar hdvar mhvar
} {
405 global current_branch
406 upvar
$ctvar ct
$hdvar hd
$mhvar mh
410 if {[catch
{set current_branch
[git symbolic-ref HEAD
]}]} {
411 set current_branch
{}
413 regsub ^refs
/((heads|tags|remotes
)/)? \
419 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
425 set merge_head
[gitdir MERGE_HEAD
]
426 if {[file exists
$merge_head]} {
428 set fd_mh
[open
$merge_head r
]
429 while {[gets
$fd_mh line
] >= 0} {
440 global PARENT empty_tree
442 set p
[lindex
$PARENT 0]
446 if {$empty_tree eq
{}} {
447 set empty_tree
[git mktree
<< {}]
452 proc rescan
{after
{honor_trustmtime
1}} {
453 global HEAD PARENT MERGE_HEAD commit_type
454 global ui_index ui_workdir ui_status_value ui_comm
455 global rescan_active file_states
458 if {$rescan_active > 0 ||
![lock_index
read]} return
460 repository_state newType newHEAD newMERGE_HEAD
461 if {[string match amend
* $commit_type]
462 && $newType eq
{normal
}
463 && $newHEAD eq
$HEAD} {
467 set MERGE_HEAD
$newMERGE_HEAD
468 set commit_type
$newType
471 array
unset file_states
473 if {![$ui_comm edit modified
]
474 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
475 if {[string match amend
* $commit_type]} {
476 } elseif
{[load_message GITGUI_MSG
]} {
477 } elseif
{[load_message MERGE_MSG
]} {
478 } elseif
{[load_message SQUASH_MSG
]} {
481 $ui_comm edit modified false
484 if {[is_enabled branch
]} {
489 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
490 rescan_stage2
{} $after
493 set ui_status_value
{Refreshing
file status...
}
494 set cmd
[list git update-index
]
496 lappend cmd
--unmerged
497 lappend cmd
--ignore-missing
498 lappend cmd
--refresh
499 set fd_rf
[open
"| $cmd" r
]
500 fconfigure
$fd_rf -blocking 0 -translation binary
501 fileevent
$fd_rf readable \
502 [list rescan_stage2
$fd_rf $after]
506 proc rescan_stage2
{fd after
} {
507 global ui_status_value
508 global rescan_active buf_rdi buf_rdf buf_rlo
512 if {![eof
$fd]} return
516 set ls_others
[list | git ls-files
--others -z \
517 --exclude-per-directory=.gitignore
]
518 set info_exclude
[gitdir info exclude
]
519 if {[file readable
$info_exclude]} {
520 lappend ls_others
"--exclude-from=$info_exclude"
528 set ui_status_value
{Scanning
for modified files ...
}
529 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
530 set fd_df
[open
"| git diff-files -z" r
]
531 set fd_lo
[open
$ls_others r
]
533 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
534 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
535 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
536 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
537 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
538 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
541 proc load_message
{file} {
545 if {[file isfile
$f]} {
546 if {[catch
{set fd
[open
$f r
]}]} {
549 set content
[string trim
[read $fd]]
551 regsub
-all -line {[ \r\t]+$
} $content {} content
552 $ui_comm delete
0.0 end
553 $ui_comm insert end
$content
559 proc read_diff_index
{fd after
} {
562 append buf_rdi
[read $fd]
564 set n
[string length
$buf_rdi]
566 set z1
[string first
"\0" $buf_rdi $c]
569 set z2
[string first
"\0" $buf_rdi $z1]
573 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
574 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
576 [encoding convertfrom
$p] \
578 [list
[lindex
$i 0] [lindex
$i 2]] \
584 set buf_rdi
[string range
$buf_rdi $c end
]
589 rescan_done
$fd buf_rdi
$after
592 proc read_diff_files
{fd after
} {
595 append buf_rdf
[read $fd]
597 set n
[string length
$buf_rdf]
599 set z1
[string first
"\0" $buf_rdf $c]
602 set z2
[string first
"\0" $buf_rdf $z1]
606 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
607 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
609 [encoding convertfrom
$p] \
612 [list
[lindex
$i 0] [lindex
$i 2]]
617 set buf_rdf
[string range
$buf_rdf $c end
]
622 rescan_done
$fd buf_rdf
$after
625 proc read_ls_others
{fd after
} {
628 append buf_rlo
[read $fd]
629 set pck
[split $buf_rlo "\0"]
630 set buf_rlo
[lindex
$pck end
]
631 foreach p
[lrange
$pck 0 end-1
] {
632 merge_state
[encoding convertfrom
$p] ?O
634 rescan_done
$fd buf_rlo
$after
637 proc rescan_done
{fd buf after
} {
638 global rescan_active current_diff_path
639 global file_states repo_config
642 if {![eof
$fd]} return
645 if {[incr rescan_active
-1] > 0} return
650 if {$current_diff_path ne
{}} reshow_diff
654 proc prune_selection
{} {
655 global file_states selected_paths
657 foreach path
[array names selected_paths
] {
658 if {[catch
{set still_here
$file_states($path)}]} {
659 unset selected_paths
($path)
664 ######################################################################
668 proc mapicon
{w state path
} {
671 if {[catch
{set r
$all_icons($state$w)}]} {
672 puts
"error: no icon for $w state={$state} $path"
678 proc mapdesc
{state path
} {
681 if {[catch
{set r
$all_descs($state)}]} {
682 puts
"error: no desc for state={$state} $path"
688 proc escape_path
{path
} {
689 regsub
-all {\\} $path "\\\\" path
690 regsub
-all "\n" $path "\\n" path
694 proc short_path
{path
} {
695 return [escape_path
[lindex
[file split $path] end
]]
699 set null_sha1
[string repeat
0 40]
701 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
702 global file_states next_icon_id null_sha1
704 set s0
[string index
$new_state 0]
705 set s1
[string index
$new_state 1]
707 if {[catch
{set info
$file_states($path)}]} {
709 set icon n
[incr next_icon_id
]
711 set state
[lindex
$info 0]
712 set icon
[lindex
$info 1]
713 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
714 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
717 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
718 elseif
{$s0 eq
{_
}} {set s0 _
}
720 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
721 elseif
{$s1 eq
{_
}} {set s1 _
}
723 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
724 set head_info
[list
0 $null_sha1]
725 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
726 && $head_info eq
{}} {
727 set head_info
$index_info
730 set file_states
($path) [list
$s0$s1 $icon \
731 $head_info $index_info \
736 proc display_file_helper
{w path icon_name old_m new_m
} {
740 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
742 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
744 $w conf
-state normal
745 $w delete
$lno.0 [expr {$lno + 1}].0
746 $w conf
-state disabled
748 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
749 lappend file_lists
($w) $path
750 set file_lists
($w) [lsort
-unique $file_lists($w)]
751 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
753 $w conf
-state normal
754 $w image create
$lno.0 \
755 -align center
-padx 5 -pady 1 \
757 -image [mapicon
$w $new_m $path]
758 $w insert
$lno.1 "[escape_path $path]\n"
759 $w conf
-state disabled
760 } elseif
{$old_m ne
$new_m} {
761 $w conf
-state normal
762 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
763 $w conf
-state disabled
767 proc display_file
{path state
} {
768 global file_states selected_paths
769 global ui_index ui_workdir
771 set old_m
[merge_state
$path $state]
772 set s
$file_states($path)
773 set new_m
[lindex
$s 0]
774 set icon_name
[lindex
$s 1]
776 set o
[string index
$old_m 0]
777 set n
[string index
$new_m 0]
784 display_file_helper
$ui_index $path $icon_name $o $n
786 if {[string index
$old_m 0] eq
{U
}} {
789 set o
[string index
$old_m 1]
791 if {[string index
$new_m 0] eq
{U
}} {
794 set n
[string index
$new_m 1]
796 display_file_helper
$ui_workdir $path $icon_name $o $n
798 if {$new_m eq
{__
}} {
799 unset file_states
($path)
800 catch
{unset selected_paths
($path)}
804 proc display_all_files_helper
{w path icon_name m
} {
807 lappend file_lists
($w) $path
808 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
809 $w image create end \
810 -align center
-padx 5 -pady 1 \
812 -image [mapicon
$w $m $path]
813 $w insert end
"[escape_path $path]\n"
816 proc display_all_files
{} {
817 global ui_index ui_workdir
818 global file_states file_lists
821 $ui_index conf
-state normal
822 $ui_workdir conf
-state normal
824 $ui_index delete
0.0 end
825 $ui_workdir delete
0.0 end
828 set file_lists
($ui_index) [list
]
829 set file_lists
($ui_workdir) [list
]
831 foreach path
[lsort
[array names file_states
]] {
832 set s
$file_states($path)
834 set icon_name
[lindex
$s 1]
836 set s
[string index
$m 0]
837 if {$s ne
{U
} && $s ne
{_
}} {
838 display_all_files_helper
$ui_index $path \
842 if {[string index
$m 0] eq
{U
}} {
845 set s
[string index
$m 1]
848 display_all_files_helper
$ui_workdir $path \
853 $ui_index conf
-state disabled
854 $ui_workdir conf
-state disabled
857 ######################################################################
862 #define mask_width 14
863 #define mask_height 15
864 static unsigned char mask_bits
[] = {
865 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
866 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
867 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
870 image create bitmap file_plain
-background white
-foreground black
-data {
871 #define plain_width 14
872 #define plain_height 15
873 static unsigned char plain_bits
[] = {
874 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
875 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
876 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
877 } -maskdata $filemask
879 image create bitmap file_mod
-background white
-foreground blue
-data {
881 #define mod_height 15
882 static unsigned char mod_bits
[] = {
883 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
884 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
885 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
886 } -maskdata $filemask
888 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
889 #define file_fulltick_width 14
890 #define file_fulltick_height 15
891 static unsigned char file_fulltick_bits
[] = {
892 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
893 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
894 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
895 } -maskdata $filemask
897 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
898 #define parttick_width 14
899 #define parttick_height 15
900 static unsigned char parttick_bits
[] = {
901 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
902 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
903 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
904 } -maskdata $filemask
906 image create bitmap file_question
-background white
-foreground black
-data {
907 #define file_question_width 14
908 #define file_question_height 15
909 static unsigned char file_question_bits
[] = {
910 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
911 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
912 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
913 } -maskdata $filemask
915 image create bitmap file_removed
-background white
-foreground red
-data {
916 #define file_removed_width 14
917 #define file_removed_height 15
918 static unsigned char file_removed_bits
[] = {
919 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
920 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
921 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
922 } -maskdata $filemask
924 image create bitmap file_merge
-background white
-foreground blue
-data {
925 #define file_merge_width 14
926 #define file_merge_height 15
927 static unsigned char file_merge_bits
[] = {
928 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
929 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
930 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
931 } -maskdata $filemask
934 #define file_width 18
935 #define file_height 18
936 static unsigned char file_bits
[] = {
937 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
938 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
939 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
940 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
941 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
943 image create bitmap file_dir
-background white
-foreground blue \
944 -data $file_dir_data -maskdata $file_dir_data
947 set file_uplevel_data
{
950 static unsigned char up_bits
[] = {
951 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
952 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
953 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
955 image create bitmap file_uplevel
-background white
-foreground red \
956 -data $file_uplevel_data -maskdata $file_uplevel_data
957 unset file_uplevel_data
959 set ui_index .vpane.files.index.list
960 set ui_workdir .vpane.files.workdir.list
962 set all_icons
(_
$ui_index) file_plain
963 set all_icons
(A
$ui_index) file_fulltick
964 set all_icons
(M
$ui_index) file_fulltick
965 set all_icons
(D
$ui_index) file_removed
966 set all_icons
(U
$ui_index) file_merge
968 set all_icons
(_
$ui_workdir) file_plain
969 set all_icons
(M
$ui_workdir) file_mod
970 set all_icons
(D
$ui_workdir) file_question
971 set all_icons
(U
$ui_workdir) file_merge
972 set all_icons
(O
$ui_workdir) file_plain
974 set max_status_desc
0
978 {_M
"Modified, not staged"}
979 {M_
"Staged for commit"}
980 {MM
"Portions staged for commit"}
981 {MD
"Staged for commit, missing"}
983 {_O
"Untracked, not staged"}
984 {A_
"Staged for commit"}
985 {AM
"Portions staged for commit"}
986 {AD
"Staged for commit, missing"}
989 {D_
"Staged for removal"}
990 {DO
"Staged for removal, still present"}
992 {U_
"Requires merge resolution"}
993 {UU
"Requires merge resolution"}
994 {UM
"Requires merge resolution"}
995 {UD
"Requires merge resolution"}
997 if {$max_status_desc < [string length
[lindex
$i 1]]} {
998 set max_status_desc
[string length
[lindex
$i 1]]
1000 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1004 ######################################################################
1008 proc bind_button3
{w cmd
} {
1009 bind $w <Any-Button-3
> $cmd
1011 bind $w <Control-Button-1
> $cmd
1015 proc scrollbar2many
{list mode args
} {
1016 foreach w
$list {eval $w $mode $args}
1019 proc many2scrollbar
{list mode sb top bottom
} {
1020 $sb set $top $bottom
1021 foreach w
$list {$w $mode moveto
$top}
1024 proc incr_font_size
{font
{amt
1}} {
1025 set sz
[font configure
$font -size]
1027 font configure
$font -size $sz
1028 font configure
${font}bold
-size $sz
1029 font configure
${font}italic
-size $sz
1032 ######################################################################
1036 set starting_gitk_msg
{Starting gitk... please
wait...
}
1038 proc do_gitk
{revs
} {
1039 global env ui_status_value starting_gitk_msg
1041 # -- Always start gitk through whatever we were loaded with. This
1042 # lets us bypass using shell process on Windows systems.
1044 set cmd
[list
[info nameofexecutable
]]
1045 lappend cmd
[gitexec gitk
]
1051 if {[catch
{eval exec $cmd &} err
]} {
1052 error_popup
"Failed to start gitk:\n\n$err"
1054 set ui_status_value
$starting_gitk_msg
1056 if {$ui_status_value eq
$starting_gitk_msg} {
1057 set ui_status_value
{Ready.
}
1066 global ui_comm is_quitting repo_config commit_type
1068 if {$is_quitting} return
1071 if {[winfo exists
$ui_comm]} {
1072 # -- Stash our current commit buffer.
1074 set save
[gitdir GITGUI_MSG
]
1075 set msg
[string trim
[$ui_comm get
0.0 end
]]
1076 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1077 if {(![string match amend
* $commit_type]
1078 ||
[$ui_comm edit modified
])
1081 set fd
[open
$save w
]
1082 puts
-nonewline $fd $msg
1086 catch
{file delete
$save}
1089 # -- Stash our current window geometry into this repository.
1091 set cfg_geometry
[list
]
1092 lappend cfg_geometry
[wm geometry .
]
1093 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1094 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1095 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1098 if {$cfg_geometry ne
$rc_geometry} {
1099 catch
{git config gui.geometry
$cfg_geometry}
1107 rescan
{set ui_status_value
{Ready.
}}
1114 proc toggle_or_diff
{w x y
} {
1115 global file_states file_lists current_diff_path ui_index ui_workdir
1116 global last_clicked selected_paths
1118 set pos
[split [$w index @
$x,$y] .
]
1119 set lno
[lindex
$pos 0]
1120 set col [lindex
$pos 1]
1121 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1127 set last_clicked
[list
$w $lno]
1128 array
unset selected_paths
1129 $ui_index tag remove in_sel
0.0 end
1130 $ui_workdir tag remove in_sel
0.0 end
1133 if {$current_diff_path eq
$path} {
1134 set after
{reshow_diff
;}
1138 if {$w eq
$ui_index} {
1140 "Unstaging [short_path $path] from commit" \
1142 [concat
$after {set ui_status_value
{Ready.
}}]
1143 } elseif
{$w eq
$ui_workdir} {
1145 "Adding [short_path $path]" \
1147 [concat
$after {set ui_status_value
{Ready.
}}]
1150 show_diff
$path $w $lno
1154 proc add_one_to_selection
{w x y
} {
1155 global file_lists last_clicked selected_paths
1157 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1158 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1164 if {$last_clicked ne
{}
1165 && [lindex
$last_clicked 0] ne
$w} {
1166 array
unset selected_paths
1167 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1170 set last_clicked
[list
$w $lno]
1171 if {[catch
{set in_sel
$selected_paths($path)}]} {
1175 unset selected_paths
($path)
1176 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1178 set selected_paths
($path) 1
1179 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1183 proc add_range_to_selection
{w x y
} {
1184 global file_lists last_clicked selected_paths
1186 if {[lindex
$last_clicked 0] ne
$w} {
1187 toggle_or_diff
$w $x $y
1191 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1192 set lc
[lindex
$last_clicked 1]
1201 foreach path
[lrange
$file_lists($w) \
1202 [expr {$begin - 1}] \
1203 [expr {$end - 1}]] {
1204 set selected_paths
($path) 1
1206 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1209 ######################################################################
1213 set cursor_ptr arrow
1214 font create font_diff
-family Courier
-size 10
1218 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1222 font create font_uiitalic
1223 font create font_uibold
1224 font create font_diffbold
1225 font create font_diffitalic
1227 foreach class
{Button Checkbutton Entry Label
1228 Labelframe Listbox Menu Message
1229 Radiobutton Spinbox Text
} {
1230 option add
*$class.font font_ui
1242 proc apply_config
{} {
1243 global repo_config font_descs
1245 foreach option
$font_descs {
1246 set name
[lindex
$option 0]
1247 set font
[lindex
$option 1]
1249 foreach
{cn cv
} $repo_config(gui.
$name) {
1250 font configure
$font $cn $cv
1253 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1255 foreach
{cn cv
} [font configure
$font] {
1256 font configure
${font}bold
$cn $cv
1257 font configure
${font}italic
$cn $cv
1259 font configure
${font}bold
-weight bold
1260 font configure
${font}italic
-slant italic
1264 set default_config
(merge.summary
) false
1265 set default_config
(merge.verbosity
) 2
1266 set default_config
(user.name
) {}
1267 set default_config
(user.email
) {}
1269 set default_config
(gui.trustmtime
) false
1270 set default_config
(gui.diffcontext
) 5
1271 set default_config
(gui.newbranchtemplate
) {}
1272 set default_config
(gui.fontui
) [font configure font_ui
]
1273 set default_config
(gui.fontdiff
) [font configure font_diff
]
1275 {fontui font_ui
{Main Font
}}
1276 {fontdiff font_diff
{Diff
/Console Font
}}
1281 ######################################################################
1283 ## feature option selection
1285 if {[regexp
{^git-
(.
+)$
} [appname
] _junk subcommand
]} {
1290 if {$subcommand eq
{gui.sh
}} {
1293 if {$subcommand eq
{gui
} && [llength
$argv] > 0} {
1294 set subcommand
[lindex
$argv 0]
1295 set argv
[lrange
$argv 1 end
]
1298 enable_option multicommit
1299 enable_option branch
1300 enable_option transport
1302 switch
-- $subcommand {
1305 disable_option multicommit
1306 disable_option branch
1307 disable_option transport
1310 enable_option singlecommit
1312 disable_option multicommit
1313 disable_option branch
1314 disable_option transport
1318 ######################################################################
1326 menu .mbar
-tearoff 0
1327 .mbar add cascade
-label Repository
-menu .mbar.repository
1328 .mbar add cascade
-label Edit
-menu .mbar.edit
1329 if {[is_enabled branch
]} {
1330 .mbar add cascade
-label Branch
-menu .mbar.branch
1332 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1333 .mbar add cascade
-label Commit
-menu .mbar.commit
1335 if {[is_enabled transport
]} {
1336 .mbar add cascade
-label Merge
-menu .mbar.merge
1337 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1338 .mbar add cascade
-label Push
-menu .mbar.push
1340 . configure
-menu .mbar
1342 # -- Repository Menu
1344 menu .mbar.repository
1346 .mbar.repository add
command \
1347 -label {Browse Current Branch
} \
1348 -command {browser
::new
$current_branch}
1349 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1350 .mbar.repository add separator
1352 .mbar.repository add
command \
1353 -label {Visualize Current Branch
} \
1354 -command {do_gitk
$current_branch}
1355 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1356 .mbar.repository add
command \
1357 -label {Visualize All Branches
} \
1358 -command {do_gitk
--all}
1359 .mbar.repository add separator
1361 if {[is_enabled multicommit
]} {
1362 .mbar.repository add
command -label {Database Statistics
} \
1365 .mbar.repository add
command -label {Compress Database
} \
1368 .mbar.repository add
command -label {Verify Database
} \
1369 -command do_fsck_objects
1371 .mbar.repository add separator
1374 .mbar.repository add
command \
1375 -label {Create Desktop Icon
} \
1376 -command do_cygwin_shortcut
1377 } elseif
{[is_Windows
]} {
1378 .mbar.repository add
command \
1379 -label {Create Desktop Icon
} \
1380 -command do_windows_shortcut
1381 } elseif
{[is_MacOSX
]} {
1382 .mbar.repository add
command \
1383 -label {Create Desktop Icon
} \
1384 -command do_macosx_app
1388 .mbar.repository add
command -label Quit \
1395 .mbar.edit add
command -label Undo \
1396 -command {catch
{[focus
] edit undo
}} \
1398 .mbar.edit add
command -label Redo \
1399 -command {catch
{[focus
] edit redo
}} \
1401 .mbar.edit add separator
1402 .mbar.edit add
command -label Cut \
1403 -command {catch
{tk_textCut
[focus
]}} \
1405 .mbar.edit add
command -label Copy \
1406 -command {catch
{tk_textCopy
[focus
]}} \
1408 .mbar.edit add
command -label Paste \
1409 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1411 .mbar.edit add
command -label Delete \
1412 -command {catch
{[focus
] delete sel.first sel.last
}} \
1414 .mbar.edit add separator
1415 .mbar.edit add
command -label {Select All
} \
1416 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1421 if {[is_enabled branch
]} {
1424 .mbar.branch add
command -label {Create...
} \
1425 -command do_create_branch \
1427 lappend disable_on_lock
[list .mbar.branch entryconf \
1428 [.mbar.branch index last
] -state]
1430 .mbar.branch add
command -label {Delete...
} \
1431 -command do_delete_branch
1432 lappend disable_on_lock
[list .mbar.branch entryconf \
1433 [.mbar.branch index last
] -state]
1435 .mbar.branch add
command -label {Reset...
} \
1436 -command merge
::reset_hard
1437 lappend disable_on_lock
[list .mbar.branch entryconf \
1438 [.mbar.branch index last
] -state]
1443 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1446 .mbar.commit add radiobutton \
1447 -label {New Commit
} \
1448 -command do_select_commit_type \
1449 -variable selected_commit_type \
1451 lappend disable_on_lock \
1452 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1454 .mbar.commit add radiobutton \
1455 -label {Amend Last Commit
} \
1456 -command do_select_commit_type \
1457 -variable selected_commit_type \
1459 lappend disable_on_lock \
1460 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1462 .mbar.commit add separator
1464 .mbar.commit add
command -label Rescan \
1465 -command do_rescan \
1467 lappend disable_on_lock \
1468 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1470 .mbar.commit add
command -label {Add To Commit
} \
1471 -command do_add_selection
1472 lappend disable_on_lock \
1473 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1475 .mbar.commit add
command -label {Add Existing To Commit
} \
1476 -command do_add_all \
1478 lappend disable_on_lock \
1479 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1481 .mbar.commit add
command -label {Unstage From Commit
} \
1482 -command do_unstage_selection
1483 lappend disable_on_lock \
1484 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1486 .mbar.commit add
command -label {Revert Changes
} \
1487 -command do_revert_selection
1488 lappend disable_on_lock \
1489 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1491 .mbar.commit add separator
1493 .mbar.commit add
command -label {Sign Off
} \
1494 -command do_signoff \
1497 .mbar.commit add
command -label Commit \
1498 -command do_commit \
1499 -accelerator $M1T-Return
1500 lappend disable_on_lock \
1501 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1506 if {[is_enabled branch
]} {
1508 .mbar.merge add
command -label {Local Merge...
} \
1509 -command merge
::dialog
1510 lappend disable_on_lock \
1511 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1512 .mbar.merge add
command -label {Abort Merge...
} \
1513 -command merge
::reset_hard
1514 lappend disable_on_lock \
1515 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1521 if {[is_enabled transport
]} {
1525 .mbar.push add
command -label {Push...
} \
1526 -command do_push_anywhere
1530 # -- Apple Menu (Mac OS X only)
1532 .mbar add cascade
-label Apple
-menu .mbar.apple
1535 .mbar.apple add
command -label "About [appname]" \
1537 .mbar.apple add
command -label "Options..." \
1542 .mbar.edit add separator
1543 .mbar.edit add
command -label {Options...
} \
1548 if {[is_Cygwin
] && [file exists
/usr
/local
/miga
/lib
/gui-miga
]} {
1550 global ui_status_value
1551 if {![lock_index update
]} return
1552 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1553 set miga_fd
[open
"|$cmd" r
]
1554 fconfigure
$miga_fd -blocking 0
1555 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
1556 set ui_status_value
{Running miga...
}
1558 proc miga_done
{fd
} {
1563 rescan
[list
set ui_status_value
{Ready.
}]
1566 .mbar add cascade
-label Tools
-menu .mbar.tools
1568 .mbar.tools add
command -label "Migrate" \
1570 lappend disable_on_lock \
1571 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
1577 .mbar add cascade
-label Help
-menu .mbar.
help
1581 .mbar.
help add
command -label "About [appname]" \
1586 catch
{set browser
$repo_config(instaweb.browser
)}
1587 set doc_path
[file dirname [gitexec
]]
1588 set doc_path
[file join $doc_path Documentation index.html
]
1591 set doc_path
[exec cygpath
--mixed $doc_path]
1594 if {$browser eq
{}} {
1597 } elseif
{[is_Cygwin
]} {
1598 set program_files
[file dirname [exec cygpath
--windir]]
1599 set program_files
[file join $program_files {Program Files
}]
1600 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1601 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1602 if {[file exists
$firefox]} {
1603 set browser
$firefox
1604 } elseif
{[file exists
$ie]} {
1607 unset program_files firefox ie
1611 if {[file isfile
$doc_path]} {
1612 set doc_url
"file:$doc_path"
1614 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1617 if {$browser ne
{}} {
1618 .mbar.
help add
command -label {Online Documentation
} \
1619 -command [list
exec $browser $doc_url &]
1621 unset browser doc_path doc_url
1623 # -- Standard bindings
1625 wm protocol . WM_DELETE_WINDOW do_quit
1626 bind all
<$M1B-Key-q> do_quit
1627 bind all
<$M1B-Key-Q> do_quit
1628 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1629 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1631 set subcommand_args
{}
1633 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1637 # -- Not a normal commit type invocation? Do that instead!
1639 switch
-- $subcommand {
1641 set subcommand_args
{rev?
}
1642 switch
[llength
$argv] {
1644 set current_branch
[git symbolic-ref HEAD
]
1645 regsub ^refs
/((heads|tags|remotes
)/)? \
1646 $current_branch {} current_branch
1649 set current_branch
[lindex
$argv 0]
1653 browser
::new
$current_branch
1657 set subcommand_args
{rev? path?
}
1662 if {$is_path ||
[file exists
$_prefix$a]} {
1663 if {$path ne
{}} usage
1666 } elseif
{$a eq
{--}} {
1668 if {$head ne
{}} usage
1673 } elseif
{$head eq
{}} {
1674 if {$head ne
{}} usage
1683 set current_branch
[git symbolic-ref HEAD
]
1684 regsub ^refs
/((heads|tags|remotes
)/)? \
1685 $current_branch {} current_branch
1687 set current_branch
$head
1690 if {$path eq
{}} usage
1691 blame
::new
$head $path
1696 if {[llength
$argv] != 0} {
1697 puts
-nonewline stderr
"usage: $argv0"
1698 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
1699 puts
-nonewline stderr
" $subcommand"
1704 # fall through to setup UI for commits
1707 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
1718 -text {Current Branch
:} \
1722 -textvariable current_branch \
1725 pack .branch.l1
-side left
1726 pack .branch.cb
-side left
-fill x
1727 pack .branch
-side top
-fill x
1729 # -- Main Window Layout
1731 panedwindow .vpane
-orient vertical
1732 panedwindow .vpane.files
-orient horizontal
1733 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
1734 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1736 # -- Index File List
1738 frame .vpane.files.index
-height 100 -width 200
1739 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
1740 -background lightgreen
1741 text
$ui_index -background white
-borderwidth 0 \
1742 -width 20 -height 10 \
1744 -cursor $cursor_ptr \
1745 -xscrollcommand {.vpane.files.index.sx
set} \
1746 -yscrollcommand {.vpane.files.index.sy
set} \
1748 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
1749 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
1750 pack .vpane.files.index.title
-side top
-fill x
1751 pack .vpane.files.index.sx
-side bottom
-fill x
1752 pack .vpane.files.index.sy
-side right
-fill y
1753 pack
$ui_index -side left
-fill both
-expand 1
1754 .vpane.files add .vpane.files.index
-sticky nsew
1756 # -- Working Directory File List
1758 frame .vpane.files.workdir
-height 100 -width 200
1759 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
1760 -background lightsalmon
1761 text
$ui_workdir -background white
-borderwidth 0 \
1762 -width 20 -height 10 \
1764 -cursor $cursor_ptr \
1765 -xscrollcommand {.vpane.files.workdir.sx
set} \
1766 -yscrollcommand {.vpane.files.workdir.sy
set} \
1768 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
1769 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
1770 pack .vpane.files.workdir.title
-side top
-fill x
1771 pack .vpane.files.workdir.sx
-side bottom
-fill x
1772 pack .vpane.files.workdir.sy
-side right
-fill y
1773 pack
$ui_workdir -side left
-fill both
-expand 1
1774 .vpane.files add .vpane.files.workdir
-sticky nsew
1776 foreach i
[list
$ui_index $ui_workdir] {
1777 $i tag conf in_diff
-background lightgray
1778 $i tag conf in_sel
-background lightgray
1782 # -- Diff and Commit Area
1784 frame .vpane.lower
-height 300 -width 400
1785 frame .vpane.lower.commarea
1786 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1787 pack .vpane.lower.commarea
-side top
-fill x
1788 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1789 .vpane add .vpane.lower
-sticky nsew
1791 # -- Commit Area Buttons
1793 frame .vpane.lower.commarea.buttons
1794 label .vpane.lower.commarea.buttons.l
-text {} \
1797 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1798 pack .vpane.lower.commarea.buttons
-side left
-fill y
1800 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1802 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1803 lappend disable_on_lock \
1804 {.vpane.lower.commarea.buttons.rescan conf
-state}
1806 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
1808 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1809 lappend disable_on_lock \
1810 {.vpane.lower.commarea.buttons.incall conf
-state}
1812 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1814 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1816 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1818 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1819 lappend disable_on_lock \
1820 {.vpane.lower.commarea.buttons.commit conf
-state}
1822 # -- Commit Message Buffer
1824 frame .vpane.lower.commarea.buffer
1825 frame .vpane.lower.commarea.buffer.header
1826 set ui_comm .vpane.lower.commarea.buffer.t
1827 set ui_coml .vpane.lower.commarea.buffer.header.l
1828 radiobutton .vpane.lower.commarea.buffer.header.new \
1829 -text {New Commit
} \
1830 -command do_select_commit_type \
1831 -variable selected_commit_type \
1833 lappend disable_on_lock \
1834 [list .vpane.lower.commarea.buffer.header.new conf
-state]
1835 radiobutton .vpane.lower.commarea.buffer.header.amend \
1836 -text {Amend Last Commit
} \
1837 -command do_select_commit_type \
1838 -variable selected_commit_type \
1840 lappend disable_on_lock \
1841 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
1845 proc trace_commit_type
{varname args
} {
1846 global ui_coml commit_type
1847 switch
-glob -- $commit_type {
1848 initial
{set txt
{Initial Commit Message
:}}
1849 amend
{set txt
{Amended Commit Message
:}}
1850 amend-initial
{set txt
{Amended Initial Commit Message
:}}
1851 amend-merge
{set txt
{Amended Merge Commit Message
:}}
1852 merge
{set txt
{Merge Commit Message
:}}
1853 * {set txt
{Commit Message
:}}
1855 $ui_coml conf
-text $txt
1857 trace add variable commit_type
write trace_commit_type
1858 pack
$ui_coml -side left
-fill x
1859 pack .vpane.lower.commarea.buffer.header.amend
-side right
1860 pack .vpane.lower.commarea.buffer.header.new
-side right
1862 text
$ui_comm -background white
-borderwidth 1 \
1865 -autoseparators true \
1867 -width 75 -height 9 -wrap none \
1869 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
1870 scrollbar .vpane.lower.commarea.buffer.sby \
1871 -command [list
$ui_comm yview
]
1872 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
1873 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1874 pack
$ui_comm -side left
-fill y
1875 pack .vpane.lower.commarea.buffer
-side left
-fill y
1877 # -- Commit Message Buffer Context Menu
1879 set ctxm .vpane.lower.commarea.buffer.ctxm
1880 menu
$ctxm -tearoff 0
1883 -command {tk_textCut
$ui_comm}
1886 -command {tk_textCopy
$ui_comm}
1889 -command {tk_textPaste
$ui_comm}
1892 -command {$ui_comm delete sel.first sel.last
}
1895 -label {Select All
} \
1896 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
1900 $ui_comm tag add sel
0.0 end
1901 tk_textCopy
$ui_comm
1902 $ui_comm tag remove sel
0.0 end
1908 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
1912 proc trace_current_diff_path
{varname args
} {
1913 global current_diff_path diff_actions file_states
1914 if {$current_diff_path eq
{}} {
1920 set p
$current_diff_path
1921 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
1923 set p
[escape_path
$p]
1927 .vpane.lower.
diff.header.status configure
-text $s
1928 .vpane.lower.
diff.header.
file configure
-text $f
1929 .vpane.lower.
diff.header.path configure
-text $p
1930 foreach w
$diff_actions {
1934 trace add variable current_diff_path
write trace_current_diff_path
1936 frame .vpane.lower.
diff.header
-background gold
1937 label .vpane.lower.
diff.header.status \
1939 -width $max_status_desc \
1942 label .vpane.lower.
diff.header.
file \
1946 label .vpane.lower.
diff.header.path \
1950 pack .vpane.lower.
diff.header.status
-side left
1951 pack .vpane.lower.
diff.header.
file -side left
1952 pack .vpane.lower.
diff.header.path
-fill x
1953 set ctxm .vpane.lower.
diff.header.ctxm
1954 menu
$ctxm -tearoff 0
1962 -- $current_diff_path
1964 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
1965 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
1969 frame .vpane.lower.
diff.body
1970 set ui_diff .vpane.lower.
diff.body.t
1971 text
$ui_diff -background white
-borderwidth 0 \
1972 -width 80 -height 15 -wrap none \
1974 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1975 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1977 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1978 -command [list
$ui_diff xview
]
1979 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1980 -command [list
$ui_diff yview
]
1981 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1982 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1983 pack
$ui_diff -side left
-fill both
-expand 1
1984 pack .vpane.lower.
diff.header
-side top
-fill x
1985 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1987 $ui_diff tag conf d_cr
-elide true
1988 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
1989 $ui_diff tag conf d_
+ -foreground {#00a000}
1990 $ui_diff tag conf d_-
-foreground red
1992 $ui_diff tag conf d_
++ -foreground {#00a000}
1993 $ui_diff tag conf d_--
-foreground red
1994 $ui_diff tag conf d_
+s \
1995 -foreground {#00a000} \
1996 -background {#e2effa}
1997 $ui_diff tag conf d_-s \
1999 -background {#e2effa}
2000 $ui_diff tag conf d_s
+ \
2001 -foreground {#00a000} \
2003 $ui_diff tag conf d_s- \
2007 $ui_diff tag conf d
<<<<<<< \
2008 -foreground orange \
2010 $ui_diff tag conf d
======= \
2011 -foreground orange \
2013 $ui_diff tag conf d
>>>>>>> \
2014 -foreground orange \
2017 $ui_diff tag raise sel
2019 # -- Diff Body Context Menu
2021 set ctxm .vpane.lower.
diff.body.ctxm
2022 menu
$ctxm -tearoff 0
2025 -command reshow_diff
2026 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2029 -command {tk_textCopy
$ui_diff}
2030 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2032 -label {Select All
} \
2033 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2034 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2038 $ui_diff tag add sel
0.0 end
2039 tk_textCopy
$ui_diff
2040 $ui_diff tag remove sel
0.0 end
2042 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2045 -label {Apply
/Reverse Hunk
} \
2046 -command {apply_hunk
$cursorX $cursorY}
2047 set ui_diff_applyhunk
[$ctxm index last
]
2048 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2051 -label {Decrease Font Size
} \
2052 -command {incr_font_size font_diff
-1}
2053 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2055 -label {Increase Font Size
} \
2056 -command {incr_font_size font_diff
1}
2057 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2060 -label {Show Less Context
} \
2061 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2062 incr repo_config
(gui.diffcontext
) -1
2065 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2067 -label {Show More Context
} \
2068 -command {if {$repo_config(gui.diffcontext
) < 99} {
2069 incr repo_config
(gui.diffcontext
)
2072 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2074 $ctxm add
command -label {Options...
} \
2076 bind_button3
$ui_diff "
2079 if {\$ui_index eq \$current_diff_side} {
2080 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2082 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2084 tk_popup $ctxm %X %Y
2086 unset ui_diff_applyhunk
2090 label .status
-textvariable ui_status_value \
2095 pack .status
-anchor w
-side bottom
-fill x
2100 set gm
$repo_config(gui.geometry
)
2101 wm geometry .
[lindex
$gm 0]
2102 .vpane sash place
0 \
2103 [lindex
[.vpane sash coord
0] 0] \
2105 .vpane.files sash place
0 \
2107 [lindex
[.vpane.files sash coord
0] 1]
2113 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2114 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2115 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2116 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2117 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2118 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2119 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2120 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2121 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2122 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2123 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2125 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2126 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2127 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2128 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2129 bind $ui_diff <$M1B-Key-v> {break}
2130 bind $ui_diff <$M1B-Key-V> {break}
2131 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2132 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2133 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2134 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2135 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2136 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2137 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2138 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2139 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2140 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2141 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2142 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2143 bind $ui_diff <Button-1
> {focus
%W
}
2145 if {[is_enabled branch
]} {
2146 bind .
<$M1B-Key-n> do_create_branch
2147 bind .
<$M1B-Key-N> do_create_branch
2150 bind all
<Key-F5
> do_rescan
2151 bind all
<$M1B-Key-r> do_rescan
2152 bind all
<$M1B-Key-R> do_rescan
2153 bind .
<$M1B-Key-s> do_signoff
2154 bind .
<$M1B-Key-S> do_signoff
2155 bind .
<$M1B-Key-i> do_add_all
2156 bind .
<$M1B-Key-I> do_add_all
2157 bind .
<$M1B-Key-Return> do_commit
2158 foreach i
[list
$ui_index $ui_workdir] {
2159 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2160 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2161 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2165 set file_lists
($ui_index) [list
]
2166 set file_lists
($ui_workdir) [list
]
2168 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2169 focus
-force $ui_comm
2171 # -- Warn the user about environmental problems. Cygwin's Tcl
2172 # does *not* pass its env array onto any processes it spawns.
2173 # This means that git processes get none of our environment.
2178 set msg
"Possible environment issues exist.
2180 The following environment variables are probably
2181 going to be ignored by any Git subprocess run
2185 foreach name
[array names env
] {
2186 switch
-regexp -- $name {
2187 {^GIT_INDEX_FILE$
} -
2188 {^GIT_OBJECT_DIRECTORY$
} -
2189 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2191 {^GIT_EXTERNAL_DIFF$
} -
2195 {^GIT_CONFIG_LOCAL$
} -
2196 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2197 append msg
" - $name\n"
2200 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2201 append msg
" - $name\n"
2203 set suggest_user
$name
2207 if {$ignored_env > 0} {
2209 This is due to a known issue with the
2210 Tcl binary distributed by Cygwin."
2212 if {$suggest_user ne
{}} {
2215 A good replacement for $suggest_user
2216 is placing values for the user.name and
2217 user.email settings into your personal
2223 unset ignored_env msg suggest_user name
2226 # -- Only initialize complex UI if we are going to stay running.
2228 if {[is_enabled transport
]} {
2232 populate_branch_menu
2237 # -- Only suggest a gc run if we are going to stay running.
2239 if {[is_enabled multicommit
]} {
2240 set object_limit
2000
2241 if {[is_Windows
]} {set object_limit
200}
2242 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
2243 if {$objects_current >= $object_limit} {
2245 "This repository currently has $objects_current loose objects.
2247 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2249 Compress the database now?"] eq
yes} {
2253 unset object_limit _junk objects_current
2256 lock_index begin-read