2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GIT_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
41 return [eval [concat
[list
file join $_gitdir] $args]]
49 ######################################################################
53 proc is_many_config
{name
} {
54 switch
-glob -- $name {
63 proc load_config
{include_global
} {
64 global repo_config global_config default_config
66 array
unset global_config
67 if {$include_global} {
69 set fd_rc
[open
"| git repo-config --global --list" r
]
70 while {[gets
$fd_rc line
] >= 0} {
71 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
72 if {[is_many_config
$name]} {
73 lappend global_config
($name) $value
75 set global_config
($name) $value
83 array
unset repo_config
85 set fd_rc
[open
"| git repo-config --list" r
]
86 while {[gets
$fd_rc line
] >= 0} {
87 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
88 if {[is_many_config
$name]} {
89 lappend repo_config
($name) $value
91 set repo_config
($name) $value
98 foreach name
[array names default_config
] {
99 if {[catch
{set v
$global_config($name)}]} {
100 set global_config
($name) $default_config($name)
102 if {[catch
{set v
$repo_config($name)}]} {
103 set repo_config
($name) $default_config($name)
108 proc save_config
{} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 foreach option
$font_descs {
114 set name
[lindex
$option 0]
115 set font
[lindex
$option 1]
116 font configure
$font \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 font configure
${font}bold \
120 -family $global_config_new(gui.
$font^^family
) \
121 -size $global_config_new(gui.
$font^^size
)
122 set global_config_new
(gui.
$name) [font configure
$font]
123 unset global_config_new
(gui.
$font^^family
)
124 unset global_config_new
(gui.
$font^^size
)
127 foreach name
[array names default_config
] {
128 set value
$global_config_new($name)
129 if {$value ne
$global_config($name)} {
130 if {$value eq
$default_config($name)} {
131 catch
{exec git repo-config
--global --unset $name}
133 regsub
-all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
144 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
150 regsub -all "\
[{}\
]" $value {"} value
151 exec git repo-config
$name $value
153 set repo_config
($name) $value
158 proc error_popup
{msg
} {
160 if {[reponame
] ne
{}} {
161 append title
" ([reponame])"
163 set cmd
[list tk_messageBox \
166 -title "$title: error" \
168 if {[winfo ismapped .
]} {
169 lappend cmd
-parent .
174 proc warn_popup
{msg
} {
176 if {[reponame
] ne
{}} {
177 append title
" ([reponame])"
179 set cmd
[list tk_messageBox \
182 -title "$title: warning" \
184 if {[winfo ismapped .
]} {
185 lappend cmd
-parent .
190 proc info_popup
{msg
} {
192 if {[reponame
] ne
{}} {
193 append title
" ([reponame])"
203 proc ask_popup
{msg
} {
205 if {[reponame
] ne
{}} {
206 append title
" ([reponame])"
208 return [tk_messageBox \
216 ######################################################################
220 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
221 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
222 catch
{wm withdraw .
}
223 error_popup
"Cannot find the git directory:\n\n$err"
226 if {![file isdirectory
$_gitdir]} {
227 catch
{wm withdraw .
}
228 error_popup
"Git directory not found:\n\n$_gitdir"
231 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
232 catch
{wm withdraw .
}
233 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
236 if {[catch
{cd [file dirname $_gitdir]} err
]} {
237 catch
{wm withdraw .
}
238 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
241 set _reponame
[lindex
[file split \
242 [file normalize
[file dirname $_gitdir]]] \
246 if {[appname
] eq
{git-citool
}} {
250 ######################################################################
258 set disable_on_lock
[list
]
259 set index_lock_type none
261 proc lock_index
{type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq
{none
}} {
265 set index_lock_type
$type
266 foreach w
$disable_on_lock {
267 uplevel
#0 $w disabled
270 } elseif
{$index_lock_type eq
"begin-$type"} {
271 set index_lock_type
$type
277 proc unlock_index
{} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w
$disable_on_lock {
286 ######################################################################
290 proc repository_state
{ctvar hdvar mhvar
} {
291 global current_branch
292 upvar
$ctvar ct
$hdvar hd
$mhvar mh
296 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
297 set current_branch
{}
299 regsub ^refs
/((heads|tags|remotes
)/)? \
305 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
311 set merge_head
[gitdir MERGE_HEAD
]
312 if {[file exists
$merge_head]} {
314 set fd_mh
[open
$merge_head r
]
315 while {[gets
$fd_mh line
] >= 0} {
326 global PARENT empty_tree
328 set p
[lindex
$PARENT 0]
332 if {$empty_tree eq
{}} {
333 set empty_tree
[exec git mktree
<< {}]
338 proc rescan
{after
{honor_trustmtime
1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
344 if {$rescan_active > 0 ||
![lock_index
read]} return
346 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend
* $commit_type]
348 && $newType eq
{normal
}
349 && $newHEAD eq
$HEAD} {
353 set MERGE_HEAD
$newMERGE_HEAD
354 set commit_type
$newType
357 array
unset file_states
359 if {![$ui_comm edit modified
]
360 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
361 if {[load_message GITGUI_MSG
]} {
362 } elseif
{[load_message MERGE_MSG
]} {
363 } elseif
{[load_message SQUASH_MSG
]} {
366 $ui_comm edit modified false
369 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
370 rescan_stage2
{} $after
373 set ui_status_value
{Refreshing
file status...
}
374 set cmd
[list git update-index
]
376 lappend cmd
--unmerged
377 lappend cmd
--ignore-missing
378 lappend cmd
--refresh
379 set fd_rf
[open
"| $cmd" r
]
380 fconfigure
$fd_rf -blocking 0 -translation binary
381 fileevent
$fd_rf readable \
382 [list rescan_stage2
$fd_rf $after]
386 proc rescan_stage2
{fd after
} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
392 if {![eof
$fd]} return
396 set ls_others
[list | git ls-files
--others -z \
397 --exclude-per-directory=.gitignore
]
398 set info_exclude
[gitdir info exclude
]
399 if {[file readable
$info_exclude]} {
400 lappend ls_others
"--exclude-from=$info_exclude"
408 set ui_status_value
{Scanning
for modified files ...
}
409 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
410 set fd_df
[open
"| git diff-files -z" r
]
411 set fd_lo
[open
$ls_others r
]
413 fconfigure
$fd_di -blocking 0 -translation binary
414 fconfigure
$fd_df -blocking 0 -translation binary
415 fconfigure
$fd_lo -blocking 0 -translation binary
416 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
417 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
418 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
421 proc load_message
{file} {
425 if {[file isfile
$f]} {
426 if {[catch
{set fd
[open
$f r
]}]} {
429 set content
[string trim
[read $fd]]
431 $ui_comm delete
0.0 end
432 $ui_comm insert end
$content
438 proc read_diff_index
{fd after
} {
441 append buf_rdi
[read $fd]
443 set n
[string length
$buf_rdi]
445 set z1
[string first
"\0" $buf_rdi $c]
448 set z2
[string first
"\0" $buf_rdi $z1]
452 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
454 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
456 [list
[lindex
$i 0] [lindex
$i 2]] \
462 set buf_rdi
[string range
$buf_rdi $c end
]
467 rescan_done
$fd buf_rdi
$after
470 proc read_diff_files
{fd after
} {
473 append buf_rdf
[read $fd]
475 set n
[string length
$buf_rdf]
477 set z1
[string first
"\0" $buf_rdf $c]
480 set z2
[string first
"\0" $buf_rdf $z1]
484 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
486 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
489 [list
[lindex
$i 0] [lindex
$i 2]]
494 set buf_rdf
[string range
$buf_rdf $c end
]
499 rescan_done
$fd buf_rdf
$after
502 proc read_ls_others
{fd after
} {
505 append buf_rlo
[read $fd]
506 set pck
[split $buf_rlo "\0"]
507 set buf_rlo
[lindex
$pck end
]
508 foreach p
[lrange
$pck 0 end-1
] {
511 rescan_done
$fd buf_rlo
$after
514 proc rescan_done
{fd buf after
} {
516 global file_states repo_config
519 if {![eof
$fd]} return
522 if {[incr rescan_active
-1] > 0} return
531 proc prune_selection
{} {
532 global file_states selected_paths
534 foreach path
[array names selected_paths
] {
535 if {[catch
{set still_here
$file_states($path)}]} {
536 unset selected_paths
($path)
541 ######################################################################
546 global ui_diff current_diff_path ui_index ui_workdir
548 $ui_diff conf
-state normal
549 $ui_diff delete
0.0 end
550 $ui_diff conf
-state disabled
552 set current_diff_path
{}
554 $ui_index tag remove in_diff
0.0 end
555 $ui_workdir tag remove in_diff
0.0 end
558 proc reshow_diff
{} {
559 global ui_status_value file_states file_lists
560 global current_diff_path current_diff_side
562 set p
$current_diff_path
564 ||
$current_diff_side eq
{}
565 ||
[catch
{set s
$file_states($p)}]
566 ||
[lsearch
-sorted $file_lists($current_diff_side) $p] == -1} {
569 show_diff
$p $current_diff_side
573 proc handle_empty_diff
{} {
574 global current_diff_path file_states file_lists
576 set path
$current_diff_path
577 set s
$file_states($path)
578 if {[lindex
$s 0] ne
{_M
}} return
580 info_popup
"No differences detected.
582 [short_path $path] has no changes.
584 The modification date of this file was updated
585 by another application and you currently have
586 the Trust File Modification Timestamps option
587 enabled, so Git did not automatically detect
588 that there are no content differences in this
592 display_file
$path __
593 rescan
{set ui_status_value
{Ready.
}} 0
596 proc show_diff
{path w
{lno
{}}} {
597 global file_states file_lists
598 global is_3way_diff diff_active repo_config
599 global ui_diff ui_status_value ui_index ui_workdir
600 global current_diff_path current_diff_side
602 if {$diff_active ||
![lock_index
read]} return
605 if {$w eq
{} ||
$lno == {}} {
606 foreach w
[array names file_lists
] {
607 set lno
[lsearch
-sorted $file_lists($w) $path]
614 if {$w ne
{} && $lno >= 1} {
615 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
618 set s
$file_states($path)
622 set current_diff_path
$path
623 set current_diff_side
$w
624 set ui_status_value
"Loading diff of [escape_path $path]..."
626 # - Git won't give us the diff, there's nothing to compare to!
630 set fd
[open
$path r
]
631 set content
[read $fd]
636 set ui_status_value
"Unable to display [escape_path $path]"
637 error_popup
"Error loading file:\n\n$err"
640 $ui_diff conf
-state normal
641 $ui_diff insert end
$content
642 $ui_diff conf
-state disabled
645 set ui_status_value
{Ready.
}
650 if {$w eq
$ui_index} {
651 lappend cmd diff-index
653 } elseif
{$w eq
$ui_workdir} {
654 if {[string index
$m 0] eq
{U
}} {
657 lappend cmd diff-files
662 lappend cmd
--no-color
663 if {$repo_config(gui.diffcontext
) > 0} {
664 lappend cmd
"-U$repo_config(gui.diffcontext)"
666 if {$w eq
$ui_index} {
672 if {[catch
{set fd
[open
$cmd r
]} err
]} {
675 set ui_status_value
"Unable to display [escape_path $path]"
676 error_popup
"Error loading diff:\n\n$err"
680 fconfigure
$fd -blocking 0 -translation auto
681 fileevent
$fd readable
[list read_diff
$fd]
684 proc read_diff
{fd
} {
685 global ui_diff ui_status_value is_3way_diff diff_active
688 $ui_diff conf
-state normal
689 while {[gets
$fd line
] >= 0} {
690 # -- Cleanup uninteresting diff header lines.
692 if {[string match
{diff --git *} $line]} continue
693 if {[string match
{diff --cc *} $line]} continue
694 if {[string match
{diff --combined *} $line]} continue
695 if {[string match
{--- *} $line]} continue
696 if {[string match
{+++ *} $line]} continue
697 if {$line eq
{deleted
file mode
120000}} {
698 set line
"deleted symlink"
701 # -- Automatically detect if this is a 3 way diff.
703 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
705 if {[string match
{index
*} $line]
706 ||
[string match
{mode
*} $line]
707 ||
[regexp
{^\
* Unmerged path
} $line]} {
709 } elseif
{$is_3way_diff} {
710 set op
[string range
$line 0 1]
720 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
721 set line
[string replace
$line 0 1 { }]
728 puts
"error: Unhandled 3 way diff marker: {$op}"
733 set op
[string index
$line 0]
739 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
740 set line
[string replace
$line 0 0 { }]
747 puts
"error: Unhandled 2 way diff marker: {$op}"
752 $ui_diff insert end
$line $tags
753 $ui_diff insert end
"\n" $tags
755 $ui_diff conf
-state disabled
761 set ui_status_value
{Ready.
}
763 if {$repo_config(gui.trustmtime
) eq
{true
}
764 && [$ui_diff index end
] eq
{2.0}} {
770 ######################################################################
774 proc load_last_commit
{} {
775 global HEAD PARENT MERGE_HEAD commit_type ui_comm
777 if {[llength
$PARENT] == 0} {
778 error_popup
{There is nothing to amend.
780 You are about to create the initial commit.
781 There is no commit before this to amend.
786 repository_state curType curHEAD curMERGE_HEAD
787 if {$curType eq
{merge
}} {
788 error_popup
{Cannot amend
while merging.
790 You are currently
in the middle of a merge that
791 has not been fully completed. You cannot amend
792 the prior commit unless you first abort the
793 current merge activity.
801 set fd
[open
"| git cat-file commit $curHEAD" r
]
802 while {[gets
$fd line
] > 0} {
803 if {[string match
{parent
*} $line]} {
804 lappend parents
[string range
$line 7 end
]
807 set msg
[string trim
[read $fd]]
810 error_popup
"Error loading commit data for amend:\n\n$err"
816 set MERGE_HEAD
[list
]
817 switch
-- [llength
$parents] {
818 0 {set commit_type amend-initial
}
819 1 {set commit_type amend
}
820 default
{set commit_type amend-merge
}
823 $ui_comm delete
0.0 end
824 $ui_comm insert end
$msg
826 $ui_comm edit modified false
827 rescan
{set ui_status_value
{Ready.
}}
830 proc create_new_commit
{} {
831 global commit_type ui_comm
833 set commit_type normal
834 $ui_comm delete
0.0 end
836 $ui_comm edit modified false
837 rescan
{set ui_status_value
{Ready.
}}
840 set GIT_COMMITTER_IDENT
{}
842 proc committer_ident
{} {
843 global GIT_COMMITTER_IDENT
845 if {$GIT_COMMITTER_IDENT eq
{}} {
846 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
847 error_popup
"Unable to obtain your identity:\n\n$err"
850 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
851 $me me GIT_COMMITTER_IDENT
]} {
852 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
857 return $GIT_COMMITTER_IDENT
860 proc commit_tree
{} {
861 global HEAD commit_type file_states ui_comm repo_config
862 global ui_status_value pch_error
864 if {![lock_index update
]} return
865 if {[committer_ident
] eq
{}} return
867 # -- Our in memory state should match the repository.
869 repository_state curType curHEAD curMERGE_HEAD
870 if {[string match amend
* $commit_type]
871 && $curType eq
{normal
}
872 && $curHEAD eq
$HEAD} {
873 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
874 info_popup
{Last scanned state does not match repository state.
876 Another Git program has modified this repository
877 since the last scan. A rescan must be performed
878 before another commit can be created.
880 The rescan will be automatically started now.
883 rescan
{set ui_status_value
{Ready.
}}
887 # -- At least one file should differ in the index.
890 foreach path
[array names file_states
] {
891 switch
-glob -- [lindex
$file_states($path) 0] {
895 M?
{set files_ready
1}
897 error_popup
"Unmerged files cannot be committed.
899 File [short_path $path] has merge conflicts.
900 You must resolve them and add the file before committing.
906 error_popup
"Unknown file state [lindex $s 0] detected.
908 File [short_path $path] cannot be committed by this program.
914 info_popup
{No changes to commit.
916 You must add
at least
1 file before you can commit.
922 # -- A message is required.
924 set msg
[string trim
[$ui_comm get
1.0 end
]]
926 error_popup
{Please supply a commit message.
928 A good commit message has the following format
:
930 - First line
: Describe
in one sentance what you did.
932 - Remaining lines
: Describe why this change is good.
938 # -- Run the pre-commit hook.
940 set pchook
[gitdir hooks pre-commit
]
942 # On Cygwin [file executable] might lie so we need to ask
943 # the shell if the hook is executable. Yes that's annoying.
945 if {[is_Windows
] && [file isfile
$pchook]} {
946 set pchook
[list sh
-c [concat \
947 "if test -x \"$pchook\";" \
948 "then exec \"$pchook\" 2>&1;" \
950 } elseif
{[file executable
$pchook]} {
951 set pchook
[list
$pchook |
& cat]
953 commit_writetree
$curHEAD $msg
957 set ui_status_value
{Calling pre-commit hook...
}
959 set fd_ph
[open
"| $pchook" r
]
960 fconfigure
$fd_ph -blocking 0 -translation binary
961 fileevent
$fd_ph readable \
962 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
965 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
966 global pch_error ui_status_value
968 append pch_error
[read $fd_ph]
969 fconfigure
$fd_ph -blocking 1
971 if {[catch
{close
$fd_ph}]} {
972 set ui_status_value
{Commit declined by pre-commit hook.
}
973 hook_failed_popup pre-commit
$pch_error
976 commit_writetree
$curHEAD $msg
981 fconfigure
$fd_ph -blocking 0
984 proc commit_writetree
{curHEAD msg
} {
985 global ui_status_value
987 set ui_status_value
{Committing changes...
}
988 set fd_wt
[open
"| git write-tree" r
]
989 fileevent
$fd_wt readable \
990 [list commit_committree
$fd_wt $curHEAD $msg]
993 proc commit_committree
{fd_wt curHEAD msg
} {
994 global HEAD PARENT MERGE_HEAD commit_type
995 global single_commit all_heads current_branch
996 global ui_status_value ui_comm selected_commit_type
997 global file_states selected_paths rescan_active
1000 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1001 error_popup
"write-tree failed:\n\n$err"
1002 set ui_status_value
{Commit failed.
}
1007 # -- Create the commit.
1009 set cmd
[list git commit-tree
$tree_id]
1010 set parents
[concat
$PARENT $MERGE_HEAD]
1011 if {[llength
$parents] > 0} {
1012 foreach p
$parents {
1016 # git commit-tree writes to stderr during initial commit.
1017 lappend cmd
2>/dev
/null
1020 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1021 error_popup
"commit-tree failed:\n\n$err"
1022 set ui_status_value
{Commit failed.
}
1027 # -- Update the HEAD ref.
1030 if {$commit_type ne
{normal
}} {
1031 append reflogm
" ($commit_type)"
1033 set i
[string first
"\n" $msg]
1035 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1037 append reflogm
{: } $msg
1039 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1040 if {[catch
{eval exec $cmd} err
]} {
1041 error_popup
"update-ref failed:\n\n$err"
1042 set ui_status_value
{Commit failed.
}
1047 # -- Make sure our current branch exists.
1049 if {$commit_type eq
{initial
}} {
1050 lappend all_heads
$current_branch
1051 set all_heads
[lsort
-unique $all_heads]
1052 populate_branch_menu
1055 # -- Cleanup after ourselves.
1057 catch
{file delete
[gitdir MERGE_HEAD
]}
1058 catch
{file delete
[gitdir MERGE_MSG
]}
1059 catch
{file delete
[gitdir SQUASH_MSG
]}
1060 catch
{file delete
[gitdir GITGUI_MSG
]}
1062 # -- Let rerere do its thing.
1064 if {[file isdirectory
[gitdir rr-cache
]]} {
1065 catch
{exec git rerere
}
1068 # -- Run the post-commit hook.
1070 set pchook
[gitdir hooks post-commit
]
1071 if {[is_Windows
] && [file isfile
$pchook]} {
1072 set pchook
[list sh
-c [concat \
1073 "if test -x \"$pchook\";" \
1074 "then exec \"$pchook\";" \
1076 } elseif
{![file executable
$pchook]} {
1079 if {$pchook ne
{}} {
1080 catch
{exec $pchook &}
1083 $ui_comm delete
0.0 end
1085 $ui_comm edit modified false
1087 if {$single_commit} do_quit
1089 # -- Update in memory status
1091 set selected_commit_type new
1092 set commit_type normal
1095 set MERGE_HEAD
[list
]
1097 foreach path
[array names file_states
] {
1098 set s
$file_states($path)
1100 switch
-glob -- $m {
1108 unset file_states
($path)
1109 catch
{unset selected_paths
($path)}
1112 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1118 set file_states
($path) [list \
1119 _
[string index
$m 1] \
1130 set ui_status_value \
1131 "Changes committed as [string range $cmt_id 0 7]."
1134 ######################################################################
1138 proc fetch_from
{remote
} {
1139 set w
[new_console
"fetch $remote" \
1140 "Fetching new changes from $remote"]
1141 set cmd
[list git fetch
]
1143 console_exec
$w $cmd
1146 proc pull_remote
{remote branch
} {
1147 global HEAD commit_type file_states repo_config
1149 if {![lock_index update
]} return
1151 # -- Our in memory state should match the repository.
1153 repository_state curType curHEAD curMERGE_HEAD
1154 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1155 info_popup
{Last scanned state does not match repository state.
1157 Another Git program has modified this repository
1158 since the last scan. A rescan must be performed
1159 before a pull operation can be started.
1161 The rescan will be automatically started now.
1164 rescan
{set ui_status_value
{Ready.
}}
1168 # -- No differences should exist before a pull.
1170 if {[array size file_states
] != 0} {
1171 error_popup
{Uncommitted but modified files are present.
1173 You should not perform a pull with unmodified
1174 files
in your working directory as Git will be
1175 unable to recover from an incorrect merge.
1177 You should commit or revert all changes before
1178 starting a pull operation.
1184 set w
[new_console
"pull $remote $branch" \
1185 "Pulling new changes from branch $branch in $remote"]
1186 set cmd
[list git pull
]
1187 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1188 lappend cmd
--no-summary
1192 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1195 proc post_pull_remote
{remote branch success
} {
1196 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1197 global ui_status_value
1201 repository_state commit_type HEAD MERGE_HEAD
1203 set selected_commit_type new
1204 set ui_status_value
"Pulling $branch from $remote complete."
1206 rescan
[list
set ui_status_value \
1207 "Conflicts detected while pulling $branch from $remote."]
1211 proc push_to
{remote
} {
1212 set w
[new_console
"push $remote" \
1213 "Pushing changes to $remote"]
1214 set cmd
[list git push
]
1216 console_exec
$w $cmd
1219 ######################################################################
1223 proc mapicon
{w state path
} {
1226 if {[catch
{set r
$all_icons($state$w)}]} {
1227 puts
"error: no icon for $w state={$state} $path"
1233 proc mapdesc
{state path
} {
1236 if {[catch
{set r
$all_descs($state)}]} {
1237 puts
"error: no desc for state={$state} $path"
1243 proc escape_path
{path
} {
1244 regsub
-all "\n" $path "\\n" path
1248 proc short_path
{path
} {
1249 return [escape_path
[lindex
[file split $path] end
]]
1253 set null_sha1
[string repeat
0 40]
1255 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1256 global file_states next_icon_id null_sha1
1258 set s0
[string index
$new_state 0]
1259 set s1
[string index
$new_state 1]
1261 if {[catch
{set info
$file_states($path)}]} {
1263 set icon n
[incr next_icon_id
]
1265 set state
[lindex
$info 0]
1266 set icon
[lindex
$info 1]
1267 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1268 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1271 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1272 elseif
{$s0 eq
{_
}} {set s0 _
}
1274 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1275 elseif
{$s1 eq
{_
}} {set s1 _
}
1277 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1278 set head_info
[list
0 $null_sha1]
1279 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1280 && $head_info eq
{}} {
1281 set head_info
$index_info
1284 set file_states
($path) [list
$s0$s1 $icon \
1285 $head_info $index_info \
1290 proc display_file_helper
{w path icon_name old_m new_m
} {
1293 if {$new_m eq
{_
}} {
1294 set lno
[lsearch
-sorted $file_lists($w) $path]
1296 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1298 $w conf
-state normal
1299 $w delete
$lno.0 [expr {$lno + 1}].0
1300 $w conf
-state disabled
1302 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1303 lappend file_lists
($w) $path
1304 set file_lists
($w) [lsort
-unique $file_lists($w)]
1305 set lno
[lsearch
-sorted $file_lists($w) $path]
1307 $w conf
-state normal
1308 $w image create
$lno.0 \
1309 -align center
-padx 5 -pady 1 \
1311 -image [mapicon
$w $new_m $path]
1312 $w insert
$lno.1 "[escape_path $path]\n"
1313 $w conf
-state disabled
1314 } elseif
{$old_m ne
$new_m} {
1315 $w conf
-state normal
1316 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1317 $w conf
-state disabled
1321 proc display_file
{path state
} {
1322 global file_states selected_paths
1323 global ui_index ui_workdir
1325 set old_m
[merge_state
$path $state]
1326 set s
$file_states($path)
1327 set new_m
[lindex
$s 0]
1328 set icon_name
[lindex
$s 1]
1330 set o
[string index
$old_m 0]
1331 set n
[string index
$new_m 0]
1338 display_file_helper
$ui_index $path $icon_name $o $n
1340 if {[string index
$old_m 0] eq
{U
}} {
1343 set o
[string index
$old_m 1]
1345 if {[string index
$new_m 0] eq
{U
}} {
1348 set n
[string index
$new_m 1]
1350 display_file_helper
$ui_workdir $path $icon_name $o $n
1352 if {$new_m eq
{__
}} {
1353 unset file_states
($path)
1354 catch
{unset selected_paths
($path)}
1358 proc display_all_files_helper
{w path icon_name m
} {
1361 lappend file_lists
($w) $path
1362 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1363 $w image create end \
1364 -align center
-padx 5 -pady 1 \
1366 -image [mapicon
$w $m $path]
1367 $w insert end
"[escape_path $path]\n"
1370 proc display_all_files
{} {
1371 global ui_index ui_workdir
1372 global file_states file_lists
1375 $ui_index conf
-state normal
1376 $ui_workdir conf
-state normal
1378 $ui_index delete
0.0 end
1379 $ui_workdir delete
0.0 end
1382 set file_lists
($ui_index) [list
]
1383 set file_lists
($ui_workdir) [list
]
1385 foreach path
[lsort
[array names file_states
]] {
1386 set s
$file_states($path)
1388 set icon_name
[lindex
$s 1]
1390 set s
[string index
$m 0]
1391 if {$s ne
{U
} && $s ne
{_
}} {
1392 display_all_files_helper
$ui_index $path \
1396 if {[string index
$m 0] eq
{U
}} {
1399 set s
[string index
$m 1]
1402 display_all_files_helper
$ui_workdir $path \
1407 $ui_index conf
-state disabled
1408 $ui_workdir conf
-state disabled
1411 proc update_indexinfo
{msg pathList after
} {
1412 global update_index_cp ui_status_value
1414 if {![lock_index update
]} return
1416 set update_index_cp
0
1417 set pathList
[lsort
$pathList]
1418 set totalCnt
[llength
$pathList]
1419 set batch [expr {int
($totalCnt * .01) + 1}]
1420 if {$batch > 25} {set batch 25}
1422 set ui_status_value
[format \
1423 "$msg... %i/%i files (%.2f%%)" \
1427 set fd
[open
"| git update-index -z --index-info" w
]
1433 fileevent
$fd writable
[list \
1434 write_update_indexinfo \
1444 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1445 global update_index_cp ui_status_value
1446 global file_states current_diff_path
1448 if {$update_index_cp >= $totalCnt} {
1455 for {set i
$batch} \
1456 {$update_index_cp < $totalCnt && $i > 0} \
1458 set path
[lindex
$pathList $update_index_cp]
1459 incr update_index_cp
1461 set s
$file_states($path)
1462 switch
-glob -- [lindex
$s 0] {
1469 set info
[lindex
$s 2]
1470 if {$info eq
{}} continue
1472 puts
-nonewline $fd "$info\t$path\0"
1473 display_file
$path $new
1476 set ui_status_value
[format \
1477 "$msg... %i/%i files (%.2f%%)" \
1480 [expr {100.0 * $update_index_cp / $totalCnt}]]
1483 proc update_index
{msg pathList after
} {
1484 global update_index_cp ui_status_value
1486 if {![lock_index update
]} return
1488 set update_index_cp
0
1489 set pathList
[lsort
$pathList]
1490 set totalCnt
[llength
$pathList]
1491 set batch [expr {int
($totalCnt * .01) + 1}]
1492 if {$batch > 25} {set batch 25}
1494 set ui_status_value
[format \
1495 "$msg... %i/%i files (%.2f%%)" \
1499 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1505 fileevent
$fd writable
[list \
1506 write_update_index \
1516 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1517 global update_index_cp ui_status_value
1518 global file_states current_diff_path
1520 if {$update_index_cp >= $totalCnt} {
1527 for {set i
$batch} \
1528 {$update_index_cp < $totalCnt && $i > 0} \
1530 set path
[lindex
$pathList $update_index_cp]
1531 incr update_index_cp
1533 switch
-glob -- [lindex
$file_states($path) 0] {
1539 if {[file exists
$path]} {
1548 puts
-nonewline $fd "$path\0"
1549 display_file
$path $new
1552 set ui_status_value
[format \
1553 "$msg... %i/%i files (%.2f%%)" \
1556 [expr {100.0 * $update_index_cp / $totalCnt}]]
1559 proc checkout_index
{msg pathList after
} {
1560 global update_index_cp ui_status_value
1562 if {![lock_index update
]} return
1564 set update_index_cp
0
1565 set pathList
[lsort
$pathList]
1566 set totalCnt
[llength
$pathList]
1567 set batch [expr {int
($totalCnt * .01) + 1}]
1568 if {$batch > 25} {set batch 25}
1570 set ui_status_value
[format \
1571 "$msg... %i/%i files (%.2f%%)" \
1575 set cmd
[list git checkout-index
]
1581 set fd
[open
"| $cmd " w
]
1587 fileevent
$fd writable
[list \
1588 write_checkout_index \
1598 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1599 global update_index_cp ui_status_value
1600 global file_states current_diff_path
1602 if {$update_index_cp >= $totalCnt} {
1609 for {set i
$batch} \
1610 {$update_index_cp < $totalCnt && $i > 0} \
1612 set path
[lindex
$pathList $update_index_cp]
1613 incr update_index_cp
1614 switch
-glob -- [lindex
$file_states($path) 0] {
1618 puts
-nonewline $fd "$path\0"
1619 display_file
$path ?_
1624 set ui_status_value
[format \
1625 "$msg... %i/%i files (%.2f%%)" \
1628 [expr {100.0 * $update_index_cp / $totalCnt}]]
1631 ######################################################################
1633 ## branch management
1635 proc is_tracking_branch
{name
} {
1636 global tracking_branches
1638 if {![catch
{set info
$tracking_branches($name)}]} {
1641 foreach t
[array names tracking_branches
] {
1642 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1649 proc load_all_heads
{} {
1652 set all_heads
[list
]
1653 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1654 while {[gets
$fd line
] > 0} {
1655 if {[is_tracking_branch
$line]} continue
1656 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1657 lappend all_heads
$name
1661 set all_heads
[lsort
$all_heads]
1664 proc populate_branch_menu
{} {
1665 global all_heads disable_on_lock
1668 set last
[$m index last
]
1669 for {set i
0} {$i <= $last} {incr i
} {
1670 if {[$m type $i] eq
{separator
}} {
1673 foreach a
$disable_on_lock {
1674 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1678 set disable_on_lock
$new_dol
1684 foreach b
$all_heads {
1685 $m add radiobutton \
1687 -command [list switch_branch
$b] \
1688 -variable current_branch \
1691 lappend disable_on_lock \
1692 [list
$m entryconf
[$m index last
] -state]
1696 proc all_tracking_branches
{} {
1697 global tracking_branches
1699 set all_trackings
{}
1701 foreach name
[array names tracking_branches
] {
1702 if {[regsub
{/\
*$
} $name {} name
]} {
1705 regsub ^refs
/(heads|remotes
)/ $name {} name
1706 lappend all_trackings
$name
1711 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1712 while {[gets
$fd name
] > 0} {
1713 regsub ^refs
/(heads|remotes
)/ $name {} name
1714 lappend all_trackings
$name
1719 return [lsort
-unique $all_trackings]
1722 proc do_create_branch_action
{w
} {
1723 global all_heads null_sha1 repo_config
1724 global create_branch_checkout create_branch_revtype
1725 global create_branch_head create_branch_trackinghead
1727 set newbranch
[string trim
[$w.desc.name_t get
0.0 end
]]
1728 if {$newbranch eq
{}
1729 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1733 -title [wm title
$w] \
1735 -message "Please supply a branch name."
1736 focus
$w.desc.name_t
1739 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1743 -title [wm title
$w] \
1745 -message "Branch '$newbranch' already exists."
1746 focus
$w.desc.name_t
1749 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1753 -title [wm title
$w] \
1755 -message "We do not like '$newbranch' as a branch name."
1756 focus
$w.desc.name_t
1761 switch
-- $create_branch_revtype {
1762 head {set rev $create_branch_head}
1763 tracking
{set rev $create_branch_trackinghead}
1764 expression
{set rev [string trim
[$w.from.exp_t get
0.0 end
]]}
1766 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1770 -title [wm title
$w] \
1772 -message "Invalid starting revision: $rev"
1775 set cmd
[list git update-ref
]
1777 lappend cmd
"branch: Created from $rev"
1778 lappend cmd
"refs/heads/$newbranch"
1780 lappend cmd
$null_sha1
1781 if {[catch
{eval exec $cmd} err
]} {
1785 -title [wm title
$w] \
1787 -message "Failed to create '$newbranch'.\n\n$err"
1791 lappend all_heads
$newbranch
1792 set all_heads
[lsort
$all_heads]
1793 populate_branch_menu
1795 if {$create_branch_checkout} {
1796 switch_branch
$newbranch
1800 proc radio_selector
{varname value args
} {
1801 upvar
#0 $varname var
1805 trace add variable create_branch_head
write \
1806 [list radio_selector create_branch_revtype
head]
1807 trace add variable create_branch_trackinghead
write \
1808 [list radio_selector create_branch_revtype tracking
]
1810 trace add variable delete_branch_head
write \
1811 [list radio_selector delete_branch_checktype
head]
1812 trace add variable delete_branch_trackinghead
write \
1813 [list radio_selector delete_branch_checktype tracking
]
1815 proc do_create_branch
{} {
1816 global all_heads current_branch repo_config
1817 global create_branch_checkout create_branch_revtype
1818 global create_branch_head create_branch_trackinghead
1820 set w .branch_editor
1822 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1824 label
$w.header
-text {Create New Branch
} \
1826 pack
$w.header
-side top
-fill x
1829 button
$w.buttons.create
-text Create \
1832 -command [list do_create_branch_action
$w]
1833 pack
$w.buttons.create
-side right
1834 button
$w.buttons.cancel
-text {Cancel
} \
1836 -command [list destroy
$w]
1837 pack
$w.buttons.cancel
-side right
-padx 5
1838 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1840 labelframe
$w.desc \
1841 -text {Branch Description
} \
1843 label
$w.desc.name_l
-text {Name
:} -font font_ui
1844 text
$w.desc.name_t \
1850 $w.desc.name_t insert
0.0 $repo_config(gui.newbranchtemplate
)
1851 grid
$w.desc.name_l
$w.desc.name_t
-stick we
-padx {0 5}
1852 bind $w.desc.name_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
1853 bind $w.desc.name_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
1854 bind $w.desc.name_t
<Key-Return
> "do_create_branch_action $w;break"
1855 bind $w.desc.name_t
<Key
> {
1856 if {{%K
} ne
{BackSpace
}
1859 && {%K
} ne
{Return
}} {
1861 if {[string first
%A
{~^
:?
*[}] >= 0} break
1864 grid columnconfigure
$w.desc
1 -weight 1
1865 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
1867 labelframe
$w.from \
1868 -text {Starting Revision
} \
1870 radiobutton
$w.from.head_r \
1871 -text {Local Branch
:} \
1873 -variable create_branch_revtype \
1875 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
1876 grid
$w.from.head_r
$w.from.head_m
-sticky w
1877 set all_trackings
[all_tracking_branches
]
1878 if {$all_trackings ne
{}} {
1879 set create_branch_trackinghead
[lindex
$all_trackings 0]
1880 radiobutton
$w.from.tracking_r \
1881 -text {Tracking Branch
:} \
1883 -variable create_branch_revtype \
1885 eval tk_optionMenu
$w.from.tracking_m \
1886 create_branch_trackinghead \
1888 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
1890 radiobutton
$w.from.exp_r \
1891 -text {Revision Expression
:} \
1893 -variable create_branch_revtype \
1895 text
$w.from.exp_t \
1901 grid
$w.from.exp_r
$w.from.exp_t
-stick we
-padx {0 5}
1902 bind $w.from.exp_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
1903 bind $w.from.exp_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
1904 bind $w.from.exp_t
<Key-Return
> "do_create_branch_action $w;break"
1905 bind $w.from.exp_t
<Key-space
> break
1906 bind $w.from.exp_t
<Key
> {set create_branch_revtype expression
}
1907 grid columnconfigure
$w.from
1 -weight 1
1908 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
1910 labelframe
$w.postActions \
1911 -text {Post Creation Actions
} \
1913 checkbutton
$w.postActions.checkout \
1914 -text {Checkout after creation
} \
1915 -variable create_branch_checkout \
1917 pack
$w.postActions.checkout
-anchor nw
1918 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
1920 set create_branch_checkout
1
1921 set create_branch_head
$current_branch
1922 set create_branch_revtype
head
1924 bind $w <Visibility
> "grab $w; focus $w.desc.name_t"
1925 bind $w <Key-Escape
> "destroy $w"
1926 bind $w <Key-Return
> "do_create_branch_action $w;break"
1927 wm title
$w "[appname] ([reponame]): Create Branch"
1931 proc do_delete_branch_action
{w
} {
1933 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1936 switch
-- $delete_branch_checktype {
1937 head {set check_rev
$delete_branch_head}
1938 tracking
{set check_rev
$delete_branch_trackinghead}
1939 always
{set check_rev
{:none
}}
1941 if {$check_rev eq
{:none
}} {
1943 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
1947 -title [wm title
$w] \
1949 -message "Invalid check revision: $check_rev"
1953 set to_delete
[list
]
1954 set not_merged
[list
]
1955 foreach i
[$w.list.l curselection
] {
1956 set b
[$w.list.l get
$i]
1957 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
1958 if {$check_cmt ne
{}} {
1959 if {$b eq
$check_rev} continue
1960 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
1962 lappend not_merged
$b
1966 lappend to_delete
[list
$b $o]
1968 if {$not_merged ne
{}} {
1969 set msg
"The following branches are not completely merged into $check_rev:
1971 - [join $not_merged "\n - "]"
1975 -title [wm title
$w] \
1979 if {$to_delete eq
{}} return
1980 if {$delete_branch_checktype eq
{always
}} {
1981 set msg
{Recovering deleted branches is difficult.
1983 Delete the selected branches?
}
1984 if {[tk_messageBox \
1987 -title [wm title
$w] \
1989 -message $msg] ne
yes} {
1995 foreach i
$to_delete {
1998 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
1999 append failed
" - $b: $err\n"
2001 set x
[lsearch
-sorted $all_heads $b]
2003 set all_heads
[lreplace
$all_heads $x $x]
2008 if {$failed ne
{}} {
2012 -title [wm title
$w] \
2014 -message "Failed to delete branches:\n$failed"
2017 set all_heads
[lsort
$all_heads]
2018 populate_branch_menu
2022 proc do_delete_branch
{} {
2023 global all_heads tracking_branches current_branch
2024 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2026 set w .branch_editor
2028 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2030 label
$w.header
-text {Delete Local Branch
} \
2032 pack
$w.header
-side top
-fill x
2035 button
$w.buttons.create
-text Delete \
2037 -command [list do_delete_branch_action
$w]
2038 pack
$w.buttons.create
-side right
2039 button
$w.buttons.cancel
-text {Cancel
} \
2041 -command [list destroy
$w]
2042 pack
$w.buttons.cancel
-side right
-padx 5
2043 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2045 labelframe
$w.list \
2046 -text {Local Branches
} \
2051 -selectmode extended \
2053 foreach h
$all_heads {
2054 if {$h ne
$current_branch} {
2055 $w.list.l insert end
$h
2058 pack
$w.list.l
-fill both
-pady 5 -padx 5
2059 pack
$w.list
-fill both
-pady 5 -padx 5
2061 labelframe
$w.validate \
2062 -text {Delete Only If
} \
2064 radiobutton
$w.validate.head_r \
2065 -text {Merged Into Local Branch
:} \
2067 -variable delete_branch_checktype \
2069 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2070 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2071 set all_trackings
[all_tracking_branches
]
2072 if {$all_trackings ne
{}} {
2073 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2074 radiobutton
$w.validate.tracking_r \
2075 -text {Merged Into Tracking Branch
:} \
2077 -variable delete_branch_checktype \
2079 eval tk_optionMenu
$w.validate.tracking_m \
2080 delete_branch_trackinghead \
2082 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2084 radiobutton
$w.validate.always_r \
2085 -text {Always
(Do not perform merge checks
)} \
2087 -variable delete_branch_checktype \
2089 grid
$w.validate.always_r
-columnspan 2 -sticky w
2090 grid columnconfigure
$w.validate
1 -weight 1
2091 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2093 set delete_branch_head
$current_branch
2094 set delete_branch_checktype
head
2096 bind $w <Visibility
> "grab $w; focus $w"
2097 bind $w <Key-Escape
> "destroy $w"
2098 wm title
$w "[appname] ([reponame]): Delete Branch"
2102 proc switch_branch
{b
} {
2103 global HEAD commit_type file_states current_branch
2104 global selected_commit_type ui_comm
2106 if {![lock_index switch
]} return
2108 # -- Backup the selected branch (repository_state resets it)
2110 set new_branch
$current_branch
2112 # -- Our in memory state should match the repository.
2114 repository_state curType curHEAD curMERGE_HEAD
2115 if {[string match amend
* $commit_type]
2116 && $curType eq
{normal
}
2117 && $curHEAD eq
$HEAD} {
2118 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2119 info_popup
{Last scanned state does not match repository state.
2121 Another Git program has modified this repository
2122 since the last scan. A rescan must be performed
2123 before the current branch can be changed.
2125 The rescan will be automatically started now.
2128 rescan
{set ui_status_value
{Ready.
}}
2132 # -- Toss the message buffer if we are in amend mode.
2134 if {[string match amend
* $curType]} {
2135 $ui_comm delete
0.0 end
2137 $ui_comm edit modified false
2140 set selected_commit_type new
2141 set current_branch
$new_branch
2144 error
"NOT FINISHED"
2147 ######################################################################
2149 ## remote management
2151 proc load_all_remotes
{} {
2153 global all_remotes tracking_branches
2155 set all_remotes
[list
]
2156 array
unset tracking_branches
2158 set rm_dir
[gitdir remotes
]
2159 if {[file isdirectory
$rm_dir]} {
2160 set all_remotes
[glob \
2164 -directory $rm_dir *]
2166 foreach name
$all_remotes {
2168 set fd
[open
[file join $rm_dir $name] r
]
2169 while {[gets
$fd line
] >= 0} {
2170 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2171 $line line src dst
]} continue
2172 if {![regexp ^refs
/ $dst]} {
2173 set dst
"refs/heads/$dst"
2175 set tracking_branches
($dst) [list
$name $src]
2182 foreach line
[array names repo_config remote.
*.url
] {
2183 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2184 lappend all_remotes
$name
2186 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2190 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2191 if {![regexp ^refs
/ $dst]} {
2192 set dst
"refs/heads/$dst"
2194 set tracking_branches
($dst) [list
$name $src]
2198 set all_remotes
[lsort
-unique $all_remotes]
2201 proc populate_fetch_menu
{m
} {
2202 global all_remotes repo_config
2204 foreach r
$all_remotes {
2206 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2207 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2212 set fd
[open
[gitdir remotes
$r] r
]
2213 while {[gets
$fd n
] >= 0} {
2214 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2225 -label "Fetch from $r..." \
2226 -command [list fetch_from
$r] \
2232 proc populate_push_menu
{m
} {
2233 global all_remotes repo_config
2235 foreach r
$all_remotes {
2237 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2238 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2243 set fd
[open
[gitdir remotes
$r] r
]
2244 while {[gets
$fd n
] >= 0} {
2245 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2256 -label "Push to $r..." \
2257 -command [list push_to
$r] \
2263 proc populate_pull_menu
{m
} {
2264 global repo_config all_remotes disable_on_lock
2266 foreach remote
$all_remotes {
2268 if {[array get repo_config remote.
$remote.url
] ne
{}} {
2269 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
2270 foreach line
$repo_config(remote.
$remote.fetch
) {
2271 if {[regexp
{^
([^
:]+):} $line line rb
]} {
2278 set fd
[open
[gitdir remotes
$remote] r
]
2279 while {[gets
$fd line
] >= 0} {
2280 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
2288 foreach rb
$rb_list {
2289 regsub ^refs
/heads
/ $rb {} rb_short
2291 -label "Branch $rb_short from $remote..." \
2292 -command [list pull_remote
$remote $rb] \
2294 lappend disable_on_lock \
2295 [list
$m entryconf
[$m index last
] -state]
2300 ######################################################################
2305 #define mask_width 14
2306 #define mask_height 15
2307 static unsigned char mask_bits
[] = {
2308 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2309 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2310 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2313 image create bitmap file_plain
-background white
-foreground black
-data {
2314 #define plain_width 14
2315 #define plain_height 15
2316 static unsigned char plain_bits
[] = {
2317 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2318 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2319 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2320 } -maskdata $filemask
2322 image create bitmap file_mod
-background white
-foreground blue
-data {
2323 #define mod_width 14
2324 #define mod_height 15
2325 static unsigned char mod_bits
[] = {
2326 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2327 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2328 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2329 } -maskdata $filemask
2331 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2332 #define file_fulltick_width 14
2333 #define file_fulltick_height 15
2334 static unsigned char file_fulltick_bits
[] = {
2335 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2336 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2337 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2338 } -maskdata $filemask
2340 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2341 #define parttick_width 14
2342 #define parttick_height 15
2343 static unsigned char parttick_bits
[] = {
2344 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2345 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2346 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2347 } -maskdata $filemask
2349 image create bitmap file_question
-background white
-foreground black
-data {
2350 #define file_question_width 14
2351 #define file_question_height 15
2352 static unsigned char file_question_bits
[] = {
2353 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2354 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2355 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2356 } -maskdata $filemask
2358 image create bitmap file_removed
-background white
-foreground red
-data {
2359 #define file_removed_width 14
2360 #define file_removed_height 15
2361 static unsigned char file_removed_bits
[] = {
2362 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2363 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2364 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2365 } -maskdata $filemask
2367 image create bitmap file_merge
-background white
-foreground blue
-data {
2368 #define file_merge_width 14
2369 #define file_merge_height 15
2370 static unsigned char file_merge_bits
[] = {
2371 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2372 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2373 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2374 } -maskdata $filemask
2376 set ui_index .vpane.files.index.list
2377 set ui_workdir .vpane.files.workdir.list
2379 set all_icons
(_
$ui_index) file_plain
2380 set all_icons
(A
$ui_index) file_fulltick
2381 set all_icons
(M
$ui_index) file_fulltick
2382 set all_icons
(D
$ui_index) file_removed
2383 set all_icons
(U
$ui_index) file_merge
2385 set all_icons
(_
$ui_workdir) file_plain
2386 set all_icons
(M
$ui_workdir) file_mod
2387 set all_icons
(D
$ui_workdir) file_question
2388 set all_icons
(U
$ui_workdir) file_merge
2389 set all_icons
(O
$ui_workdir) file_plain
2391 set max_status_desc
0
2395 {_M
"Modified, not staged"}
2396 {M_
"Staged for commit"}
2397 {MM
"Portions staged for commit"}
2398 {MD
"Staged for commit, missing"}
2400 {_O
"Untracked, not staged"}
2401 {A_
"Staged for commit"}
2402 {AM
"Portions staged for commit"}
2403 {AD
"Staged for commit, missing"}
2406 {D_
"Staged for removal"}
2407 {DO
"Staged for removal, still present"}
2409 {U_
"Requires merge resolution"}
2410 {UU
"Requires merge resolution"}
2411 {UM
"Requires merge resolution"}
2412 {UD
"Requires merge resolution"}
2414 if {$max_status_desc < [string length
[lindex
$i 1]]} {
2415 set max_status_desc
[string length
[lindex
$i 1]]
2417 set all_descs
([lindex
$i 0]) [lindex
$i 1]
2421 ######################################################################
2426 global tcl_platform tk_library
2427 if {[tk windowingsystem
] eq
{aqua
}} {
2433 proc is_Windows
{} {
2435 if {$tcl_platform(platform
) eq
{windows
}} {
2441 proc bind_button3
{w cmd
} {
2442 bind $w <Any-Button-3
> $cmd
2444 bind $w <Control-Button-1
> $cmd
2448 proc incr_font_size
{font
{amt
1}} {
2449 set sz
[font configure
$font -size]
2451 font configure
$font -size $sz
2452 font configure
${font}bold
-size $sz
2455 proc hook_failed_popup
{hook msg
} {
2460 label
$w.m.l1
-text "$hook hook failed:" \
2465 -background white
-borderwidth 1 \
2467 -width 80 -height 10 \
2469 -yscrollcommand [list
$w.m.sby
set]
2471 -text {You must correct the above errors before committing.
} \
2475 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2476 pack
$w.m.l1
-side top
-fill x
2477 pack
$w.m.l2
-side bottom
-fill x
2478 pack
$w.m.sby
-side right
-fill y
2479 pack
$w.m.t
-side left
-fill both
-expand 1
2480 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2482 $w.m.t insert
1.0 $msg
2483 $w.m.t conf
-state disabled
2485 button
$w.ok
-text OK \
2488 -command "destroy $w"
2489 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2491 bind $w <Visibility
> "grab $w; focus $w"
2492 bind $w <Key-Return
> "destroy $w"
2493 wm title
$w "[appname] ([reponame]): error"
2497 set next_console_id
0
2499 proc new_console
{short_title long_title
} {
2500 global next_console_id console_data
2501 set w .console
[incr next_console_id
]
2502 set console_data
($w) [list
$short_title $long_title]
2503 return [console_init
$w]
2506 proc console_init
{w
} {
2507 global console_cr console_data M1B
2509 set console_cr
($w) 1.0
2512 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2517 -background white
-borderwidth 1 \
2519 -width 80 -height 10 \
2522 -yscrollcommand [list
$w.m.sby
set]
2523 label
$w.m.s
-text {Working... please
wait...
} \
2527 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2528 pack
$w.m.l1
-side top
-fill x
2529 pack
$w.m.s
-side bottom
-fill x
2530 pack
$w.m.sby
-side right
-fill y
2531 pack
$w.m.t
-side left
-fill both
-expand 1
2532 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2534 menu
$w.ctxm
-tearoff 0
2535 $w.ctxm add
command -label "Copy" \
2537 -command "tk_textCopy $w.m.t"
2538 $w.ctxm add
command -label "Select All" \
2540 -command "$w.m.t tag add sel 0.0 end"
2541 $w.ctxm add
command -label "Copy All" \
2544 $w.m.t tag add sel 0.0 end
2546 $w.m.t tag remove sel 0.0 end
2549 button
$w.ok
-text {Close
} \
2552 -command "destroy $w"
2553 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2555 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2556 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2557 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2558 bind $w <Visibility
> "focus $w"
2559 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2563 proc console_exec
{w cmd
{after
{}}} {
2564 # -- Windows tosses the enviroment when we exec our child.
2565 # But most users need that so we have to relogin. :-(
2568 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2571 # -- Tcl won't let us redirect both stdout and stderr to
2572 # the same pipe. So pass it through cat...
2574 set cmd
[concat |
$cmd |
& cat]
2576 set fd_f
[open
$cmd r
]
2577 fconfigure
$fd_f -blocking 0 -translation binary
2578 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2581 proc console_read
{w fd after
} {
2582 global console_cr console_data
2586 if {![winfo exists
$w]} {console_init
$w}
2587 $w.m.t conf
-state normal
2589 set n
[string length
$buf]
2591 set cr
[string first
"\r" $buf $c]
2592 set lf
[string first
"\n" $buf $c]
2593 if {$cr < 0} {set cr
[expr {$n + 1}]}
2594 if {$lf < 0} {set lf
[expr {$n + 1}]}
2597 $w.m.t insert end
[string range
$buf $c $lf]
2598 set console_cr
($w) [$w.m.t index
{end
-1c}]
2602 $w.m.t delete
$console_cr($w) end
2603 $w.m.t insert end
"\n"
2604 $w.m.t insert end
[string range
$buf $c $cr]
2609 $w.m.t conf
-state disabled
2613 fconfigure
$fd -blocking 1
2615 if {[catch
{close
$fd}]} {
2616 if {![winfo exists
$w]} {console_init
$w}
2617 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2618 $w.ok conf
-state normal
2620 } elseif
{[winfo exists
$w]} {
2621 $w.m.s conf
-background green
-text {Success
}
2622 $w.ok conf
-state normal
2625 array
unset console_cr
$w
2626 array
unset console_data
$w
2628 uplevel
#0 $after $ok
2632 fconfigure
$fd -blocking 0
2635 ######################################################################
2639 set starting_gitk_msg
{Starting gitk... please
wait...
}
2641 proc do_gitk
{revs
} {
2642 global ui_status_value starting_gitk_msg
2650 set cmd
"sh -c \"exec $cmd\""
2654 if {[catch
{eval exec $cmd} err
]} {
2655 error_popup
"Failed to start gitk:\n\n$err"
2657 set ui_status_value
$starting_gitk_msg
2659 if {$ui_status_value eq
$starting_gitk_msg} {
2660 set ui_status_value
{Ready.
}
2667 set w
[new_console
{gc
} {Compressing the object database
}]
2668 console_exec
$w {git gc
}
2671 proc do_fsck_objects
{} {
2672 set w
[new_console
{fsck-objects
} \
2673 {Verifying the object database with fsck-objects
}]
2674 set cmd
[list git fsck-objects
]
2677 lappend cmd
--strict
2678 console_exec
$w $cmd
2684 global ui_comm is_quitting repo_config commit_type
2686 if {$is_quitting} return
2689 # -- Stash our current commit buffer.
2691 set save
[gitdir GITGUI_MSG
]
2692 set msg
[string trim
[$ui_comm get
0.0 end
]]
2693 if {![string match amend
* $commit_type]
2694 && [$ui_comm edit modified
]
2697 set fd
[open
$save w
]
2698 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2702 catch
{file delete
$save}
2705 # -- Stash our current window geometry into this repository.
2707 set cfg_geometry
[list
]
2708 lappend cfg_geometry
[wm geometry .
]
2709 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
2710 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
2711 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2714 if {$cfg_geometry ne
$rc_geometry} {
2715 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2722 rescan
{set ui_status_value
{Ready.
}}
2725 proc unstage_helper
{txt paths
} {
2726 global file_states current_diff_path
2728 if {![lock_index begin-update
]} return
2732 foreach path
$paths {
2733 switch
-glob -- [lindex
$file_states($path) 0] {
2737 lappend pathList
$path
2738 if {$path eq
$current_diff_path} {
2739 set after
{reshow_diff
;}
2744 if {$pathList eq
{}} {
2750 [concat
$after {set ui_status_value
{Ready.
}}]
2754 proc do_unstage_selection
{} {
2755 global current_diff_path selected_paths
2757 if {[array size selected_paths
] > 0} {
2759 {Unstaging selected files from commit
} \
2760 [array names selected_paths
]
2761 } elseif
{$current_diff_path ne
{}} {
2763 "Unstaging [short_path $current_diff_path] from commit" \
2764 [list
$current_diff_path]
2768 proc add_helper
{txt paths
} {
2769 global file_states current_diff_path
2771 if {![lock_index begin-update
]} return
2775 foreach path
$paths {
2776 switch
-glob -- [lindex
$file_states($path) 0] {
2781 lappend pathList
$path
2782 if {$path eq
$current_diff_path} {
2783 set after
{reshow_diff
;}
2788 if {$pathList eq
{}} {
2794 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2798 proc do_add_selection
{} {
2799 global current_diff_path selected_paths
2801 if {[array size selected_paths
] > 0} {
2803 {Adding selected files
} \
2804 [array names selected_paths
]
2805 } elseif
{$current_diff_path ne
{}} {
2807 "Adding [short_path $current_diff_path]" \
2808 [list
$current_diff_path]
2812 proc do_add_all
{} {
2816 foreach path
[array names file_states
] {
2817 switch
-glob -- [lindex
$file_states($path) 0] {
2820 ?D
{lappend paths
$path}
2823 add_helper
{Adding all changed files
} $paths
2826 proc revert_helper
{txt paths
} {
2827 global file_states current_diff_path
2829 if {![lock_index begin-update
]} return
2833 foreach path
$paths {
2834 switch
-glob -- [lindex
$file_states($path) 0] {
2838 lappend pathList
$path
2839 if {$path eq
$current_diff_path} {
2840 set after
{reshow_diff
;}
2846 set n
[llength
$pathList]
2850 } elseif
{$n == 1} {
2851 set s
"[short_path [lindex $pathList]]"
2853 set s
"these $n files"
2856 set reply
[tk_dialog \
2858 "[appname] ([reponame])" \
2859 "Revert changes in $s?
2861 Any unadded changes will be permanently lost by the revert." \
2871 [concat
$after {set ui_status_value
{Ready.
}}]
2877 proc do_revert_selection
{} {
2878 global current_diff_path selected_paths
2880 if {[array size selected_paths
] > 0} {
2882 {Reverting selected files
} \
2883 [array names selected_paths
]
2884 } elseif
{$current_diff_path ne
{}} {
2886 "Reverting [short_path $current_diff_path]" \
2887 [list
$current_diff_path]
2891 proc do_signoff
{} {
2894 set me
[committer_ident
]
2895 if {$me eq
{}} return
2897 set sob
"Signed-off-by: $me"
2898 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2899 if {$last ne
$sob} {
2900 $ui_comm edit separator
2902 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2903 $ui_comm insert end
"\n"
2905 $ui_comm insert end
"\n$sob"
2906 $ui_comm edit separator
2911 proc do_select_commit_type
{} {
2912 global commit_type selected_commit_type
2914 if {$selected_commit_type eq
{new
}
2915 && [string match amend
* $commit_type]} {
2917 } elseif
{$selected_commit_type eq
{amend
}
2918 && ![string match amend
* $commit_type]} {
2921 # The amend request was rejected...
2923 if {![string match amend
* $commit_type]} {
2924 set selected_commit_type new
2934 global appvers copyright
2935 global tcl_patchLevel tk_patchLevel
2939 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2941 label
$w.header
-text "About [appname]" \
2943 pack
$w.header
-side top
-fill x
2946 button
$w.buttons.close
-text {Close
} \
2948 -command [list destroy
$w]
2949 pack
$w.buttons.close
-side right
2950 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2953 -text "[appname] - a commit creation tool for Git.
2961 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2964 append v
"[appname] version $appvers\n"
2965 append v
"[exec git version]\n"
2967 if {$tcl_patchLevel eq
$tk_patchLevel} {
2968 append v
"Tcl/Tk version $tcl_patchLevel"
2970 append v
"Tcl version $tcl_patchLevel"
2971 append v
", Tk version $tk_patchLevel"
2982 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2984 menu
$w.ctxm
-tearoff 0
2985 $w.ctxm add
command \
2990 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2993 bind $w <Visibility
> "grab $w; focus $w"
2994 bind $w <Key-Escape
> "destroy $w"
2995 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2996 wm title
$w "About [appname]"
3000 proc do_options
{} {
3001 global repo_config global_config font_descs
3002 global repo_config_new global_config_new
3004 array
unset repo_config_new
3005 array
unset global_config_new
3006 foreach name
[array names repo_config
] {
3007 set repo_config_new
($name) $repo_config($name)
3010 foreach name
[array names repo_config
] {
3012 gui.diffcontext
{continue}
3014 set repo_config_new
($name) $repo_config($name)
3016 foreach name
[array names global_config
] {
3017 set global_config_new
($name) $global_config($name)
3020 set w .options_editor
3022 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3024 label
$w.header
-text "[appname] Options" \
3026 pack
$w.header
-side top
-fill x
3029 button
$w.buttons.restore
-text {Restore Defaults
} \
3031 -command do_restore_defaults
3032 pack
$w.buttons.restore
-side left
3033 button
$w.buttons.save
-text Save \
3036 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3039 pack
$w.buttons.save
-side right
3040 button
$w.buttons.cancel
-text {Cancel
} \
3042 -command [list destroy
$w]
3043 pack
$w.buttons.cancel
-side right
-padx 5
3044 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3046 labelframe
$w.repo
-text "[reponame] Repository" \
3048 -relief raised
-borderwidth 2
3049 labelframe
$w.global
-text {Global
(All Repositories
)} \
3051 -relief raised
-borderwidth 2
3052 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3053 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3056 {b pullsummary
{Show Pull Summary
}}
3057 {b trustmtime
{Trust File Modification Timestamps
}}
3058 {i diffcontext
{Number of Diff Context Lines
}}
3059 {t newbranchtemplate
{New Branch Name Template
}}
3061 set type [lindex
$option 0]
3062 set name
[lindex
$option 1]
3063 set text
[lindex
$option 2]
3064 foreach f
{repo global
} {
3067 checkbutton
$w.
$f.
$name -text $text \
3068 -variable ${f}_config_new
(gui.
$name) \
3072 pack
$w.
$f.
$name -side top
-anchor w
3076 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3077 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
3078 spinbox
$w.
$f.
$name.v \
3079 -textvariable ${f}_config_new
(gui.
$name) \
3080 -from 1 -to 99 -increment 1 \
3083 bind $w.
$f.
$name.v
<FocusIn
> {%W selection range
0 end
}
3084 pack
$w.
$f.
$name.v
-side right
-anchor e
-padx 5
3085 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3089 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3090 text
$w.
$f.
$name.v \
3096 $w.
$f.
$name.v insert
0.0 [set ${f}_config_new
(gui.
$name)]
3097 bind $w.
$f.
$name.v
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
3098 bind $w.
$f.
$name.v
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
3099 bind $w.
$f.
$name.v
<Key-Return
> break
3100 bind $w.
$f.
$name.v
<FocusIn
> "$w.$f.$name.v tag add sel 0.0 end"
3101 bind $w.
$f.
$name.v
<FocusOut
> "
3102 set ${f}_config_new(gui.$name) \
3103 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3105 pack
$w.
$f.
$name.l
-side left
-anchor w
3106 pack
$w.
$f.
$name.v
-side left
-anchor w \
3109 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3115 set all_fonts
[lsort
[font families
]]
3116 foreach option
$font_descs {
3117 set name
[lindex
$option 0]
3118 set font
[lindex
$option 1]
3119 set text
[lindex
$option 2]
3121 set global_config_new
(gui.
$font^^family
) \
3122 [font configure
$font -family]
3123 set global_config_new
(gui.
$font^^size
) \
3124 [font configure
$font -size]
3126 frame
$w.global.
$name
3127 label
$w.global.
$name.l
-text "$text:" -font font_ui
3128 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3129 eval tk_optionMenu
$w.global.
$name.family \
3130 global_config_new
(gui.
$font^^family
) \
3132 spinbox
$w.global.
$name.size \
3133 -textvariable global_config_new
(gui.
$font^^size
) \
3134 -from 2 -to 80 -increment 1 \
3137 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3138 pack
$w.global.
$name.size
-side right
-anchor e
3139 pack
$w.global.
$name.family
-side right
-anchor e
3140 pack
$w.global.
$name -side top
-anchor w
-fill x
3143 bind $w <Visibility
> "grab $w; focus $w"
3144 bind $w <Key-Escape
> "destroy $w"
3145 wm title
$w "[appname] ([reponame]): Options"
3149 proc do_restore_defaults
{} {
3150 global font_descs default_config repo_config
3151 global repo_config_new global_config_new
3153 foreach name
[array names default_config
] {
3154 set repo_config_new
($name) $default_config($name)
3155 set global_config_new
($name) $default_config($name)
3158 foreach option
$font_descs {
3159 set name
[lindex
$option 0]
3160 set repo_config
(gui.
$name) $default_config(gui.
$name)
3164 foreach option
$font_descs {
3165 set name
[lindex
$option 0]
3166 set font
[lindex
$option 1]
3167 set global_config_new
(gui.
$font^^family
) \
3168 [font configure
$font -family]
3169 set global_config_new
(gui.
$font^^size
) \
3170 [font configure
$font -size]
3174 proc do_save_config
{w
} {
3175 if {[catch
{save_config
} err
]} {
3176 error_popup
"Failed to completely save options:\n\n$err"
3182 proc do_windows_shortcut
{} {
3186 set desktop
[exec cygpath \
3194 set fn
[tk_getSaveFile \
3196 -title "[appname] ([reponame]): Create Desktop Icon" \
3197 -initialdir $desktop \
3198 -initialfile "Git [reponame].bat"]
3202 set sh
[exec cygpath \
3206 set me
[exec cygpath \
3210 set gd
[exec cygpath \
3214 set gw
[exec cygpath \
3217 [file dirname [gitdir
]]]
3218 regsub
-all ' $me "'\\''" me
3219 regsub -all ' $gd "'\\''" gd
3220 puts $fd "@ECHO Entering $gw"
3221 puts $fd "@ECHO Starting git-gui... please wait..."
3222 puts -nonewline $fd "@\"$sh\" --login -c \""
3223 puts -nonewline $fd "GIT_DIR='$gd'"
3224 puts -nonewline $fd " '$me'"
3228 error_popup "Cannot write script:\n\n$err"
3233 proc do_macosx_app {} {
3236 set fn [tk_getSaveFile \
3238 -title "[appname] ([reponame]): Create Desktop Icon" \
3239 -initialdir [file join $env(HOME) Desktop] \
3240 -initialfile "Git [reponame].app"]
3243 set Contents [file join $fn Contents]
3244 set MacOS [file join $Contents MacOS]
3245 set exe [file join $MacOS git-gui]
3249 set fd [open [file join $Contents Info.plist] w]
3250 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3251 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3252 <plist version="1.0">
3254 <key>CFBundleDevelopmentRegion</key>
3255 <string>English</string>
3256 <key>CFBundleExecutable</key>
3257 <string>git-gui</string>
3258 <key>CFBundleIdentifier</key>
3259 <string>org.spearce.git-gui</string>
3260 <key>CFBundleInfoDictionaryVersion</key>
3261 <string>6.0</string>
3262 <key>CFBundlePackageType</key>
3263 <string>APPL</string>
3264 <key>CFBundleSignature</key>
3265 <string>????</string>
3266 <key>CFBundleVersion</key>
3267 <string>1.0</string>
3268 <key>NSPrincipalClass</key>
3269 <string>NSApplication</string>
3274 set fd [open $exe w]
3275 set gd [file normalize [gitdir]]
3276 set ep [file normalize [exec git --exec-path]]
3277 regsub -all ' $gd "'\\''" gd
3278 regsub
-all ' $ep "'\\''" ep
3279 puts $fd "#!/bin/sh"
3280 foreach name
[array names env
] {
3281 if {[string match GIT_
* $name]} {
3282 regsub
-all ' $env($name) "'\\''" v
3283 puts $fd "export $name='$v'"
3286 puts $fd "export PATH
='$ep':\
$PATH"
3287 puts $fd "export GIT_DIR
='$gd'"
3288 puts $fd "exec [file normalize
$argv0]"
3291 file attributes $exe -permissions u+x,g+x,o+x
3293 error_popup "Cannot
write icon
:\n\n$err"
3298 proc toggle_or_diff {w x y} {
3299 global file_states file_lists current_diff_path ui_index ui_workdir
3300 global last_clicked selected_paths
3302 set pos [split [$w index @$x,$y] .]
3303 set lno [lindex $pos 0]
3304 set col [lindex $pos 1]
3305 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3311 set last_clicked [list $w $lno]
3312 array unset selected_paths
3313 $ui_index tag remove in_sel 0.0 end
3314 $ui_workdir tag remove in_sel 0.0 end
3317 if {$current_diff_path eq $path} {
3318 set after {reshow_diff;}
3322 if {$w eq $ui_index} {
3324 "Unstaging
[short_path
$path] from commit
" \
3326 [concat $after {set ui_status_value {Ready.}}]
3327 } elseif {$w eq $ui_workdir} {
3329 "Adding
[short_path
$path]" \
3331 [concat $after {set ui_status_value {Ready.}}]
3334 show_diff $path $w $lno
3338 proc add_one_to_selection {w x y} {
3339 global file_lists last_clicked selected_paths
3341 set lno [lindex [split [$w index @$x,$y] .] 0]
3342 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3348 if {$last_clicked ne {}
3349 && [lindex $last_clicked 0] ne $w} {
3350 array unset selected_paths
3351 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3354 set last_clicked [list $w $lno]
3355 if {[catch {set in_sel $selected_paths($path)}]} {
3359 unset selected_paths($path)
3360 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3362 set selected_paths($path) 1
3363 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3367 proc add_range_to_selection {w x y} {
3368 global file_lists last_clicked selected_paths
3370 if {[lindex $last_clicked 0] ne $w} {
3371 toggle_or_diff $w $x $y
3375 set lno [lindex [split [$w index @$x,$y] .] 0]
3376 set lc [lindex $last_clicked 1]
3385 foreach path [lrange $file_lists($w) \
3386 [expr {$begin - 1}] \
3387 [expr {$end - 1}]] {
3388 set selected_paths($path) 1
3390 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3393 ######################################################################
3397 set cursor_ptr arrow
3398 font create font_diff -family Courier -size 10
3402 eval font configure font_ui [font actual [.dummy cget -font]]
3406 font create font_uibold
3407 font create font_diffbold
3412 } elseif {[is_MacOSX]} {
3420 proc apply_config {} {
3421 global repo_config font_descs
3423 foreach option $font_descs {
3424 set name [lindex $option 0]
3425 set font [lindex $option 1]
3427 foreach {cn cv} $repo_config(gui.$name) {
3428 font configure $font $cn $cv
3431 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3433 foreach {cn cv} [font configure $font] {
3434 font configure ${font}bold $cn $cv
3436 font configure ${font}bold -weight bold
3440 set default_config(gui.trustmtime) false
3441 set default_config(gui.pullsummary) true
3442 set default_config(gui.diffcontext) 5
3443 set default_config(gui.newbranchtemplate) {}
3444 set default_config(gui.fontui) [font configure font_ui]
3445 set default_config(gui.fontdiff) [font configure font_diff]
3447 {fontui font_ui {Main Font}}
3448 {fontdiff font_diff {Diff/Console Font}}
3453 ######################################################################
3459 menu .mbar -tearoff 0
3460 .mbar add cascade -label Repository -menu .mbar.repository
3461 .mbar add cascade -label Edit -menu .mbar.edit
3462 if {!$single_commit} {
3463 .mbar add cascade -label Branch -menu .mbar.branch
3465 .mbar add cascade -label Commit -menu .mbar.commit
3466 if {!$single_commit} {
3467 .mbar add cascade -label Fetch -menu .mbar.fetch
3468 .mbar add cascade -label Pull -menu .mbar.pull
3469 .mbar add cascade -label Push -menu .mbar.push
3471 . configure -menu .mbar
3473 # -- Repository Menu
3475 menu .mbar.repository
3476 .mbar.repository add command \
3477 -label {Visualize Current Branch} \
3478 -command {do_gitk {}} \
3481 .mbar.repository add command \
3482 -label {Visualize All Branches} \
3483 -command {do_gitk {--all}} \
3486 .mbar.repository add separator
3488 if {!$single_commit} {
3489 .mbar.repository add command -label {Compress Database} \
3493 .mbar.repository add command -label {Verify Database} \
3494 -command do_fsck_objects \
3497 .mbar.repository add separator
3500 .mbar.repository add command \
3501 -label {Create Desktop Icon} \
3502 -command do_windows_shortcut \
3504 } elseif {[is_MacOSX]} {
3505 .mbar.repository add command \
3506 -label {Create Desktop Icon} \
3507 -command do_macosx_app \
3512 .mbar.repository add command -label Quit \
3514 -accelerator $M1T-Q \
3520 .mbar.edit add command -label Undo \
3521 -command {catch {[focus] edit undo}} \
3522 -accelerator $M1T-Z \
3524 .mbar.edit add command -label Redo \
3525 -command {catch {[focus] edit redo}} \
3526 -accelerator $M1T-Y \
3528 .mbar.edit add separator
3529 .mbar.edit add command -label Cut \
3530 -command {catch {tk_textCut [focus]}} \
3531 -accelerator $M1T-X \
3533 .mbar.edit add command -label Copy \
3534 -command {catch {tk_textCopy [focus]}} \
3535 -accelerator $M1T-C \
3537 .mbar.edit add command -label Paste \
3538 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3539 -accelerator $M1T-V \
3541 .mbar.edit add command -label Delete \
3542 -command {catch {[focus] delete sel.first sel.last}} \
3545 .mbar.edit add separator
3546 .mbar.edit add command -label {Select All} \
3547 -command {catch {[focus] tag add sel 0.0 end}} \
3548 -accelerator $M1T-A \
3553 if {!$single_commit} {
3556 .mbar.branch add command -label {Create...} \
3557 -command do_create_branch \
3558 -accelerator $M1T-N \
3560 lappend disable_on_lock [list .mbar.branch entryconf \
3561 [.mbar.branch index last] -state]
3563 .mbar.branch add command -label {Delete...} \
3564 -command do_delete_branch \
3566 lappend disable_on_lock [list .mbar.branch entryconf \
3567 [.mbar.branch index last] -state]
3574 .mbar.commit add radiobutton \
3575 -label {New Commit} \
3576 -command do_select_commit_type \
3577 -variable selected_commit_type \
3580 lappend disable_on_lock \
3581 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3583 .mbar.commit add radiobutton \
3584 -label {Amend Last Commit} \
3585 -command do_select_commit_type \
3586 -variable selected_commit_type \
3589 lappend disable_on_lock \
3590 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3592 .mbar.commit add separator
3594 .mbar.commit add command -label Rescan \
3595 -command do_rescan \
3598 lappend disable_on_lock \
3599 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3601 .mbar.commit add command -label {Add To Commit} \
3602 -command do_add_selection \
3604 lappend disable_on_lock \
3605 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3607 .mbar.commit add command -label {Add All To Commit} \
3608 -command do_add_all \
3609 -accelerator $M1T-I \
3611 lappend disable_on_lock \
3612 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3614 .mbar.commit add command -label {Unstage From Commit} \
3615 -command do_unstage_selection \
3617 lappend disable_on_lock \
3618 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3620 .mbar.commit add command -label {Revert Changes} \
3621 -command do_revert_selection \
3623 lappend disable_on_lock \
3624 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3626 .mbar.commit add separator
3628 .mbar.commit add command -label {Sign Off} \
3629 -command do_signoff \
3630 -accelerator $M1T-S \
3633 .mbar.commit add command -label Commit \
3634 -command do_commit \
3635 -accelerator $M1T-Return \
3637 lappend disable_on_lock \
3638 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3640 # -- Transport menus
3642 if {!$single_commit} {
3649 # -- Apple Menu (Mac OS X only)
3651 .mbar add cascade -label Apple -menu .mbar.apple
3654 .mbar.apple add command -label "About
[appname
]" \
3657 .mbar.apple add command -label "[appname
] Options...
" \
3658 -command do_options \
3663 .mbar.edit add separator
3664 .mbar.edit add command -label {Options...} \
3665 -command do_options \
3670 if {[file exists /usr/local/miga/lib/gui-miga]
3671 && [file exists .pvcsrc]} {
3673 global ui_status_value
3674 if {![lock_index update]} return
3675 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3676 set miga_fd [open "|
$cmd" r]
3677 fconfigure $miga_fd -blocking 0
3678 fileevent $miga_fd readable [list miga_done $miga_fd]
3679 set ui_status_value {Running miga...}
3681 proc miga_done {fd} {
3686 rescan [list set ui_status_value {Ready.}]
3689 .mbar add cascade -label Tools -menu .mbar.tools
3691 .mbar.tools add command -label "Migrate
" \
3694 lappend disable_on_lock \
3695 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3700 .mbar add cascade -label Help -menu .mbar.help
3703 .mbar.help add command -label "About
[appname
]" \
3715 -text {Current Branch:} \
3720 -textvariable current_branch \
3724 pack .branch.l1 -side left
3725 pack .branch.cb -side left -fill x
3726 pack .branch -side top -fill x
3728 # -- Main Window Layout
3730 panedwindow .vpane -orient vertical
3731 panedwindow .vpane.files -orient horizontal
3732 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3733 pack .vpane -anchor n -side top -fill both -expand 1
3735 # -- Index File List
3737 frame .vpane.files.index -height 100 -width 200
3738 label .vpane.files.index.title -text {Changes To Be Committed} \
3741 text $ui_index -background white -borderwidth 0 \
3742 -width 20 -height 10 \
3745 -cursor $cursor_ptr \
3746 -xscrollcommand {.vpane.files.index.sx set} \
3747 -yscrollcommand {.vpane.files.index.sy set} \
3749 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3750 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3751 pack .vpane.files.index.title -side top -fill x
3752 pack .vpane.files.index.sx -side bottom -fill x
3753 pack .vpane.files.index.sy -side right -fill y
3754 pack $ui_index -side left -fill both -expand 1
3755 .vpane.files add .vpane.files.index -sticky nsew
3757 # -- Working Directory File List
3759 frame .vpane.files.workdir -height 100 -width 200
3760 label .vpane.files.workdir.title -text {Changed But Not Updated} \
3763 text $ui_workdir -background white -borderwidth 0 \
3764 -width 20 -height 10 \
3767 -cursor $cursor_ptr \
3768 -xscrollcommand {.vpane.files.workdir.sx set} \
3769 -yscrollcommand {.vpane.files.workdir.sy set} \
3771 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3772 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3773 pack .vpane.files.workdir.title -side top -fill x
3774 pack .vpane.files.workdir.sx -side bottom -fill x
3775 pack .vpane.files.workdir.sy -side right -fill y
3776 pack $ui_workdir -side left -fill both -expand 1
3777 .vpane.files add .vpane.files.workdir -sticky nsew
3779 foreach i [list $ui_index $ui_workdir] {
3780 $i tag conf in_diff -font font_uibold
3781 $i tag conf in_sel \
3782 -background [$i cget -foreground] \
3783 -foreground [$i cget -background]
3787 # -- Diff and Commit Area
3789 frame .vpane.lower -height 300 -width 400
3790 frame .vpane.lower.commarea
3791 frame .vpane.lower.diff -relief sunken -borderwidth 1
3792 pack .vpane.lower.commarea -side top -fill x
3793 pack .vpane.lower.diff -side bottom -fill both -expand 1
3794 .vpane add .vpane.lower -stick nsew
3796 # -- Commit Area Buttons
3798 frame .vpane.lower.commarea.buttons
3799 label .vpane.lower.commarea.buttons.l -text {} \
3803 pack .vpane.lower.commarea.buttons.l -side top -fill x
3804 pack .vpane.lower.commarea.buttons -side left -fill y
3806 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3807 -command do_rescan \
3809 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3810 lappend disable_on_lock \
3811 {.vpane.lower.commarea.buttons.rescan conf -state}
3813 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3814 -command do_add_all \
3816 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3817 lappend disable_on_lock \
3818 {.vpane.lower.commarea.buttons.incall conf -state}
3820 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3821 -command do_signoff \
3823 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3825 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3826 -command do_commit \
3828 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3829 lappend disable_on_lock \
3830 {.vpane.lower.commarea.buttons.commit conf -state}
3832 # -- Commit Message Buffer
3834 frame .vpane.lower.commarea.buffer
3835 frame .vpane.lower.commarea.buffer.header
3836 set ui_comm .vpane.lower.commarea.buffer.t
3837 set ui_coml .vpane.lower.commarea.buffer.header.l
3838 radiobutton .vpane.lower.commarea.buffer.header.new \
3839 -text {New Commit} \
3840 -command do_select_commit_type \
3841 -variable selected_commit_type \
3844 lappend disable_on_lock \
3845 [list .vpane.lower.commarea.buffer.header.new conf -state]
3846 radiobutton .vpane.lower.commarea.buffer.header.amend \
3847 -text {Amend Last Commit} \
3848 -command do_select_commit_type \
3849 -variable selected_commit_type \
3852 lappend disable_on_lock \
3853 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3858 proc trace_commit_type {varname args} {
3859 global ui_coml commit_type
3860 switch -glob -- $commit_type {
3861 initial {set txt {Initial Commit Message:}}
3862 amend {set txt {Amended Commit Message:}}
3863 amend-initial {set txt {Amended Initial Commit Message:}}
3864 amend-merge {set txt {Amended Merge Commit Message:}}
3865 merge {set txt {Merge Commit Message:}}
3866 * {set txt {Commit Message:}}
3868 $ui_coml conf -text $txt
3870 trace add variable commit_type write trace_commit_type
3871 pack $ui_coml -side left -fill x
3872 pack .vpane.lower.commarea.buffer.header.amend -side right
3873 pack .vpane.lower.commarea.buffer.header.new -side right
3875 text $ui_comm -background white -borderwidth 1 \
3878 -autoseparators true \
3880 -width 75 -height 9 -wrap none \
3882 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3883 scrollbar .vpane.lower.commarea.buffer.sby \
3884 -command [list $ui_comm yview]
3885 pack .vpane.lower.commarea.buffer.header -side top -fill x
3886 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3887 pack $ui_comm -side left -fill y
3888 pack .vpane.lower.commarea.buffer -side left -fill y
3890 # -- Commit Message Buffer Context Menu
3892 set ctxm .vpane.lower.commarea.buffer.ctxm
3893 menu $ctxm -tearoff 0
3897 -command {tk_textCut $ui_comm}
3901 -command {tk_textCopy $ui_comm}
3905 -command {tk_textPaste $ui_comm}
3909 -command {$ui_comm delete sel.first sel.last}
3912 -label {Select All} \
3914 -command {$ui_comm tag add sel 0.0 end}
3919 $ui_comm tag add sel 0.0 end
3920 tk_textCopy $ui_comm
3921 $ui_comm tag remove sel 0.0 end
3928 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3932 set current_diff_path {}
3933 set diff_actions [list]
3934 proc trace_current_diff_path {varname args} {
3935 global current_diff_path diff_actions file_states
3936 if {$current_diff_path eq {}} {
3942 set p $current_diff_path
3943 set s [mapdesc [lindex $file_states($p) 0] $p]
3945 set p [escape_path $p]
3949 .vpane.lower.diff.header.status configure -text $s
3950 .vpane.lower.diff.header.file configure -text $f
3951 .vpane.lower.diff.header.path configure -text $p
3952 foreach w $diff_actions {
3956 trace add variable current_diff_path write trace_current_diff_path
3958 frame .vpane.lower.diff.header -background orange
3959 label .vpane.lower.diff.header.status \
3960 -background orange \
3961 -width $max_status_desc \
3965 label .vpane.lower.diff.header.file \
3966 -background orange \
3970 label .vpane.lower.diff.header.path \
3971 -background orange \
3975 pack .vpane.lower.diff.header.status -side left
3976 pack .vpane.lower.diff.header.file -side left
3977 pack .vpane.lower.diff.header.path -fill x
3978 set ctxm .vpane.lower.diff.header.ctxm
3979 menu $ctxm -tearoff 0
3988 -- $current_diff_path
3990 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3991 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3995 frame .vpane.lower.diff.body
3996 set ui_diff .vpane.lower.diff.body.t
3997 text $ui_diff -background white -borderwidth 0 \
3998 -width 80 -height 15 -wrap none \
4000 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4001 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4003 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4004 -command [list $ui_diff xview]
4005 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4006 -command [list $ui_diff yview]
4007 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4008 pack .vpane.lower.diff.body.sby -side right -fill y
4009 pack $ui_diff -side left -fill both -expand 1
4010 pack .vpane.lower.diff.header -side top -fill x
4011 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4013 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4014 $ui_diff tag conf d_+ -foreground {#00a000}
4015 $ui_diff tag conf d_- -foreground red
4017 $ui_diff tag conf d_++ -foreground {#00a000}
4018 $ui_diff tag conf d_-- -foreground red
4019 $ui_diff tag conf d_+s \
4020 -foreground {#00a000} \
4021 -background {#e2effa}
4022 $ui_diff tag conf d_-s \
4024 -background {#e2effa}
4025 $ui_diff tag conf d_s+ \
4026 -foreground {#00a000} \
4028 $ui_diff tag conf d_s- \
4032 $ui_diff tag conf d<<<<<<< \
4033 -foreground orange \
4035 $ui_diff tag conf d======= \
4036 -foreground orange \
4038 $ui_diff tag conf d>>>>>>> \
4039 -foreground orange \
4042 $ui_diff tag raise sel
4044 # -- Diff Body Context Menu
4046 set ctxm .vpane.lower.diff.body.ctxm
4047 menu $ctxm -tearoff 0
4051 -command reshow_diff
4055 -command {tk_textCopy $ui_diff}
4056 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4058 -label {Select All} \
4060 -command {$ui_diff tag add sel 0.0 end}
4061 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4066 $ui_diff tag add sel 0.0 end
4067 tk_textCopy $ui_diff
4068 $ui_diff tag remove sel 0.0 end
4070 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4073 -label {Decrease Font Size} \
4075 -command {incr_font_size font_diff -1}
4076 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4078 -label {Increase Font Size} \
4080 -command {incr_font_size font_diff 1}
4081 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4084 -label {Show Less Context} \
4086 -command {if {$repo_config(gui.diffcontext) >= 2} {
4087 incr repo_config(gui.diffcontext) -1
4090 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4092 -label {Show More Context} \
4095 incr repo_config(gui.diffcontext)
4098 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4100 $ctxm add command -label {Options...} \
4103 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
4107 set ui_status_value {Initializing...}
4108 label .status -textvariable ui_status_value \
4114 pack .status -anchor w -side bottom -fill x
4119 set gm $repo_config(gui.geometry)
4120 wm geometry . [lindex $gm 0]
4121 .vpane sash place 0 \
4122 [lindex [.vpane sash coord 0] 0] \
4124 .vpane.files sash place 0 \
4126 [lindex [.vpane.files sash coord 0] 1]
4132 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4133 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4134 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4135 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4136 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4137 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4138 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4139 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4140 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4141 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4142 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4144 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4145 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4146 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4147 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4148 bind $ui_diff <$M1B-Key-v> {break}
4149 bind $ui_diff <$M1B-Key-V> {break}
4150 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4151 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4152 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4153 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4154 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4155 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4157 if {!$single_commit} {
4158 bind . <$M1B-Key-n> do_create_branch
4159 bind . <$M1B-Key-N> do_create_branch
4162 bind . <Destroy> do_quit
4163 bind all <Key-F5> do_rescan
4164 bind all <$M1B-Key-r> do_rescan
4165 bind all <$M1B-Key-R> do_rescan
4166 bind . <$M1B-Key-s> do_signoff
4167 bind . <$M1B-Key-S> do_signoff
4168 bind . <$M1B-Key-i> do_add_all
4169 bind . <$M1B-Key-I> do_add_all
4170 bind . <$M1B-Key-Return> do_commit
4171 bind all <$M1B-Key-q> do_quit
4172 bind all <$M1B-Key-Q> do_quit
4173 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4174 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4175 foreach i [list $ui_index $ui_workdir] {
4176 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
4177 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
4178 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
4182 set file_lists($ui_index) [list]
4183 set file_lists($ui_workdir) [list]
4187 set MERGE_HEAD [list]
4190 set current_branch {}
4191 set current_diff_path {}
4192 set selected_commit_type new
4194 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
4195 focus -force $ui_comm
4197 # -- Warn the user about environmental problems. Cygwin's Tcl
4198 # does *not* pass its env array onto any processes it spawns.
4199 # This means that git processes get none of our environment.
4204 set msg "Possible environment issues exist.
4206 The following environment variables are probably
4207 going to be ignored by any Git subprocess run
4211 foreach name [array names env] {
4212 switch -regexp -- $name {
4213 {^GIT_INDEX_FILE$} -
4214 {^GIT_OBJECT_DIRECTORY$} -
4215 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4217 {^GIT_EXTERNAL_DIFF$} -
4221 {^GIT_CONFIG_LOCAL$} -
4222 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4223 append msg " - $name\n"
4226 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4227 append msg " - $name\n"
4229 set suggest_user $name
4233 if {$ignored_env > 0} {
4235 This is due to a known issue with the
4236 Tcl binary distributed by Cygwin.
"
4238 if {$suggest_user ne {}} {
4241 A good replacement
for $suggest_user
4242 is placing values
for the user.name and
4243 user.email settings into your personal
4249 unset ignored_env msg suggest_user name
4252 # -- Only initialize complex UI if we are going to stay running.
4254 if {!$single_commit} {
4258 populate_branch_menu
4259 populate_fetch_menu .mbar.fetch
4260 populate_pull_menu .mbar.pull
4261 populate_push_menu .mbar.push
4264 # -- Only suggest a gc run if we are going to stay running.
4266 if {!$single_commit} {
4267 set object_limit 2000
4268 if {[is_Windows]} {set object_limit 200}
4269 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4270 if {$objects_current >= $object_limit} {
4272 "This repository currently has
$objects_current loose objects.
4274 To maintain optimal performance it is strongly
4275 recommended that you
compress the database
4276 when
more than
$object_limit loose objects exist.
4278 Compress the database now?
"] eq yes} {
4282 unset object_limit _junk objects_current
4285 lock_index begin-read