#!/usr/bin/wish -f

# rcsview version 1.4
# written by Andrew Myers (andru@lcs.mit.edu)

set usage "Usage: rcsview \[-a\] \[-v <max versions> \] <RCSfile> \[version\]"

set scp "/usr/bin/scp"

if {$argc == 0} {
    puts stderr $usage
    exit 1
}

if {[lindex $argv 0] == "-a"} {
    set argv [lrange $argv 1 end]
    set argc [expr $argc - 1]
    set authormode 1
    set authors {}
} else {
    set authormode 0
}

set maxvers 25

if {[lindex $argv 0] == "-v"} {
    set maxvers [lindex $argv 1]
    if {! [regexp {^[0-9]*$} $maxvers]} {
	puts stderr $usage
	exit 1
    }
    set argv [lrange $argv 2 end]
    set argc [expr $argc - 2]
}

if {$argc != 1 && $argc != 2} {
    puts stderr $usage
    exit 1
}

puts stderr "Displaying at most $maxvers versions"

set fname [lindex $argv 0]
wm minsize . 500 300

set controls .controls
set panel .top.panel
set buttons .buttons
set texth $panel.text
set scroll $panel.scroll
set row 0
set buttoncount 0
set rowsize 12

frame .top
frame $panel
frame $buttons -bd 2
frame $buttons.$row -bd 2

text $texth -yscrollcommand "$scroll set"
scrollbar $scroll -relief flat -command "$texth yview"
pack $texth -side left -fill both -expand yes
pack $scroll -side right -fill y
pack $buttons -side bottom -fill x -expand no

proc createrow {} {
    global row buttoncount buttons
    set row [expr $row + 1]
    set buttoncount 0
    frame $buttons.$row
    pack $buttons.$row -side bottom -fill x -expand no
}

createrow

proc buttonentry {path texth length} {
    frame $path
    button $path.button -text $texth
    entry $path.entry -width $length -relief sunken
    pack $path.button -side left -padx 2
    pack $path.entry -side right -padx 2
}
frame $controls -bd 2 -relief raised
buttonentry $controls.search "Search" 40
buttonentry $controls.goto "Goto line" 5
button $controls.next -text "Forward"
$controls.goto.button configure -command { gotoline }
bind $controls.goto.entry <KeyPress-Return> { gotoline }
$controls.search.button configure -command { dosearch }
bind $controls.search.entry <KeyPress-Return> { dosearch }
$controls.next configure -command skip

pack $controls.search -side left -padx 2 -pady 2
pack $controls.goto -side left -padx 2 -pady 2
pack $controls.next -side left -padx 2 -pady 2
pack $controls -side top -before $texth -fill x -pady 2
pack $panel -side left -fill both -expand yes
pack .top -fill both -expand yes

proc text_insert {texth tags str} {
    # Record starting index
    set start [$texth index insert]

    # Insert
    $texth insert insert $str

    # Remove existing tags
    foreach t [$texth tag names $start] {
        $texth tag remove $t $start insert
    }

    # Add new tags
    foreach t $tags {
        $texth tag add $t $start insert
    }
}

proc errmsg {msg} {
    if {! [winfo exists .errmsg]} {
	toplevel .errmsg
	wm title .errmsg "rcsview error message"
	wm minsize .errmsg 300 200
	label .errmsg.label -font "*helvetica*--*-180*" -foreground red
	pack .errmsg.label -fill x -fill y -padx 10 -pady 10
    }
    .errmsg.label configure -text "$msg"
}

set selstart 0.0
set selend 0.0
$texth tag configure selection \
      -foreground red -font "*courier-bold-r-normal--18-*"
$texth tag raise selection

proc moveselection {t index1 index2} {
    global selstart selend
    $t tag remove selection $selstart $selend
    set selstart [$t index $index1]
    set selend [$t index $index2]
    $t tag add selection $selstart $selend
}

set lastsearch {}

proc dosearch {} {
    global texth controls lastsearch
    set height [winfo reqheight $texth]
    set end [$texth index end]
    set str [$controls.search.entry get]
    if {"$str" == "$lastsearch"} {
	set pos [$texth index insert]
    } else {
	set pos [$texth index @0,0]
    }
    set lastsearch $str
    set stuff [$texth get $pos $end]
    set offset [string first $str $stuff]
    if {$offset == -1} {
	set pos 0.0
	set offset [string first $str [$texth get $pos $end]]
	if {$offset == -1} {
	    errmsg "Can't find string \"$str\""
	    return
	}
    }
    $texth mark set insert "$pos + $offset chars"
    set len [string length "$str"]
    moveselection $texth insert "insert + $len chars"
    $texth mark set insert "insert + $len chars"
    $texth see insert
}

proc gotoline {} {
    global texth controls
    if [catch {$texth mark set insert [$controls.goto.entry get].0}] {
	errmsg "Not a valid line number"
	return
    }
    $texth see insert
    moveselection $texth insert "insert + 1 lines"
}

proc skip {} {
    global texth
    set height [winfo reqheight $texth]
    $texth mark set insert "@0,$height"
    set ctags [$texth tag names insert]
    set octags $ctags
    while {"$ctags" != {} && "$ctags" == "$octags"} {
	$texth mark set insert "insert + 1 lines"
	set octags [$texth tag names insert]
    }
    $texth see insert
}
   
proc peek-line {} {
    global flines i nlines
    return [lindex $flines $i]
}

proc get_line {} {
    global peek-line i
    set x [peek-line]
    set i [expr $i + 1]
    return $x
}

proc try_open {fname} {
    global fd fdata flines nlines i head
    if [catch { set fd [open $fname r]}] { return 0 }

    set fdata [read $fd]

    set flines [split $fdata "\n"]
    set nlines [llength $flines]

    set i 0
    set line [get_line]
    if {[regsub "^head\[ \t]*" $line {} tmp]} {
	set head [lindex [split $tmp "\t; "] 0]
	return 1
    } else {
	close $fd
	return 0
    }
}

if {[try_open $fname]} {
   set rcsname $fname
} elseif [try_open "$fname,v"] {
   set rcsname "$fname,v"
} else {
    if ![regexp {/} $fname] {
	set dirname "."
	set basename $fname
    } else {
	regsub {/+[^/]*$} $fname "" dirname
	set basename [string range $fname [string length $dirname] end]
    }
    set rcsname "$dirname/RCS/$basename,v"
    if [try_open $rcsname] {
    } else {
	set rootf [file join "$dirname" "CVS" "Root"]
	if [file readable "$rootf"] {
	    set rootfd [open "$rootf" r]
	    set root [string trim [read $rootfd]]
	    regsub {^:ext:} "$root" "" root
	    puts stderr "Root is $root"
	} else {
	    set root ""
	}
	set rep [file join "$dirname" CVS Repository]
	if [file readable $rep] {
		set repfd [open $rep r]
		set repository [string trim [read $repfd]]
		set rcsname [file join "$root" "$repository" "$basename,v"]
		if {[regexp {^([a-zA-Z0-9]+\.)*[a-zA-Z0-9]+:} "$rcsname"]} {
		    puts stderr "looks like we need to use scp"
		    set tempfile "rcsview.tmp.[pid]"
		    puts stderr "copying RCS file $rcsname to $tempfile"
		    set result [exec $scp "-q" "$rcsname" "$tempfile"]
		    puts stderr "Result: $result"
		    set rcsname "$tempfile"
		}
		if ![try_open $rcsname] {
		  puts stderr "$rcsname is not a valid RCS file"
		  exit 1
		}
	} else {
	    puts stderr "Can't find RCS file for $fname."
	    exit 1
	}
    }
}

puts stderr "Reading RCS file $rcsname"

proc eof {} {
    global i nlines
    if {$i > $nlines} {return 1} else {return 0}
}

# Read the header
while {1} {
    set line [get_line]
    if {$line == ""} { break; }
}

proc scan_to_next {} {
    while {1} {
	set line [get_line]
	if {[regexp "^next\[ \t]" $line]} {
	    return "$line"
	}
    }
}

# puts stderr "Read header"

set prev($head) "none"

# prev actually refers to what would ordinarily be considered the
# next version, and next to prev. The names come from the format of
# the RCS file, in which they are reversed.

set months {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}

set versions {}

set verscount 0
while {1} {
    global next prev date author versions
    set line [get_line]
    if [regexp {^[0-9]+\.[0-9]} $line] {
	set version $line
#           puts stdout $version
	set verscount [expr $verscount + 1]
	if {$verscount > [expr $maxvers]} {
#	    puts stderr "Ignoring version $version"
	    scan_to_next
	} else {
	    set versions "$versions $version"
	    set dateetc [split [get_line] ";"]
	    regsub "^date\[ \t]*" [lindex $dateetc 0] {} datel
	    set datel [split $datel "."]
	    regsub "^0*" [lindex $datel 1] {} month;
	    set month [lindex $months [expr int($month) - 1]]
	    set date($version) "[lindex $datel 2] $month [lindex $datel 0]"
	    regsub "^\[ \t]*author\[ \t]*" [lindex $dateetc 1] {} tmp
	    set author($version) $tmp
	    if {$authormode} {
		if {[lsearch $authors $author($version)] == -1} {
		    lappend authors $author($version)
		}
	    }

	    set next_line [scan_to_next]
	    if {$verscount == $maxvers} {
		set next($version) {}
	    } else {
		regsub "^next\[ \t]*" $next_line {} vers
		set vers [lindex [split $vers " \t;"] 0]
		set next($version) $vers
		if {$vers != {}} {
		    set prev($vers) $version
		}
	    }
	}
    } elseif {$line == "desc"} {
	break
    }
}

proc last_line {line} {
    set n [expr [string length $line] - 1]
    if {$line == "@"} {
	return 1
    }
    switch -regexp -- [string range $line $n end] {
	{@} {
	    set n [expr $n - 1]
	    if [last_line [string range $line 0 $n]] {
		return 0
	    } else {
		return 1
	    }
	}
	{.} {
	    return 0
	}
    }
    return 0
}

if ![last_line "@hi@"] {
    error "last_line is busted"
}

if ![last_line "#endif@"] {
    error "last_line is busted"
}

proc fixup_line {line} {
    regsub -all "@@" $line "@" result
    return $result
}

proc skip_section {line} {
    if {[last_line $line]} return
    while {1} {
	set line [get_line]
	if [last_line $line] return
    }
}

proc skip_log {} {
    set ret ""
    set line [get_line]
    if {[string range $line 0 0] != "@"} {
	error "ERROR: log does not begin with @"
    }
    set line [string range $line 1 [expr [string length $line] - 1]]
    while 1 {
	set fl [fixup_line $line]
	if {$fl != "@"} { set ret "$ret[fixup_line $line]\n" }
	if [last_line $line] { return $ret }
	set line [get_line]
    }
}


skip_log

proc find_version_number {} {
    global i
    while {![eof] && [get_line] == ""} {}
    set i [expr $i - 1]
    set version [get_line]
    return $version
}

proc set_source {version linenum src} {
    global source prev backmap
    set source($version,$linenum) $src
    #puts stdout "Source of $version:$linenum is $src"
    set prev_version $prev($version)
    set prevnum $backmap($version,$linenum)
    if {$prevnum != 0} {
	set_source $prev_version $prevnum $src
    }
}

# backmap(version,line): maps a line to the same line in the previous version,
#		else to 0 if none.
# linetext(version,line): the text of the line
# source(version,line): the version that originated this line
# lines(version): number of lines in the version

set version $head
set verscount 0

while ![eof] {
    global backmap linetext
    set {new-version} [find_version_number]
    if [eof] {break}
    set version ${new-version}

    set verscount [expr $verscount + 1]
    if {$verscount > $maxvers} {break}
    
#   puts stderr "Reading version $version"
    set dummy [get_line]
    if {$dummy != "log"} {
	 puts stderr $dummy
	 error "ERROR: Log line not found in version $version"
    }
    set logs($version) [skip_log]

    if {[get_line] != "text"} {
	error "ERROR: expected 'text'"
    }
    set line [get_line]
    if ![regexp {^@} $line] {
	error "ERROR: First line of version text does not start with @"
    } else {
	set line [string range $line 1 end]
    }
    if {"X$version" == "X$head"} {
	set linenum 1
	while 1 {
	    #puts stdout $line
	    if [last_line $line] break
	    set line [fixup_line $line]
	    set linetext($version,$linenum) $line
	    set source($version,$linenum) {?}
	    set backmap($version,$linenum) 0
	    set line [get_line]
	    set linenum [expr int($linenum + 1)]
	}
	set lines($version) [expr $linenum - 1]
	#puts stdout "$version: $lines($version) lines"
    } elseif {[regexp {[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*} $version]} {
	puts "Sorry, ignoring branch version $version"
# skip text
	skip_section "$line"
	set verscount [expr $verscount - 1]
    } else {
	set prevnum 1
	set linenum 1
	set sawlast 0
	set prev_version $prev($version)
	while 1 {
	    if [last_line $line] { set sawlast 1 }
	    if $sawlast break
	    set line [fixup_line $line]
	    set cmd [string range $line 0 0]
	    case $cmd in {
		{a} {
		    set range [split [string range $line 1 end] " "]
		    set first [lindex $range 0]
		    set num [lindex $range 1]
	     for {} \
	     {$prevnum <= $first} \
	     {set prevnum [expr $prevnum + 1]
	      set linenum [expr $linenum + 1]} \
	     {if {$prev_version != "none"} {
		     set linetext($version,$linenum) \
			 $linetext($prev_version,$prevnum)
		 } else {
		     set linetext($version,$linenum) {}
		 }
	      set backmap($version,$linenum) $prevnum
# 		    puts stdout "Copying line $prevnum to line $linenum"}
		    set last [expr $linenum + $num]
# Now, add the new lines
		    while {$linenum < $last} {
			set line [get_line]
#			puts stderr $line
			set linetext($version,$linenum) [fixup_line $line]
			set backmap($version,$linenum) 0
#			puts stdout "Adding line $linenum"
			set linenum [expr $linenum + 1]
			if [last_line $line] {
			    puts stderr "Warning: line without newline?"
			    set sawlast 1
			    break
			}
		    }
		}

		{d} {
			set range [split [string range $line 1 end] " "]
			set first [lindex $range 0]
			set num [lindex $range 1]
	          for {} \
	          {$prevnum < $first} \
		  {set prevnum [expr $prevnum + 1]
		   set linenum [expr $linenum + 1]} \
		  {if {$prev_version != "none"} {
		       set linetext($version,$linenum) \
		           $linetext($prev_version,$prevnum)
		   } else {
		       set linetext($version,$linenum) {}
		   }
		   set backmap($version,$linenum) $prevnum
		   # puts stdout "Copying line $prevnum to line $linenum"
		  }
		
#delete the old lines and set their source to the previous version
	# puts stdout "Deleting lines $first through [expr $first + $num - 1]"
		  while {$prevnum < $first + $num} {
		     if {$prev_version != "none"} {
			 set_source $prev_version $prevnum $prev_version
		     }
		     set prevnum [expr $prevnum + 1]
		  }
		}
	    }
	    set line [get_line]
	}
	for {} \
	    {$prev_version != "none" && $prevnum <= $lines($prev_version)} \
	    {set prevnum [expr $prevnum + 1]
	     set linenum [expr $linenum + 1] } \
	    {set linetext($version,$linenum) \
		  $linetext($prev_version,$prevnum)
	      set backmap($version,$linenum) $prevnum
	      # puts stdout "Copying line $prevnum to line $linenum"}
	set lines($version) [expr $linenum - 1]
	#puts stdout "$version: $lines($version) lines"
    }
}

if { $argc == 1 } {
    set current $head
} else {
    set current [lindex $argv 1]
}

# puts stderr "Done reading."

proc nodots {version} {
    regsub -all {\.} $version {-} name
    return $name
}

# frame .outer -height 30
# pack append . .outer {bottom}

set acolors {
    {2 0 0}
    {0 2 0}
    {0 0 2}
    {2 2 0}
    {2 0 2}
    {0 2 2}
    {2 1 0}
    {0 2 1}
    {1 0 2}
    {1 2 0}
    {0 1 2}
    {2 0 1}
}

set mcolors {d0 e8 ff}
set amcolors {80 b0 e0}

set cindex 0

set bnames(0) "foo"

proc assign-button-version {version} {
    global row bnames
    set bnames($version) ".buttons.$row.button-[nodots $version]"
    return [version-to-button $version]
}

proc version-to-button {version} {
    global bnames
    return $bnames($version)
}

toplevel .legend
wm title .legend "$fname legend"

set currentv $current

foreach version $versions {
    global row buttoncount rowsize
    set nv [nodots $version]
    set button [assign-button-version $version]
    if {$authormode} {
	set cindex [expr [lsearch $authors $author($version)]%\
			 [llength $acolors]]
    }
    set acolor [lindex $acolors $cindex]
    set r [lindex $acolor 0]
    set g [lindex $acolor 1]
    set b [lindex $acolor 2]
    set color "#[lindex $mcolors $r][lindex $mcolors $g][lindex $mcolors $b]"
    set satcolor \
	"#[lindex $amcolors $r][lindex $amcolors $g][lindex $amcolors $b]"
    set vcolor($version) $color
    radiobutton $button -text $version \
                    -background $color \
		    -activebackground $satcolor \
		    -variable currentv \
		    -value $version \
		    -borderwidth 1 \
		    -command "change-version $version"
    if {!$authormode} {
	set cindex [expr ($cindex + 1)%[llength $acolors]]	   
    }

    pack $button -side right -fill x
    set buttoncount [expr $buttoncount + 1]
    if {$buttoncount >= $rowsize} {
	createrow
    }
    $texth tag configure $nv -background $color
    $texth tag bind $nv <Enter> "highlight-version $version"
    $texth tag bind $nv <Leave> "dehighlight-version $version"
    $texth tag bind $nv <ButtonRelease-1> "change-version $version"

    label .legend.$nv -text "$version $author($version) $date($version)" \
	-background $color
    pack append .legend .legend.$nv {top fillx}
    bind .legend.$nv <ButtonRelease-1> "display-log $version"
}

proc display-log {version} {
    global logs fname
    set nv [nodots $version]
    toplevel .log-$nv
    wm title .log-$nv "log entry for $fname:$version"
    set texth ".log-$nv.text"
    text $texth 
    $texth insert insert $logs($version)
    pack append .log-$nv $texth {top fill}
}

set version $current

while {$next($version) != ""} { set version $next($version) }
set root $version

set linenum 1
while {$linenum <= $lines($root)} {
      set_source $root $linenum $root
      set linenum [expr $linenum + 1]
}

proc remap-line {line oldv newv} {
     global versions next prev backmap lines
     if {$oldv == $newv} { return $line}
     if {[lsearch $versions $oldv] > [lsearch $versions $newv]} {
	# moving to a later version
	while 1 {
	  if {$newv == $oldv} { return $line }
	  set newerv $prev($oldv)
	  while {$line <= $lines($oldv) && $backmap($oldv,$line) == 0} {
	     set line [expr $line + 1]
	  }
	  if {$line > $lines($oldv)} {
	      set line $lines($newerv)
	  } else {
	      set line $backmap($oldv,$line)
	  }
	  set oldv $newerv
	}
     } else {
	# moving to a earlier version
	while 1 {
	      if {$newv == $oldv} { return $line }
	      set olderv $next($oldv)
	      set prevnum 1
	      while {$prevnum < $lines($olderv)} {
		    if {$backmap($olderv,$prevnum) >= $line} break
		    set prevnum [expr $prevnum + 1]
	      }
	      set line $prevnum
	      set oldv $olderv
	}
     }
}

set pointing_to ""

proc change-version {version} {
    global texth current lines linetext source fname pointing_to currentv vcolor
    set linenum 1
    if {$pointing_to != ""} {
	set cpos [lindex [split [$texth index current] "."] 0]
    } else {
	set height [winfo reqheight $texth]
	set cpos [$texth index "@0,[expr $height / 2]"]
	set cpos [lindex [split $cpos "."] 0]
	if {$cpos < 1} {set cpos 1}
    }
    set newpos [remap-line $cpos $current $version]
    $texth tag configure [nodots $current] -background $vcolor($current)
    set current $version
    set currentv $current
    $texth tag configure [nodots $current] -background "#ffffff"
    $texth configure -state normal
    $texth delete 1.0 end
    while {$linenum <= $lines($version)} {
    set src $source($version,$linenum)
    text_insert $texth [nodots $src] "$linetext($version,$linenum)\n"
	set linenum [expr $linenum + 1]
    }
    $texth configure -state disabled
    $texth see "$newpos.0"
    wm title . "$fname:$version"
    set frame [version-to-button $version]
}

proc highlight-version {version} {
     global vcolor text pointing_to
     set pointing_to $version
    "[version-to-button $version]" configure -state active
}
proc dehighlight-version {version} {
     global vcolor pointing_to
     if {$pointing_to == $version} {
	 set pointing_to ""
     }
    "[version-to-button $version]" configure -state normal
}

change-version $current
