#!/bin/sh # Tcl ignores the next line -*- tcl -*- \ exec wish "$0" -- "$@" # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved. # This program is free software; it may be used, copied, modified # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. ###################################################################### ## ## task management set single_commit 0 set status_active 0 set diff_active 0 set checkin_active 0 set commit_active 0 set update_index_fd {} set disable_on_lock [list] set index_lock_type none set HEAD {} set PARENT {} set commit_type {} proc lock_index {type} { global index_lock_type disable_on_lock if {$index_lock_type == {none}} { set index_lock_type $type foreach w $disable_on_lock { uplevel #0 $w disabled } return 1 } elseif {$index_lock_type == {begin-update} && $type == {update}} { set index_lock_type $type return 1 } return 0 } proc unlock_index {} { global index_lock_type disable_on_lock set index_lock_type none foreach w $disable_on_lock { uplevel #0 $w normal } } ###################################################################### ## ## status proc repository_state {hdvar ctvar} { global gitdir upvar $hdvar hd $ctvar ct if {[catch {set hd [exec git rev-parse --verify HEAD]}]} { set ct initial } elseif {[file exists [file join $gitdir MERGE_HEAD]]} { set ct merge } else { set ct normal } } proc update_status {{final Ready.}} { global HEAD PARENT commit_type global ui_index ui_other ui_status_value ui_comm global status_active file_states global cfg_trust_mtime if {$status_active || ![lock_index read]} return repository_state new_HEAD new_type if {$commit_type == {amend} && $new_type == {normal} && $new_HEAD == $HEAD} { } else { set HEAD $new_HEAD set PARENT $new_HEAD set commit_type $new_type } array unset file_states foreach w [list $ui_index $ui_other] { $w conf -state normal $w delete 0.0 end $w conf -state disabled } if {![$ui_comm edit modified] || [string trim [$ui_comm get 0.0 end]] == {}} { if {[load_message GITGUI_MSG]} { } elseif {[load_message MERGE_MSG]} { } elseif {[load_message SQUASH_MSG]} { } $ui_comm edit modified false } if {$cfg_trust_mtime == {true}} { update_status_stage2 {} $final } else { set status_active 1 set ui_status_value {Refreshing file status...} set fd_rf [open "| git update-index -q --unmerged --refresh" r] fconfigure $fd_rf -blocking 0 -translation binary fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final] } } proc update_status_stage2 {fd final} { global gitdir PARENT commit_type global ui_index ui_other ui_status_value ui_comm global status_active file_states global buf_rdi buf_rdf buf_rlo if {$fd != {}} { read $fd if {![eof $fd]} return close $fd } set ls_others [list | git ls-files --others -z \ --exclude-per-directory=.gitignore] set info_exclude [file join $gitdir info exclude] if {[file readable $info_exclude]} { lappend ls_others "--exclude-from=$info_exclude" } set buf_rdi {} set buf_rdf {} set buf_rlo {} set status_active 3 set ui_status_value {Scanning for modified files ...} set fd_di [open "| git diff-index --cached -z $PARENT" r] set fd_df [open "| git diff-files -z" r] set fd_lo [open $ls_others r] fconfigure $fd_di -blocking 0 -translation binary fconfigure $fd_df -blocking 0 -translation binary fconfigure $fd_lo -blocking 0 -translation binary fileevent $fd_di readable [list read_diff_index $fd_di $final] fileevent $fd_df readable [list read_diff_files $fd_df $final] fileevent $fd_lo readable [list read_ls_others $fd_lo $final] } proc load_message {file} { global gitdir ui_comm set f [file join $gitdir $file] if {[file isfile $f]} { if {[catch {set fd [open $f r]}]} { return 0 } set content [string trim [read $fd]] close $fd $ui_comm delete 0.0 end $ui_comm insert end $content return 1 } return 0 } proc read_diff_index {fd final} { global buf_rdi append buf_rdi [read $fd] set c 0 set n [string length $buf_rdi] while {$c < $n} { set z1 [string first "\0" $buf_rdi $c] if {$z1 == -1} break incr z1 set z2 [string first "\0" $buf_rdi $z1] if {$z2 == -1} break set c $z2 incr z2 -1 display_file \ [string range $buf_rdi $z1 $z2] \ [string index $buf_rdi [expr $z1 - 2]]_ incr c } if {$c < $n} { set buf_rdi [string range $buf_rdi $c end] } else { set buf_rdi {} } status_eof $fd buf_rdi $final } proc read_diff_files {fd final} { global buf_rdf append buf_rdf [read $fd] set c 0 set n [string length $buf_rdf] while {$c < $n} { set z1 [string first "\0" $buf_rdf $c] if {$z1 == -1} break incr z1 set z2 [string first "\0" $buf_rdf $z1] if {$z2 == -1} break set c $z2 incr z2 -1 display_file \ [string range $buf_rdf $z1 $z2] \ _[string index $buf_rdf [expr $z1 - 2]] incr c } if {$c < $n} { set buf_rdf [string range $buf_rdf $c end] } else { set buf_rdf {} } status_eof $fd buf_rdf $final } proc read_ls_others {fd final} { global buf_rlo append buf_rlo [read $fd] set pck [split $buf_rlo "\0"] set buf_rlo [lindex $pck end] foreach p [lrange $pck 0 end-1] { display_file $p _O } status_eof $fd buf_rlo $final } proc status_eof {fd buf final} { global status_active $buf global ui_fname_value ui_status_value file_states if {[eof $fd]} { set $buf {} close $fd if {[incr status_active -1] == 0} { unlock_index display_all_files set ui_status_value $final if {$ui_fname_value != {} && [array names file_states \ -exact $ui_fname_value] != {}} { show_diff $ui_fname_value } else { clear_diff } } } } ###################################################################### ## ## diff proc clear_diff {} { global ui_diff ui_fname_value ui_fstatus_value $ui_diff conf -state normal $ui_diff delete 0.0 end $ui_diff conf -state disabled set ui_fname_value {} set ui_fstatus_value {} } proc show_diff {path} { global file_states PARENT diff_3way diff_active global ui_diff ui_fname_value ui_fstatus_value ui_status_value if {$diff_active || ![lock_index read]} return clear_diff set s $file_states($path) set m [lindex $s 0] set diff_3way 0 set diff_active 1 set ui_fname_value $path set ui_fstatus_value [mapdesc $m $path] set ui_status_value "Loading diff of $path..." set cmd [list | git diff-index -p $PARENT -- $path] switch $m { AM { } MM { set cmd [list | git diff-index -p -c $PARENT $path] } _O { if {[catch { set fd [open $path r] set content [read $fd] close $fd } err ]} { set diff_active 0 unlock_index set ui_status_value "Unable to display $path" error_popup "Error loading file:\n$err" return } $ui_diff conf -state normal $ui_diff insert end $content $ui_diff conf -state disabled set diff_active 0 unlock_index set ui_status_value {Ready.} return } } if {[catch {set fd [open $cmd r]} err]} { set diff_active 0 unlock_index set ui_status_value "Unable to display $path" error_popup "Error loading diff:\n$err" return } fconfigure $fd -blocking 0 -translation auto fileevent $fd readable [list read_diff $fd] } proc read_diff {fd} { global ui_diff ui_status_value diff_3way diff_active while {[gets $fd line] >= 0} { if {[string match {diff --git *} $line]} continue if {[string match {diff --combined *} $line]} continue if {[string match {--- *} $line]} continue if {[string match {+++ *} $line]} continue if {[string match index* $line]} { if {[string first , $line] >= 0} { set diff_3way 1 } } $ui_diff conf -state normal if {!$diff_3way} { set x [string index $line 0] switch -- $x { "@" {set tags da} "+" {set tags dp} "-" {set tags dm} default {set tags {}} } } else { set x [string range $line 0 1] switch -- $x { default {set tags {}} "@@" {set tags da} "++" {set tags dp; set x " +"} " +" {set tags {di bold}; set x "++"} "+ " {set tags dni; set x "-+"} "--" {set tags dm; set x " -"} " -" {set tags {dm bold}; set x "--"} "- " {set tags di; set x "+-"} default {set tags {}} } set line [string replace $line 0 1 $x] } $ui_diff insert end $line $tags $ui_diff insert end "\n" $ui_diff conf -state disabled } if {[eof $fd]} { close $fd set diff_active 0 unlock_index set ui_status_value {Ready.} } } ###################################################################### ## ## commit proc load_last_commit {} { global HEAD PARENT commit_type ui_comm if {$commit_type == {amend}} return if {$commit_type != {normal}} { error_popup "Can't amend a $commit_type commit." return } set msg {} set parent {} set parent_count 0 if {[catch { set fd [open "| git cat-file commit $HEAD" r] while {[gets $fd line] > 0} { if {[string match {parent *} $line]} { set parent [string range $line 7 end] incr parent_count } } set msg [string trim [read $fd]] close $fd } err]} { error_popup "Error loading commit data for amend:\n$err" return } if {$parent_count == 0} { set commit_type amend set HEAD {} set PARENT {} update_status } elseif {$parent_count == 1} { set commit_type amend set PARENT $parent $ui_comm delete 0.0 end $ui_comm insert end $msg $ui_comm edit modified false update_status } else { error_popup {You can't amend a merge commit.} return } } proc commit_tree {} { global tcl_platform HEAD gitdir commit_type file_states global commit_active ui_status_value global ui_comm if {$commit_active || ![lock_index update]} return # -- Our in memory state should match the repository. # repository_state curHEAD cur_type if {$commit_type == {amend} && $cur_type == {normal} && $curHEAD == $HEAD} { } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} { error_popup {Last scanned state does not match repository state. Its highly likely that another Git program modified the repository since our last scan. A rescan is required before committing. } unlock_index update_status return } # -- At least one file should differ in the index. # set files_ready 0 foreach path [array names file_states] { set s $file_states($path) switch -glob -- [lindex $s 0] { _* {continue} A* - D* - M* {set files_ready 1; break} U* { error_popup "Unmerged files cannot be committed. File $path has merge conflicts. You must resolve them and check the file in before committing. " unlock_index return } default { error_popup "Unknown file state [lindex $s 0] detected. File $path cannot be committed by this program. " } } } if {!$files_ready} { error_popup {No checked-in files to commit. You must check-in at least 1 file before you can commit. } unlock_index return } # -- A message is required. # set msg [string trim [$ui_comm get 1.0 end]] if {$msg == {}} { error_popup {Please supply a commit message. A good commit message has the following format: - First line: Describe in one sentance what you did. - Second line: Blank - Remaining lines: Describe why this change is good. } unlock_index return } # -- Ask the pre-commit hook for the go-ahead. # set pchook [file join $gitdir hooks pre-commit] if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} { set pchook [list sh -c \ "if test -x \"$pchook\"; then exec \"$pchook\"; fi"] } elseif {[file executable $pchook]} { set pchook [list $pchook] } else { set pchook {} } if {$pchook != {} && [catch {eval exec $pchook} err]} { hook_failed_popup pre-commit $err unlock_index return } # -- Write the tree in the background. # set commit_active 1 set ui_status_value {Committing changes...} set fd_wt [open "| git write-tree" r] fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg] } proc commit_stage2 {fd_wt curHEAD msg} { global single_commit gitdir PARENT commit_type global commit_active ui_status_value ui_comm gets $fd_wt tree_id close $fd_wt if {$tree_id == {}} { error_popup "write-tree failed" set commit_active 0 set ui_status_value {Commit failed.} unlock_index return } # -- Create the commit. # set cmd [list git commit-tree $tree_id] if {$PARENT != {}} { lappend cmd -p $PARENT } if {$commit_type == {merge}} { if {[catch { set fd_mh [open [file join $gitdir MERGE_HEAD] r] while {[gets $fd_mh merge_head] >= 0} { lappend cmd -p $merge_head } close $fd_mh } err]} { error_popup "Loading MERGE_HEADs failed:\n$err" set commit_active 0 set ui_status_value {Commit failed.} unlock_index return } } if {$PARENT == {}} { # git commit-tree writes to stderr during initial commit. lappend cmd 2>/dev/null } lappend cmd << $msg if {[catch {set cmt_id [eval exec $cmd]} err]} { error_popup "commit-tree failed:\n$err" set commit_active 0 set ui_status_value {Commit failed.} unlock_index return } # -- Update the HEAD ref. # set reflogm commit if {$commit_type != {normal}} { append reflogm " ($commit_type)" } set i [string first "\n" $msg] if {$i >= 0} { append reflogm {: } [string range $msg 0 [expr $i - 1]] } else { append reflogm {: } $msg } set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD] if {[catch {eval exec $cmd} err]} { error_popup "update-ref failed:\n$err" set commit_active 0 set ui_status_value {Commit failed.} unlock_index return } # -- Cleanup after ourselves. # catch {file delete [file join $gitdir MERGE_HEAD]} catch {file delete [file join $gitdir MERGE_MSG]} catch {file delete [file join $gitdir SQUASH_MSG]} catch {file delete [file join $gitdir GITGUI_MSG]} # -- Let rerere do its thing. # if {[file isdirectory [file join $gitdir rr-cache]]} { catch {exec git rerere} } $ui_comm delete 0.0 end $ui_comm edit modified false if {$single_commit} do_quit set commit_type {} set commit_active 0 set HEAD $cmt_id set PARENT $cmt_id unlock_index update_status "Changes committed as $cmt_id." } ###################################################################### ## ## fetch pull push proc fetch_from {remote} { set w [new_console "fetch $remote" \ "Fetching new changes from $remote"] set cmd [list git fetch] lappend cmd $remote console_exec $w $cmd } proc pull_remote {remote branch} { global HEAD commit_type global file_states if {![lock_index update]} return # -- Our in memory state should match the repository. # repository_state curHEAD cur_type if {$commit_type != $cur_type || $HEAD != $curHEAD} { error_popup {Last scanned state does not match repository state. Its highly likely that another Git program modified the repository since our last scan. A rescan is required before a pull can be started. } unlock_index update_status return } # -- No differences should exist before a pull. # if {[array size file_states] != 0} { error_popup {Uncommitted but modified files are present. You should not perform a pull with unmodified files in your working directory as Git would be unable to recover from an incorrect merge. Commit or throw away all changes before starting a pull operation. } unlock_index return } set w [new_console "pull $remote $branch" \ "Pulling new changes from branch $branch in $remote"] set cmd [list git pull] lappend cmd $remote lappend cmd $branch console_exec $w $cmd [list post_pull_remote $remote $branch] } proc post_pull_remote {remote branch success} { global HEAD PARENT commit_type global ui_status_value unlock_index if {$success} { repository_state HEAD commit_type set PARENT $HEAD set $ui_status_value {Ready.} } else { update_status "Conflicts detected while pulling $branch from $remote." } } proc push_to {remote} { set w [new_console "push $remote" \ "Pushing changes to $remote"] set cmd [list git push] lappend cmd $remote console_exec $w $cmd } ###################################################################### ## ## ui helpers proc mapcol {state path} { global all_cols ui_other if {[catch {set r $all_cols($state)}]} { puts "error: no column for state={$state} $path" return $ui_other } return $r } proc mapicon {state path} { global all_icons if {[catch {set r $all_icons($state)}]} { puts "error: no icon for state={$state} $path" return file_plain } return $r } proc mapdesc {state path} { global all_descs if {[catch {set r $all_descs($state)}]} { puts "error: no desc for state={$state} $path" return $state } return $r } proc bsearch {w path} { set hi [expr [lindex [split [$w index end] .] 0] - 2] if {$hi == 0} { return -1 } set lo 0 while {$lo < $hi} { set mi [expr [expr $lo + $hi] / 2] set ti [expr $mi + 1] set cmp [string compare [$w get $ti.1 $ti.end] $path] if {$cmp < 0} { set lo $ti } elseif {$cmp == 0} { return $mi } else { set hi $mi } } return -[expr $lo + 1] } set next_icon_id 0 proc merge_state {path new_state} { global file_states next_icon_id set s0 [string index $new_state 0] set s1 [string index $new_state 1] if {[catch {set info $file_states($path)}]} { set state __ set icon n[incr next_icon_id] } else { set state [lindex $info 0] set icon [lindex $info 1] } if {$s0 == {_}} { set s0 [string index $state 0] } elseif {$s0 == {*}} { set s0 _ } if {$s1 == {_}} { set s1 [string index $state 1] } elseif {$s1 == {*}} { set s1 _ } set file_states($path) [list $s0$s1 $icon] return $state } proc display_file {path state} { global ui_index ui_other file_states status_active set old_m [merge_state $path $state] if {$status_active} return set s $file_states($path) set new_m [lindex $s 0] set new_w [mapcol $new_m $path] set old_w [mapcol $old_m $path] set new_icon [mapicon $new_m $path] if {$new_w != $old_w} { set lno [bsearch $old_w $path] if {$lno >= 0} { incr lno $old_w conf -state normal $old_w delete $lno.0 [expr $lno + 1].0 $old_w conf -state disabled } set lno [expr abs([bsearch $new_w $path] + 1) + 1] $new_w conf -state normal $new_w image create $lno.0 \ -align center -padx 5 -pady 1 \ -name [lindex $s 1] \ -image $new_icon $new_w insert $lno.1 "$path\n" $new_w conf -state disabled } elseif {$new_icon != [mapicon $old_m $path]} { $new_w conf -state normal $new_w image conf [lindex $s 1] -image $new_icon $new_w conf -state disabled } } proc display_all_files {} { global ui_index ui_other file_states $ui_index conf -state normal $ui_other conf -state normal foreach path [lsort [array names file_states]] { set s $file_states($path) set m [lindex $s 0] set w [mapcol $m $path] $w image create end \ -align center -padx 5 -pady 1 \ -name [lindex $s 1] \ -image [mapicon $m $path] $w insert end "$path\n" } $ui_index conf -state disabled $ui_other conf -state disabled } proc with_update_index {body} { global update_index_fd if {$update_index_fd == {}} { if {![lock_index update]} return set update_index_fd [open \ "| git update-index --add --remove -z --stdin" \ w] fconfigure $update_index_fd -translation binary uplevel 1 $body close $update_index_fd set update_index_fd {} unlock_index } else { uplevel 1 $body } } proc update_index {path} { global update_index_fd if {$update_index_fd == {}} { error {not in with_update_index} } else { puts -nonewline $update_index_fd "$path\0" } } proc toggle_mode {path} { global file_states ui_fname_value set s $file_states($path) set m [lindex $s 0] switch -- $m { AM - _O {set new A*} _M - MM {set new M*} AD - _D {set new D*} default {return} } with_update_index {update_index $path} display_file $path $new if {$ui_fname_value == $path} { show_diff $path } } ###################################################################### ## ## config (fetch push pull) proc load_repo_config {} { global repo_config global cfg_trust_mtime array unset repo_config catch { set fd_rc [open "| git repo-config --list" r] while {[gets $fd_rc line] >= 0} { if {[regexp {^([^=]+)=(.*)$} $line line name value]} { lappend repo_config($name) $value } } close $fd_rc } if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} { set cfg_trust_mtime false } } proc save_my_config {} { global repo_config global cfg_trust_mtime if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} { set rc_trustMTime false } if {$cfg_trust_mtime != $rc_trustMTime} { exec git repo-config gui.trustMTime $cfg_trust_mtime } } proc load_all_remotes {} { global gitdir all_remotes repo_config set all_remotes [list] set rm_dir [file join $gitdir remotes] if {[file isdirectory $rm_dir]} { set all_remotes [concat $all_remotes [glob \ -types f \ -tails \ -nocomplain \ -directory $rm_dir *]] } foreach line [array names repo_config remote.*.url] { if {[regexp ^remote\.(.*)\.url\$ $line line name]} { lappend all_remotes $name } } set all_remotes [lsort -unique $all_remotes] } proc populate_remote_menu {m pfx op} { global all_remotes mainfont foreach remote $all_remotes { $m add command -label "$pfx $remote..." \ -command [list $op $remote] \ -font $mainfont } } proc populate_pull_menu {m} { global gitdir repo_config all_remotes mainfont disable_on_lock foreach remote $all_remotes { set rb {} if {[array get repo_config remote.$remote.url] != {}} { if {[array get repo_config remote.$remote.fetch] != {}} { regexp {^([^:]+):} \ [lindex $repo_config(remote.$remote.fetch) 0] \ line rb } } else { catch { set fd [open [file join $gitdir remotes $remote] r] while {[gets $fd line] >= 0} { if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} { break } } close $fd } } set rb_short $rb regsub ^refs/heads/ $rb {} rb_short if {$rb_short != {}} { $m add command \ -label "Branch $rb_short from $remote..." \ -command [list pull_remote $remote $rb] \ -font $mainfont lappend disable_on_lock \ [list $m entryconf [$m index last] -state] } } } ###################################################################### ## ## icons set filemask { #define mask_width 14 #define mask_height 15 static unsigned char mask_bits[] = { 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f}; } image create bitmap file_plain -background white -foreground black -data { #define plain_width 14 #define plain_height 15 static unsigned char plain_bits[] = { 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_mod -background white -foreground blue -data { #define mod_width 14 #define mod_height 15 static unsigned char mod_bits[] = { 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_fulltick -background white -foreground "#007000" -data { #define file_fulltick_width 14 #define file_fulltick_height 15 static unsigned char file_fulltick_bits[] = { 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16, 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_parttick -background white -foreground "#005050" -data { #define parttick_width 14 #define parttick_height 15 static unsigned char parttick_bits[] = { 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10, 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10, 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_question -background white -foreground black -data { #define file_question_width 14 #define file_question_height 15 static unsigned char file_question_bits[] = { 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13, 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_removed -background white -foreground red -data { #define file_removed_width 14 #define file_removed_height 15 static unsigned char file_removed_bits[] = { 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10, 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13, 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask image create bitmap file_merge -background white -foreground blue -data { #define file_merge_width 14 #define file_merge_height 15 static unsigned char file_merge_bits[] = { 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10, 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f}; } -maskdata $filemask set ui_index .vpane.files.index.list set ui_other .vpane.files.other.list set max_status_desc 0 foreach i { {__ i plain "Unmodified"} {_M i mod "Modified"} {M_ i fulltick "Checked in"} {MM i parttick "Partially checked in"} {_O o plain "Untracked"} {A_ o fulltick "Added"} {AM o parttick "Partially added"} {AD o question "Added (but now gone)"} {_D i question "Missing"} {D_ i removed "Removed"} {DD i removed "Removed"} {DO i removed "Removed (still exists)"} {UM i merge "Merge conflicts"} {U_ i merge "Merge conflicts"} } { if {$max_status_desc < [string length [lindex $i 3]]} { set max_status_desc [string length [lindex $i 3]] } if {[lindex $i 1] == {i}} { set all_cols([lindex $i 0]) $ui_index } else { set all_cols([lindex $i 0]) $ui_other } set all_icons([lindex $i 0]) file_[lindex $i 2] set all_descs([lindex $i 0]) [lindex $i 3] } unset filemask i ###################################################################### ## ## util proc error_popup {msg} { set w .error toplevel $w wm transient $w . show_msg $w $w $msg } proc show_msg {w top msg} { global gitdir appname mainfont message $w.m -text $msg -justify left -aspect 400 pack $w.m -side top -fill x -padx 5 -pady 10 button $w.ok -text OK \ -width 15 \ -font $mainfont \ -command "destroy $top" pack $w.ok -side bottom bind $top "grab $top; focus $top" bind $top "destroy $top" wm title $w "$appname ([lindex [file split \ [file normalize [file dirname $gitdir]]] \ end]): error" tkwait window $top } proc hook_failed_popup {hook msg} { global gitdir mainfont difffont appname set w .hookfail toplevel $w wm transient $w . frame $w.m label $w.m.l1 -text "$hook hook failed:" \ -anchor w \ -justify left \ -font [concat $mainfont bold] text $w.m.t \ -background white -borderwidth 1 \ -relief sunken \ -width 80 -height 10 \ -font $difffont \ -yscrollcommand [list $w.m.sby set] label $w.m.l2 \ -text {You must correct the above errors before committing.} \ -anchor w \ -justify left \ -font [concat $mainfont bold] scrollbar $w.m.sby -command [list $w.m.t yview] pack $w.m.l1 -side top -fill x pack $w.m.l2 -side bottom -fill x pack $w.m.sby -side right -fill y pack $w.m.t -side left -fill both -expand 1 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10 $w.m.t insert 1.0 $msg $w.m.t conf -state disabled button $w.ok -text OK \ -width 15 \ -font $mainfont \ -command "destroy $w" pack $w.ok -side bottom bind $w "grab $w; focus $w" bind $w "destroy $w" wm title $w "$appname ([lindex [file split \ [file normalize [file dirname $gitdir]]] \ end]): error" tkwait window $w } set next_console_id 0 proc new_console {short_title long_title} { global next_console_id console_data set w .console[incr next_console_id] set console_data($w) [list $short_title $long_title] return [console_init $w] } proc console_init {w} { global console_cr console_data global gitdir appname mainfont difffont set console_cr($w) 1.0 toplevel $w frame $w.m label $w.m.l1 -text "[lindex $console_data($w) 1]:" \ -anchor w \ -justify left \ -font [concat $mainfont bold] text $w.m.t \ -background white -borderwidth 1 \ -relief sunken \ -width 80 -height 10 \ -font $difffont \ -state disabled \ -yscrollcommand [list $w.m.sby set] label $w.m.s -anchor w \ -justify left \ -font [concat $mainfont bold] scrollbar $w.m.sby -command [list $w.m.t yview] pack $w.m.l1 -side top -fill x pack $w.m.s -side bottom -fill x pack $w.m.sby -side right -fill y pack $w.m.t -side left -fill both -expand 1 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10 button $w.ok -text {Running...} \ -width 15 \ -font $mainfont \ -state disabled \ -command "destroy $w" pack $w.ok -side bottom bind $w "focus $w" wm title $w "$appname ([lindex [file split \ [file normalize [file dirname $gitdir]]] \ end]): [lindex $console_data($w) 0]" return $w } proc console_exec {w cmd {after {}}} { global tcl_platform # -- Windows tosses the enviroment when we exec our child. # But most users need that so we have to relogin. :-( # if {$tcl_platform(platform) == {windows}} { set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"] } # -- Tcl won't let us redirect both stdout and stderr to # the same pipe. So pass it through cat... # set cmd [concat | $cmd |& cat] set fd_f [open $cmd r] fconfigure $fd_f -blocking 0 -translation binary fileevent $fd_f readable [list console_read $w $fd_f $after] } proc console_read {w fd after} { global console_cr console_data set buf [read $fd] if {$buf != {}} { if {![winfo exists $w]} {console_init $w} $w.m.t conf -state normal set c 0 set n [string length $buf] while {$c < $n} { set cr [string first "\r" $buf $c] set lf [string first "\n" $buf $c] if {$cr < 0} {set cr [expr $n + 1]} if {$lf < 0} {set lf [expr $n + 1]} if {$lf < $cr} { $w.m.t insert end [string range $buf $c $lf] set console_cr($w) [$w.m.t index {end -1c}] set c $lf incr c } else { $w.m.t delete $console_cr($w) end $w.m.t insert end "\n" $w.m.t insert end [string range $buf $c $cr] set c $cr incr c } } $w.m.t conf -state disabled $w.m.t see end } fconfigure $fd -blocking 1 if {[eof $fd]} { if {[catch {close $fd}]} { if {![winfo exists $w]} {console_init $w} $w.m.s conf -background red -text {Error: Command Failed} $w.ok conf -text Close $w.ok conf -state normal set ok 0 } elseif {[winfo exists $w]} { $w.m.s conf -background green -text {Success} $w.ok conf -text Close $w.ok conf -state normal set ok 1 } array unset console_cr $w array unset console_data $w if {$after != {}} { uplevel #0 $after $ok } return } fconfigure $fd -blocking 0 } ###################################################################### ## ## ui commands set starting_gitk_msg {Please wait... Starting gitk...} proc do_gitk {} { global tcl_platform ui_status_value starting_gitk_msg set ui_status_value $starting_gitk_msg after 10000 { if {$ui_status_value == $starting_gitk_msg} { set ui_status_value {Ready.} } } if {$tcl_platform(platform) == {windows}} { exec sh -c gitk & } else { exec gitk & } } proc do_repack {} { set w [new_console "repack" "Repacking the object database"] set cmd [list git repack] lappend cmd -a lappend cmd -d console_exec $w $cmd } proc do_quit {} { global gitdir ui_comm set save [file join $gitdir GITGUI_MSG] set msg [string trim [$ui_comm get 0.0 end]] if {[$ui_comm edit modified] && $msg != {}} { catch { set fd [open $save w] puts $fd [string trim [$ui_comm get 0.0 end]] close $fd } } elseif {$msg == {} && [file exists $save]} { file delete $save } save_my_config destroy . } proc do_rescan {} { update_status } proc do_checkin_all {} { global checkin_active ui_status_value if {$checkin_active || ![lock_index begin-update]} return set checkin_active 1 set ui_status_value {Checking in all files...} after 1 { with_update_index { foreach path [array names file_states] { set s $file_states($path) set m [lindex $s 0] switch -- $m { AM - MM - _M - _D {toggle_mode $path} } } } set checkin_active 0 set ui_status_value {Ready.} } } proc do_signoff {} { global ui_comm catch { set me [exec git var GIT_COMMITTER_IDENT] if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} { set str "Signed-off-by: $name" if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} { $ui_comm insert end "\n" $ui_comm insert end $str $ui_comm see end } } } } proc do_amend_last {} { load_last_commit } proc do_commit {} { commit_tree } # shift == 1: left click # 3: right click proc click {w x y shift wx wy} { global ui_index ui_other set pos [split [$w index @$x,$y] .] set lno [lindex $pos 0] set col [lindex $pos 1] set path [$w get $lno.1 $lno.end] if {$path == {}} return if {$col > 0 && $shift == 1} { $ui_index tag remove in_diff 0.0 end $ui_other tag remove in_diff 0.0 end $w tag add in_diff $lno.0 [expr $lno + 1].0 show_diff $path } } proc unclick {w x y} { set pos [split [$w index @$x,$y] .] set lno [lindex $pos 0] set col [lindex $pos 1] set path [$w get $lno.1 $lno.end] if {$path == {}} return if {$col == 0} { toggle_mode $path } } ###################################################################### ## ## ui init set mainfont {Helvetica 10} set difffont {Courier 10} set maincursor [. cget -cursor] switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" { windows,* {set M1B Control; set M1T Ctrl} unix,Darwin {set M1B M1; set M1T Cmd} default {set M1B M1; set M1T M1} } # -- Menu Bar menu .mbar -tearoff 0 .mbar add cascade -label Project -menu .mbar.project .mbar add cascade -label Commit -menu .mbar.commit .mbar add cascade -label Fetch -menu .mbar.fetch .mbar add cascade -label Pull -menu .mbar.pull .mbar add cascade -label Push -menu .mbar.push .mbar add cascade -label Options -menu .mbar.options . configure -menu .mbar # -- Project Menu menu .mbar.project .mbar.project add command -label Visualize \ -command do_gitk \ -font $mainfont .mbar.project add command -label {Repack Database} \ -command do_repack \ -font $mainfont .mbar.project add command -label Quit \ -command do_quit \ -accelerator $M1T-Q \ -font $mainfont # -- Commit Menu menu .mbar.commit .mbar.commit add command -label Rescan \ -command do_rescan \ -accelerator F5 \ -font $mainfont lappend disable_on_lock \ [list .mbar.commit entryconf [.mbar.commit index last] -state] .mbar.commit add command -label {Amend Last Commit} \ -command do_amend_last \ -font $mainfont lappend disable_on_lock \ [list .mbar.commit entryconf [.mbar.commit index last] -state] .mbar.commit add command -label {Check-in All Files} \ -command do_checkin_all \ -accelerator $M1T-U \ -font $mainfont lappend disable_on_lock \ [list .mbar.commit entryconf [.mbar.commit index last] -state] .mbar.commit add command -label {Sign Off} \ -command do_signoff \ -accelerator $M1T-S \ -font $mainfont .mbar.commit add command -label Commit \ -command do_commit \ -accelerator $M1T-Return \ -font $mainfont lappend disable_on_lock \ [list .mbar.commit entryconf [.mbar.commit index last] -state] # -- Fetch Menu menu .mbar.fetch # -- Pull Menu menu .mbar.pull # -- Push Menu menu .mbar.push # -- Options Menu menu .mbar.options .mbar.options add checkbutton -label {Trust File Modification Timestamps} \ -offvalue false \ -onvalue true \ -variable cfg_trust_mtime # -- Main Window Layout panedwindow .vpane -orient vertical panedwindow .vpane.files -orient horizontal .vpane add .vpane.files -sticky nsew -height 100 -width 400 pack .vpane -anchor n -side top -fill both -expand 1 # -- Index File List frame .vpane.files.index -height 100 -width 400 label .vpane.files.index.title -text {Modified Files} \ -background green \ -font $mainfont text $ui_index -background white -borderwidth 0 \ -width 40 -height 10 \ -font $mainfont \ -yscrollcommand {.vpane.files.index.sb set} \ -cursor $maincursor \ -state disabled scrollbar .vpane.files.index.sb -command [list $ui_index yview] pack .vpane.files.index.title -side top -fill x pack .vpane.files.index.sb -side right -fill y pack $ui_index -side left -fill both -expand 1 .vpane.files add .vpane.files.index -sticky nsew # -- Other (Add) File List frame .vpane.files.other -height 100 -width 100 label .vpane.files.other.title -text {Untracked Files} \ -background red \ -font $mainfont text $ui_other -background white -borderwidth 0 \ -width 40 -height 10 \ -font $mainfont \ -yscrollcommand {.vpane.files.other.sb set} \ -cursor $maincursor \ -state disabled scrollbar .vpane.files.other.sb -command [list $ui_other yview] pack .vpane.files.other.title -side top -fill x pack .vpane.files.other.sb -side right -fill y pack $ui_other -side left -fill both -expand 1 .vpane.files add .vpane.files.other -sticky nsew $ui_index tag conf in_diff -font [concat $mainfont bold] $ui_other tag conf in_diff -font [concat $mainfont bold] # -- Diff and Commit Area frame .vpane.lower -height 400 -width 400 frame .vpane.lower.commarea frame .vpane.lower.diff -relief sunken -borderwidth 1 pack .vpane.lower.commarea -side top -fill x pack .vpane.lower.diff -side bottom -fill both -expand 1 .vpane add .vpane.lower -stick nsew # -- Commit Area Buttons frame .vpane.lower.commarea.buttons label .vpane.lower.commarea.buttons.l -text {} \ -anchor w \ -justify left \ -font $mainfont pack .vpane.lower.commarea.buttons.l -side top -fill x pack .vpane.lower.commarea.buttons -side left -fill y button .vpane.lower.commarea.buttons.rescan -text {Rescan} \ -command do_rescan \ -font $mainfont pack .vpane.lower.commarea.buttons.rescan -side top -fill x lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state} button .vpane.lower.commarea.buttons.amend -text {Amend Last} \ -command do_amend_last \ -font $mainfont pack .vpane.lower.commarea.buttons.amend -side top -fill x lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state} button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \ -command do_checkin_all \ -font $mainfont pack .vpane.lower.commarea.buttons.ciall -side top -fill x lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state} button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \ -command do_signoff \ -font $mainfont pack .vpane.lower.commarea.buttons.signoff -side top -fill x button .vpane.lower.commarea.buttons.commit -text {Commit} \ -command do_commit \ -font $mainfont pack .vpane.lower.commarea.buttons.commit -side top -fill x lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state} # -- Commit Message Buffer frame .vpane.lower.commarea.buffer set ui_comm .vpane.lower.commarea.buffer.t set ui_coml .vpane.lower.commarea.buffer.l label $ui_coml -text {Commit Message:} \ -anchor w \ -justify left \ -font $mainfont trace add variable commit_type write {uplevel #0 { switch -glob $commit_type \ initial {$ui_coml conf -text {Initial Commit Message:}} \ amend {$ui_coml conf -text {Amended Commit Message:}} \ merge {$ui_coml conf -text {Merge Commit Message:}} \ * {$ui_coml conf -text {Commit Message:}} }} text $ui_comm -background white -borderwidth 1 \ -relief sunken \ -width 75 -height 9 -wrap none \ -font $difffont \ -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \ -cursor $maincursor scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview] pack $ui_coml -side top -fill x pack .vpane.lower.commarea.buffer.sby -side right -fill y pack $ui_comm -side left -fill y pack .vpane.lower.commarea.buffer -side left -fill y # -- Diff Header set ui_fname_value {} set ui_fstatus_value {} frame .vpane.lower.diff.header -background orange label .vpane.lower.diff.header.l1 -text {File:} \ -background orange \ -font $mainfont label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \ -background orange \ -anchor w \ -justify left \ -font $mainfont label .vpane.lower.diff.header.l3 -text {Status:} \ -background orange \ -font $mainfont label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \ -background orange \ -width $max_status_desc \ -anchor w \ -justify left \ -font $mainfont pack .vpane.lower.diff.header.l1 -side left pack .vpane.lower.diff.header.l2 -side left -fill x pack .vpane.lower.diff.header.l4 -side right pack .vpane.lower.diff.header.l3 -side right # -- Diff Body frame .vpane.lower.diff.body set ui_diff .vpane.lower.diff.body.t text $ui_diff -background white -borderwidth 0 \ -width 80 -height 15 -wrap none \ -font $difffont \ -xscrollcommand {.vpane.lower.diff.body.sbx set} \ -yscrollcommand {.vpane.lower.diff.body.sby set} \ -cursor $maincursor \ -state disabled scrollbar .vpane.lower.diff.body.sbx -orient horizontal \ -command [list $ui_diff xview] scrollbar .vpane.lower.diff.body.sby -orient vertical \ -command [list $ui_diff yview] pack .vpane.lower.diff.body.sbx -side bottom -fill x pack .vpane.lower.diff.body.sby -side right -fill y pack $ui_diff -side left -fill both -expand 1 pack .vpane.lower.diff.header -side top -fill x pack .vpane.lower.diff.body -side bottom -fill both -expand 1 $ui_diff tag conf dm -foreground red $ui_diff tag conf dp -foreground blue $ui_diff tag conf da -font [concat $difffont bold] $ui_diff tag conf di -foreground "#00a000" $ui_diff tag conf dni -foreground "#a000a0" $ui_diff tag conf bold -font [concat $difffont bold] # -- Status Bar set ui_status_value {Initializing...} label .status -textvariable ui_status_value \ -anchor w \ -justify left \ -borderwidth 1 \ -relief sunken \ -font $mainfont pack .status -anchor w -side bottom -fill x # -- Key Bindings bind $ui_comm <$M1B-Key-Return> {do_commit;break} bind . do_quit bind all do_rescan bind all <$M1B-Key-r> do_rescan bind all <$M1B-Key-R> do_rescan bind . <$M1B-Key-s> do_signoff bind . <$M1B-Key-S> do_signoff bind . <$M1B-Key-u> do_checkin_all bind . <$M1B-Key-U> do_checkin_all bind . <$M1B-Key-Return> do_commit bind all <$M1B-Key-q> do_quit bind all <$M1B-Key-Q> do_quit bind all <$M1B-Key-w> {destroy [winfo toplevel %W]} bind all <$M1B-Key-W> {destroy [winfo toplevel %W]} foreach i [list $ui_index $ui_other] { bind $i {click %W %x %y 1 %X %Y; break} bind $i {click %W %x %y 3 %X %Y; break} bind $i {unclick %W %x %y; break} } unset i M1B M1T ###################################################################### ## ## main set appname [lindex [file split $argv0] end] set gitdir {} if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} { show_msg {} . "Cannot find the git directory: $err" exit 1 } if {$cdup != ""} { cd $cdup } unset cdup if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} { show_msg {} . "Cannot find the git directory: $err" exit 1 } if {$appname == {git-citool}} { set single_commit 1 } wm title . "$appname ([file normalize [file dirname $gitdir]])" focus -force $ui_comm load_repo_config load_all_remotes populate_remote_menu .mbar.fetch From fetch_from populate_remote_menu .mbar.push To push_to populate_pull_menu .mbar.pull update_status