git-most

#!/usr/bin/tclsh

if { $argv == "--help" } {
	puts "Usage: [file tail $argv0] ?-l|-g|-a? ?-h? ?-o...? ?directory?"
	puts "Options:"
	puts "\t-l  - Use local path, relative to current dir (default)"
	puts "\t-g  - Use global path (absolute)"
	puts "\t-a  - Display path with \$(git top) in front then relative to repo"
	puts "\t-h  - Explain wordly the state of given file after the path"
	puts "\t-o  - Display only files of specified state; syntax:"
	puts "\t... -o?s|v?\[m|a|d|o|u|g|i\] (multiple allowed) where:"
	puts "\t... s or v limits to stage or view only respectively"
	puts "\t... m: modified files"
	puts "\t... a: added files (stage only)"
	puts "\t... d: deleted files (stage only)"
	puts "\t... o/u: view private files (view only)"
	puts "\t... g: unmerged files"
	puts "\t... i: ignored files (.gitignore etc.)"
	puts "\tdirectory: limit display to files contained there only"
	puts "\nExample: git-most -g -ovim"
	puts "Displays files modified in view and ignored with absolute path"

	exit 1
}

set screwpath 1
if { "-l" in $argv } {
	set screwpath 1
} elseif { "-g" in $argv } {
	set screwpath -1
} elseif { "-a" in $argv } {
	set screwpath 0
}

set explain 0
if { "-h" in $argv } {
	set explain 1
}

set git_options "--porcelain"

set only ""
set onlyin ""

set onlyopt [lsearch -inline $argv -o*]
if { $onlyopt != "" } {
	set oo [string range $onlyopt 2 end]
	while 1 {
		switch -- [string index $oo 0] {
			m { set only mod }
			a { set only add }
			d { set only del }
			o { set only prv }
			u { set only prv }
			g { set only umg }
			i { set only ign }
			s { set onlyin stage; set oo [string range $oo 1 end]; continue }
			v { set onlyin view; set oo [string range $oo 1 end]; continue }
			default {
				puts stderr "Incorrect -o (only) option: use one of: m, a, d, o, u, g, i, s, v"
				exit 1
			}
		}
		break
	}
}

set want_ignored no
set want_other yes

# Show untacked (also if untracked-only)
if { "-u" ni $argv && $only != "prv" } {
	set want_other no 
}

if {"-i" in $argv || $only == "ign"} {
	set want_ignored yes
}

# You can't display ignored files, but without other files.
if {!$want_other && !$want_ignored} {
	lappend git_options -uno
}

if {$want_ignored} {
	lappend git_options --ignored
}

set args ""
foreach a $argv {
	if { [string index $a 0] != "-" } {
		lappend args $a
	}
}

set top [exec git rev-parse --show-toplevel]

proc gethash_full ref {
	return [exec git log -1 $ref --format=%H --]
}

proc distance_to_remote {} {

	# This is not supported up to git 1.7.1, just blindly try.
	if { [catch {exec git status --short --branch} outlines] } {
		return " (distance not supported)"
	}

	set line1 [lindex [split $outlines \n] 0]
	#puts stderr "*** STATUSINFO: $line1"

	set distoriginfo ""
	set branchrange .WTF???
	catch {set distoriginfo [lassign $line1 hashhash branchrange]}
	# This stupid git must use [] dunno what for.
	set p [string first "\[" $line1]
	if { $p == -1 } {
		set distinfo [join $distoriginfo " "]
	} else {
		# Strip [...]
		set distinfo [string range $line1 $p+1 end-1]
	}

	set ahead ""
	set behind ""
	# Both can be found, unfortunately
	if { [string first , $distinfo] != -1 } {
		set parts [split $distinfo ,]
		set one [string trim [lindex $parts 0]]
		set two [string trim [lindex $parts 1]]
		foreach {dir val} [concat $one $two] {
			if { $dir ni {ahead behind} } {
				puts stderr "INVALID DIST INFO: $distinfo"
				break
			}
			set $dir $val
		}
    } elseif { $distinfo == "gone" } {
		set ahead gone
		set behind gone
	} elseif { $distinfo != "" } {
		# we have "ahead/behind" val
		set dir [lindex $distinfo 0]
		if { $dir ni {ahead behind} } {
			puts stderr "WEIRD DIST INFO: $distinfo"
		}
		set $dir [lindex $distinfo 1]
	}
	# Otherwise just leave ahead and behind empty

	#puts stderr "*** DIST INFO: '$distinfo'"
	# No, this must be exactly "..."
	set sep ...
	set pos [string first $sep $branchrange]
	if { $pos == -1 } {
		# In earlier version of git (likely < 2.0), git status --short --branch
		# doesn't show the remote branch. We need to extract this information differently.
		set remotebranch REMOTE/$branchrange ;# fallback
		set brinfo [exec git branch -vv]
		if { [string range $brinfo 0 1] == "* " } {
			set brinfo [lindex $brinfo 3]  ;# [REMOTE/BRANCH]
			if { [string index $brinfo 0] == "\[" } {
				set brinfo [string range $brinfo 1 end-1]
			}
			set remotebranch $brinfo
		}
	} else {
		set remotebranch [string range $branchrange [expr {$pos+[string length $sep]}] end]
	}
	#puts stderr "*** REMOTE BRANCH: $remotebranch"

	if { $distinfo == "" } {
		set distance "(= $remotebranch)"
    } elseif { $distinfo == "gone" } {
		set distance "(NOT IN REMOTE)"
	} else {
		set distance ""
		if { $behind != "" } {
			append distance " - $behind"
		}
		if { $ahead != "" } {
			append distance " + $ahead"
		}

		set direction ?
		switch -- [lindex $distinfo 0] {
			ahead {
				set direction +
			}

			behind {
				set direction -
			}
		}
		set distance "($remotebranch $distance)"
	}
}

set gitdir $top/.git

if { [file isfile $gitdir] } {
	set gitdirspec [exec cat $gitdir]
	set gitdir [file join $top [lindex $gitdirspec 1]]
}

if { $only == "" } {

lassign [exec cat $gitdir/HEAD] hdx path
if { $hdx == "ref:" } {
	set parts [file split $path]
	# Skip refs/heads or whatever...
	set brname [file join {*}[lrange $parts 2 end]]

	# Find the branch in the configuration
	if { [catch {set reponame [exec git config branch.$brname.remote]}] } {
		set reponame ""
	}

	if { ![catch {set hh [exec git show --format=format:%H HEAD]}] } {
		set hh [lindex [split $hh \n] 0]
		set hhs [string range $hh 0 7]
	} else {
		set hh ""
		set hhs "NONE (nothing checked in yet)"  ;# The initial case when HEAD does not exist
	}
	set hdx $hh
	set hosted ""
	set distance " (LOCAL)"

	# Display HOSTED and distance, if there is branch.<br>.remote.
	if { $reponame != "" } { 
		set repourl [exec git config remote.$reponame.url]
		set hosted "$reponame ($repourl)"
		set distance [distance_to_remote]
	}

	set branch "BRANCH: $brname $distance    OBJECT: $hhs"
	if { $hosted != "" } {
		set hosted "HOSTED: $hosted"
		puts stderr "=$hosted"
	}
	puts stderr "=$branch"
} else {
	# In order to display a remote, here you have to select one
	# that seems best, as with detached head it is not assigned to
	# any.
	#
	# Unfortunately git doesn't have a mechanism to list subkeys. Good old grep can be of help.

	set remotes [split [exec git config -l | grep ^remote\\.] \n]

	# The procedure is: find any remote. If there is a remote
	# named "origin", used it. Otherwise use the first found.
	# Therefore notify the first one and the one with name origin.

	set retr_origin ""
	set retr_first_url ""

	# Here we iterate over all config entries, but we are only
	# interested with remote.X.url.
	foreach r $remotes {
		 if { [regexp {^remote.([^\.]+).url=(.*)} $r unu name url] } {
			 if {$retr_first_url == ""} {
				 set retr_first_url [list $name $url]
			 }

			 if {$name == "origin"} {
				 set retr_origin $url
			 }
		 }
	}

	if {$retr_origin != ""} {
		set hosted "HOSTED: origin ($retr_origin) \[found origin\]"
	} elseif {$retr_first_url != ""} {
		set hosted "HOSTED: [lindex $retr_first_url 0] ([lindex $retr_first_url 1]) \[first found\]"
	} else {
		set hosted "HOSTED: locally"
	}

	puts stderr "=$hosted"

	set branch "DETACHED: $hdx"
	puts stderr "=$branch"
}

if { $hdx != "" } {
	set seen_labs [exec git tag -l --contains $hdx]

	# Git seems to have a bug that reports some labels that are not attached to that commit.
	# For every label, check if the target of this label is this commit.
	set labs ""

	foreach l $seen_labs {
		set h [gethash_full $l]
		if { $h == $hdx } {
			lappend labs $l
		} else {
			#puts stderr "=FALSE LABEL: '$l' really assigned to $h (not $hdx)"
		}
	}

	if { $labs != "" } {
		puts stderr "=LABELS: $labs"
	}
}

}


puts -nonewline stderr "Reading:..."
set porc [exec git status {*}$git_options {*}$args]
puts -nonewline stderr "\r                    \r"

proc localize {cwd path} {

	if { [file pathtype $path] == "relative" } {
		return $path
	}

	set localcomp [file split $cwd]
	set path [file normalize $path] ;# for any case, skip any weird things
	# Check for simple strip

	if { [string first $cwd/ $path] == 0 } {
		return [string range $path [string length $cwd]+1 end]
	}

	set pathcomp [file split $path]

	# Find split point
	set len [llength $localcomp]
	for {set i 0} {$i < $len} {incr i} {
		if { [lindex $localcomp $i] != [lindex $pathcomp $i] } {
			break
		}
	}

	#puts stderr "PWD: $localcomp"
	#puts stderr "PTH: $pathcomp"
	#puts stderr "Mismatch at \[$i\]"

	# Strip common prefix
	set furthercomp [lrange $localcomp $i end]
	set pathcomp [lrange $pathcomp $i end]

	set updir [lrepeat [llength $furthercomp] ..]
	set comp [concat $updir $pathcomp]

	return [file join {*}$comp]
}

if { $only == "" } {
	puts stderr "=Stg View Path"
}

set sigmap {
	M mod
	A add
	R ren
	C cpy
	U umg
	D del
	T typ
	? prv
	! ign
	" " ---
}

set helpmap {
	mod "Modified in "
	add "Added to "
	ren "Renamed in "
	cpy "Copied in "
	umg "Updated, but not merged"
	del "Deleted in "
	typ "Changed type in "
	prv "Not under version control"
	ign "Found in ignore list"
}

array set sig $sigmap
array set hlp $helpmap

proc screw path {
	if { !$::screwpath } {
		return "\"\$(git-top)/$path\""
	} elseif { 1+$::screwpath } {  ;# local
		return [localize [pwd] [file join $::top $path]]
	} else { ;# global
		return [file join $::top $path]
	}
}

proc get_help {type container} {
	global hlp
	if { [info exists hlp($type)] } {
		set h $hlp($type)
		if { [string index $h end] == " " } {
			return "$h$container"
		}
		return $h
	}
}

foreach ln [split $porc \n] {
	set istage [string index $ln 0]
	set iview [string index $ln 1]
	set path [string range $ln 3 end] ;# [2] is space

	#puts "D stage='$istage' view='$iview' path=$path"

	if { [llength $path] == 3 && [lindex $path 1] == "->" } {
		set tar [lindex $path 2]
		set path [lindex $path 0]
		set pathline "[screw $path] -> [screw $tar]"
	} else {
		set pathline [screw $path]
	}

	set sig_view "??$iview"
	set sig_stage "??$istage"
	if { [info exists sig($iview)] } {
		set sig_view $sig($iview)
	}
	if { [info exists sig($istage)] } {
		set sig_stage $sig($istage)
	}
	set help_ext ""
	if { $explain } {
		set help_view [get_help $sig_view view]
		set help_stage [get_help $sig_stage stage]
		if {$help_view != "" || $help_stage != ""} {
			set help_ext "($help_view"
			if {$help_ext != "(" && $help_stage != ""} {
				append help_ext ", "
			}
			append help_ext $help_stage)
		}
	}

	if { $onlyin == "view" } {
		set onlywanted { $sig_view == $only }
	} elseif { $onlyin == "stage" } {
		set onlywanted { $sig_stage == $only }
	} else {
		set onlywanted { $sig_view == $only || $sig_stage == $only } 
	}

	# There's a special situation about the other files that
	# must be displayed together with ignored files. Therefore
	# if others are not wanted and this is one, do not display it.
	if {!$want_other && $iview == "?"} {
		continue
	}

	if { $only == "" } {
		puts " $sig_stage $sig_view $pathline $help_ext"
	} elseif $onlywanted {
		puts $pathline
	}
}