2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc is_many_config
{name
} {
18 switch
-glob -- $name {
27 proc load_config
{include_global
} {
28 global repo_config global_config default_config
30 array
unset global_config
31 if {$include_global} {
33 set fd_rc
[open
"| git repo-config --global --list" r
]
34 while {[gets
$fd_rc line
] >= 0} {
35 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
36 if {[is_many_config
$name]} {
37 lappend global_config
($name) $value
39 set global_config
($name) $value
47 array
unset repo_config
49 set fd_rc
[open
"| git repo-config --list" r
]
50 while {[gets
$fd_rc line
] >= 0} {
51 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
52 if {[is_many_config
$name]} {
53 lappend repo_config
($name) $value
55 set repo_config
($name) $value
62 foreach name
[array names default_config
] {
63 if {[catch
{set v
$global_config($name)}]} {
64 set global_config
($name) $default_config($name)
66 if {[catch
{set v
$repo_config($name)}]} {
67 set repo_config
($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option
$font_descs {
78 set name
[lindex
$option 0]
79 set font
[lindex
$option 1]
80 font configure
$font \
81 -family $global_config_new(gui.
$font^^family
) \
82 -size $global_config_new(gui.
$font^^size
)
83 font configure
${font}bold \
84 -family $global_config_new(gui.
$font^^family
) \
85 -size $global_config_new(gui.
$font^^size
)
86 set global_config_new
(gui.
$name) [font configure
$font]
87 unset global_config_new
(gui.
$font^^family
)
88 unset global_config_new
(gui.
$font^^size
)
91 foreach name
[array names default_config
] {
92 set value
$global_config_new($name)
93 if {$value ne
$global_config($name)} {
94 if {$value eq
$default_config($name)} {
95 catch
{exec git repo-config
--global --unset $name}
97 regsub
-all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\
[{}\
]" $value {"} value
115 exec git repo-config
$name $value
117 set repo_config
($name) $value
122 proc error_popup
{msg
} {
123 global gitdir appname
128 append title
[lindex \
129 [file split [file normalize
[file dirname $gitdir]]] \
137 -title "$title: error" \
141 proc info_popup
{msg
} {
142 global gitdir appname
147 append title
[lindex \
148 [file split [file normalize
[file dirname $gitdir]]] \
160 ######################################################################
164 if { [catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]
165 ||
[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
166 catch
{wm withdraw .
}
167 error_popup
"Cannot find the git directory:\n\n$err"
176 if {$appname eq
{git-citool
}} {
180 ######################################################################
188 set disable_on_lock
[list
]
189 set index_lock_type none
195 proc lock_index
{type} {
196 global index_lock_type disable_on_lock
198 if {$index_lock_type eq
{none
}} {
199 set index_lock_type
$type
200 foreach w
$disable_on_lock {
201 uplevel
#0 $w disabled
204 } elseif
{$index_lock_type eq
{begin-update
} && $type eq
{update
}} {
205 set index_lock_type
$type
211 proc unlock_index
{} {
212 global index_lock_type disable_on_lock
214 set index_lock_type none
215 foreach w
$disable_on_lock {
220 ######################################################################
224 proc repository_state
{hdvar ctvar
} {
226 upvar
$hdvar hd
$ctvar ct
228 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
230 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
237 proc rescan
{after
} {
238 global HEAD PARENT commit_type
239 global ui_index ui_other ui_status_value ui_comm
240 global rescan_active file_states
243 if {$rescan_active > 0 ||
![lock_index
read]} return
245 repository_state new_HEAD new_type
246 if {$commit_type eq
{amend
}
247 && $new_type eq
{normal
}
248 && $new_HEAD eq
$HEAD} {
252 set commit_type
$new_type
255 array
unset file_states
257 if {![$ui_comm edit modified
]
258 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
259 if {[load_message GITGUI_MSG
]} {
260 } elseif
{[load_message MERGE_MSG
]} {
261 } elseif
{[load_message SQUASH_MSG
]} {
263 $ui_comm edit modified false
267 if {$repo_config(gui.trustmtime
) eq
{true
}} {
268 rescan_stage2
{} $after
271 set ui_status_value
{Refreshing
file status...
}
272 set cmd
[list git update-index
]
274 lappend cmd
--unmerged
275 lappend cmd
--ignore-missing
276 lappend cmd
--refresh
277 set fd_rf
[open
"| $cmd" r
]
278 fconfigure
$fd_rf -blocking 0 -translation binary
279 fileevent
$fd_rf readable \
280 [list rescan_stage2
$fd_rf $after]
284 proc rescan_stage2
{fd after
} {
285 global gitdir PARENT commit_type
286 global ui_index ui_other ui_status_value ui_comm
288 global buf_rdi buf_rdf buf_rlo
292 if {![eof
$fd]} return
296 set ls_others
[list | git ls-files
--others -z \
297 --exclude-per-directory=.gitignore
]
298 set info_exclude
[file join $gitdir info exclude
]
299 if {[file readable
$info_exclude]} {
300 lappend ls_others
"--exclude-from=$info_exclude"
308 set ui_status_value
{Scanning
for modified files ...
}
309 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
310 set fd_df
[open
"| git diff-files -z" r
]
311 set fd_lo
[open
$ls_others r
]
313 fconfigure
$fd_di -blocking 0 -translation binary
314 fconfigure
$fd_df -blocking 0 -translation binary
315 fconfigure
$fd_lo -blocking 0 -translation binary
316 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
317 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
318 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
321 proc load_message
{file} {
322 global gitdir ui_comm
324 set f
[file join $gitdir $file]
325 if {[file isfile
$f]} {
326 if {[catch
{set fd
[open
$f r
]}]} {
329 set content
[string trim
[read $fd]]
331 $ui_comm delete
0.0 end
332 $ui_comm insert end
$content
338 proc read_diff_index
{fd after
} {
341 append buf_rdi
[read $fd]
343 set n
[string length
$buf_rdi]
345 set z1
[string first
"\0" $buf_rdi $c]
348 set z2
[string first
"\0" $buf_rdi $z1]
354 [string range
$buf_rdi $z1 $z2] \
355 [string index
$buf_rdi [expr {$z1 - 2}]]_
359 set buf_rdi
[string range
$buf_rdi $c end
]
364 rescan_done
$fd buf_rdi
$after
367 proc read_diff_files
{fd after
} {
370 append buf_rdf
[read $fd]
372 set n
[string length
$buf_rdf]
374 set z1
[string first
"\0" $buf_rdf $c]
377 set z2
[string first
"\0" $buf_rdf $z1]
383 [string range
$buf_rdf $z1 $z2] \
384 _
[string index
$buf_rdf [expr {$z1 - 2}]]
388 set buf_rdf
[string range
$buf_rdf $c end
]
393 rescan_done
$fd buf_rdf
$after
396 proc read_ls_others
{fd after
} {
399 append buf_rlo
[read $fd]
400 set pck
[split $buf_rlo "\0"]
401 set buf_rlo
[lindex
$pck end
]
402 foreach p
[lrange
$pck 0 end-1
] {
405 rescan_done
$fd buf_rlo
$after
408 proc rescan_done
{fd buf after
} {
410 global file_states repo_config
413 if {![eof
$fd]} return
416 if {[incr rescan_active
-1] > 0} return
422 if {$repo_config(gui.partialinclude
) ne
{true
}} {
424 foreach path
[array names file_states
] {
425 switch
-- [lindex
$file_states($path) 0] {
427 MM
{lappend pathList
$path}
430 if {$pathList ne
{}} {
432 "Updating included files" \
434 [concat
{reshow_diff
;} $after]
443 proc prune_selection
{} {
444 global file_states selected_paths
446 foreach path
[array names selected_paths
] {
447 if {[catch
{set still_here
$file_states($path)}]} {
448 unset selected_paths
($path)
453 ######################################################################
458 global ui_diff current_diff ui_index ui_other
460 $ui_diff conf
-state normal
461 $ui_diff delete
0.0 end
462 $ui_diff conf
-state disabled
466 $ui_index tag remove in_diff
0.0 end
467 $ui_other tag remove in_diff
0.0 end
470 proc reshow_diff
{} {
471 global current_diff ui_status_value file_states
473 if {$current_diff eq
{}
474 ||
[catch
{set s
$file_states($current_diff)}]} {
477 show_diff
$current_diff
481 proc handle_empty_diff
{} {
482 global current_diff file_states file_lists
484 set path
$current_diff
485 set s
$file_states($path)
486 if {[lindex
$s 0] ne
{_M
}} return
488 info_popup
"No differences detected.
490 [short_path $path] has no changes.
492 The modification date of this file was updated
493 by another application and you currently have
494 the Trust File Modification Timestamps option
495 enabled, so Git did not automatically detect
496 that there are no content differences in this
499 This file will now be removed from the modified
500 files list, to prevent possible confusion.
502 if {[catch
{exec git update-index
-- $path} err
]} {
503 error_popup
"Failed to refresh index:\n\n$err"
507 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
508 set lno
[lsearch
-sorted $file_lists($old_w) $path]
510 set file_lists
($old_w) \
511 [lreplace
$file_lists($old_w) $lno $lno]
513 $old_w conf
-state normal
514 $old_w delete
$lno.0 [expr {$lno + 1}].0
515 $old_w conf
-state disabled
519 proc show_diff
{path
{w
{}} {lno
{}}} {
520 global file_states file_lists
521 global PARENT diff_3way diff_active repo_config
522 global ui_diff current_diff ui_status_value
524 if {$diff_active ||
![lock_index
read]} return
527 if {$w eq
{} ||
$lno == {}} {
528 foreach w
[array names file_lists
] {
529 set lno
[lsearch
-sorted $file_lists($w) $path]
536 if {$w ne
{} && $lno >= 1} {
537 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
540 set s
$file_states($path)
544 set current_diff
$path
545 set ui_status_value
"Loading diff of [escape_path $path]..."
547 set cmd
[list | git diff-index
]
548 lappend cmd
--no-color
549 if {$repo_config(gui.diffcontext
) > 0} {
550 lappend cmd
"-U$repo_config(gui.diffcontext)"
560 set fd
[open
$path r
]
561 set content
[read $fd]
566 set ui_status_value
"Unable to display [escape_path $path]"
567 error_popup
"Error loading file:\n\n$err"
570 $ui_diff conf
-state normal
571 $ui_diff insert end
$content
572 $ui_diff conf
-state disabled
575 set ui_status_value
{Ready.
}
584 if {[catch
{set fd
[open
$cmd r
]} err
]} {
587 set ui_status_value
"Unable to display [escape_path $path]"
588 error_popup
"Error loading diff:\n\n$err"
592 fconfigure
$fd -blocking 0 -translation auto
593 fileevent
$fd readable
[list read_diff
$fd]
596 proc read_diff
{fd
} {
597 global ui_diff ui_status_value diff_3way diff_active
600 while {[gets
$fd line
] >= 0} {
601 if {[string match
{diff --git *} $line]} continue
602 if {[string match
{diff --combined *} $line]} continue
603 if {[string match
{--- *} $line]} continue
604 if {[string match
{+++ *} $line]} continue
605 if {[string match index
* $line]} {
606 if {[string first
, $line] >= 0} {
611 $ui_diff conf
-state normal
613 set x
[string index
$line 0]
618 default
{set tags
{}}
621 set x
[string range
$line 0 1]
623 default
{set tags
{}}
625 "++" {set tags dp
; set x
" +"}
626 " +" {set tags
{di bold
}; set x
"++"}
627 "+ " {set tags dni
; set x
"-+"}
628 "--" {set tags dm
; set x
" -"}
629 " -" {set tags
{dm bold
}; set x
"--"}
630 "- " {set tags di
; set x
"+-"}
631 default
{set tags
{}}
633 set line
[string replace
$line 0 1 $x]
635 $ui_diff insert end
$line $tags
636 $ui_diff insert end
"\n"
637 $ui_diff conf
-state disabled
644 set ui_status_value
{Ready.
}
646 if {$repo_config(gui.trustmtime
) eq
{true
}
647 && [$ui_diff index end
] eq
{2.0}} {
653 ######################################################################
657 proc load_last_commit
{} {
658 global HEAD PARENT commit_type ui_comm
660 if {$commit_type eq
{amend
}} return
661 if {$commit_type ne
{normal
}} {
662 error_popup
"Can't amend a $commit_type commit."
670 set fd
[open
"| git cat-file commit $HEAD" r
]
671 while {[gets
$fd line
] > 0} {
672 if {[string match
{parent
*} $line]} {
673 set parent
[string range
$line 7 end
]
677 set msg
[string trim
[read $fd]]
680 error_popup
"Error loading commit data for amend:\n\n$err"
684 if {$parent_count == 0} {
685 set commit_type amend
688 rescan
{set ui_status_value
{Ready.
}}
689 } elseif
{$parent_count == 1} {
690 set commit_type amend
692 $ui_comm delete
0.0 end
693 $ui_comm insert end
$msg
694 $ui_comm edit modified false
696 rescan
{set ui_status_value
{Ready.
}}
698 error_popup
{You can
't amend a merge commit.}
703 proc commit_tree {} {
704 global HEAD commit_type file_states ui_comm repo_config
706 if {![lock_index update]} return
708 # -- Our in memory state should match the repository.
710 repository_state curHEAD cur_type
711 if {$commit_type eq {amend}
712 && $cur_type eq {normal}
713 && $curHEAD eq $HEAD} {
714 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
715 error_popup {Last scanned state does not match repository state.
717 Its highly likely that another Git program modified the
718 repository since the last scan. A rescan is required
721 A rescan will be automatically started now.
724 rescan {set ui_status_value {Ready.}}
728 # -- At least one file should differ in the index.
731 foreach path [array names file_states] {
732 switch -glob -- [lindex $file_states($path) 0] {
736 M? {set files_ready 1; break}
738 error_popup "Unmerged files cannot be committed.
740 File [short_path $path] has merge conflicts.
741 You must resolve them and include the file before committing.
747 error_popup "Unknown file state [lindex $s 0] detected.
749 File [short_path $path] cannot be committed by this program.
755 error_popup {No included files to commit.
757 You must include at least 1 file before you can commit.
763 # -- A message is required.
765 set msg [string trim [$ui_comm get 1.0 end]]
767 error_popup {Please supply a commit message.
769 A good commit message has the following format:
771 - First line: Describe in one sentance what you did.
773 - Remaining lines: Describe why this change is good.
779 # -- Update included files if partialincludes are off.
781 if {$repo_config(gui.partialinclude) ne {true}} {
783 foreach path [array names file_states] {
784 switch -glob -- [lindex $file_states($path) 0] {
786 M? {lappend pathList $path}
789 if {$pathList ne {}} {
792 "Updating included files" \
794 [concat {lock_index update;} \
795 [list commit_prehook $curHEAD $msg]]
800 commit_prehook $curHEAD $msg
803 proc commit_prehook {curHEAD msg} {
804 global tcl_platform gitdir ui_status_value pch_error
806 # On Cygwin [file executable] might lie so we need to ask
807 # the shell if the hook is executable. Yes that's annoying.
809 set pchook
[file join $gitdir hooks pre-commit
]
810 if {$tcl_platform(platform
) eq
{windows
}
811 && [file isfile
$pchook]} {
812 set pchook
[list sh
-c [concat \
813 "if test -x \"$pchook\";" \
814 "then exec \"$pchook\" 2>&1;" \
816 } elseif
{[file executable
$pchook]} {
817 set pchook
[list
$pchook |
& cat]
819 commit_writetree
$curHEAD $msg
823 set ui_status_value
{Calling pre-commit hook...
}
825 set fd_ph
[open
"| $pchook" r
]
826 fconfigure
$fd_ph -blocking 0 -translation binary
827 fileevent
$fd_ph readable \
828 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
831 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
832 global pch_error ui_status_value
834 append pch_error
[read $fd_ph]
835 fconfigure
$fd_ph -blocking 1
837 if {[catch
{close
$fd_ph}]} {
838 set ui_status_value
{Commit declined by pre-commit hook.
}
839 hook_failed_popup pre-commit
$pch_error
842 commit_writetree
$curHEAD $msg
847 fconfigure
$fd_ph -blocking 0
850 proc commit_writetree
{curHEAD msg
} {
851 global ui_status_value
853 set ui_status_value
{Committing changes...
}
854 set fd_wt
[open
"| git write-tree" r
]
855 fileevent
$fd_wt readable \
856 [list commit_committree
$fd_wt $curHEAD $msg]
859 proc commit_committree
{fd_wt curHEAD msg
} {
860 global single_commit gitdir HEAD PARENT commit_type tcl_platform
861 global ui_status_value ui_comm
862 global file_states selected_paths
865 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
866 error_popup
"write-tree failed:\n\n$err"
867 set ui_status_value
{Commit failed.
}
872 # -- Create the commit.
874 set cmd
[list git commit-tree
$tree_id]
876 lappend cmd
-p $PARENT
878 if {$commit_type eq
{merge
}} {
880 set fd_mh
[open
[file join $gitdir MERGE_HEAD
] r
]
881 while {[gets
$fd_mh merge_head
] >= 0} {
882 lappend cmd
-p $merge_head
886 error_popup
"Loading MERGE_HEAD failed:\n\n$err"
887 set ui_status_value
{Commit failed.
}
893 # git commit-tree writes to stderr during initial commit.
894 lappend cmd
2>/dev
/null
897 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
898 error_popup
"commit-tree failed:\n\n$err"
899 set ui_status_value
{Commit failed.
}
904 # -- Update the HEAD ref.
907 if {$commit_type ne
{normal
}} {
908 append reflogm
" ($commit_type)"
910 set i
[string first
"\n" $msg]
912 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
914 append reflogm
{: } $msg
916 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
917 if {[catch
{eval exec $cmd} err
]} {
918 error_popup
"update-ref failed:\n\n$err"
919 set ui_status_value
{Commit failed.
}
924 # -- Cleanup after ourselves.
926 catch
{file delete
[file join $gitdir MERGE_HEAD
]}
927 catch
{file delete
[file join $gitdir MERGE_MSG
]}
928 catch
{file delete
[file join $gitdir SQUASH_MSG
]}
929 catch
{file delete
[file join $gitdir GITGUI_MSG
]}
931 # -- Let rerere do its thing.
933 if {[file isdirectory
[file join $gitdir rr-cache
]]} {
934 catch
{exec git rerere
}
937 # -- Run the post-commit hook.
939 set pchook
[file join $gitdir hooks post-commit
]
940 if {$tcl_platform(platform
) eq
{windows
} && [file isfile
$pchook]} {
941 set pchook
[list sh
-c [concat \
942 "if test -x \"$pchook\";" \
943 "then exec \"$pchook\";" \
945 } elseif
{![file executable
$pchook]} {
949 catch
{exec $pchook &}
952 $ui_comm delete
0.0 end
953 $ui_comm edit modified false
956 if {$single_commit} do_quit
958 # -- Update status without invoking any git commands.
960 set commit_type normal
964 foreach path
[array names file_states
] {
965 set s
$file_states($path)
970 D?
{set m _
[string index
$m 1]}
974 unset file_states
($path)
975 catch
{unset selected_paths
($path)}
977 lset file_states
($path) 0 $m
984 set ui_status_value \
985 "Changes committed as [string range $cmt_id 0 7]."
988 ######################################################################
992 proc fetch_from
{remote
} {
993 set w
[new_console
"fetch $remote" \
994 "Fetching new changes from $remote"]
995 set cmd
[list git fetch
]
1000 proc pull_remote
{remote branch
} {
1001 global HEAD commit_type file_states repo_config
1003 if {![lock_index update
]} return
1005 # -- Our in memory state should match the repository.
1007 repository_state curHEAD cur_type
1008 if {$commit_type ne
$cur_type ||
$HEAD ne
$curHEAD} {
1009 error_popup
{Last scanned state does not match repository state.
1011 Its highly likely that another Git program modified the
1012 repository since our last scan. A rescan is required
1013 before a pull can be started.
1016 rescan
{set ui_status_value
{Ready.
}}
1020 # -- No differences should exist before a pull.
1022 if {[array size file_states
] != 0} {
1023 error_popup
{Uncommitted but modified files are present.
1025 You should not perform a pull with unmodified files
in your working
1026 directory as Git would be unable to recover from an incorrect merge.
1028 Commit or throw away all changes before starting a pull operation.
1034 set w
[new_console
"pull $remote $branch" \
1035 "Pulling new changes from branch $branch in $remote"]
1036 set cmd
[list git pull
]
1037 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1038 lappend cmd
--no-summary
1042 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1045 proc post_pull_remote
{remote branch success
} {
1046 global HEAD PARENT commit_type
1047 global ui_status_value
1051 repository_state HEAD commit_type
1053 set $ui_status_value "Pulling $branch from $remote complete."
1055 set m
"Conflicts detected while pulling $branch from $remote."
1056 rescan
"set ui_status_value {$m}"
1060 proc push_to
{remote
} {
1061 set w
[new_console
"push $remote" \
1062 "Pushing changes to $remote"]
1063 set cmd
[list git push
]
1065 console_exec
$w $cmd
1068 ######################################################################
1072 proc mapcol
{state path
} {
1073 global all_cols ui_other
1075 if {[catch
{set r
$all_cols($state)}]} {
1076 puts
"error: no column for state={$state} $path"
1082 proc mapicon
{state path
} {
1085 if {[catch
{set r
$all_icons($state)}]} {
1086 puts
"error: no icon for state={$state} $path"
1092 proc mapdesc
{state path
} {
1095 if {[catch
{set r
$all_descs($state)}]} {
1096 puts
"error: no desc for state={$state} $path"
1102 proc escape_path
{path
} {
1103 regsub
-all "\n" $path "\\n" path
1107 proc short_path
{path
} {
1108 return [escape_path
[lindex
[file split $path] end
]]
1113 proc merge_state
{path new_state
} {
1114 global file_states next_icon_id
1116 set s0
[string index
$new_state 0]
1117 set s1
[string index
$new_state 1]
1119 if {[catch
{set info
$file_states($path)}]} {
1121 set icon n
[incr next_icon_id
]
1123 set state
[lindex
$info 0]
1124 set icon
[lindex
$info 1]
1128 set s0
[string index
$state 0]
1129 } elseif
{$s0 eq
{*}} {
1134 set s1
[string index
$state 1]
1135 } elseif
{$s1 eq
{*}} {
1139 set file_states
($path) [list
$s0$s1 $icon]
1143 proc display_file
{path state
} {
1144 global file_states file_lists selected_paths rescan_active
1146 set old_m
[merge_state
$path $state]
1147 if {$rescan_active > 0} return
1149 set s
$file_states($path)
1150 set new_m
[lindex
$s 0]
1151 set new_w
[mapcol
$new_m $path]
1152 set old_w
[mapcol
$old_m $path]
1153 set new_icon
[mapicon
$new_m $path]
1155 if {$new_w ne
$old_w} {
1156 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1159 $old_w conf
-state normal
1160 $old_w delete
$lno.0 [expr {$lno + 1}].0
1161 $old_w conf
-state disabled
1164 lappend file_lists
($new_w) $path
1165 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1166 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1168 $new_w conf
-state normal
1169 $new_w image create
$lno.0 \
1170 -align center
-padx 5 -pady 1 \
1171 -name [lindex
$s 1] \
1173 $new_w insert
$lno.1 "[escape_path $path]\n"
1174 if {[catch
{set in_sel
$selected_paths($path)}]} {
1178 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1180 $new_w conf
-state disabled
1181 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1182 $new_w conf
-state normal
1183 $new_w image conf
[lindex
$s 1] -image $new_icon
1184 $new_w conf
-state disabled
1188 proc display_all_files
{} {
1189 global ui_index ui_other
1190 global file_states file_lists
1191 global last_clicked selected_paths
1193 $ui_index conf
-state normal
1194 $ui_other conf
-state normal
1196 $ui_index delete
0.0 end
1197 $ui_other delete
0.0 end
1200 set file_lists
($ui_index) [list
]
1201 set file_lists
($ui_other) [list
]
1203 foreach path
[lsort
[array names file_states
]] {
1204 set s
$file_states($path)
1206 set w
[mapcol
$m $path]
1207 lappend file_lists
($w) $path
1208 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1209 $w image create end \
1210 -align center
-padx 5 -pady 1 \
1211 -name [lindex
$s 1] \
1212 -image [mapicon
$m $path]
1213 $w insert end
"[escape_path $path]\n"
1214 if {[catch
{set in_sel
$selected_paths($path)}]} {
1218 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1222 $ui_index conf
-state disabled
1223 $ui_other conf
-state disabled
1226 proc update_index
{msg pathList after
} {
1227 global update_index_cp update_index_rsd ui_status_value
1229 if {![lock_index update
]} return
1231 set update_index_cp
0
1232 set update_index_rsd
0
1233 set pathList
[lsort
$pathList]
1234 set totalCnt
[llength
$pathList]
1235 set batch [expr {int
($totalCnt * .01) + 1}]
1236 if {$batch > 25} {set batch 25}
1238 set ui_status_value
[format \
1239 "$msg... %i/%i files (%.2f%%)" \
1243 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1249 fileevent
$fd writable
[list \
1250 write_update_index \
1260 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1261 global update_index_cp update_index_rsd ui_status_value
1262 global file_states current_diff
1264 if {$update_index_cp >= $totalCnt} {
1267 if {$update_index_rsd} reshow_diff
1272 for {set i
$batch} \
1273 {$update_index_cp < $totalCnt && $i > 0} \
1275 set path
[lindex
$pathList $update_index_cp]
1276 incr update_index_cp
1278 switch
-glob -- [lindex
$file_states($path) 0] {
1294 puts
-nonewline $fd $path
1295 puts
-nonewline $fd "\0"
1296 display_file
$path $new
1297 if {$current_diff eq
$path} {
1298 set update_index_rsd
1
1302 set ui_status_value
[format \
1303 "$msg... %i/%i files (%.2f%%)" \
1306 [expr {100.0 * $update_index_cp / $totalCnt}]]
1309 ######################################################################
1311 ## remote management
1313 proc load_all_remotes
{} {
1314 global gitdir all_remotes repo_config
1316 set all_remotes
[list
]
1317 set rm_dir
[file join $gitdir remotes
]
1318 if {[file isdirectory
$rm_dir]} {
1319 set all_remotes
[concat
$all_remotes [glob \
1323 -directory $rm_dir *]]
1326 foreach line
[array names repo_config remote.
*.url
] {
1327 if {[regexp ^remote\.
(.
*)\.url\$
$line line name
]} {
1328 lappend all_remotes
$name
1332 set all_remotes
[lsort
-unique $all_remotes]
1335 proc populate_remote_menu
{m pfx op
} {
1338 foreach remote
$all_remotes {
1339 $m add
command -label "$pfx $remote..." \
1340 -command [list
$op $remote] \
1345 proc populate_pull_menu
{m
} {
1346 global gitdir repo_config all_remotes disable_on_lock
1348 foreach remote
$all_remotes {
1350 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1351 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1352 regexp
{^
([^
:]+):} \
1353 [lindex
$repo_config(remote.
$remote.fetch
) 0] \
1358 set fd
[open
[file join $gitdir remotes
$remote] r
]
1359 while {[gets
$fd line
] >= 0} {
1360 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1369 regsub ^refs
/heads
/ $rb {} rb_short
1370 if {$rb_short ne
{}} {
1372 -label "Branch $rb_short from $remote..." \
1373 -command [list pull_remote
$remote $rb] \
1375 lappend disable_on_lock \
1376 [list
$m entryconf
[$m index last
] -state]
1381 ######################################################################
1386 #define mask_width 14
1387 #define mask_height 15
1388 static unsigned char mask_bits
[] = {
1389 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1390 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1391 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1394 image create bitmap file_plain
-background white
-foreground black
-data {
1395 #define plain_width 14
1396 #define plain_height 15
1397 static unsigned char plain_bits
[] = {
1398 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1399 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1400 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1401 } -maskdata $filemask
1403 image create bitmap file_mod
-background white
-foreground blue
-data {
1404 #define mod_width 14
1405 #define mod_height 15
1406 static unsigned char mod_bits
[] = {
1407 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1408 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1409 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1410 } -maskdata $filemask
1412 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1413 #define file_fulltick_width 14
1414 #define file_fulltick_height 15
1415 static unsigned char file_fulltick_bits
[] = {
1416 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1417 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1418 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1419 } -maskdata $filemask
1421 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1422 #define parttick_width 14
1423 #define parttick_height 15
1424 static unsigned char parttick_bits
[] = {
1425 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1426 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1427 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1428 } -maskdata $filemask
1430 image create bitmap file_question
-background white
-foreground black
-data {
1431 #define file_question_width 14
1432 #define file_question_height 15
1433 static unsigned char file_question_bits
[] = {
1434 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1435 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1436 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1437 } -maskdata $filemask
1439 image create bitmap file_removed
-background white
-foreground red
-data {
1440 #define file_removed_width 14
1441 #define file_removed_height 15
1442 static unsigned char file_removed_bits
[] = {
1443 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1444 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1445 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1446 } -maskdata $filemask
1448 image create bitmap file_merge
-background white
-foreground blue
-data {
1449 #define file_merge_width 14
1450 #define file_merge_height 15
1451 static unsigned char file_merge_bits
[] = {
1452 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1453 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1454 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1455 } -maskdata $filemask
1457 set ui_index .vpane.files.index.list
1458 set ui_other .vpane.files.other.list
1459 set max_status_desc
0
1461 {__ i plain
"Unmodified"}
1462 {_M i mod
"Modified"}
1463 {M_ i fulltick
"Included in commit"}
1464 {MM i parttick
"Partially included"}
1466 {_O o plain
"Untracked"}
1467 {A_ o fulltick
"Added by commit"}
1468 {AM o parttick
"Partially added"}
1469 {AD o question
"Added (but now gone)"}
1471 {_D i question
"Missing"}
1472 {D_ i removed
"Removed by commit"}
1473 {DD i removed
"Removed by commit"}
1474 {DO i removed
"Removed (still exists)"}
1476 {UM i merge
"Merge conflicts"}
1477 {U_ i merge
"Merge conflicts"}
1479 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1480 set max_status_desc
[string length
[lindex
$i 3]]
1482 if {[lindex
$i 1] eq
{i
}} {
1483 set all_cols
([lindex
$i 0]) $ui_index
1485 set all_cols
([lindex
$i 0]) $ui_other
1487 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1488 set all_descs
([lindex
$i 0]) [lindex
$i 3]
1492 ######################################################################
1497 global tcl_platform tk_library
1498 if {$tcl_platform(platform
) eq
{unix
}
1499 && $tcl_platform(os
) eq
{Darwin
}
1500 && [string match
/Library
/Frameworks
/* $tk_library]} {
1506 proc bind_button3
{w cmd
} {
1507 bind $w <Any-Button-3
> $cmd
1509 bind $w <Control-Button-1
> $cmd
1513 proc incr_font_size
{font
{amt
1}} {
1514 set sz
[font configure
$font -size]
1516 font configure
$font -size $sz
1517 font configure
${font}bold
-size $sz
1520 proc hook_failed_popup
{hook msg
} {
1521 global gitdir appname
1527 label
$w.m.l1
-text "$hook hook failed:" \
1532 -background white
-borderwidth 1 \
1534 -width 80 -height 10 \
1536 -yscrollcommand [list
$w.m.sby
set]
1538 -text {You must correct the above errors before committing.
} \
1542 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1543 pack
$w.m.l1
-side top
-fill x
1544 pack
$w.m.l2
-side bottom
-fill x
1545 pack
$w.m.sby
-side right
-fill y
1546 pack
$w.m.t
-side left
-fill both
-expand 1
1547 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1549 $w.m.t insert
1.0 $msg
1550 $w.m.t conf
-state disabled
1552 button
$w.ok
-text OK \
1555 -command "destroy $w"
1556 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1558 bind $w <Visibility
> "grab $w; focus $w"
1559 bind $w <Key-Return
> "destroy $w"
1560 wm title
$w "$appname ([lindex [file split \
1561 [file normalize [file dirname $gitdir]]] \
1566 set next_console_id
0
1568 proc new_console
{short_title long_title
} {
1569 global next_console_id console_data
1570 set w .console
[incr next_console_id
]
1571 set console_data
($w) [list
$short_title $long_title]
1572 return [console_init
$w]
1575 proc console_init
{w
} {
1576 global console_cr console_data
1577 global gitdir appname M1B
1579 set console_cr
($w) 1.0
1582 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
1587 -background white
-borderwidth 1 \
1589 -width 80 -height 10 \
1592 -yscrollcommand [list
$w.m.sby
set]
1593 label
$w.m.s
-text {Working... please
wait...
} \
1597 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1598 pack
$w.m.l1
-side top
-fill x
1599 pack
$w.m.s
-side bottom
-fill x
1600 pack
$w.m.sby
-side right
-fill y
1601 pack
$w.m.t
-side left
-fill both
-expand 1
1602 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1604 menu
$w.ctxm
-tearoff 0
1605 $w.ctxm add
command -label "Copy" \
1607 -command "tk_textCopy $w.m.t"
1608 $w.ctxm add
command -label "Select All" \
1610 -command "$w.m.t tag add sel 0.0 end"
1611 $w.ctxm add
command -label "Copy All" \
1614 $w.m.t tag add sel 0.0 end
1616 $w.m.t tag remove sel 0.0 end
1619 button
$w.ok
-text {Close
} \
1622 -command "destroy $w"
1623 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1625 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
1626 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1627 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1628 bind $w <Visibility
> "focus $w"
1629 wm title
$w "$appname ([lindex [file split \
1630 [file normalize [file dirname $gitdir]]] \
1631 end]): [lindex $console_data($w) 0]"
1635 proc console_exec
{w cmd
{after
{}}} {
1638 # -- Windows tosses the enviroment when we exec our child.
1639 # But most users need that so we have to relogin. :-(
1641 if {$tcl_platform(platform
) eq
{windows
}} {
1642 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
1645 # -- Tcl won't let us redirect both stdout and stderr to
1646 # the same pipe. So pass it through cat...
1648 set cmd
[concat |
$cmd |
& cat]
1650 set fd_f
[open
$cmd r
]
1651 fconfigure
$fd_f -blocking 0 -translation binary
1652 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1655 proc console_read
{w fd after
} {
1656 global console_cr console_data
1660 if {![winfo exists
$w]} {console_init
$w}
1661 $w.m.t conf
-state normal
1663 set n
[string length
$buf]
1665 set cr
[string first
"\r" $buf $c]
1666 set lf
[string first
"\n" $buf $c]
1667 if {$cr < 0} {set cr
[expr {$n + 1}]}
1668 if {$lf < 0} {set lf
[expr {$n + 1}]}
1671 $w.m.t insert end
[string range
$buf $c $lf]
1672 set console_cr
($w) [$w.m.t index
{end
-1c}]
1676 $w.m.t delete
$console_cr($w) end
1677 $w.m.t insert end
"\n"
1678 $w.m.t insert end
[string range
$buf $c $cr]
1683 $w.m.t conf
-state disabled
1687 fconfigure
$fd -blocking 1
1689 if {[catch
{close
$fd}]} {
1690 if {![winfo exists
$w]} {console_init
$w}
1691 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1692 $w.ok conf
-state normal
1694 } elseif
{[winfo exists
$w]} {
1695 $w.m.s conf
-background green
-text {Success
}
1696 $w.ok conf
-state normal
1699 array
unset console_cr
$w
1700 array
unset console_data
$w
1702 uplevel
#0 $after $ok
1706 fconfigure
$fd -blocking 0
1709 ######################################################################
1713 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1716 global tcl_platform ui_status_value starting_gitk_msg
1718 set ui_status_value
$starting_gitk_msg
1720 if {$ui_status_value eq
$starting_gitk_msg} {
1721 set ui_status_value
{Ready.
}
1725 if {$tcl_platform(platform
) eq
{windows
}} {
1733 set w
[new_console
"repack" "Repacking the object database"]
1734 set cmd
[list git repack
]
1737 console_exec
$w $cmd
1743 global gitdir ui_comm is_quitting repo_config
1745 if {$is_quitting} return
1748 # -- Stash our current commit buffer.
1750 set save
[file join $gitdir GITGUI_MSG
]
1751 set msg
[string trim
[$ui_comm get
0.0 end
]]
1752 if {[$ui_comm edit modified
] && $msg ne
{}} {
1754 set fd
[open
$save w
]
1755 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1758 } elseif
{$msg eq
{} && [file exists
$save]} {
1762 # -- Stash our current window geometry into this repository.
1764 set cfg_geometry
[list
]
1765 lappend cfg_geometry
[wm geometry .
]
1766 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1767 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1768 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1771 if {$cfg_geometry ne
$rc_geometry} {
1772 catch
{exec git repo-config gui.geometry
$cfg_geometry}
1779 rescan
{set ui_status_value
{Ready.
}}
1782 proc do_include_all
{} {
1785 if {![lock_index begin-update
]} return
1788 foreach path
[array names file_states
] {
1789 set s
$file_states($path)
1795 _D
{lappend pathList
$path}
1798 if {$pathList eq
{}} {
1802 "Including all modified files" \
1804 {set ui_status_value
{Ready to commit.
}}
1808 set GIT_COMMITTER_IDENT
{}
1810 proc do_signoff
{} {
1811 global ui_comm GIT_COMMITTER_IDENT
1813 if {$GIT_COMMITTER_IDENT eq
{}} {
1814 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1815 error_popup
"Unable to obtain your identity:\n\n$err"
1818 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1819 $me me GIT_COMMITTER_IDENT
]} {
1820 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1825 set sob
"Signed-off-by: $GIT_COMMITTER_IDENT"
1826 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
1827 if {$last ne
$sob} {
1828 $ui_comm edit separator
1830 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
1831 $ui_comm insert end
"\n"
1833 $ui_comm insert end
"\n$sob"
1834 $ui_comm edit separator
1839 proc do_amend_last
{} {
1847 proc do_options
{} {
1848 global appname gitdir font_descs
1849 global repo_config global_config
1850 global repo_config_new global_config_new
1852 array
unset repo_config_new
1853 array
unset global_config_new
1854 foreach name
[array names repo_config
] {
1855 set repo_config_new
($name) $repo_config($name)
1858 foreach name
[array names repo_config
] {
1860 gui.diffcontext
{continue}
1862 set repo_config_new
($name) $repo_config($name)
1864 foreach name
[array names global_config
] {
1865 set global_config_new
($name) $global_config($name)
1867 set reponame
[lindex
[file split \
1868 [file normalize
[file dirname $gitdir]]] \
1871 set w .options_editor
1873 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1875 label
$w.header
-text "$appname Options" \
1877 pack
$w.header
-side top
-fill x
1880 button
$w.buttons.restore
-text {Restore Defaults
} \
1882 -command do_restore_defaults
1883 pack
$w.buttons.restore
-side left
1884 button
$w.buttons.save
-text Save \
1886 -command [list do_save_config
$w]
1887 pack
$w.buttons.save
-side right
1888 button
$w.buttons.cancel
-text {Cancel
} \
1890 -command [list destroy
$w]
1891 pack
$w.buttons.cancel
-side right
1892 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1894 labelframe
$w.repo
-text "$reponame Repository" \
1896 -relief raised
-borderwidth 2
1897 labelframe
$w.global
-text {Global
(All Repositories
)} \
1899 -relief raised
-borderwidth 2
1900 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
1901 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
1904 {b partialinclude
{Allow Partially Included Files
}}
1905 {b pullsummary
{Show Pull Summary
}}
1906 {b trustmtime
{Trust File Modification Timestamps
}}
1907 {i diffcontext
{Number of Diff Context Lines
}}
1909 set type [lindex
$option 0]
1910 set name
[lindex
$option 1]
1911 set text
[lindex
$option 2]
1912 foreach f
{repo global
} {
1915 checkbutton
$w.
$f.
$name -text $text \
1916 -variable ${f}_config_new
(gui.
$name) \
1920 pack
$w.
$f.
$name -side top
-anchor w
1924 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
1925 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
1926 spinbox
$w.
$f.
$name.v \
1927 -textvariable ${f}_config_new
(gui.
$name) \
1928 -from 1 -to 99 -increment 1 \
1931 pack
$w.
$f.
$name.v
-side right
-anchor e
1932 pack
$w.
$f.
$name -side top
-anchor w
-fill x
1938 set all_fonts
[lsort
[font families
]]
1939 foreach option
$font_descs {
1940 set name
[lindex
$option 0]
1941 set font
[lindex
$option 1]
1942 set text
[lindex
$option 2]
1944 set global_config_new
(gui.
$font^^family
) \
1945 [font configure
$font -family]
1946 set global_config_new
(gui.
$font^^size
) \
1947 [font configure
$font -size]
1949 frame
$w.global.
$name
1950 label
$w.global.
$name.l
-text "$text:" -font font_ui
1951 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
1952 eval tk_optionMenu
$w.global.
$name.family \
1953 global_config_new
(gui.
$font^^family
) \
1955 spinbox
$w.global.
$name.size \
1956 -textvariable global_config_new
(gui.
$font^^size
) \
1957 -from 2 -to 80 -increment 1 \
1960 pack
$w.global.
$name.size
-side right
-anchor e
1961 pack
$w.global.
$name.family
-side right
-anchor e
1962 pack
$w.global.
$name -side top
-anchor w
-fill x
1965 bind $w <Visibility
> "grab $w; focus $w"
1966 bind $w <Key-Escape
> "destroy $w"
1967 wm title
$w "$appname ($reponame): Options"
1971 proc do_restore_defaults
{} {
1972 global font_descs default_config repo_config
1973 global repo_config_new global_config_new
1975 foreach name
[array names default_config
] {
1976 set repo_config_new
($name) $default_config($name)
1977 set global_config_new
($name) $default_config($name)
1980 foreach option
$font_descs {
1981 set name
[lindex
$option 0]
1982 set repo_config
(gui.
$name) $default_config(gui.
$name)
1986 foreach option
$font_descs {
1987 set name
[lindex
$option 0]
1988 set font
[lindex
$option 1]
1989 set global_config_new
(gui.
$font^^family
) \
1990 [font configure
$font -family]
1991 set global_config_new
(gui.
$font^^size
) \
1992 [font configure
$font -size]
1996 proc do_save_config
{w
} {
1997 if {[catch
{save_config
} err
]} {
1998 error_popup
"Failed to completely save options:\n\n$err"
2004 proc toggle_or_diff
{w x y
} {
2005 global file_lists ui_index ui_other
2006 global last_clicked selected_paths
2008 set pos
[split [$w index @
$x,$y] .
]
2009 set lno
[lindex
$pos 0]
2010 set col [lindex
$pos 1]
2011 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2017 set last_clicked
[list
$w $lno]
2018 array
unset selected_paths
2019 $ui_index tag remove in_sel
0.0 end
2020 $ui_other tag remove in_sel
0.0 end
2024 "Including [short_path $path]" \
2026 {set ui_status_value
{Ready.
}}
2028 show_diff
$path $w $lno
2032 proc add_one_to_selection
{w x y
} {
2034 global last_clicked selected_paths
2036 set pos
[split [$w index @
$x,$y] .
]
2037 set lno
[lindex
$pos 0]
2038 set col [lindex
$pos 1]
2039 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2045 set last_clicked
[list
$w $lno]
2046 if {[catch
{set in_sel
$selected_paths($path)}]} {
2050 unset selected_paths
($path)
2051 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2053 set selected_paths
($path) 1
2054 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2058 proc add_range_to_selection
{w x y
} {
2060 global last_clicked selected_paths
2062 if {[lindex
$last_clicked 0] ne
$w} {
2063 toggle_or_diff
$w $x $y
2067 set pos
[split [$w index @
$x,$y] .
]
2068 set lno
[lindex
$pos 0]
2069 set lc
[lindex
$last_clicked 1]
2078 foreach path
[lrange
$file_lists($w) \
2079 [expr {$begin - 1}] \
2080 [expr {$end - 1}]] {
2081 set selected_paths
($path) 1
2083 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2086 ######################################################################
2090 set cursor_ptr arrow
2091 font create font_diff
-family Courier
-size 10
2095 eval font configure font_ui
[font actual
[.dummy cget
-font]]
2099 font create font_uibold
2100 font create font_diffbold
2104 if {$tcl_platform(platform
) eq
{windows
}} {
2107 } elseif
{[is_MacOSX
]} {
2112 proc apply_config
{} {
2113 global repo_config font_descs
2115 foreach option
$font_descs {
2116 set name
[lindex
$option 0]
2117 set font
[lindex
$option 1]
2119 foreach
{cn cv
} $repo_config(gui.
$name) {
2120 font configure
$font $cn $cv
2123 error_popup
"Invalid font specified in gui.$name:\n\n$err"
2125 foreach
{cn cv
} [font configure
$font] {
2126 font configure
${font}bold
$cn $cv
2128 font configure
${font}bold
-weight bold
2132 set default_config
(gui.trustmtime
) false
2133 set default_config
(gui.pullsummary
) true
2134 set default_config
(gui.partialinclude
) false
2135 set default_config
(gui.diffcontext
) 5
2136 set default_config
(gui.fontui
) [font configure font_ui
]
2137 set default_config
(gui.fontdiff
) [font configure font_diff
]
2139 {fontui font_ui
{Main Font
}}
2140 {fontdiff font_diff
{Diff
/Console Font
}}
2145 ######################################################################
2150 menu .mbar
-tearoff 0
2151 .mbar add cascade
-label Project
-menu .mbar.project
2152 .mbar add cascade
-label Edit
-menu .mbar.edit
2153 .mbar add cascade
-label Commit
-menu .mbar.commit
2154 if {!$single_commit} {
2155 .mbar add cascade
-label Fetch
-menu .mbar.fetch
2156 .mbar add cascade
-label Pull
-menu .mbar.pull
2157 .mbar add cascade
-label Push
-menu .mbar.push
2159 . configure
-menu .mbar
2163 .mbar.project add
command -label Visualize \
2166 if {!$single_commit} {
2167 .mbar.project add
command -label {Repack Database
} \
2168 -command do_repack \
2171 .mbar.project add
command -label Quit \
2173 -accelerator $M1T-Q \
2179 .mbar.edit add
command -label Undo \
2180 -command {catch
{[focus
] edit undo
}} \
2181 -accelerator $M1T-Z \
2183 .mbar.edit add
command -label Redo \
2184 -command {catch
{[focus
] edit redo
}} \
2185 -accelerator $M1T-Y \
2187 .mbar.edit add separator
2188 .mbar.edit add
command -label Cut \
2189 -command {catch
{tk_textCut
[focus
]}} \
2190 -accelerator $M1T-X \
2192 .mbar.edit add
command -label Copy \
2193 -command {catch
{tk_textCopy
[focus
]}} \
2194 -accelerator $M1T-C \
2196 .mbar.edit add
command -label Paste \
2197 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2198 -accelerator $M1T-V \
2200 .mbar.edit add
command -label Delete \
2201 -command {catch
{[focus
] delete sel.first sel.last
}} \
2204 .mbar.edit add separator
2205 .mbar.edit add
command -label {Select All
} \
2206 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2207 -accelerator $M1T-A \
2209 .mbar.edit add separator
2210 .mbar.edit add
command -label {Options...
} \
2211 -command do_options \
2216 .mbar.commit add
command -label Rescan \
2217 -command do_rescan \
2220 lappend disable_on_lock \
2221 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2222 .mbar.commit add
command -label {Amend Last Commit
} \
2223 -command do_amend_last \
2225 lappend disable_on_lock \
2226 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2227 .mbar.commit add
command -label {Include All Files
} \
2228 -command do_include_all \
2229 -accelerator $M1T-I \
2231 lappend disable_on_lock \
2232 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2233 .mbar.commit add
command -label {Sign Off
} \
2234 -command do_signoff \
2235 -accelerator $M1T-S \
2237 .mbar.commit add
command -label Commit \
2238 -command do_commit \
2239 -accelerator $M1T-Return \
2241 lappend disable_on_lock \
2242 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2244 if {!$single_commit} {
2255 # -- Main Window Layout
2256 panedwindow .vpane
-orient vertical
2257 panedwindow .vpane.files
-orient horizontal
2258 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
2259 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2261 # -- Index File List
2262 frame .vpane.files.index
-height 100 -width 400
2263 label .vpane.files.index.title
-text {Modified Files
} \
2266 text
$ui_index -background white
-borderwidth 0 \
2267 -width 40 -height 10 \
2269 -cursor $cursor_ptr \
2270 -yscrollcommand {.vpane.files.index.sb
set} \
2272 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
2273 pack .vpane.files.index.title
-side top
-fill x
2274 pack .vpane.files.index.sb
-side right
-fill y
2275 pack
$ui_index -side left
-fill both
-expand 1
2276 .vpane.files add .vpane.files.index
-sticky nsew
2278 # -- Other (Add) File List
2279 frame .vpane.files.other
-height 100 -width 100
2280 label .vpane.files.other.title
-text {Untracked Files
} \
2283 text
$ui_other -background white
-borderwidth 0 \
2284 -width 40 -height 10 \
2286 -cursor $cursor_ptr \
2287 -yscrollcommand {.vpane.files.other.sb
set} \
2289 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
2290 pack .vpane.files.other.title
-side top
-fill x
2291 pack .vpane.files.other.sb
-side right
-fill y
2292 pack
$ui_other -side left
-fill both
-expand 1
2293 .vpane.files add .vpane.files.other
-sticky nsew
2295 foreach i
[list
$ui_index $ui_other] {
2296 $i tag conf in_diff
-font font_uibold
2297 $i tag conf in_sel \
2298 -background [$i cget
-foreground] \
2299 -foreground [$i cget
-background]
2303 # -- Diff and Commit Area
2304 frame .vpane.lower
-height 300 -width 400
2305 frame .vpane.lower.commarea
2306 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2307 pack .vpane.lower.commarea
-side top
-fill x
2308 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2309 .vpane add .vpane.lower
-stick nsew
2311 # -- Commit Area Buttons
2312 frame .vpane.lower.commarea.buttons
2313 label .vpane.lower.commarea.buttons.l
-text {} \
2317 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2318 pack .vpane.lower.commarea.buttons
-side left
-fill y
2320 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2321 -command do_rescan \
2323 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2324 lappend disable_on_lock \
2325 {.vpane.lower.commarea.buttons.rescan conf
-state}
2327 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
2328 -command do_amend_last \
2330 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
2331 lappend disable_on_lock \
2332 {.vpane.lower.commarea.buttons.amend conf
-state}
2334 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
2335 -command do_include_all \
2337 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2338 lappend disable_on_lock \
2339 {.vpane.lower.commarea.buttons.incall conf
-state}
2341 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2342 -command do_signoff \
2344 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2346 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2347 -command do_commit \
2349 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2350 lappend disable_on_lock \
2351 {.vpane.lower.commarea.buttons.commit conf
-state}
2353 # -- Commit Message Buffer
2354 frame .vpane.lower.commarea.buffer
2355 set ui_comm .vpane.lower.commarea.buffer.t
2356 set ui_coml .vpane.lower.commarea.buffer.l
2357 label
$ui_coml -text {Commit Message
:} \
2361 trace add variable commit_type
write {uplevel
#0 {
2362 switch
-glob $commit_type \
2363 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
2364 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
2365 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
2366 * {$ui_coml conf
-text {Commit Message
:}}
2368 text
$ui_comm -background white
-borderwidth 1 \
2371 -autoseparators true \
2373 -width 75 -height 9 -wrap none \
2375 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2376 scrollbar .vpane.lower.commarea.buffer.sby \
2377 -command [list
$ui_comm yview
]
2378 pack
$ui_coml -side top
-fill x
2379 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2380 pack
$ui_comm -side left
-fill y
2381 pack .vpane.lower.commarea.buffer
-side left
-fill y
2383 # -- Commit Message Buffer Context Menu
2385 set ctxm .vpane.lower.commarea.buffer.ctxm
2386 menu
$ctxm -tearoff 0
2390 -command {tk_textCut
$ui_comm}
2394 -command {tk_textCopy
$ui_comm}
2398 -command {tk_textPaste
$ui_comm}
2402 -command {$ui_comm delete sel.first sel.last
}
2405 -label {Select All
} \
2407 -command {$ui_comm tag add sel
0.0 end
}
2412 $ui_comm tag add sel
0.0 end
2413 tk_textCopy
$ui_comm
2414 $ui_comm tag remove sel
0.0 end
2421 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2425 set diff_actions
[list
]
2426 proc current_diff_trace
{varname args
} {
2427 global current_diff diff_actions file_states
2428 if {$current_diff eq
{}} {
2435 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2437 set p
[escape_path
$p]
2441 .vpane.lower.
diff.header.status configure
-text $s
2442 .vpane.lower.
diff.header.
file configure
-text $f
2443 .vpane.lower.
diff.header.path configure
-text $p
2444 foreach w
$diff_actions {
2448 trace add variable current_diff
write current_diff_trace
2450 frame .vpane.lower.
diff.header
-background orange
2451 label .vpane.lower.
diff.header.status \
2452 -background orange \
2453 -width $max_status_desc \
2457 label .vpane.lower.
diff.header.
file \
2458 -background orange \
2462 label .vpane.lower.
diff.header.path \
2463 -background orange \
2467 pack .vpane.lower.
diff.header.status
-side left
2468 pack .vpane.lower.
diff.header.
file -side left
2469 pack .vpane.lower.
diff.header.path
-fill x
2470 set ctxm .vpane.lower.
diff.header.ctxm
2471 menu
$ctxm -tearoff 0
2482 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2483 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2486 frame .vpane.lower.
diff.body
2487 set ui_diff .vpane.lower.
diff.body.t
2488 text
$ui_diff -background white
-borderwidth 0 \
2489 -width 80 -height 15 -wrap none \
2491 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2492 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2494 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2495 -command [list
$ui_diff xview
]
2496 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2497 -command [list
$ui_diff yview
]
2498 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2499 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2500 pack
$ui_diff -side left
-fill both
-expand 1
2501 pack .vpane.lower.
diff.header
-side top
-fill x
2502 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2504 $ui_diff tag conf dm
-foreground red
2505 $ui_diff tag conf dp
-foreground blue
2506 $ui_diff tag conf di
-foreground {#00a000}
2507 $ui_diff tag conf dni
-foreground {#a000a0}
2508 $ui_diff tag conf da
-font font_diffbold
2509 $ui_diff tag conf bold
-font font_diffbold
2511 # -- Diff Body Context Menu
2513 set ctxm .vpane.lower.
diff.body.ctxm
2514 menu
$ctxm -tearoff 0
2518 -command {tk_textCopy
$ui_diff}
2519 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2521 -label {Select All
} \
2523 -command {$ui_diff tag add sel
0.0 end
}
2524 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2529 $ui_diff tag add sel
0.0 end
2530 tk_textCopy
$ui_diff
2531 $ui_diff tag remove sel
0.0 end
2533 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2536 -label {Decrease Font Size
} \
2538 -command {incr_font_size font_diff
-1}
2539 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2541 -label {Increase Font Size
} \
2543 -command {incr_font_size font_diff
1}
2544 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2547 -label {Show Less Context
} \
2549 -command {if {$repo_config(gui.diffcontext
) >= 2} {
2550 incr repo_config
(gui.diffcontext
) -1
2553 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2555 -label {Show More Context
} \
2558 incr repo_config
(gui.diffcontext
)
2561 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2563 $ctxm add
command -label {Options...
} \
2566 bind_button3
$ui_diff "tk_popup $ctxm %X %Y"
2570 set ui_status_value
{Initializing...
}
2571 label .status
-textvariable ui_status_value \
2577 pack .status
-anchor w
-side bottom
-fill x
2582 set gm
$repo_config(gui.geometry
)
2583 wm geometry .
[lindex
$gm 0]
2584 .vpane sash place
0 \
2585 [lindex
[.vpane sash coord
0] 0] \
2587 .vpane.files sash place
0 \
2589 [lindex
[.vpane.files sash coord
0] 1]
2595 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2596 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
2597 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
2598 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2599 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2600 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2601 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2602 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2603 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2604 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2605 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2607 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2608 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2609 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2610 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2611 bind $ui_diff <$M1B-Key-v> {break}
2612 bind $ui_diff <$M1B-Key-V> {break}
2613 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2614 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2615 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2616 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2617 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2618 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2620 bind .
<Destroy
> do_quit
2621 bind all
<Key-F5
> do_rescan
2622 bind all
<$M1B-Key-r> do_rescan
2623 bind all
<$M1B-Key-R> do_rescan
2624 bind .
<$M1B-Key-s> do_signoff
2625 bind .
<$M1B-Key-S> do_signoff
2626 bind .
<$M1B-Key-i> do_include_all
2627 bind .
<$M1B-Key-I> do_include_all
2628 bind .
<$M1B-Key-Return> do_commit
2629 bind all
<$M1B-Key-q> do_quit
2630 bind all
<$M1B-Key-Q> do_quit
2631 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2632 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2633 foreach i
[list
$ui_index $ui_other] {
2634 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2635 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2636 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2640 set file_lists
($ui_index) [list
]
2641 set file_lists
($ui_other) [list
]
2644 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
2645 focus
-force $ui_comm
2646 if {!$single_commit} {
2648 populate_remote_menu .mbar.fetch From fetch_from
2649 populate_remote_menu .mbar.push To push_to
2650 populate_pull_menu .mbar.pull