#
# TCL Library for tkCVS
#

#
# $Id: cvs.tcl,v 1.41 1996/05/25 02:54:58 del Exp $
# 
# Contains procedures used in interaction with CVS.
#

proc cvs_notincvs {} {
  cvserror "This directory is not in CVS.\nPlease import it first."
}

proc cvs_incvs {} {
  cvserror "You cant do that here because this directory is already in CVS."
}

proc cvs_remote_bad {} {
  cvserror "You cant do that with a remote CVS repository."
}

proc cvs_remove args {
#
# This deletes a file from the directory and the repository,
# asking for confirmation first.
#
  global cvs
  global incvs
  # need access to cvscfg(rm_cmd) and cvscfg(rm_flags) 
  # -sj
  global cvscfg

  if {$args == "{}"} {
    cvserror "Please select some files to delete first!"
    return
  }

  # modified to provide a more detailed warning  
  # and use the cvscfg(rm_cmd) and cvscfg(rm_flags) 
  # -sj
  set mess ""
  if {$incvs} {
    set mess "WARNING!!! This will modify"
    set mess "$mess the contents of the CVS"
    set mess "$mess repository!!!!"
  }
  set mess "$mess\n\nYou are about to remove these"
  set mess "$mess files:"
  if { [ are_you_sure $mess $args ] == 1 } {
    set results ""
    foreach file $args {
      eval exec $cvscfg(rm_cmd) $cvscfg(rm_flags) $file
      if {$incvs} {
        catch {eval "exec $cvs remove $file"} view_this
        if { $view_this != "" } {set results "$results\n$view_this" }
      }
    }
    view_output "CVS Delete" $results
    setup_dir
  }
}

proc cvs_add args {
#
# This adds a file to the repository.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "{}"} {
    set mess "This will add all new files!"
  } else {
    set mess "This will add these files:\n\n"
    foreach file $args {
      set mess "$mess   $file\n"
    }  
  }

  set mess "$mess\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    if {$args == "{}"} {
      foreach file [glob -nocomplain *] {
        catch {eval "exec $cvs add $file"} view_this
        # Probably don't need to see the output, but you can uncomment this
        # line if you like.
        # view_output "CVS Add" $view_this
      }
    } else {
      foreach file $args {
        catch {eval "exec $cvs add $file"} view_this
        # view_output "CVS Add" $view_this
      }
    }
  }
}

proc cvs_diff args {
#
# This diffs a file with the repository.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "{}"} {
    foreach file [glob -nocomplain *] {
      catch {eval "exec tkdiff -C $file &"} view_this
    }
  } else {
    foreach file $args {
      catch {eval "exec tkdiff -C $file &"} view_this
    }
  }
}

proc cvs_diff_r {rev1 rev2 args} {
#
# This diffs a file with the repository, using two revisions or tags.
#
  global cvs
  global incvs
 
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  if {$rev1 == {} || $rev2 == {}} {
    cvserror "Must have two revision numbers for this function!"
    return 1
  }
 
  if {$args == "{}"} {
    foreach file [glob -nocomplain *] {
      catch {eval "exec tkdiff -C $rev1 -C $rev2 $file &"} view_this
    }
  } else {
    foreach file $args {
      catch {eval "exec tkdiff -C $rev1 -C $rev2 $file &"} view_this
    }
  }
}

proc cvs_view_r {rev args} {
#
# This views a specific revision of a file in the repository.
#
  global cvs
  global incvs
 
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
 
  if {$args == "{}"} {
    foreach file [glob -nocomplain *] {
      catch {eval "exec $cvs update -p -r $rev $file 2>/dev/null"} view_this
      view_output "CVS View" $view_this
    }
  } else {
    foreach file $args {
      catch {eval "exec $cvs update -p -r $rev $file 2>/dev/null"} view_this
      view_output "CVS View" $view_this
    }
  }
}

proc cvs_logcanvas args {
#
# This looks at a log from the repository.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "{}"} {
    set filelist "."
  } else {
    set filelist $args
  }
  foreach file $filelist {
    catch {eval "exec $cvs log $file"} view_this
    # New style file log viewer
    new_logcanvas $file $view_this
  }
}

proc cvs_log args {
#
# This looks at a log from the repository.
# This is an old style file log with just the output from cvs log.
#
  global cvs
  global incvs
  # need access to cvscfg (ldetail)
  # -sj
  global cvscfg

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "{}"} {
    set filelist "."
  } else {
    set filelist $args
  }
  # modified to allow for varying level of detail
  # -sj
  if {$cvscfg(cvsver) < 1.3} {
    set cvscfg(ldetail) "verbose"
  }

  if { $cvscfg(ldetail) == "verbose" } {
    set commandline "exec $cvs log $filelist"
  } elseif { $cvscfg(ldetail) == "last" || $cvscfg(ldetail) == "summary"} {
    set commandline "exec cvs -l -n log -l $filelist "
    set commandline "$commandline | awk { BEGIN {LM=-1000}\n"
    set commandline "$commandline \$0 ~ /----------------------------/"
    set commandline "$commandline {LM=0; printf(\"\\n--------------------\\n\");}"
    set commandline "$commandline \$0 ~ /\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\="
    set commandline "$commandline\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=/ "
    set commandline "$commandline {LM=0; printf(\"\\n\");}"
    set commandline "$commandline {if (LM \=\= 1) printf(\"%s \", \$0);"
    set commandline "$commandline if (LM \>\= 3) printf(\"%s \", \$0);"
    set commandline "$commandline LM\+\+;}} "
    set commandline "$commandline | tail \+2"
    if {$cvscfg(ldetail) == "last" } {
      set commandline "$commandline | head \-2 "
    }
  }

  # puts stderr "command line is $commandline"
  catch { eval $commandline } view_this
  view_output "CVS Log" $view_this
}

proc cvs_commit {revision comment args} {
#
# This commits changes to the repository.
#
# The parameters work differently here -- args is a list.  The first
# element of args is a list of file names.  This is because I can't
# use eval on the parameters, because comment contains spaces.
#
  global cvs
  global cvscfg
  global incvs
  global filelist

  # puts stderr "Revision = $revision"
  # puts stderr "Comment  = $comment"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$comment == ""} {
    cvserror "You must enter a comment!"
    return 1
  }

  if {$args == "{}"} {
    set filelist "."
    if {$cvscfg(cvsver) < 1.3} {
      # cosmetic cleanup
      # -sj
      set errstr "You must select files to be committed with CVS version"
      set errstr "$errstr $cvscfg(cvsver)."
      set errstr "$errstr\n\nEither select a list of files or upgrade"
      set errstr "$errstr your CVS to version 1.3"
      cvserror "$errstr"
      return
    }
  } else {
    set filelist [lindex $args 0]
  }

  # changed the message to be a little more explicit.
  # -sj
  set commit_output ""
  if { $filelist == "." } {
      set mess "This will commit your changes to ** ALL ** files in"
      set mess "$mess and under this directory.\n\nAre you sure?"
  } else {
      foreach file $filelist {
	  set commit_output "$commit_output\n$file"
      }
      set mess "This will commit your changes to:$commit_output\n\nAre you sure?"
  }
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  set commit_output ""
  if {$confirm == 0} {
    if {$revision != ""} {
      if {$cvscfg(cvsver) < 1.3} {
        foreach file $filelist {
          # puts stderr "1 Committing $file"
          catch {exec $cvs commit -f -r $revision -m "$comment" $file} \
            commit_tmp
          set commit_output "$commit_output\n$commit_tmp"
        }
      } else {
        foreach file $filelist {
          # puts stderr "2 Committing $file"
          catch {exec $cvs commit -r $revision -m "$comment" $file} \
            commit_tmp
          set commit_output "$commit_output\n$commit_tmp"
        }
      }
    } else {
      if {$cvscfg(cvsver) < 1.3} {
        foreach file $filelist {
          # puts stderr "3 Committing $file"
          catch {exec $cvs commit -f -m "$comment" $file} \
            commit_tmp
          set commit_output "$commit_output\n$commit_tmp"
        }
      } else {
        foreach file $filelist {
          # puts stderr "4 Committing $file"
          catch {exec $cvs commit -m "$comment" $file} \
            commit_tmp
          set commit_output "$commit_output\n$commit_tmp"
        }
      }
    }
    view_output "CVS Commit" $commit_output
  }
}

proc cvs_tag {tagname branch args} {
#
# This tags a file in a directory.
#
  global cvs
  global cvscfg
  global incvs
  global filelist

  if {$cvscfg(cvsver) < 1.3} {
    cvserror "This function is not supported in CVS version $cvscfg(cvsver).

Please upgrade your CVS to version 1.3"
    return
  }

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$tagname == ""} {
    cvserror "You must enter a tag name!"
    return 1
  }

  set cmd_options ""

  if {$cvscfg(cvsver) > 1.3} {
    set cmd_options "$cmd_options -F"
  }

  if {$args == "{}"} {
    set filelist "."
  } else {
    set filelist $args
  }

  if {$branch == "yes"} {
    set cmd_options "$cmd_options -b"
    catch {eval "exec $cvs tag $cmd_options $tagname $filelist"} tag_output
    catch {eval "exec $cvs update -r $tagname $filelist"} tag_output2
    set tag_output "$tag_output\n\n$tag_output2"
  } else {
    catch {eval "exec $cvs tag $cmd_options $tagname $filelist"} tag_output
  }
  view_output "CVS Tag" $tag_output
}

proc cvs_update {tagname args} {
#
# This updates the files in the current directory.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "{}"} {
    set filelist "."
  } else {
    set filelist $args
  }

  # changed the message to be a little more explicit.
  # -sj
  if { $filelist == "." } {
      set mess "You are about to download from"
      set mess "$mess the repository to your local"
      set mess "$mess filespace ** ALL ** files which"
      set mess "$mess have changed in it."
  } else {
      set mess "You are about to download from"
      set mess "$mess the repository to your local"
      set mess "$mess filespace these files which"
      set mess "$mess have changed:\n"
      regsub -all {" "} $filelist {"\\n\\t"} tmp
	  set mess "$mess\n$tmp"
  }
  set mess "$mess\n\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    # modified to allow putting the comandline executed to the console.
    # more to support debugging than anything else.
    # -sj
    set str [join $filelist "" ]
    if {$tagname == ""} {
      set commandline "exec $cvs update $str "
      catch {eval $commandline} view_this
    } else {
      set commandline "exec cvs update -r $tagname $str"
      catch {eval $commandline} view_this
    }
    view_output "CVS Update" $view_this
    setup_dir
  }
}

proc cvs_join {localfile branchver} {
#
# This does a join (merge) of the branchver revision of localfile to the
# head revision.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set mess "This will merge revision $branchver to the head revision of $localfile

Are you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    catch {eval "exec $cvs update -j$branchver $localfile"} view_this
    view_output "CVS Merge" $view_this
    setup_dir
  }
}

proc cvs_delta {localfile ver1 ver2} {
#
# This merges the changes between ver1 and ver2 into the head revision.
#
  global cvs
  global incvs

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$ver1 == {} || $ver2 == {}} {
    cvserror "Must have two revision numbers for this function!"
    return 1
  }
  set mess "This will merge the changes between revision $ver1 and $ver2 (if $ver1 > $ver2 the changes are removed) to the head revision of $localfile

Are you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    catch {eval "exec $cvs update -j$ver1 -j$ver2 $localfile"} view_this
    view_output "CVS Merge" $view_this
    setup_dir
  }
}

proc cvs_status args {
#
# This does a status report on the files in the current directory.
#
  global cvs
  global incvs
  global cvscfg

  # provided as convient place holders.
  # -sj
  set global_options ""
  set cmd_options ""

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  # added recurse capability to reports.
  # -sj
  # if recurse option is false or there are selected files, don't recurse
  if { ( $cvscfg(recurse) == "false" ) || ( $args != {} ) } { 
    set cmd_options "$cmd_options -l"
  }

  if {$args == "{}"} {
    set filelist "."
  } else {
    set filelist $args
  }

  # Additional support added for 1.4
  # -sj
  if {$cvscfg(cvsver) < 1.3} {
    set cmd_options ""
    set cvscfg(rdetail) "verbose"
  } elseif { $cvscfg(cvsver) < 1.4} {
    set global_options "$global_options -q"
  } else {
    set global_options "$global_options -Q"
  }
  # added to support verious levels of verboseness. Ideas derived and some of the 
  # awk expressions derived from GIC.
  # -sj
  if { $cvscfg(rdetail) == "verbose" } {
      set commandline "exec $cvs $global_options status $cmd_options $filelist"
  } elseif { $cvscfg(rdetail) == "summary" } {
      set commandline "exec $cvs $global_options status $cmd_options $filelist | "
      set commandline "$commandline awk {\$3 ~ /Status:/ "
      set commandline "$commandline { printf(\"%s %s %s %s \\t%s\\n\", \$4, \$5, \$6, \$7, \$2);}}"
  } elseif { $cvscfg(rdetail) == "terse" } {
      set commandline "exec $cvs $global_options status $cmd_options $filelist | "
      set commandline "$commandline awk {\$3 ~ /Status:/ {if (\$4 != \"Up-to-date\") "
      set commandline "$commandline { printf(\"%s %s %s %s \\t%s\\n\", \$4, \$5, \$6, \$7, \$2);}}} "
  }
  # puts stderr "command line is $commandline"
  catch { eval $commandline } view_this
  if { $view_this == "" } {
    set mess "Everything is Up-to-date."
    set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK ]
  } else {
    view_output "CVS Status" $view_this
  }
}

proc cvs_check {} {
#
# This does a cvscheck on the files in the current directory.
#
  global cvs
  global incvs
  global cvscfg

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  catch {exec cvscheck $cvscfg(checkrecursive)} view_this
  view_output "CVS Check" $view_this
}

proc cvs_checkout {mcode revision} {
#
# This checks out a new module into the current directory.
#
  #puts "Entered cvs_checkout, mcode=$mcode, revision=$revision"
  global cvs
  global incvs

  if {$incvs} {
    set mess "You are already in a CVS controlled directory.  Are you"
    set mess "$mess sure that you want to check out another module in"
    set mess "$mess to this directory?"
    set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
    if {$confirm} { return 1 }
  }

  set mess "This will check out $mcode from CVS.\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  #puts "From cvs_checkout, mcode=$mcode  pwd=[exec pwd]"
  if {$confirm == 0} {
    feedback_cvs "Checking out module $mcode, please wait"
    if {$revision == {}} {
      catch {exec $cvs co $mcode} view_this
    } else {
      catch {exec $cvs co -r $revision $mcode} view_this
    }
    feedback_cvs ""
    view_output "CVS Checkout" $view_this
    setup_dir
  }
}

proc cvs_filelog {mcode filename} {
#
# This looks at a revision log of a file from the repository without
# checking it out.
#
  global cvs
  global cvsroot
  global location
  global cvscfg
  
  feedback_cvs "Executing rlog command, please wait"
  catch {exec rlog $cvsroot/$location($mcode)/$filename} view_this
  feedback_cvs ""

  # Old style file log with just the output from cvs log.
  # view_output "CVS File Log" $view_this

  # New style file log viewer
  new_logcanvas "no file" $view_this
}

proc rcs_fileview {filename revision} {
#
# This views an RCS file in the repository.
#
  if {$cvscfg(remote)} {
    cvs_remote_bad
    return 1
  }

  if {$revision == {}} {
    catch {exec co -p $filename 2>/dev/null} view_this
  } else {
    catch {exec co -p$revision $filename 2>/dev/null} view_this
  }
  view_output "CVS File View" $view_this
}

proc cvs_fileview {mcode filename revision} {
#
# This looks at a revision of a file from the repository without
# checking it out.
#
  global cvs

  if {$revision == {}} {
    catch {exec $cvs co -p $mcode/$filename 2>/dev/null} view_this
  } else {
    catch {exec $cvs co -p -r $revision $mcode/$filename 2>/dev/null} view_this
  }
  view_output "CVS File View" $view_this
}

proc rcs_filediff {filename ver1 ver2} {
#
# This does a diff of an RCS file within the repository.
#
  if {$cvscfg(remote)} {
    cvs_remote_bad
    return 1
  }
  if {$ver1 == {} || $ver2 == {}} {
    cvserror "Must have two revision numbers for this function!"
    return 1
  }
  # catch {exec rcsdiff -r$ver1 -r$ver2 $filename} view_this
  # view_output "CVS File Diff" $view_this
  exec tkdiff -r$ver1 -r$ver2 $filename &
}


proc cvs_filediff {mcode filename ver1 ver2} {
#
# This looks at a diff of a file from the repository without
# checking it out.
#
  global cvs
  global cvsroot
  global location

  rcs_filediff $cvsroot/$location($mcode)/$filename $ver1 $ver2
}

proc cvs_export {mcode revision} {
#
# This exports a new module (see man cvs and read about export) into
# the current directory.
#
  global cvs
  global incvs
  global cvscfg

  if {$incvs} {
    cvs_incvs
    return 1
  }

  if {$cvscfg(cvsver) < 1.3} {
    cvserror "This function is not supported in CVS version $cvscfg(cvsver).

Please upgrade your CVS to version 1.3"
    return
  }

  if {$revision == {}} {
    cvserror "You must enter a tag name for this function."
    return
  }

  set mess "This will export $mcode from CVS.\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    catch {exec $cvs export -r $revision $mcode} view_this
    view_output "CVS Export" $view_this
    setup_dir
  }
}

proc cvs_patch {mcode revision1 revision2} {
#
# This creates a patch file between two revisions of a module.  If the
# second revision is null, it creates a patch to the head revision.
#
  global cvs
  global cvscfg
 
  if {$revision1 == {}} {
    cvserror "You must enter a tag name for this function."
    return
  }
 
  set mess "This will make a patch file for $mcode from CVS.\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
 
  if {$confirm == 0} {
    if {$revision2 == {}} {
      catch {exec $cvs patch -r $revision1 $mcode > $mcode.pat} view_this
    } else {
      catch {exec $cvs patch -r $revision1 -r $revision2 $mcode > $mcode.pat} \
        view_this
    }
    set view_this "$view_this\n\nPatch file $mcode.pat created."
    view_output "CVS Patch" $view_this
    setup_dir
  }
}

proc cvs_patch_summary {mcode revision1 revision2} {
#
# This creates a patch summary of a module between 2 revisions.
#
  global cvs
  global cvscfg
 
  if {$revision1 == {}} {
    cvserror "You must enter a tag name for this function."
    return
  }
 
  if {$revision2 == {}} {
    catch {exec $cvs patch -s -r $revision1 $mcode} view_this
  } else {
    catch {exec $cvs patch -s -r $revision1 -r $revision2 $mcode} view_this
  }
  view_output "CVS Patch Summary" $view_this
}

proc cvs_version {} {
#
# This shows the current CVS version number.
#
  global cvs

  catch {exec $cvs -v} view_this
  view_output "CVS Version" $view_this
}

proc cvs_rtag {mcode branch tagnameA tagnameB} {
#
# This tags a module in the repository.
#
  global cvs
  global cvscfg

  if {$cvscfg(cvsver) < 1.3} {
    set command "tag"
  } else {
    set command "rtag"
  }

  set cmd_options ""

  if {$branch == "yes"} {
    if {$cvscfg(cvsver) < 1.3} {
      set mess "This function is not supported in CVS version $cvscfg(cvsver)."
      set mess "$mess\n\nPlease upgrade your CVS to version 1.3"
      cvserror $mess
      return
    }
    set cmd_options "-b"
  }

  # puts stderr "Using options for CVS version $cvscfg(cvsver)"
  if {$cvscfg(cvsver) > 1.3} {
    set cmd_options "$cmd_options -F"
  }

  if {$tagnameA == ""} {
    cvserror "You must enter a tag name!"
    return 1
  }

  set mess "This will tag module \"$mcode\" in CVS with tag \"$tagnameA\"."
  if {$tagnameB == ""} {
    set mess "$mess\n\nThe head revision of all files will be tagged."
  } else {
    set mess "$mess\n\nThe revisions tagged with \"$tagnameB\" will be tagged."
    set cmd_options "$cmd_options -r $tagnameB"
  }
  set mess "$mess\n\nAre you sure?"
  set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]

  if {$confirm == 0} {
    catch {eval "exec $cvs $command $cmd_options $tagnameA $mcode"} view_this
    view_output "CVS Rtag" $view_this
  }
}

proc cvs_usercmd {args} {
#
# Allows the user to run a user-specified cvs command.
#
  global cvs

  catch {eval "exec $cvs $args"} view_this
  view_output "CVS [lindex $args 0]" $view_this
}

proc cvs_anycmd {args} {
#
# Allows the user to run any user-specified command.
#
  catch {eval "exec $args"} view_this
  view_output [lindex $args 0] $view_this
}

proc view_output {title output_string} {
#
# Set up a dialog containing a text box that can be used to view
# the report on the screen.
#
  static {viewer 0}

  # If nothing to report, then say so.
  # -sj
  if {$output_string == ""} {
    set mess "Nothing to report."
    set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  } else {
    incr viewer
    set cvsview ".cvsview$viewer"
    toplevel $cvsview
    text $cvsview.text -setgrid yes -relief sunken -border 2 \
      -yscroll "$cvsview.scroll set"
    scrollbar $cvsview.scroll -relief sunken \
      -command "$cvsview.text yview"
    button $cvsview.ok -text "OK" \
      -command "destroy $cvsview"

    pack $cvsview.ok -side bottom -fill x
    pack $cvsview.scroll -side right -fill y -padx 2 -pady 2
    pack $cvsview.text -fill both -expand 1

    wm title $cvsview "$title Output"
    $cvsview.text insert end $output_string
    $cvsview.text configure -state disabled
  }
}
