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
]
46 ######################################################################
50 proc is_many_config
{name
} {
51 switch
-glob -- $name {
60 proc load_config
{include_global
} {
61 global repo_config global_config default_config
63 array
unset global_config
64 if {$include_global} {
66 set fd_rc
[open
"| git repo-config --global --list" r
]
67 while {[gets
$fd_rc line
] >= 0} {
68 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
69 if {[is_many_config
$name]} {
70 lappend global_config
($name) $value
72 set global_config
($name) $value
80 array
unset repo_config
82 set fd_rc
[open
"| git repo-config --list" r
]
83 while {[gets
$fd_rc line
] >= 0} {
84 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
85 if {[is_many_config
$name]} {
86 lappend repo_config
($name) $value
88 set repo_config
($name) $value
95 foreach name
[array names default_config
] {
96 if {[catch
{set v
$global_config($name)}]} {
97 set global_config
($name) $default_config($name)
99 if {[catch
{set v
$repo_config($name)}]} {
100 set repo_config
($name) $default_config($name)
105 proc save_config
{} {
106 global default_config font_descs
107 global repo_config global_config
108 global repo_config_new global_config_new
110 foreach option
$font_descs {
111 set name
[lindex
$option 0]
112 set font
[lindex
$option 1]
113 font configure
$font \
114 -family $global_config_new(gui.
$font^^family
) \
115 -size $global_config_new(gui.
$font^^size
)
116 font configure
${font}bold \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 set global_config_new
(gui.
$name) [font configure
$font]
120 unset global_config_new
(gui.
$font^^family
)
121 unset global_config_new
(gui.
$font^^size
)
124 foreach name
[array names default_config
] {
125 set value
$global_config_new($name)
126 if {$value ne
$global_config($name)} {
127 if {$value eq
$default_config($name)} {
128 catch
{exec git repo-config
--global --unset $name}
130 regsub
-all "\[{}\]" $value {"} value
131 exec git repo-config --global $name $value
133 set global_config($name) $value
134 if {$value eq $repo_config($name)} {
135 catch {exec git repo-config --unset $name}
136 set repo_config($name) $value
141 foreach name [array names default_config] {
142 set value $repo_config_new($name)
143 if {$value ne $repo_config($name)} {
144 if {$value eq $global_config($name)} {
145 catch {exec git repo-config --unset $name}
147 regsub -all "\
[{}\
]" $value {"} value
148 exec git repo-config
$name $value
150 set repo_config
($name) $value
155 proc error_popup
{msg
} {
157 if {[reponame
] ne
{}} {
158 append title
" ([reponame])"
160 set cmd
[list tk_messageBox \
163 -title "$title: error" \
165 if {[winfo ismapped .
]} {
166 lappend cmd
-parent .
171 proc warn_popup
{msg
} {
173 if {[reponame
] ne
{}} {
174 append title
" ([reponame])"
176 set cmd
[list tk_messageBox \
179 -title "$title: warning" \
181 if {[winfo ismapped .
]} {
182 lappend cmd
-parent .
187 proc info_popup
{msg
} {
189 if {[reponame
] ne
{}} {
190 append title
" ([reponame])"
200 proc ask_popup
{msg
} {
202 if {[reponame
] ne
{}} {
203 append title
" ([reponame])"
205 return [tk_messageBox \
213 ######################################################################
217 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
218 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
219 catch
{wm withdraw .
}
220 error_popup
"Cannot find the git directory:\n\n$err"
223 if {![file isdirectory
$_gitdir]} {
224 catch
{wm withdraw .
}
225 error_popup
"Git directory not found:\n\n$_gitdir"
228 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
229 catch
{wm withdraw .
}
230 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
233 if {[catch
{cd [file dirname $_gitdir]} err
]} {
234 catch
{wm withdraw .
}
235 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
238 set _reponame
[lindex
[file split \
239 [file normalize
[file dirname $_gitdir]]] \
243 if {[appname
] eq
{git-citool
}} {
247 ######################################################################
255 set disable_on_lock
[list
]
256 set index_lock_type none
258 proc lock_index
{type} {
259 global index_lock_type disable_on_lock
261 if {$index_lock_type eq
{none
}} {
262 set index_lock_type
$type
263 foreach w
$disable_on_lock {
264 uplevel
#0 $w disabled
267 } elseif
{$index_lock_type eq
"begin-$type"} {
268 set index_lock_type
$type
274 proc unlock_index
{} {
275 global index_lock_type disable_on_lock
277 set index_lock_type none
278 foreach w
$disable_on_lock {
283 ######################################################################
287 proc repository_state
{ctvar hdvar mhvar
} {
288 global current_branch
289 upvar
$ctvar ct
$hdvar hd
$mhvar mh
293 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
294 set current_branch
{}
296 regsub ^refs
/((heads|tags|remotes
)/)? \
302 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
308 set merge_head
[file join [gitdir
] MERGE_HEAD
]
309 if {[file exists
$merge_head]} {
311 set fd_mh
[open
$merge_head r
]
312 while {[gets
$fd_mh line
] >= 0} {
323 global PARENT empty_tree
325 set p
[lindex
$PARENT 0]
329 if {$empty_tree eq
{}} {
330 set empty_tree
[exec git mktree
<< {}]
335 proc rescan
{after
} {
336 global HEAD PARENT MERGE_HEAD commit_type
337 global ui_index ui_other ui_status_value ui_comm
338 global rescan_active file_states
341 if {$rescan_active > 0 ||
![lock_index
read]} return
343 repository_state newType newHEAD newMERGE_HEAD
344 if {[string match amend
* $commit_type]
345 && $newType eq
{normal
}
346 && $newHEAD eq
$HEAD} {
350 set MERGE_HEAD
$newMERGE_HEAD
351 set commit_type
$newType
354 array
unset file_states
356 if {![$ui_comm edit modified
]
357 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
358 if {[load_message GITGUI_MSG
]} {
359 } elseif
{[load_message MERGE_MSG
]} {
360 } elseif
{[load_message SQUASH_MSG
]} {
363 $ui_comm edit modified false
366 if {$repo_config(gui.trustmtime
) eq
{true
}} {
367 rescan_stage2
{} $after
370 set ui_status_value
{Refreshing
file status...
}
371 set cmd
[list git update-index
]
373 lappend cmd
--unmerged
374 lappend cmd
--ignore-missing
375 lappend cmd
--refresh
376 set fd_rf
[open
"| $cmd" r
]
377 fconfigure
$fd_rf -blocking 0 -translation binary
378 fileevent
$fd_rf readable \
379 [list rescan_stage2
$fd_rf $after]
383 proc rescan_stage2
{fd after
} {
384 global ui_status_value
385 global rescan_active buf_rdi buf_rdf buf_rlo
389 if {![eof
$fd]} return
393 set ls_others
[list | git ls-files
--others -z \
394 --exclude-per-directory=.gitignore
]
395 set info_exclude
[file join [gitdir
] info exclude
]
396 if {[file readable
$info_exclude]} {
397 lappend ls_others
"--exclude-from=$info_exclude"
405 set ui_status_value
{Scanning
for modified files ...
}
406 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
407 set fd_df
[open
"| git diff-files -z" r
]
408 set fd_lo
[open
$ls_others r
]
410 fconfigure
$fd_di -blocking 0 -translation binary
411 fconfigure
$fd_df -blocking 0 -translation binary
412 fconfigure
$fd_lo -blocking 0 -translation binary
413 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
414 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
415 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
418 proc load_message
{file} {
421 set f
[file join [gitdir
] $file]
422 if {[file isfile
$f]} {
423 if {[catch
{set fd
[open
$f r
]}]} {
426 set content
[string trim
[read $fd]]
428 $ui_comm delete
0.0 end
429 $ui_comm insert end
$content
435 proc read_diff_index
{fd after
} {
438 append buf_rdi
[read $fd]
440 set n
[string length
$buf_rdi]
442 set z1
[string first
"\0" $buf_rdi $c]
445 set z2
[string first
"\0" $buf_rdi $z1]
449 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
451 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
453 [list
[lindex
$i 0] [lindex
$i 2]] \
459 set buf_rdi
[string range
$buf_rdi $c end
]
464 rescan_done
$fd buf_rdi
$after
467 proc read_diff_files
{fd after
} {
470 append buf_rdf
[read $fd]
472 set n
[string length
$buf_rdf]
474 set z1
[string first
"\0" $buf_rdf $c]
477 set z2
[string first
"\0" $buf_rdf $z1]
481 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
483 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
486 [list
[lindex
$i 0] [lindex
$i 2]]
491 set buf_rdf
[string range
$buf_rdf $c end
]
496 rescan_done
$fd buf_rdf
$after
499 proc read_ls_others
{fd after
} {
502 append buf_rlo
[read $fd]
503 set pck
[split $buf_rlo "\0"]
504 set buf_rlo
[lindex
$pck end
]
505 foreach p
[lrange
$pck 0 end-1
] {
508 rescan_done
$fd buf_rlo
$after
511 proc rescan_done
{fd buf after
} {
513 global file_states repo_config
516 if {![eof
$fd]} return
519 if {[incr rescan_active
-1] > 0} return
525 if {$repo_config(gui.partialinclude
) ne
{true
}} {
527 foreach path
[array names file_states
] {
528 switch
-- [lindex
$file_states($path) 0] {
530 M?
{lappend pathList
$path}
533 if {$pathList ne
{}} {
535 "Updating included files" \
537 [concat
{reshow_diff
;} $after]
546 proc prune_selection
{} {
547 global file_states selected_paths
549 foreach path
[array names selected_paths
] {
550 if {[catch
{set still_here
$file_states($path)}]} {
551 unset selected_paths
($path)
556 ######################################################################
561 global ui_diff current_diff ui_index ui_other
563 $ui_diff conf
-state normal
564 $ui_diff delete
0.0 end
565 $ui_diff conf
-state disabled
569 $ui_index tag remove in_diff
0.0 end
570 $ui_other tag remove in_diff
0.0 end
573 proc reshow_diff
{} {
574 global current_diff ui_status_value file_states
576 if {$current_diff eq
{}
577 ||
[catch
{set s
$file_states($current_diff)}]} {
580 show_diff
$current_diff
584 proc handle_empty_diff
{} {
585 global current_diff file_states file_lists
587 set path
$current_diff
588 set s
$file_states($path)
589 if {[lindex
$s 0] ne
{_M
}} return
591 info_popup
"No differences detected.
593 [short_path $path] has no changes.
595 The modification date of this file was updated
596 by another application and you currently have
597 the Trust File Modification Timestamps option
598 enabled, so Git did not automatically detect
599 that there are no content differences in this
602 This file will now be removed from the modified
603 files list, to prevent possible confusion.
605 if {[catch
{exec git update-index
-- $path} err
]} {
606 error_popup
"Failed to refresh index:\n\n$err"
610 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
611 set lno
[lsearch
-sorted $file_lists($old_w) $path]
613 set file_lists
($old_w) \
614 [lreplace
$file_lists($old_w) $lno $lno]
616 $old_w conf
-state normal
617 $old_w delete
$lno.0 [expr {$lno + 1}].0
618 $old_w conf
-state disabled
622 proc show_diff
{path
{w
{}} {lno
{}}} {
623 global file_states file_lists
624 global is_3way_diff diff_active repo_config
625 global ui_diff current_diff ui_status_value
627 if {$diff_active ||
![lock_index
read]} return
630 if {$w eq
{} ||
$lno == {}} {
631 foreach w
[array names file_lists
] {
632 set lno
[lsearch
-sorted $file_lists($w) $path]
639 if {$w ne
{} && $lno >= 1} {
640 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
643 set s
$file_states($path)
647 set current_diff
$path
648 set ui_status_value
"Loading diff of [escape_path $path]..."
650 set cmd
[list | git diff-index
]
651 lappend cmd
--no-color
652 if {$repo_config(gui.diffcontext
) > 0} {
653 lappend cmd
"-U$repo_config(gui.diffcontext)"
663 set fd
[open
$path r
]
664 set content
[read $fd]
669 set ui_status_value
"Unable to display [escape_path $path]"
670 error_popup
"Error loading file:\n\n$err"
673 $ui_diff conf
-state normal
674 $ui_diff insert end
$content
675 $ui_diff conf
-state disabled
678 set ui_status_value
{Ready.
}
687 if {[catch
{set fd
[open
$cmd r
]} err
]} {
690 set ui_status_value
"Unable to display [escape_path $path]"
691 error_popup
"Error loading diff:\n\n$err"
695 fconfigure
$fd -blocking 0 -translation auto
696 fileevent
$fd readable
[list read_diff
$fd]
699 proc read_diff
{fd
} {
700 global ui_diff ui_status_value is_3way_diff diff_active
703 $ui_diff conf
-state normal
704 while {[gets
$fd line
] >= 0} {
705 # -- Cleanup uninteresting diff header lines.
707 if {[string match
{diff --git *} $line]} continue
708 if {[string match
{diff --combined *} $line]} continue
709 if {[string match
{--- *} $line]} continue
710 if {[string match
{+++ *} $line]} continue
711 if {$line eq
{deleted
file mode
120000}} {
712 set line
"deleted symlink"
715 # -- Automatically detect if this is a 3 way diff.
717 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
719 # -- Reformat a 3 way diff, 'cause its too weird.
722 set op
[string range
$line 0 1]
725 {++} {set tags d_
+ ; set op
{ +}}
726 {--} {set tags d_-
; set op
{ -}}
727 { +} {set tags d_
++; set op
{++}}
728 { -} {set tags d_--
; set op
{--}}
729 {+ } {set tags d_-
+; set op
{-+}}
730 {- } {set tags d_
+-; set op
{+-}}
731 default
{set tags
{}}
733 set line
[string replace
$line 0 1 $op]
735 switch
-- [string index
$line 0] {
739 default
{set tags
{}}
742 $ui_diff insert end
$line $tags
743 $ui_diff insert end
"\n" $tags
745 $ui_diff conf
-state disabled
751 set ui_status_value
{Ready.
}
753 if {$repo_config(gui.trustmtime
) eq
{true
}
754 && [$ui_diff index end
] eq
{2.0}} {
760 ######################################################################
764 proc load_last_commit
{} {
765 global HEAD PARENT MERGE_HEAD commit_type ui_comm
767 if {[llength
$PARENT] == 0} {
768 error_popup
{There is nothing to amend.
770 You are about to create the initial commit.
771 There is no commit before this to amend.
776 repository_state curType curHEAD curMERGE_HEAD
777 if {$curType eq
{merge
}} {
778 error_popup
{Cannot amend
while merging.
780 You are currently
in the middle of a merge that
781 has not been fully completed. You cannot amend
782 the prior commit unless you first abort the
783 current merge activity.
791 set fd
[open
"| git cat-file commit $curHEAD" r
]
792 while {[gets
$fd line
] > 0} {
793 if {[string match
{parent
*} $line]} {
794 lappend parents
[string range
$line 7 end
]
797 set msg
[string trim
[read $fd]]
800 error_popup
"Error loading commit data for amend:\n\n$err"
806 set MERGE_HEAD
[list
]
807 switch
-- [llength
$parents] {
808 0 {set commit_type amend-initial
}
809 1 {set commit_type amend
}
810 default
{set commit_type amend-merge
}
813 $ui_comm delete
0.0 end
814 $ui_comm insert end
$msg
816 $ui_comm edit modified false
817 rescan
{set ui_status_value
{Ready.
}}
820 proc create_new_commit
{} {
821 global commit_type ui_comm
823 set commit_type normal
824 $ui_comm delete
0.0 end
826 $ui_comm edit modified false
827 rescan
{set ui_status_value
{Ready.
}}
830 set GIT_COMMITTER_IDENT
{}
832 proc committer_ident
{} {
833 global GIT_COMMITTER_IDENT
835 if {$GIT_COMMITTER_IDENT eq
{}} {
836 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
837 error_popup
"Unable to obtain your identity:\n\n$err"
840 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
841 $me me GIT_COMMITTER_IDENT
]} {
842 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
847 return $GIT_COMMITTER_IDENT
850 proc commit_tree
{} {
851 global HEAD commit_type file_states ui_comm repo_config
853 if {![lock_index update
]} return
854 if {[committer_ident
] eq
{}} return
856 # -- Our in memory state should match the repository.
858 repository_state curType curHEAD curMERGE_HEAD
859 if {[string match amend
* $commit_type]
860 && $curType eq
{normal
}
861 && $curHEAD eq
$HEAD} {
862 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
863 info_popup
{Last scanned state does not match repository state.
865 Another Git program has modified this repository
866 since the last scan. A rescan must be performed
867 before another commit can be created.
869 The rescan will be automatically started now.
872 rescan
{set ui_status_value
{Ready.
}}
876 # -- At least one file should differ in the index.
879 foreach path
[array names file_states
] {
880 switch
-glob -- [lindex
$file_states($path) 0] {
884 M?
{set files_ready
1; break}
886 error_popup
"Unmerged files cannot be committed.
888 File [short_path $path] has merge conflicts.
889 You must resolve them and include the file before committing.
895 error_popup
"Unknown file state [lindex $s 0] detected.
897 File [short_path $path] cannot be committed by this program.
903 error_popup
{No included files to commit.
905 You must include
at least
1 file before you can commit.
911 # -- A message is required.
913 set msg
[string trim
[$ui_comm get
1.0 end
]]
915 error_popup
{Please supply a commit message.
917 A good commit message has the following format
:
919 - First line
: Describe
in one sentance what you did.
921 - Remaining lines
: Describe why this change is good.
927 # -- Update included files if partialincludes are off.
929 if {$repo_config(gui.partialinclude
) ne
{true
}} {
931 foreach path
[array names file_states
] {
932 switch
-glob -- [lindex
$file_states($path) 0] {
934 M?
{lappend pathList
$path}
937 if {$pathList ne
{}} {
940 "Updating included files" \
942 [concat
{lock_index update
;} \
943 [list commit_prehook
$curHEAD $msg]]
948 commit_prehook
$curHEAD $msg
951 proc commit_prehook
{curHEAD msg
} {
952 global ui_status_value pch_error
954 set pchook
[file join [gitdir
] hooks pre-commit
]
956 # On Cygwin [file executable] might lie so we need to ask
957 # the shell if the hook is executable. Yes that's annoying.
959 if {[is_Windows
] && [file isfile
$pchook]} {
960 set pchook
[list sh
-c [concat \
961 "if test -x \"$pchook\";" \
962 "then exec \"$pchook\" 2>&1;" \
964 } elseif
{[file executable
$pchook]} {
965 set pchook
[list
$pchook |
& cat]
967 commit_writetree
$curHEAD $msg
971 set ui_status_value
{Calling pre-commit hook...
}
973 set fd_ph
[open
"| $pchook" r
]
974 fconfigure
$fd_ph -blocking 0 -translation binary
975 fileevent
$fd_ph readable \
976 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
979 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
980 global pch_error ui_status_value
982 append pch_error
[read $fd_ph]
983 fconfigure
$fd_ph -blocking 1
985 if {[catch
{close
$fd_ph}]} {
986 set ui_status_value
{Commit declined by pre-commit hook.
}
987 hook_failed_popup pre-commit
$pch_error
990 commit_writetree
$curHEAD $msg
995 fconfigure
$fd_ph -blocking 0
998 proc commit_writetree
{curHEAD msg
} {
999 global ui_status_value
1001 set ui_status_value
{Committing changes...
}
1002 set fd_wt
[open
"| git write-tree" r
]
1003 fileevent
$fd_wt readable \
1004 [list commit_committree
$fd_wt $curHEAD $msg]
1007 proc commit_committree
{fd_wt curHEAD msg
} {
1008 global HEAD PARENT MERGE_HEAD commit_type
1009 global single_commit
1010 global ui_status_value ui_comm selected_commit_type
1011 global file_states selected_paths rescan_active
1014 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1015 error_popup
"write-tree failed:\n\n$err"
1016 set ui_status_value
{Commit failed.
}
1021 # -- Create the commit.
1023 set cmd
[list git commit-tree
$tree_id]
1024 set parents
[concat
$PARENT $MERGE_HEAD]
1025 if {[llength
$parents] > 0} {
1026 foreach p
$parents {
1030 # git commit-tree writes to stderr during initial commit.
1031 lappend cmd
2>/dev
/null
1034 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1035 error_popup
"commit-tree failed:\n\n$err"
1036 set ui_status_value
{Commit failed.
}
1041 # -- Update the HEAD ref.
1044 if {$commit_type ne
{normal
}} {
1045 append reflogm
" ($commit_type)"
1047 set i
[string first
"\n" $msg]
1049 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1051 append reflogm
{: } $msg
1053 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1054 if {[catch
{eval exec $cmd} err
]} {
1055 error_popup
"update-ref failed:\n\n$err"
1056 set ui_status_value
{Commit failed.
}
1061 # -- Cleanup after ourselves.
1063 catch
{file delete
[file join [gitdir
] MERGE_HEAD
]}
1064 catch
{file delete
[file join [gitdir
] MERGE_MSG
]}
1065 catch
{file delete
[file join [gitdir
] SQUASH_MSG
]}
1066 catch
{file delete
[file join [gitdir
] GITGUI_MSG
]}
1068 # -- Let rerere do its thing.
1070 if {[file isdirectory
[file join [gitdir
] rr-cache
]]} {
1071 catch
{exec git rerere
}
1074 # -- Run the post-commit hook.
1076 set pchook
[file join [gitdir
] hooks post-commit
]
1077 if {[is_Windows
] && [file isfile
$pchook]} {
1078 set pchook
[list sh
-c [concat \
1079 "if test -x \"$pchook\";" \
1080 "then exec \"$pchook\";" \
1082 } elseif
{![file executable
$pchook]} {
1085 if {$pchook ne
{}} {
1086 catch
{exec $pchook &}
1089 $ui_comm delete
0.0 end
1091 $ui_comm edit modified false
1093 if {$single_commit} do_quit
1095 # -- Update in memory status
1097 set selected_commit_type new
1098 set commit_type normal
1101 set MERGE_HEAD
[list
]
1103 foreach path
[array names file_states
] {
1104 set s
$file_states($path)
1106 switch
-glob -- $m {
1114 unset file_states
($path)
1115 catch
{unset selected_paths
($path)}
1118 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1125 set file_states
($path) [list \
1126 _
[string index
$m 1] \
1137 set ui_status_value \
1138 "Changes committed as [string range $cmt_id 0 7]."
1141 ######################################################################
1145 proc fetch_from
{remote
} {
1146 set w
[new_console
"fetch $remote" \
1147 "Fetching new changes from $remote"]
1148 set cmd
[list git fetch
]
1150 console_exec
$w $cmd
1153 proc pull_remote
{remote branch
} {
1154 global HEAD commit_type file_states repo_config
1156 if {![lock_index update
]} return
1158 # -- Our in memory state should match the repository.
1160 repository_state curType curHEAD curMERGE_HEAD
1161 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1162 info_popup
{Last scanned state does not match repository state.
1164 Another Git program has modified this repository
1165 since the last scan. A rescan must be performed
1166 before a pull operation can be started.
1168 The rescan will be automatically started now.
1171 rescan
{set ui_status_value
{Ready.
}}
1175 # -- No differences should exist before a pull.
1177 if {[array size file_states
] != 0} {
1178 error_popup
{Uncommitted but modified files are present.
1180 You should not perform a pull with unmodified
1181 files
in your working directory as Git will be
1182 unable to recover from an incorrect merge.
1184 You should commit or revert all changes before
1185 starting a pull operation.
1191 set w
[new_console
"pull $remote $branch" \
1192 "Pulling new changes from branch $branch in $remote"]
1193 set cmd
[list git pull
]
1194 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1195 lappend cmd
--no-summary
1199 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1202 proc post_pull_remote
{remote branch success
} {
1203 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1204 global ui_status_value
1208 repository_state commit_type HEAD MERGE_HEAD
1210 set selected_commit_type new
1211 set ui_status_value
"Pulling $branch from $remote complete."
1213 rescan
[list
set ui_status_value \
1214 "Conflicts detected while pulling $branch from $remote."]
1218 proc push_to
{remote
} {
1219 set w
[new_console
"push $remote" \
1220 "Pushing changes to $remote"]
1221 set cmd
[list git push
]
1223 console_exec
$w $cmd
1226 ######################################################################
1230 proc mapcol
{state path
} {
1231 global all_cols ui_other
1233 if {[catch
{set r
$all_cols($state)}]} {
1234 puts
"error: no column for state={$state} $path"
1240 proc mapicon
{state path
} {
1243 if {[catch
{set r
$all_icons($state)}]} {
1244 puts
"error: no icon for state={$state} $path"
1250 proc mapdesc
{state path
} {
1253 if {[catch
{set r
$all_descs($state)}]} {
1254 puts
"error: no desc for state={$state} $path"
1260 proc escape_path
{path
} {
1261 regsub
-all "\n" $path "\\n" path
1265 proc short_path
{path
} {
1266 return [escape_path
[lindex
[file split $path] end
]]
1270 set null_sha1
[string repeat
0 40]
1272 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1273 global file_states next_icon_id null_sha1
1275 set s0
[string index
$new_state 0]
1276 set s1
[string index
$new_state 1]
1278 if {[catch
{set info
$file_states($path)}]} {
1280 set icon n
[incr next_icon_id
]
1282 set state
[lindex
$info 0]
1283 set icon
[lindex
$info 1]
1284 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1285 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1288 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1289 elseif
{$s0 eq
{_
}} {set s0 _
}
1291 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1292 elseif
{$s1 eq
{_
}} {set s1 _
}
1294 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1295 set head_info
[list
0 $null_sha1]
1296 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1297 && $head_info eq
{}} {
1298 set head_info
$index_info
1301 set file_states
($path) [list
$s0$s1 $icon \
1302 $head_info $index_info \
1307 proc display_file
{path state
} {
1308 global file_states file_lists selected_paths
1310 set old_m
[merge_state
$path $state]
1311 set s
$file_states($path)
1312 set new_m
[lindex
$s 0]
1313 set new_w
[mapcol
$new_m $path]
1314 set old_w
[mapcol
$old_m $path]
1315 set new_icon
[mapicon
$new_m $path]
1317 if {$new_m eq
{__
}} {
1318 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1320 set file_lists
($old_w) \
1321 [lreplace
$file_lists($old_w) $lno $lno]
1323 $old_w conf
-state normal
1324 $old_w delete
$lno.0 [expr {$lno + 1}].0
1325 $old_w conf
-state disabled
1327 unset file_states
($path)
1328 catch
{unset selected_paths
($path)}
1332 if {$new_w ne
$old_w} {
1333 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1335 set file_lists
($old_w) \
1336 [lreplace
$file_lists($old_w) $lno $lno]
1338 $old_w conf
-state normal
1339 $old_w delete
$lno.0 [expr {$lno + 1}].0
1340 $old_w conf
-state disabled
1343 lappend file_lists
($new_w) $path
1344 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1345 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1347 $new_w conf
-state normal
1348 $new_w image create
$lno.0 \
1349 -align center
-padx 5 -pady 1 \
1350 -name [lindex
$s 1] \
1352 $new_w insert
$lno.1 "[escape_path $path]\n"
1353 if {[catch
{set in_sel
$selected_paths($path)}]} {
1357 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1359 $new_w conf
-state disabled
1360 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1361 $new_w conf
-state normal
1362 $new_w image conf
[lindex
$s 1] -image $new_icon
1363 $new_w conf
-state disabled
1367 proc display_all_files
{} {
1368 global ui_index ui_other
1369 global file_states file_lists
1370 global last_clicked selected_paths
1372 $ui_index conf
-state normal
1373 $ui_other conf
-state normal
1375 $ui_index delete
0.0 end
1376 $ui_other delete
0.0 end
1379 set file_lists
($ui_index) [list
]
1380 set file_lists
($ui_other) [list
]
1382 foreach path
[lsort
[array names file_states
]] {
1383 set s
$file_states($path)
1385 set w
[mapcol
$m $path]
1386 lappend file_lists
($w) $path
1387 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1388 $w image create end \
1389 -align center
-padx 5 -pady 1 \
1390 -name [lindex
$s 1] \
1391 -image [mapicon
$m $path]
1392 $w insert end
"[escape_path $path]\n"
1393 if {[catch
{set in_sel
$selected_paths($path)}]} {
1397 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1401 $ui_index conf
-state disabled
1402 $ui_other conf
-state disabled
1405 proc update_indexinfo
{msg pathList after
} {
1406 global update_index_cp ui_status_value
1408 if {![lock_index update
]} return
1410 set update_index_cp
0
1411 set pathList
[lsort
$pathList]
1412 set totalCnt
[llength
$pathList]
1413 set batch [expr {int
($totalCnt * .01) + 1}]
1414 if {$batch > 25} {set batch 25}
1416 set ui_status_value
[format \
1417 "$msg... %i/%i files (%.2f%%)" \
1421 set fd
[open
"| git update-index -z --index-info" w
]
1427 fileevent
$fd writable
[list \
1428 write_update_indexinfo \
1438 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1439 global update_index_cp ui_status_value
1440 global file_states current_diff
1442 if {$update_index_cp >= $totalCnt} {
1449 for {set i
$batch} \
1450 {$update_index_cp < $totalCnt && $i > 0} \
1452 set path
[lindex
$pathList $update_index_cp]
1453 incr update_index_cp
1455 set s
$file_states($path)
1456 switch
-glob -- [lindex
$s 0] {
1463 set info
[lindex
$s 2]
1464 if {$info eq
{}} continue
1466 puts
-nonewline $fd $info
1467 puts
-nonewline $fd "\t"
1468 puts
-nonewline $fd $path
1469 puts
-nonewline $fd "\0"
1470 display_file
$path $new
1473 set ui_status_value
[format \
1474 "$msg... %i/%i files (%.2f%%)" \
1477 [expr {100.0 * $update_index_cp / $totalCnt}]]
1480 proc update_index
{msg pathList after
} {
1481 global update_index_cp ui_status_value
1483 if {![lock_index update
]} return
1485 set update_index_cp
0
1486 set pathList
[lsort
$pathList]
1487 set totalCnt
[llength
$pathList]
1488 set batch [expr {int
($totalCnt * .01) + 1}]
1489 if {$batch > 25} {set batch 25}
1491 set ui_status_value
[format \
1492 "$msg... %i/%i files (%.2f%%)" \
1496 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1502 fileevent
$fd writable
[list \
1503 write_update_index \
1513 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1514 global update_index_cp ui_status_value
1515 global file_states current_diff
1517 if {$update_index_cp >= $totalCnt} {
1524 for {set i
$batch} \
1525 {$update_index_cp < $totalCnt && $i > 0} \
1527 set path
[lindex
$pathList $update_index_cp]
1528 incr update_index_cp
1530 switch
-glob -- [lindex
$file_states($path) 0] {
1549 puts
-nonewline $fd $path
1550 puts
-nonewline $fd "\0"
1551 display_file
$path $new
1554 set ui_status_value
[format \
1555 "$msg... %i/%i files (%.2f%%)" \
1558 [expr {100.0 * $update_index_cp / $totalCnt}]]
1561 proc checkout_index
{msg pathList after
} {
1562 global update_index_cp ui_status_value
1564 if {![lock_index update
]} return
1566 set update_index_cp
0
1567 set pathList
[lsort
$pathList]
1568 set totalCnt
[llength
$pathList]
1569 set batch [expr {int
($totalCnt * .01) + 1}]
1570 if {$batch > 25} {set batch 25}
1572 set ui_status_value
[format \
1573 "$msg... %i/%i files (%.2f%%)" \
1577 set cmd
[list git checkout-index
]
1583 set fd
[open
"| $cmd " w
]
1589 fileevent
$fd writable
[list \
1590 write_checkout_index \
1600 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1601 global update_index_cp ui_status_value
1602 global file_states current_diff
1604 if {$update_index_cp >= $totalCnt} {
1611 for {set i
$batch} \
1612 {$update_index_cp < $totalCnt && $i > 0} \
1614 set path
[lindex
$pathList $update_index_cp]
1615 incr update_index_cp
1617 switch
-glob -- [lindex
$file_states($path) 0] {
1627 puts
-nonewline $fd $path
1628 puts
-nonewline $fd "\0"
1629 display_file
$path $new
1632 set ui_status_value
[format \
1633 "$msg... %i/%i files (%.2f%%)" \
1636 [expr {100.0 * $update_index_cp / $totalCnt}]]
1639 ######################################################################
1641 ## branch management
1643 proc load_all_heads
{} {
1644 global all_heads tracking_branches
1646 set all_heads
[list
]
1647 set cmd
[list git for-each-ref
]
1648 lappend cmd
--format=%(refname
)
1649 lappend cmd refs
/heads
1650 set fd
[open
"| $cmd" r
]
1651 while {[gets
$fd line
] > 0} {
1652 if {![catch
{set info
$tracking_branches($line)}]} continue
1653 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1654 lappend all_heads
$name
1658 set all_heads
[lsort
$all_heads]
1661 proc populate_branch_menu
{m
} {
1662 global all_heads disable_on_lock
1665 foreach b
$all_heads {
1666 $m add radiobutton \
1668 -command [list switch_branch
$b] \
1669 -variable current_branch \
1672 lappend disable_on_lock \
1673 [list
$m entryconf
[$m index last
] -state]
1677 proc do_create_branch
{} {
1678 error
"NOT IMPLEMENTED"
1681 proc do_delete_branch
{} {
1682 error
"NOT IMPLEMENTED"
1685 proc switch_branch
{b
} {
1686 global HEAD commit_type file_states current_branch
1687 global selected_commit_type ui_comm
1689 if {![lock_index switch
]} return
1691 # -- Backup the selected branch (repository_state resets it)
1693 set new_branch
$current_branch
1695 # -- Our in memory state should match the repository.
1697 repository_state curType curHEAD curMERGE_HEAD
1698 if {[string match amend
* $commit_type]
1699 && $curType eq
{normal
}
1700 && $curHEAD eq
$HEAD} {
1701 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1702 info_popup
{Last scanned state does not match repository state.
1704 Another Git program has modified this repository
1705 since the last scan. A rescan must be performed
1706 before the current branch can be changed.
1708 The rescan will be automatically started now.
1711 rescan
{set ui_status_value
{Ready.
}}
1715 # -- Toss the message buffer if we are in amend mode.
1717 if {[string match amend
* $curType]} {
1718 $ui_comm delete
0.0 end
1720 $ui_comm edit modified false
1723 set selected_commit_type new
1724 set current_branch
$new_branch
1727 error
"NOT FINISHED"
1730 ######################################################################
1732 ## remote management
1734 proc load_all_remotes
{} {
1736 global all_remotes tracking_branches
1738 set all_remotes
[list
]
1739 array
unset tracking_branches
1741 set rm_dir
[file join [gitdir
] remotes
]
1742 if {[file isdirectory
$rm_dir]} {
1743 set all_remotes
[glob \
1747 -directory $rm_dir *]
1749 foreach name
$all_remotes {
1751 set fd
[open
[file join $rm_dir $name] r
]
1752 while {[gets
$fd line
] >= 0} {
1753 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
1754 $line line src dst
]} continue
1755 if {![regexp ^refs
/ $dst]} {
1756 set dst
"refs/heads/$dst"
1758 set tracking_branches
($dst) [list
$name $src]
1765 foreach line
[array names repo_config remote.
*.url
] {
1766 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
1767 lappend all_remotes
$name
1769 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
1773 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
1774 if {![regexp ^refs
/ $dst]} {
1775 set dst
"refs/heads/$dst"
1777 set tracking_branches
($dst) [list
$name $src]
1781 set all_remotes
[lsort
-unique $all_remotes]
1784 proc populate_fetch_menu
{m
} {
1785 global all_remotes repo_config
1787 foreach r
$all_remotes {
1789 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1790 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1795 set fd
[open
[file join [gitdir
] remotes
$r] r
]
1796 while {[gets
$fd n
] >= 0} {
1797 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1808 -label "Fetch from $r..." \
1809 -command [list fetch_from
$r] \
1815 proc populate_push_menu
{m
} {
1816 global all_remotes repo_config
1818 foreach r
$all_remotes {
1820 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1821 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1826 set fd
[open
[file join [gitdir
] remotes
$r] r
]
1827 while {[gets
$fd n
] >= 0} {
1828 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1839 -label "Push to $r..." \
1840 -command [list push_to
$r] \
1846 proc populate_pull_menu
{m
} {
1847 global repo_config all_remotes disable_on_lock
1849 foreach remote
$all_remotes {
1851 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1852 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1853 foreach line
$repo_config(remote.
$remote.fetch
) {
1854 if {[regexp
{^
([^
:]+):} $line line rb
]} {
1861 set fd
[open
[file join [gitdir
] remotes
$remote] r
]
1862 while {[gets
$fd line
] >= 0} {
1863 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1871 foreach rb
$rb_list {
1872 regsub ^refs
/heads
/ $rb {} rb_short
1874 -label "Branch $rb_short from $remote..." \
1875 -command [list pull_remote
$remote $rb] \
1877 lappend disable_on_lock \
1878 [list
$m entryconf
[$m index last
] -state]
1883 ######################################################################
1888 #define mask_width 14
1889 #define mask_height 15
1890 static unsigned char mask_bits
[] = {
1891 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1892 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1893 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1896 image create bitmap file_plain
-background white
-foreground black
-data {
1897 #define plain_width 14
1898 #define plain_height 15
1899 static unsigned char plain_bits
[] = {
1900 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1901 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1902 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1903 } -maskdata $filemask
1905 image create bitmap file_mod
-background white
-foreground blue
-data {
1906 #define mod_width 14
1907 #define mod_height 15
1908 static unsigned char mod_bits
[] = {
1909 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1910 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1911 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1912 } -maskdata $filemask
1914 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1915 #define file_fulltick_width 14
1916 #define file_fulltick_height 15
1917 static unsigned char file_fulltick_bits
[] = {
1918 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1919 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1920 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1921 } -maskdata $filemask
1923 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1924 #define parttick_width 14
1925 #define parttick_height 15
1926 static unsigned char parttick_bits
[] = {
1927 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1928 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1929 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1930 } -maskdata $filemask
1932 image create bitmap file_question
-background white
-foreground black
-data {
1933 #define file_question_width 14
1934 #define file_question_height 15
1935 static unsigned char file_question_bits
[] = {
1936 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1937 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1938 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1939 } -maskdata $filemask
1941 image create bitmap file_removed
-background white
-foreground red
-data {
1942 #define file_removed_width 14
1943 #define file_removed_height 15
1944 static unsigned char file_removed_bits
[] = {
1945 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1946 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1947 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1948 } -maskdata $filemask
1950 image create bitmap file_merge
-background white
-foreground blue
-data {
1951 #define file_merge_width 14
1952 #define file_merge_height 15
1953 static unsigned char file_merge_bits
[] = {
1954 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1955 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1956 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1957 } -maskdata $filemask
1959 set ui_index .vpane.files.index.list
1960 set ui_other .vpane.files.other.list
1961 set max_status_desc
0
1963 {__ i plain
"Unmodified"}
1964 {_M i mod
"Modified"}
1965 {M_ i fulltick
"Added to commit"}
1966 {MM i parttick
"Partially included"}
1967 {MD i question
"Added (but gone)"}
1969 {_O o plain
"Untracked"}
1970 {A_ o fulltick
"Added by commit"}
1971 {AM o parttick
"Partially added"}
1972 {AD o question
"Added (but gone)"}
1974 {_D i question
"Missing"}
1975 {DD i removed
"Removed by commit"}
1976 {D_ i removed
"Removed by commit"}
1977 {DO i removed
"Removed (still exists)"}
1978 {DM i removed
"Removed (but modified)"}
1980 {UD i merge
"Merge conflicts"}
1981 {UM i merge
"Merge conflicts"}
1982 {U_ i merge
"Merge conflicts"}
1984 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1985 set max_status_desc
[string length
[lindex
$i 3]]
1987 if {[lindex
$i 1] eq
{i
}} {
1988 set all_cols
([lindex
$i 0]) $ui_index
1990 set all_cols
([lindex
$i 0]) $ui_other
1992 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1993 set all_descs
([lindex
$i 0]) [lindex
$i 3]
1997 ######################################################################
2002 global tcl_platform tk_library
2003 if {[tk windowingsystem
] eq
{aqua
}} {
2009 proc is_Windows
{} {
2011 if {$tcl_platform(platform
) eq
{windows
}} {
2017 proc bind_button3
{w cmd
} {
2018 bind $w <Any-Button-3
> $cmd
2020 bind $w <Control-Button-1
> $cmd
2024 proc incr_font_size
{font
{amt
1}} {
2025 set sz
[font configure
$font -size]
2027 font configure
$font -size $sz
2028 font configure
${font}bold
-size $sz
2031 proc hook_failed_popup
{hook msg
} {
2036 label
$w.m.l1
-text "$hook hook failed:" \
2041 -background white
-borderwidth 1 \
2043 -width 80 -height 10 \
2045 -yscrollcommand [list
$w.m.sby
set]
2047 -text {You must correct the above errors before committing.
} \
2051 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2052 pack
$w.m.l1
-side top
-fill x
2053 pack
$w.m.l2
-side bottom
-fill x
2054 pack
$w.m.sby
-side right
-fill y
2055 pack
$w.m.t
-side left
-fill both
-expand 1
2056 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2058 $w.m.t insert
1.0 $msg
2059 $w.m.t conf
-state disabled
2061 button
$w.ok
-text OK \
2064 -command "destroy $w"
2065 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2067 bind $w <Visibility
> "grab $w; focus $w"
2068 bind $w <Key-Return
> "destroy $w"
2069 wm title
$w "[appname] ([reponame]): error"
2073 set next_console_id
0
2075 proc new_console
{short_title long_title
} {
2076 global next_console_id console_data
2077 set w .console
[incr next_console_id
]
2078 set console_data
($w) [list
$short_title $long_title]
2079 return [console_init
$w]
2082 proc console_init
{w
} {
2083 global console_cr console_data M1B
2085 set console_cr
($w) 1.0
2088 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2093 -background white
-borderwidth 1 \
2095 -width 80 -height 10 \
2098 -yscrollcommand [list
$w.m.sby
set]
2099 label
$w.m.s
-text {Working... please
wait...
} \
2103 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2104 pack
$w.m.l1
-side top
-fill x
2105 pack
$w.m.s
-side bottom
-fill x
2106 pack
$w.m.sby
-side right
-fill y
2107 pack
$w.m.t
-side left
-fill both
-expand 1
2108 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2110 menu
$w.ctxm
-tearoff 0
2111 $w.ctxm add
command -label "Copy" \
2113 -command "tk_textCopy $w.m.t"
2114 $w.ctxm add
command -label "Select All" \
2116 -command "$w.m.t tag add sel 0.0 end"
2117 $w.ctxm add
command -label "Copy All" \
2120 $w.m.t tag add sel 0.0 end
2122 $w.m.t tag remove sel 0.0 end
2125 button
$w.ok
-text {Close
} \
2128 -command "destroy $w"
2129 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2131 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2132 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2133 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2134 bind $w <Visibility
> "focus $w"
2135 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2139 proc console_exec
{w cmd
{after
{}}} {
2140 # -- Windows tosses the enviroment when we exec our child.
2141 # But most users need that so we have to relogin. :-(
2144 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2147 # -- Tcl won't let us redirect both stdout and stderr to
2148 # the same pipe. So pass it through cat...
2150 set cmd
[concat |
$cmd |
& cat]
2152 set fd_f
[open
$cmd r
]
2153 fconfigure
$fd_f -blocking 0 -translation binary
2154 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2157 proc console_read
{w fd after
} {
2158 global console_cr console_data
2162 if {![winfo exists
$w]} {console_init
$w}
2163 $w.m.t conf
-state normal
2165 set n
[string length
$buf]
2167 set cr
[string first
"\r" $buf $c]
2168 set lf
[string first
"\n" $buf $c]
2169 if {$cr < 0} {set cr
[expr {$n + 1}]}
2170 if {$lf < 0} {set lf
[expr {$n + 1}]}
2173 $w.m.t insert end
[string range
$buf $c $lf]
2174 set console_cr
($w) [$w.m.t index
{end
-1c}]
2178 $w.m.t delete
$console_cr($w) end
2179 $w.m.t insert end
"\n"
2180 $w.m.t insert end
[string range
$buf $c $cr]
2185 $w.m.t conf
-state disabled
2189 fconfigure
$fd -blocking 1
2191 if {[catch
{close
$fd}]} {
2192 if {![winfo exists
$w]} {console_init
$w}
2193 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2194 $w.ok conf
-state normal
2196 } elseif
{[winfo exists
$w]} {
2197 $w.m.s conf
-background green
-text {Success
}
2198 $w.ok conf
-state normal
2201 array
unset console_cr
$w
2202 array
unset console_data
$w
2204 uplevel
#0 $after $ok
2208 fconfigure
$fd -blocking 0
2211 ######################################################################
2215 set starting_gitk_msg
{Please
wait... Starting gitk...
}
2217 proc do_gitk
{revs
} {
2218 global ui_status_value starting_gitk_msg
2226 set cmd
"sh -c \"exec $cmd\""
2230 if {[catch
{eval exec $cmd} err
]} {
2231 error_popup
"Failed to start gitk:\n\n$err"
2233 set ui_status_value
$starting_gitk_msg
2235 if {$ui_status_value eq
$starting_gitk_msg} {
2236 set ui_status_value
{Ready.
}
2243 set w
[new_console
{gc
} {Compressing the object database
}]
2244 console_exec
$w {git gc
}
2247 proc do_fsck_objects
{} {
2248 set w
[new_console
{fsck-objects
} \
2249 {Verifying the object database with fsck-objects
}]
2250 set cmd
[list git fsck-objects
]
2253 lappend cmd
--strict
2254 console_exec
$w $cmd
2260 global ui_comm is_quitting repo_config commit_type
2262 if {$is_quitting} return
2265 # -- Stash our current commit buffer.
2267 set save
[file join [gitdir
] GITGUI_MSG
]
2268 set msg
[string trim
[$ui_comm get
0.0 end
]]
2269 if {![string match amend
* $commit_type]
2270 && [$ui_comm edit modified
]
2273 set fd
[open
$save w
]
2274 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2278 catch
{file delete
$save}
2281 # -- Stash our current window geometry into this repository.
2283 set cfg_geometry
[list
]
2284 lappend cfg_geometry
[wm geometry .
]
2285 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
2286 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
2287 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2290 if {$cfg_geometry ne
$rc_geometry} {
2291 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2298 rescan
{set ui_status_value
{Ready.
}}
2301 proc remove_helper
{txt paths
} {
2302 global file_states current_diff
2304 if {![lock_index begin-update
]} return
2308 foreach path
$paths {
2309 switch
-glob -- [lindex
$file_states($path) 0] {
2313 lappend pathList
$path
2314 if {$path eq
$current_diff} {
2315 set after
{reshow_diff
;}
2320 if {$pathList eq
{}} {
2326 [concat
$after {set ui_status_value
{Ready.
}}]
2330 proc do_remove_selection
{} {
2331 global current_diff selected_paths
2333 if {[array size selected_paths
] > 0} {
2335 {Removing selected files from commit
} \
2336 [array names selected_paths
]
2337 } elseif
{$current_diff ne
{}} {
2339 "Removing [short_path $current_diff] from commit" \
2340 [list
$current_diff]
2344 proc include_helper
{txt paths
} {
2345 global file_states current_diff
2347 if {![lock_index begin-update
]} return
2351 foreach path
$paths {
2352 switch
-glob -- [lindex
$file_states($path) 0] {
2361 lappend pathList
$path
2362 if {$path eq
$current_diff} {
2363 set after
{reshow_diff
;}
2368 if {$pathList eq
{}} {
2374 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2378 proc do_include_selection
{} {
2379 global current_diff selected_paths
2381 if {[array size selected_paths
] > 0} {
2383 {Adding selected files
} \
2384 [array names selected_paths
]
2385 } elseif
{$current_diff ne
{}} {
2387 "Adding [short_path $current_diff]" \
2388 [list
$current_diff]
2392 proc do_include_all
{} {
2396 foreach path
[array names file_states
] {
2397 switch
-- [lindex
$file_states($path) 0] {
2403 _D
{lappend paths
$path}
2407 {Adding all modified files
} \
2411 proc revert_helper
{txt paths
} {
2412 global file_states current_diff
2414 if {![lock_index begin-update
]} return
2418 foreach path
$paths {
2419 switch
-glob -- [lindex
$file_states($path) 0] {
2426 lappend pathList
$path
2427 if {$path eq
$current_diff} {
2428 set after
{reshow_diff
;}
2434 set n
[llength
$pathList]
2438 } elseif
{$n == 1} {
2439 set s
"[short_path [lindex $pathList]]"
2441 set s
"these $n files"
2444 set reply
[tk_dialog \
2446 "[appname] ([reponame])" \
2447 "Revert changes in $s?
2449 Any unadded changes will be permanently lost by the revert." \
2459 [concat
$after {set ui_status_value
{Ready.
}}]
2465 proc do_revert_selection
{} {
2466 global current_diff selected_paths
2468 if {[array size selected_paths
] > 0} {
2470 {Reverting selected files
} \
2471 [array names selected_paths
]
2472 } elseif
{$current_diff ne
{}} {
2474 "Reverting [short_path $current_diff]" \
2475 [list
$current_diff]
2479 proc do_signoff
{} {
2482 set me
[committer_ident
]
2483 if {$me eq
{}} return
2485 set sob
"Signed-off-by: $me"
2486 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2487 if {$last ne
$sob} {
2488 $ui_comm edit separator
2490 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2491 $ui_comm insert end
"\n"
2493 $ui_comm insert end
"\n$sob"
2494 $ui_comm edit separator
2499 proc do_select_commit_type
{} {
2500 global commit_type selected_commit_type
2502 if {$selected_commit_type eq
{new
}
2503 && [string match amend
* $commit_type]} {
2505 } elseif
{$selected_commit_type eq
{amend
}
2506 && ![string match amend
* $commit_type]} {
2509 # The amend request was rejected...
2511 if {![string match amend
* $commit_type]} {
2512 set selected_commit_type new
2522 global appvers copyright
2523 global tcl_patchLevel tk_patchLevel
2527 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2529 label
$w.header
-text "About [appname]" \
2531 pack
$w.header
-side top
-fill x
2534 button
$w.buttons.close
-text {Close
} \
2536 -command [list destroy
$w]
2537 pack
$w.buttons.close
-side right
2538 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2541 -text "[appname] - a commit creation tool for Git.
2549 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2552 append v
"[appname] version $appvers\n"
2553 append v
"[exec git version]\n"
2555 if {$tcl_patchLevel eq
$tk_patchLevel} {
2556 append v
"Tcl/Tk version $tcl_patchLevel"
2558 append v
"Tcl version $tcl_patchLevel"
2559 append v
", Tk version $tk_patchLevel"
2570 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2572 menu
$w.ctxm
-tearoff 0
2573 $w.ctxm add
command \
2578 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2581 bind $w <Visibility
> "grab $w; focus $w"
2582 bind $w <Key-Escape
> "destroy $w"
2583 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2584 wm title
$w "About [appname]"
2588 proc do_options
{} {
2589 global repo_config global_config font_descs
2590 global repo_config_new global_config_new
2592 array
unset repo_config_new
2593 array
unset global_config_new
2594 foreach name
[array names repo_config
] {
2595 set repo_config_new
($name) $repo_config($name)
2598 foreach name
[array names repo_config
] {
2600 gui.diffcontext
{continue}
2602 set repo_config_new
($name) $repo_config($name)
2604 foreach name
[array names global_config
] {
2605 set global_config_new
($name) $global_config($name)
2608 set w .options_editor
2610 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2612 label
$w.header
-text "[appname] Options" \
2614 pack
$w.header
-side top
-fill x
2617 button
$w.buttons.restore
-text {Restore Defaults
} \
2619 -command do_restore_defaults
2620 pack
$w.buttons.restore
-side left
2621 button
$w.buttons.save
-text Save \
2623 -command [list do_save_config
$w]
2624 pack
$w.buttons.save
-side right
2625 button
$w.buttons.cancel
-text {Cancel
} \
2627 -command [list destroy
$w]
2628 pack
$w.buttons.cancel
-side right
2629 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2631 labelframe
$w.repo
-text "[reponame] Repository" \
2633 -relief raised
-borderwidth 2
2634 labelframe
$w.global
-text {Global
(All Repositories
)} \
2636 -relief raised
-borderwidth 2
2637 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2638 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2641 {b partialinclude
{Allow Partially Added Files
}}
2642 {b pullsummary
{Show Pull Summary
}}
2643 {b trustmtime
{Trust File Modification Timestamps
}}
2644 {i diffcontext
{Number of Diff Context Lines
}}
2646 set type [lindex
$option 0]
2647 set name
[lindex
$option 1]
2648 set text
[lindex
$option 2]
2649 foreach f
{repo global
} {
2652 checkbutton
$w.
$f.
$name -text $text \
2653 -variable ${f}_config_new
(gui.
$name) \
2657 pack
$w.
$f.
$name -side top
-anchor w
2661 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2662 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2663 spinbox
$w.
$f.
$name.v \
2664 -textvariable ${f}_config_new
(gui.
$name) \
2665 -from 1 -to 99 -increment 1 \
2668 pack
$w.
$f.
$name.v
-side right
-anchor e
2669 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2675 set all_fonts
[lsort
[font families
]]
2676 foreach option
$font_descs {
2677 set name
[lindex
$option 0]
2678 set font
[lindex
$option 1]
2679 set text
[lindex
$option 2]
2681 set global_config_new
(gui.
$font^^family
) \
2682 [font configure
$font -family]
2683 set global_config_new
(gui.
$font^^size
) \
2684 [font configure
$font -size]
2686 frame
$w.global.
$name
2687 label
$w.global.
$name.l
-text "$text:" -font font_ui
2688 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2689 eval tk_optionMenu
$w.global.
$name.family \
2690 global_config_new
(gui.
$font^^family
) \
2692 spinbox
$w.global.
$name.size \
2693 -textvariable global_config_new
(gui.
$font^^size
) \
2694 -from 2 -to 80 -increment 1 \
2697 pack
$w.global.
$name.size
-side right
-anchor e
2698 pack
$w.global.
$name.family
-side right
-anchor e
2699 pack
$w.global.
$name -side top
-anchor w
-fill x
2702 bind $w <Visibility
> "grab $w; focus $w"
2703 bind $w <Key-Escape
> "destroy $w"
2704 wm title
$w "[appname] ([reponame]): Options"
2708 proc do_restore_defaults
{} {
2709 global font_descs default_config repo_config
2710 global repo_config_new global_config_new
2712 foreach name
[array names default_config
] {
2713 set repo_config_new
($name) $default_config($name)
2714 set global_config_new
($name) $default_config($name)
2717 foreach option
$font_descs {
2718 set name
[lindex
$option 0]
2719 set repo_config
(gui.
$name) $default_config(gui.
$name)
2723 foreach option
$font_descs {
2724 set name
[lindex
$option 0]
2725 set font
[lindex
$option 1]
2726 set global_config_new
(gui.
$font^^family
) \
2727 [font configure
$font -family]
2728 set global_config_new
(gui.
$font^^size
) \
2729 [font configure
$font -size]
2733 proc do_save_config
{w
} {
2734 if {[catch
{save_config
} err
]} {
2735 error_popup
"Failed to completely save options:\n\n$err"
2741 proc do_windows_shortcut
{} {
2745 set desktop
[exec cygpath \
2753 set fn
[tk_getSaveFile \
2755 -title "[appname] ([reponame]): Create Desktop Icon" \
2756 -initialdir $desktop \
2757 -initialfile "Git [reponame].bat"]
2761 set sh
[exec cygpath \
2765 set me
[exec cygpath \
2769 set gd
[exec cygpath \
2773 regsub
-all ' $me "'\\''" me
2774 regsub -all ' $gd "'\\''" gd
2775 puts $fd "@ECHO Starting git-gui... Please wait..."
2776 puts -nonewline $fd "@\"$sh\" --login -c \""
2777 puts -nonewline $fd "GIT_DIR='$gd'"
2778 puts -nonewline $fd " '$me'"
2782 error_popup "Cannot write script:\n\n$err"
2787 proc do_macosx_app {} {
2790 set fn [tk_getSaveFile \
2792 -title "[appname] ([reponame]): Create Desktop Icon" \
2793 -initialdir [file join $env(HOME) Desktop] \
2794 -initialfile "Git [reponame].app"]
2797 set Contents [file join $fn Contents]
2798 set MacOS [file join $Contents MacOS]
2799 set exe [file join $MacOS git-gui]
2803 set fd [open [file join $Contents Info.plist] w]
2804 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2805 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2806 <plist version="1.0">
2808 <key>CFBundleDevelopmentRegion</key>
2809 <string>English</string>
2810 <key>CFBundleExecutable</key>
2811 <string>git-gui</string>
2812 <key>CFBundleIdentifier</key>
2813 <string>org.spearce.git-gui</string>
2814 <key>CFBundleInfoDictionaryVersion</key>
2815 <string>6.0</string>
2816 <key>CFBundlePackageType</key>
2817 <string>APPL</string>
2818 <key>CFBundleSignature</key>
2819 <string>????</string>
2820 <key>CFBundleVersion</key>
2821 <string>1.0</string>
2822 <key>NSPrincipalClass</key>
2823 <string>NSApplication</string>
2828 set fd [open $exe w]
2829 set gd [file normalize [gitdir]]
2830 set ep [file normalize [exec git --exec-path]]
2831 regsub -all ' $gd "'\\''" gd
2832 regsub
-all ' $ep "'\\''" ep
2833 puts $fd "#!/bin/sh"
2834 foreach name
[array names env
] {
2835 if {[string match GIT_
* $name]} {
2836 regsub
-all ' $env($name) "'\\''" v
2837 puts $fd "export $name='$v'"
2840 puts $fd "export PATH
='$ep':\
$PATH"
2841 puts $fd "export GIT_DIR
='$gd'"
2842 puts $fd "exec [file normalize
$argv0]"
2845 file attributes $exe -permissions u+x,g+x,o+x
2847 error_popup "Cannot
write icon
:\n\n$err"
2852 proc toggle_or_diff {w x y} {
2853 global file_states file_lists current_diff ui_index ui_other
2854 global last_clicked selected_paths
2856 set pos [split [$w index @$x,$y] .]
2857 set lno [lindex $pos 0]
2858 set col [lindex $pos 1]
2859 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2865 set last_clicked [list $w $lno]
2866 array unset selected_paths
2867 $ui_index tag remove in_sel 0.0 end
2868 $ui_other tag remove in_sel 0.0 end
2871 if {$current_diff eq $path} {
2872 set after {reshow_diff;}
2876 switch -glob -- [lindex $file_states($path) 0] {
2883 "Removing
[short_path
$path] from commit
" \
2885 [concat $after {set ui_status_value {Ready.}}]
2889 "Adding
[short_path
$path]" \
2891 [concat $after {set ui_status_value {Ready.}}]
2895 show_diff $path $w $lno
2899 proc add_one_to_selection {w x y} {
2901 global last_clicked selected_paths
2903 set pos [split [$w index @$x,$y] .]
2904 set lno [lindex $pos 0]
2905 set col [lindex $pos 1]
2906 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2912 set last_clicked [list $w $lno]
2913 if {[catch {set in_sel $selected_paths($path)}]} {
2917 unset selected_paths($path)
2918 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2920 set selected_paths($path) 1
2921 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2925 proc add_range_to_selection {w x y} {
2927 global last_clicked selected_paths
2929 if {[lindex $last_clicked 0] ne $w} {
2930 toggle_or_diff $w $x $y
2934 set pos [split [$w index @$x,$y] .]
2935 set lno [lindex $pos 0]
2936 set lc [lindex $last_clicked 1]
2945 foreach path [lrange $file_lists($w) \
2946 [expr {$begin - 1}] \
2947 [expr {$end - 1}]] {
2948 set selected_paths($path) 1
2950 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2953 ######################################################################
2957 set cursor_ptr arrow
2958 font create font_diff -family Courier -size 10
2962 eval font configure font_ui [font actual [.dummy cget -font]]
2966 font create font_uibold
2967 font create font_diffbold
2972 } elseif {[is_MacOSX]} {
2980 proc apply_config {} {
2981 global repo_config font_descs
2983 foreach option $font_descs {
2984 set name [lindex $option 0]
2985 set font [lindex $option 1]
2987 foreach {cn cv} $repo_config(gui.$name) {
2988 font configure $font $cn $cv
2991 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
2993 foreach {cn cv} [font configure $font] {
2994 font configure ${font}bold $cn $cv
2996 font configure ${font}bold -weight bold
3000 set default_config(gui.trustmtime) false
3001 set default_config(gui.pullsummary) true
3002 set default_config(gui.partialinclude) false
3003 set default_config(gui.diffcontext) 5
3004 set default_config(gui.fontui) [font configure font_ui]
3005 set default_config(gui.fontdiff) [font configure font_diff]
3007 {fontui font_ui {Main Font}}
3008 {fontdiff font_diff {Diff/Console Font}}
3013 ######################################################################
3019 menu .mbar -tearoff 0
3020 .mbar add cascade -label Repository -menu .mbar.repository
3021 .mbar add cascade -label Edit -menu .mbar.edit
3022 if {!$single_commit} {
3023 .mbar add cascade -label Branch -menu .mbar.branch
3025 .mbar add cascade -label Commit -menu .mbar.commit
3026 if {!$single_commit} {
3027 .mbar add cascade -label Fetch -menu .mbar.fetch
3028 .mbar add cascade -label Pull -menu .mbar.pull
3029 .mbar add cascade -label Push -menu .mbar.push
3031 . configure -menu .mbar
3033 # -- Repository Menu
3035 menu .mbar.repository
3036 .mbar.repository add command \
3037 -label {Visualize Current Branch} \
3038 -command {do_gitk {}} \
3041 .mbar.repository add command \
3042 -label {Visualize All Branches} \
3043 -command {do_gitk {--all}} \
3046 .mbar.repository add separator
3048 if {!$single_commit} {
3049 .mbar.repository add command -label {Compress Database} \
3053 .mbar.repository add command -label {Verify Database} \
3054 -command do_fsck_objects \
3057 .mbar.repository add separator
3060 .mbar.repository add command \
3061 -label {Create Desktop Icon} \
3062 -command do_windows_shortcut \
3064 } elseif {[is_MacOSX]} {
3065 .mbar.repository add command \
3066 -label {Create Desktop Icon} \
3067 -command do_macosx_app \
3072 .mbar.repository add command -label Quit \
3074 -accelerator $M1T-Q \
3080 .mbar.edit add command -label Undo \
3081 -command {catch {[focus] edit undo}} \
3082 -accelerator $M1T-Z \
3084 .mbar.edit add command -label Redo \
3085 -command {catch {[focus] edit redo}} \
3086 -accelerator $M1T-Y \
3088 .mbar.edit add separator
3089 .mbar.edit add command -label Cut \
3090 -command {catch {tk_textCut [focus]}} \
3091 -accelerator $M1T-X \
3093 .mbar.edit add command -label Copy \
3094 -command {catch {tk_textCopy [focus]}} \
3095 -accelerator $M1T-C \
3097 .mbar.edit add command -label Paste \
3098 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3099 -accelerator $M1T-V \
3101 .mbar.edit add command -label Delete \
3102 -command {catch {[focus] delete sel.first sel.last}} \
3105 .mbar.edit add separator
3106 .mbar.edit add command -label {Select All} \
3107 -command {catch {[focus] tag add sel 0.0 end}} \
3108 -accelerator $M1T-A \
3113 if {!$single_commit} {
3116 .mbar.branch add command -label {Create...} \
3117 -command do_create_branch \
3119 lappend disable_on_lock [list .mbar.branch entryconf \
3120 [.mbar.branch index last] -state]
3122 .mbar.branch add command -label {Delete...} \
3123 -command do_delete_branch \
3125 lappend disable_on_lock [list .mbar.branch entryconf \
3126 [.mbar.branch index last] -state]
3133 .mbar.commit add radiobutton \
3134 -label {New Commit} \
3135 -command do_select_commit_type \
3136 -variable selected_commit_type \
3139 lappend disable_on_lock \
3140 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3142 .mbar.commit add radiobutton \
3143 -label {Amend Last Commit} \
3144 -command do_select_commit_type \
3145 -variable selected_commit_type \
3148 lappend disable_on_lock \
3149 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3151 .mbar.commit add separator
3153 .mbar.commit add command -label Rescan \
3154 -command do_rescan \
3157 lappend disable_on_lock \
3158 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3160 .mbar.commit add command -label {Add To Commit} \
3161 -command do_include_selection \
3163 lappend disable_on_lock \
3164 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3166 .mbar.commit add command -label {Add All To Commit} \
3167 -command do_include_all \
3168 -accelerator $M1T-I \
3170 lappend disable_on_lock \
3171 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173 .mbar.commit add command -label {Remove From Commit} \
3174 -command do_remove_selection \
3176 lappend disable_on_lock \
3177 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179 .mbar.commit add command -label {Revert Changes} \
3180 -command do_revert_selection \
3182 lappend disable_on_lock \
3183 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185 .mbar.commit add separator
3187 .mbar.commit add command -label {Sign Off} \
3188 -command do_signoff \
3189 -accelerator $M1T-S \
3192 .mbar.commit add command -label Commit \
3193 -command do_commit \
3194 -accelerator $M1T-Return \
3196 lappend disable_on_lock \
3197 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3199 # -- Transport menus
3201 if {!$single_commit} {
3208 # -- Apple Menu (Mac OS X only)
3210 .mbar add cascade -label Apple -menu .mbar.apple
3213 .mbar.apple add command -label "About
[appname
]" \
3216 .mbar.apple add command -label "[appname
] Options...
" \
3217 -command do_options \
3222 .mbar.edit add separator
3223 .mbar.edit add command -label {Options...} \
3224 -command do_options \
3229 if {[file exists /usr/local/miga/lib/gui-miga]
3230 && [file exists .pvcsrc]} {
3232 global ui_status_value
3233 if {![lock_index update]} return
3234 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3235 set miga_fd [open "|
$cmd" r]
3236 fconfigure $miga_fd -blocking 0
3237 fileevent $miga_fd readable [list miga_done $miga_fd]
3238 set ui_status_value {Running miga...}
3240 proc miga_done {fd} {
3245 rescan [list set ui_status_value {Ready.}]
3248 .mbar add cascade -label Tools -menu .mbar.tools
3250 .mbar.tools add command -label "Migrate
" \
3253 lappend disable_on_lock \
3254 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3259 .mbar add cascade -label Help -menu .mbar.help
3262 .mbar.help add command -label "About
[appname
]" \
3274 -text {Current Branch:} \
3279 -textvariable current_branch \
3283 pack .branch.l1 -side left
3284 pack .branch.cb -side left -fill x
3285 pack .branch -side top -fill x
3287 # -- Main Window Layout
3289 panedwindow .vpane -orient vertical
3290 panedwindow .vpane.files -orient horizontal
3291 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3292 pack .vpane -anchor n -side top -fill both -expand 1
3294 # -- Index File List
3296 frame .vpane.files.index -height 100 -width 400
3297 label .vpane.files.index.title -text {Modified Files} \
3300 text $ui_index -background white -borderwidth 0 \
3301 -width 40 -height 10 \
3303 -cursor $cursor_ptr \
3304 -yscrollcommand {.vpane.files.index.sb set} \
3306 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3307 pack .vpane.files.index.title -side top -fill x
3308 pack .vpane.files.index.sb -side right -fill y
3309 pack $ui_index -side left -fill both -expand 1
3310 .vpane.files add .vpane.files.index -sticky nsew
3312 # -- Other (Add) File List
3314 frame .vpane.files.other -height 100 -width 100
3315 label .vpane.files.other.title -text {Untracked Files} \
3318 text $ui_other -background white -borderwidth 0 \
3319 -width 40 -height 10 \
3321 -cursor $cursor_ptr \
3322 -yscrollcommand {.vpane.files.other.sb set} \
3324 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3325 pack .vpane.files.other.title -side top -fill x
3326 pack .vpane.files.other.sb -side right -fill y
3327 pack $ui_other -side left -fill both -expand 1
3328 .vpane.files add .vpane.files.other -sticky nsew
3330 foreach i [list $ui_index $ui_other] {
3331 $i tag conf in_diff -font font_uibold
3332 $i tag conf in_sel \
3333 -background [$i cget -foreground] \
3334 -foreground [$i cget -background]
3338 # -- Diff and Commit Area
3340 frame .vpane.lower -height 300 -width 400
3341 frame .vpane.lower.commarea
3342 frame .vpane.lower.diff -relief sunken -borderwidth 1
3343 pack .vpane.lower.commarea -side top -fill x
3344 pack .vpane.lower.diff -side bottom -fill both -expand 1
3345 .vpane add .vpane.lower -stick nsew
3347 # -- Commit Area Buttons
3349 frame .vpane.lower.commarea.buttons
3350 label .vpane.lower.commarea.buttons.l -text {} \
3354 pack .vpane.lower.commarea.buttons.l -side top -fill x
3355 pack .vpane.lower.commarea.buttons -side left -fill y
3357 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3358 -command do_rescan \
3360 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3361 lappend disable_on_lock \
3362 {.vpane.lower.commarea.buttons.rescan conf -state}
3364 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3365 -command do_include_all \
3367 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3368 lappend disable_on_lock \
3369 {.vpane.lower.commarea.buttons.incall conf -state}
3371 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3372 -command do_signoff \
3374 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3376 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3377 -command do_commit \
3379 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3380 lappend disable_on_lock \
3381 {.vpane.lower.commarea.buttons.commit conf -state}
3383 # -- Commit Message Buffer
3385 frame .vpane.lower.commarea.buffer
3386 frame .vpane.lower.commarea.buffer.header
3387 set ui_comm .vpane.lower.commarea.buffer.t
3388 set ui_coml .vpane.lower.commarea.buffer.header.l
3389 radiobutton .vpane.lower.commarea.buffer.header.new \
3390 -text {New Commit} \
3391 -command do_select_commit_type \
3392 -variable selected_commit_type \
3395 lappend disable_on_lock \
3396 [list .vpane.lower.commarea.buffer.header.new conf -state]
3397 radiobutton .vpane.lower.commarea.buffer.header.amend \
3398 -text {Amend Last Commit} \
3399 -command do_select_commit_type \
3400 -variable selected_commit_type \
3403 lappend disable_on_lock \
3404 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3409 proc trace_commit_type {varname args} {
3410 global ui_coml commit_type
3411 switch -glob -- $commit_type {
3412 initial {set txt {Initial Commit Message:}}
3413 amend {set txt {Amended Commit Message:}}
3414 amend-initial {set txt {Amended Initial Commit Message:}}
3415 amend-merge {set txt {Amended Merge Commit Message:}}
3416 merge {set txt {Merge Commit Message:}}
3417 * {set txt {Commit Message:}}
3419 $ui_coml conf -text $txt
3421 trace add variable commit_type write trace_commit_type
3422 pack $ui_coml -side left -fill x
3423 pack .vpane.lower.commarea.buffer.header.amend -side right
3424 pack .vpane.lower.commarea.buffer.header.new -side right
3426 text $ui_comm -background white -borderwidth 1 \
3429 -autoseparators true \
3431 -width 75 -height 9 -wrap none \
3433 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3434 scrollbar .vpane.lower.commarea.buffer.sby \
3435 -command [list $ui_comm yview]
3436 pack .vpane.lower.commarea.buffer.header -side top -fill x
3437 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3438 pack $ui_comm -side left -fill y
3439 pack .vpane.lower.commarea.buffer -side left -fill y
3441 # -- Commit Message Buffer Context Menu
3443 set ctxm .vpane.lower.commarea.buffer.ctxm
3444 menu $ctxm -tearoff 0
3448 -command {tk_textCut $ui_comm}
3452 -command {tk_textCopy $ui_comm}
3456 -command {tk_textPaste $ui_comm}
3460 -command {$ui_comm delete sel.first sel.last}
3463 -label {Select All} \
3465 -command {$ui_comm tag add sel 0.0 end}
3470 $ui_comm tag add sel 0.0 end
3471 tk_textCopy $ui_comm
3472 $ui_comm tag remove sel 0.0 end
3479 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3484 set diff_actions [list]
3485 proc trace_current_diff {varname args} {
3486 global current_diff diff_actions file_states
3487 if {$current_diff eq {}} {
3494 set s [mapdesc [lindex $file_states($p) 0] $p]
3496 set p [escape_path $p]
3500 .vpane.lower.diff.header.status configure -text $s
3501 .vpane.lower.diff.header.file configure -text $f
3502 .vpane.lower.diff.header.path configure -text $p
3503 foreach w $diff_actions {
3507 trace add variable current_diff write trace_current_diff
3509 frame .vpane.lower.diff.header -background orange
3510 label .vpane.lower.diff.header.status \
3511 -background orange \
3512 -width $max_status_desc \
3516 label .vpane.lower.diff.header.file \
3517 -background orange \
3521 label .vpane.lower.diff.header.path \
3522 -background orange \
3526 pack .vpane.lower.diff.header.status -side left
3527 pack .vpane.lower.diff.header.file -side left
3528 pack .vpane.lower.diff.header.path -fill x
3529 set ctxm .vpane.lower.diff.header.ctxm
3530 menu $ctxm -tearoff 0
3541 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3542 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3546 frame .vpane.lower.diff.body
3547 set ui_diff .vpane.lower.diff.body.t
3548 text $ui_diff -background white -borderwidth 0 \
3549 -width 80 -height 15 -wrap none \
3551 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3552 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3554 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3555 -command [list $ui_diff xview]
3556 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3557 -command [list $ui_diff yview]
3558 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3559 pack .vpane.lower.diff.body.sby -side right -fill y
3560 pack $ui_diff -side left -fill both -expand 1
3561 pack .vpane.lower.diff.header -side top -fill x
3562 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3564 $ui_diff tag conf d_@ -font font_diffbold
3565 $ui_diff tag conf d_+ -foreground blue
3566 $ui_diff tag conf d_- -foreground red
3567 $ui_diff tag conf d_++ -foreground {#00a000}
3568 $ui_diff tag conf d_-- -foreground {#a000a0}
3569 $ui_diff tag conf d_+- \
3571 -background {light goldenrod yellow}
3572 $ui_diff tag conf d_-+ \
3576 # -- Diff Body Context Menu
3578 set ctxm .vpane.lower.diff.body.ctxm
3579 menu $ctxm -tearoff 0
3583 -command {tk_textCopy $ui_diff}
3584 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3586 -label {Select All} \
3588 -command {$ui_diff tag add sel 0.0 end}
3589 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3594 $ui_diff tag add sel 0.0 end
3595 tk_textCopy $ui_diff
3596 $ui_diff tag remove sel 0.0 end
3598 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3601 -label {Decrease Font Size} \
3603 -command {incr_font_size font_diff -1}
3604 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3606 -label {Increase Font Size} \
3608 -command {incr_font_size font_diff 1}
3609 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3612 -label {Show Less Context} \
3614 -command {if {$repo_config(gui.diffcontext) >= 2} {
3615 incr repo_config(gui.diffcontext) -1
3618 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3620 -label {Show More Context} \
3623 incr repo_config(gui.diffcontext)
3626 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3628 $ctxm add command -label {Options...} \
3631 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3635 set ui_status_value {Initializing...}
3636 label .status -textvariable ui_status_value \
3642 pack .status -anchor w -side bottom -fill x
3647 set gm $repo_config(gui.geometry)
3648 wm geometry . [lindex $gm 0]
3649 .vpane sash place 0 \
3650 [lindex [.vpane sash coord 0] 0] \
3652 .vpane.files sash place 0 \
3654 [lindex [.vpane.files sash coord 0] 1]
3660 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3661 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3662 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3663 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3664 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3665 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3666 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3667 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3668 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3669 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3670 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3672 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3673 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3674 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3675 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3676 bind $ui_diff <$M1B-Key-v> {break}
3677 bind $ui_diff <$M1B-Key-V> {break}
3678 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3679 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3680 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3681 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3682 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3683 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3685 bind . <Destroy> do_quit
3686 bind all <Key-F5> do_rescan
3687 bind all <$M1B-Key-r> do_rescan
3688 bind all <$M1B-Key-R> do_rescan
3689 bind . <$M1B-Key-s> do_signoff
3690 bind . <$M1B-Key-S> do_signoff
3691 bind . <$M1B-Key-i> do_include_all
3692 bind . <$M1B-Key-I> do_include_all
3693 bind . <$M1B-Key-Return> do_commit
3694 bind all <$M1B-Key-q> do_quit
3695 bind all <$M1B-Key-Q> do_quit
3696 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3697 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3698 foreach i [list $ui_index $ui_other] {
3699 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3700 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3701 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3705 set file_lists($ui_index) [list]
3706 set file_lists($ui_other) [list]
3710 set MERGE_HEAD [list]
3713 set current_branch {}
3715 set selected_commit_type new
3717 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
3718 focus -force $ui_comm
3720 # -- Warn the user about environmental problems. Cygwin's Tcl
3721 # does *not* pass its env array onto any processes it spawns.
3722 # This means that git processes get none of our environment.
3727 set msg "Possible environment issues exist.
3729 The following environment variables are probably
3730 going to be ignored by any Git subprocess run
3734 foreach name [array names env] {
3735 switch -regexp -- $name {
3736 {^GIT_INDEX_FILE$} -
3737 {^GIT_OBJECT_DIRECTORY$} -
3738 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3740 {^GIT_EXTERNAL_DIFF$} -
3744 {^GIT_CONFIG_LOCAL$} -
3745 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3746 append msg " - $name\n"
3749 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3750 append msg " - $name\n"
3752 set suggest_user $name
3756 if {$ignored_env > 0} {
3758 This is due to a known issue with the
3759 Tcl binary distributed by Cygwin.
"
3761 if {$suggest_user ne {}} {
3764 A good replacement
for $suggest_user
3765 is placing values
for the user.name and
3766 user.email settings into your personal
3772 unset ignored_env msg suggest_user name
3775 # -- Only initialize complex UI if we are going to stay running.
3777 if {!$single_commit} {
3781 populate_branch_menu .mbar.branch
3782 populate_fetch_menu .mbar.fetch
3783 populate_pull_menu .mbar.pull
3784 populate_push_menu .mbar.push
3787 # -- Only suggest a gc run if we are going to stay running.
3789 if {!$single_commit} {
3790 set object_limit 2000
3791 if {[is_Windows]} {set object_limit 200}
3792 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3793 if {$objects_current >= $object_limit} {
3795 "This repository currently has
$objects_current loose objects.
3797 To maintain optimal performance it is strongly
3798 recommended that you
compress the database
3799 when
more than
$object_limit loose objects exist.
3801 Compress the database now?
"] eq yes} {
3805 unset object_limit _junk objects_current
3808 lock_index begin-read