#
# TCL Library for TkCVS
#

#
# $Id: cvs.tcl,v 1.86 2002/01/23 06:55:26 dorothyr Exp $
# 
# Contains procedures used in interaction with CVS.
#

proc cvs_notincvs {} {
  cvsfail "This directory is not in CVS."
}

proc cvs_incvs {} {
  cvsfail "You can\'t do that here because this directory is already in CVS."
}

#
#  Create a temporary directory
#  cd to that directory
#  run the CVS command in that directory
#
#  returns: the current wd (ERROR) or the sandbox directory (OK)
#
proc cvs_sandbox_runcmd {cmd output_var} {
  global cvscfg
  global cwd

  upvar $output_var view_this

  # Big note: the temp directory fed to a remote servers's command line
  # needs to be seen by the server.  It can't cd to an absolute path.
  # In addition it's fussy about where you are when you do a checkout -d.
  # Best avoid that altogether.
  gen_log:log T "ENTER ($cmd $output_var)"
  set pid [pid]
  
  cd $cvscfg(tmpdir)
  gen_log:log F "CD [pwd]"
  if {! [file isdirectory cvstmpdir.$pid]} {
    gen_log:log F "MKDIR cvstmpdir.$pid"
    file mkdir cvstmpdir.$pid
  }

  cd cvstmpdir.$pid
  gen_log:log F "CD [pwd]"

  gen_log:log C "$cmd"
  set ret [catch {eval "exec $cmd"} view_this]
  return $cvscfg(tmpdir)/cvstmpdir.$pid
}

#
#  cvs_sandbox_filetags
#   assume that the sandbox contains the checked out files
#   return a list of all the tags in the files
#
proc cvs_sandbox_filetags {mcode filenames} {
  global cvscfg
  global cvs

  set pid [pid]
  gen_log:log T "ENTER"
  
  cd [file join $cvscfg(tmpdir) cvstmpdir.$pid $mcode]
  set commandline "$cvs -d $cvscfg(cvsroot) -l -n log -l $filenames"
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$ret} {
    cvsfail $view_this
    gen_log:log T "LEAVE ERROR"
    return $keepers
  }
  set view_lines [split $view_this "\n"]
  foreach line $view_lines {
    if {[string index $line 0] == "\t" } {
      regsub -all {[\t ]*} $line "" tag
      append keepers "$tag "
    }
  }
  gen_log:log T "LEAVE"
  return $keepers
}

proc cvs_remove {args} {
#
# This deletes a file from the directory and the repository,
# asking for confirmation first.
#
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"
  set filelist [join $args]

  set exec_idx [exec_command_init "CVS Delete"]
  foreach file $filelist {
    gen_log:log F "DELETE $file"
    if {[file isfile $file]} {
      file delete -force -- $file
      if {[file exists $file]} {cvsfail "Remove $file failed"}
    }
    if {$incvs} {
      set commandline "$cvs -d $cvscfg(cvsroot) remove \"$file\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"
    }
  }
  exec_command_end $exec_idx
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_remove_dir {args} {
# This removes files recursively.
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select a directory!"
    return 
  } else {
    set mess "This will remove the contents of these directories:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }  
  }
  
  set exec_idx [exec_command_init "CVS Remove directory"]

  set awd [pwd]
  foreach file $filelist {
    if {[file isdirectory $file]} {
      set awd [pwd]
      cd $file
      gen_log:log F "CD [pwd]"
      rem_subdirs
      cd $awd
      gen_log:log F "CD [pwd]"

      set commandline "$cvs remove \"$file\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"

    }
  }
  exec_command_end $exec_idx

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_edit {args} {
#
# This sets the edit flag for a file
# asking for confirmation first.
#
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  foreach file [join $args] {
    regsub -all {\$} $file {\$} file
    set commandline "$cvs -d $cvscfg(cvsroot) edit \"$file\""
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret != 0} {
      view_output "CVS Edit" $view_this
    }
  }
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_unedit {args} {
#
# This resets the edit flag for a file.
# Needs stdin as there is sometimes a dialog if file is modified
# (defaults to no)
#
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  foreach file [join $args] {
    # Unedit may hang asking for confirmation if file is not up-to-date
    regsub -all {\$} $file {\$} file
    set commandline "cvs -d $cvscfg(cvsroot) -n -l update \"$file\""
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} view_this
    # Its OK if its locally added
    if {([llength $view_this] > 0) && ![string match "A*" $view_this] } {
      gen_log:log D "$view_this"
      cvsfail "File $file is not up-to-date"
      gen_log:log T "LEAVE -- cvs unedit failed"
      return
    }

    set commandline "$cvs -d $cvscfg(cvsroot) unedit \"$file\""
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret != 0} {
      view_output "CVS Edit" $view_this
    }
  }
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_history {allflag mcode} {
  global cvs
  global cvscfg

  set all ""
  gen_log:log T "ENTER ($allflag $mcode)"
  if {$allflag == "all"} {
    set all "-a"
  }
  if {$mcode == ""} {
    set commandline "$cvs -d $cvscfg(cvsroot) history $all"
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) history $all -n $mcode"
  }
  # Note: If $all, it would be nice to process the output
  gen_log:log C "$commandline"
  exec_command "CVS Checkouts" "$commandline"
  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($binflag $args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]
  if {$filelist == ""} {
    set mess "This will add all new files"
  } else {
    set mess "This will add these files:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }  
  }

  set exec_idx [exec_command_init "CVS Add"]
  if {$filelist == ""} {
    foreach file [glob -nocomplain $cvscfg(aster) .??*] {
      set commandline "$cvs -d $cvscfg(cvsroot) add $binflag \"$file\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"
    }
  } else {
    foreach file $filelist {
      set commandline "$cvs -d $cvscfg(cvsroot) add $binflag \"$file\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"
    }
  }
  exec_command_end $exec_idx
  if {$cvscfg(auto_status)} {
    setup_dir
  }

  gen_log:log T "LEAVE"
}

proc cvs_add_dir {binflag args} {
# This starts adding recursively at the directory level
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($binflag $args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select a directory!"
    return 1
  } else {
    set mess "This will recursively add these directories:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }  
  }
  
  set exec_idx [exec_command_init "CVS Add directory"]

  set awd [pwd]
  foreach file $filelist {
    if {[file isdirectory $file]} {
      set commandline "$cvs add \"$file\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"

      cd $file
      gen_log:log F "CD [pwd]"
      add_subdirs $binflag
    }
  }
  exec_command_end $exec_idx

  cd $awd
  gen_log:log F "[pwd]"
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc add_subdirs {binflag} {
  global cvs
  global incvs
  global cvsglb
  global cvscfg
  upvar exec_idx exec_idx

  gen_log:log T "ENTER ($binflag)"
  set plainfiles {}
  foreach child  [glob -nocomplain $cvscfg(aster)] {
    if [file isdirectory $child] {
      if {[regexp -nocase {^CVS$} [file tail $child]]} {
        gen_log:log D "Skipping $child"
        continue
      }
      set commandline "$cvs add \"$child\""
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"
      set awd [pwd]
      cd $child
      gen_log:log F "CD [pwd]"
      add_subdirs $binflag
      cd $awd
      gen_log:log F "CD [pwd]"
    } else {
      lappend plainfiles $child
    }
  }
  if {[llength $plainfiles] > 0} {
    # LJZ: get local ignore file filter list
    set ignore_file_filter $cvsglb(default_ignore_filter)
    if { [ file exists ".cvsignore" ] } {
      set fileId [ open ".cvsignore" "r" ]
      while { [ eof $fileId ] == 0 } {
        gets $fileId line
        append ignore_file_filter " $line"
      }
      close $fileId
    }

    # LJZ: ignore files if requested in recursive add
    if { $ignore_file_filter != "" } {
      foreach item $ignore_file_filter {
        # for each pattern
        if { $item != "*" } {
          # if not "*"
          while { [set idx [lsearch $plainfiles $item]] != -1 } {
            # for each occurence, delete
            catch { set plainfiles [ lreplace $plainfiles $idx $idx ] }
          }
        }
      }
    }

    # LJZ: any files left after filtering?
    if {[llength $plainfiles] > 0} {
      set commandline "$cvs -d $cvscfg(cvsroot) add $binflag $plainfiles"
      gen_log:log C "$commandline"
      exec_command_body $exec_idx "$commandline"
    }
  }

  gen_log:log T "LEAVE"
}

proc rem_subdirs { } {
  global cvs
  global incvs
  global cvscfg
  upvar exec_idx exec_idx

  gen_log:log T "ENTER"
  set plainfiles {}
  foreach child  [glob -nocomplain $cvscfg(aster) .??*] {
    if [file isdirectory $child] {
      if {[regexp -nocase {^CVS$} [file tail $child]]} {
        gen_log:log D "Skipping $child"
        continue
      }
      set awd [pwd]
      cd $child
      gen_log:log F "CD [pwd]"
      rem_subdirs
      cd $awd
      gen_log:log F "CD [pwd]"
    } else {
      lappend plainfiles $child
    }
  }
  if {[llength $plainfiles] > 0} {
    foreach file $plainfiles {
      gen_log:log F "DELETE $file"    
      file delete -force -- $file
      if {[file exists $file]} {cvsfail "Remove $file failed"}
    }
    set commandline "$cvs -d $cvscfg(cvsroot) remove $plainfiles"
    gen_log:log C "$commandline"
    exec_command_body $exec_idx "$commandline"
  }

  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select one or more files to compare!"
  } else {
    foreach file $filelist {
      regsub -all {\$} $file {\$} file
      gen_log:log C "$cvscfg(tkdiff) \"$file\""
      catch {eval "exec $cvscfg(tkdiff) \"$file\" &"} view_this
    }
  }
  gen_log:log T "LEAVE"
}

proc cvs_diff_r {rev1 rev2 args} {
#
# This diffs a file with the repository, using two revisions or tags.
#
  global cvs
  global cvscfg
  global incvs
 
  gen_log:log T "ENTER ($rev1 $rev2 $args)"

  if {$rev1 == {} || $rev2 == {}} {
    cvsfail "Must have two revision numbers for this function!"
    return 1
  }
 
  # dont join args because we dont get them from workdir_list_files
  foreach file $args {
    regsub -all {\$} $file {\$} file
    gen_log:log C "$cvscfg(tkdiff) -r$rev1 -r$rev2 $file"
    catch {eval "exec $cvscfg(tkdiff) -r$rev1 -r$rev2 \"$file\" &"} view_this
  }
  gen_log:log T "LEAVE"
}

proc cvs_view_r {rev args} {
#
# This views a specific revision of a file in the repository.
#
  global cvs
  global incvs
  global cvscfg
 
  gen_log:log T "ENTER ($rev $args)"
  if {$args == ""} {
    foreach file [glob -nocomplain $cvscfg(aster) .??*] {
      set commandline \
         "$cvs -d $cvscfg(cvsroot) update -p -r $rev \"$file\" 2>$cvscfg(null)"
      gen_log:log C "$commandline"
      catch {eval "exec $commandline"} view_this
      ### exec_command: problems to handle stdout/stderr seperately
      view_output "CVS View: $file" $view_this
    }
  } else {
    # dont join args because we dont get them from workdir_list_files
    foreach file $args {
      set commandline \
         "$cvs -d $cvscfg(cvsroot) update -p -r $rev \"$file\" 2>$cvscfg(null)"
      gen_log:log C "$commandline"
      catch {eval "exec $commandline"} view_this
      ### exec_command: problems to handle stdout/stderr seperately
      view_output "CVS View: $file" $view_this
    }
  }
  gen_log:log T "LEAVE"
}

proc cvs_logcanvas {args} {
#
# This looks at the revision log of a file.  It's is called from workdir.tcl,
# when we are in a CVS-controlled directory.  Merges are enabled.
#
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select one or more files!"
    return
  }

  foreach file $filelist {
    if {[file isdirectory "$file"]} {
      cvsfail "\"$file\" is a directory!"
      continue
    }
    regsub -all {\$} $file {\$} file
    set commandline "$cvs -d $cvscfg(cvsroot) -l -n log -l \"$file\""
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret} {
      cvsfail $view_this
      return
    }
    # Set up the log diagram
    new_logcanvas "$file" $view_this
  }
  gen_log:log T "LEAVE"
}

proc cvs_log {args} {
#
# This looks at a log from the repository.
# Called by Workdir menu Reports->"CVS log ..."
#
  global cvs
  global incvs
  global cvscfg
  global current_tagname

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  busy_start .workdir.main
  set filelist [join $args]

  set commandline "$cvs -d $cvscfg(cvsroot) log "
  if {$cvscfg(ldetail) == "latest"} {
    if {[llength $current_tagname] == 1} {
      # We have a branch here
      append commandline "-r$current_tagname "
    }
    append commandline "-N "
  }
  append commandline "$filelist"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} raw_log
  
  # If verbose, just output the whole thing
  if {$cvscfg(ldetail) == "verbose"} {
    view_output "CVS Log ($cvscfg(ldetail))" $raw_log
    busy_done .workdir.main
    gen_log:log T "LEAVE"
    return
  }

  # Else we have to take out some of it
  set cooked_log ""
  if {$cvscfg(ldetail) == "summary"} {
    set n -9999
    set log_lines [split $raw_log "\n"]
    foreach logline $log_lines {
      # Beginning of a file's record
      gen_log:log D "$logline"
      if {[string match "Working file:*" $logline]} {
        append cooked_log "$logline\n"
        # Zingggg - reset!
        set n -9999
      }
      # Beginning of a revision
      if {[string match "----------------------------" $logline]} {
        append cooked_log "$logline\n"
        set n 0
      }
      if {$n >= 1} {
        append cooked_log "$logline\n"
      }
      incr n
    }
  } elseif {$cvscfg(ldetail) == "latest"} {
    set br 0
    set log_lines [split $raw_log "\n"]
    while {[llength $log_lines] > 0} {
      set logline [join [lrange $log_lines 0 0]]
      set log_lines [lrange $log_lines 1 end]
      gen_log:log D "$logline"

      # Beginning of a file's record
      if {[string match "Working file:*" $logline]} {
        append cooked_log "$logline\n"
        while {[llength $log_lines] > 0} {
          set log_lines [lrange $log_lines 1 end]
          set logline [join [lrange $log_lines 0 0]]
          gen_log:log D " ! $logline !"

          # Reason to skip
          if {[string match "*selected revisions: 0" $logline]} {
            append cooked_log "No revisions on branch\n"
            append cooked_log "======================================="
            append cooked_log "=======================================\n"
            #set br 0
            break
          }
          # Beginning of a revision
          if {[string match "----------------------------" $logline]} {
            gen_log:log D "  !! $logline !!"
            append cooked_log "$logline\n"
            while {[llength $log_lines] > 0} {
              set log_lines [lrange $log_lines 1 end]
              set logline [join [lrange $log_lines 0 0]]
              gen_log:log D "        $logline"
              if { [string match "========================*" $logline] ||
                  [string match "--------------*" $logline]} {
                append cooked_log "======================================="
                append cooked_log "=======================================\n"
                set br 1
                break
              } else {
                append cooked_log "$logline\n"
              }
            }
          }
          # If we broke out of the inside loop, break out of this one too
          if {$br == 1} {set br 0; break}
        }
      }
    }
  } else {
    cvsfail "Unknown log option \"$cvscfg(ldetail)\""
  }

  busy_done .workdir.main
  view_output "CVS Log ($cvscfg(ldetail))" $cooked_log
  gen_log:log T "LEAVE"
}

proc cvs_annotate {args} {
#
# This looks at a log from the repository.
# Called by Workdir menu Reports->"CVS log ..."
#
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  busy_start .workdir.main
  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Annotate:\nPlease select one or more files !"
    gen_log:log T "LEAVE (Unselected files)"
    return
  }
  foreach file $filelist {
    annotate_view $file
  }
  busy_done .workdir.main
  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($revision $comment $args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$comment == ""} {
    cvsfail "You must enter a comment!"
    return 1
  }
  regsub -all "\"" $comment "\\\"" comment

  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"
    append mess " and under this directory."
  } else {
    foreach file $filelist {
      append commit_output "\n$file"
    }
    set mess "This will commit your changes to:$commit_output"
  }
  append mess "\n\nAre you sure?"
  set commit_output ""

  if {[cvsconfirm $mess] == 1} {
    return 1
  }
  set exec_idx [exec_command_init "CVS Commit"]
  set revflag ""
  if {$revision != ""} {
    set revflag "-r $revision"
  }
  set commandline \
    "$cvs -d $cvscfg(cvsroot) commit -R $revflag -m \"$comment\" $filelist"
  gen_log:log C "$commandline"
  exec_command_body $exec_idx "$commandline"
  exec_command_end $exec_idx

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($tagname $force $branch $args)"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

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

  set filelist [join $args]

  set exec_idx [exec_command_init "CVS Tag"]
  if {$branch == "yes"} {
    # Make the branch
    set commandline "$cvs -d $cvscfg(cvsroot) tag $force -b $tagname $filelist"
    gen_log:log C "$commandline"
    exec_command_body $exec_idx "$commandline"

    # update so we're on the branch
    set commandline "$cvs -d $cvscfg(cvsroot) update -r $tagname $filelist"
    gen_log:log C "$commandline"
    exec_command_body $exec_idx "$commandline"
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) tag $force $tagname $filelist"
    gen_log:log C "$commandline"
    exec_command_body $exec_idx "$commandline"
  }
  exec_command_end $exec_idx
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_rtag {mcode options tag} {
#
# This tags a module in the repository.
#
  global cvs
  global cvscfg
  global forceflag

  gen_log:log T "ENTER ($mcode $options $tag)"
  if {$tag == ""} {
    cvsfail "You must enter a tag name!"
    return 1
  }

  set command "$cvs -d $cvscfg(cvsroot) rtag $options $forceflag $tag $mcode"
  gen_log:log C $command
  exec_command "CVS Rtag" "$command"

  gen_log:log T "LEAVE"
}

proc cvs_lock {action rev args} {
#
# This locks/unlocks the file(s) given by $args.
# If $rev is empty the head revision of all files given by $args will be locked.
# If $rev is not empty, then $args must contain exactly one name.
# Currently $rev is always empty.
#
# 10-Jan-2000  lcs
#

  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($action $rev $args)"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Lock / Unlock:\nPlease select one or more files !"
    gen_log:log T "LEAVE (Unselected files)"
    return
  }

  if { $action == "lock" } {
    set title "CVS Lock"
    set lockOpt "-l"
    set chmod_cmd $cvscfg(chmod_rw_cmd)
  } elseif { $action == "unlock" } {
    set title "CVS Unlock"
    set lockOpt "-u"
    set chmod_cmd $cvscfg(chmod_ro_cmd)
  } else {
    cvsfail "cvs_lock(): Invalid mode $action.\nPlease inform your local guru about this."
    gen_log:log T "LEAVE (Invalid action $action)"
    return 1
  }
    
  set exec_idx [exec_command_init $title]

  set files [lindex $filelist 0]

  set commandline "$cvs -d $cvscfg(cvsroot) -l admin $lockOpt$rev $files"
  gen_log:log C   "$commandline"
  exec_command_body $exec_idx "$commandline"

  foreach i $files {
    set commandline "$chmod_cmd $i"
    gen_log:log C   "$commandline"
    exec_command_body $exec_idx "$commandline"
  }
  exec_command_end $exec_idx

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

#
# Build report of locked files
# 13-Jan-2000  lcs
#

proc report_locks {} {
  global cvs
  global cvscfg
  global cwd
  upvar  linenum linenum

  gen_log:log T "ENTER"

  if {! [winfo exists .viewer]} {
    viewer_setup
  } else {
    .viewer.text configure -state normal
    .viewer.text delete 1.0 end
  }
  set linenum 1

  set commandline "$cvs -d $cvscfg(cvsroot) -l log"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} view_this

  set filelist ""
  set found "f"
  set view_lines [split $view_this "\n"]

  foreach line $view_lines {
    if {[string match "Working file: *" $line]} {
      regsub "Working file: " $line "" filename
      lappend filelist $filename
      set locklist($filename) ""
    }
    if {[string match "*locked by*" $line]} {
      lappend locklist($filename) $line
      set found "t"
    }
  }

  .viewer.text insert end "\nLocked files:\n"
  .viewer.text insert end   "--------------------\n"
  incr linenum 2

  if { $found == "t" } {
    foreach filename $filelist {
      if { [llength $locklist($filename)] > 0 } {
        .viewer.text insert end [format "\n %s:\n" $filename]
        incr linenum
        foreach rev $locklist($filename) {
          .viewer.text insert end [format "    %s\n" $rev]
          incr linenum
        }
      }
    }
  } else {
    .viewer.text insert end "\n $cwd:"
    .viewer.text insert end "\n   No files locked in and under THIS directory."
    incr linenum 2
  }

  .viewer.text configure -state disabled
  # Focus in the text widget to activate the text bindings
  focus .viewer.text
  wm deiconify .viewer
  raise .viewer

  gen_log:log T "LEAVE"
}


proc cvs_update {tagname normal_binary action_if_no_tag get_all_dirs dir args} {
#
# This updates the files in the current directory.
#
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($tagname $normal_binary $action_if_no_tag $get_all_dirs $dir $args)"

  if { $normal_binary == "Normal" } {
      set mess "Using normal (text) mode.\n"
  } elseif { $normal_binary == "Binary" } {
      set mess "Using binary mode.\n"
  } else {
      set mess "Unknown mode:  $normal_binary\n"
  }

  if { $tagname != "BASE"  && $tagname != "HEAD" } {
      append mess "\nIf a file does not have tag $tagname"
      if { $action_if_no_tag == "Remove" } {
          append mess " it will be removed from your local directory.\n"
      } elseif { $action_if_no_tag == "Get_head" } {
          append mess " the head revision will be retrieved.\n"
      } elseif { $action_if_no_tag == "Skip" } {
          append mess " it will be skipped.\n"
      }
  }

  if { $tagname == "HEAD" } {
    append mess "\nYour local files will be updated to the"
    append mess " latest main trunk (head) revision."
    append mess " CVS will try to preserve any local, un-committed changes.\n"
  }

  append mess "\nIf there is a directory in the repository"
  append mess " that is not in your local, working directory,"
  if { $get_all_dirs == "Yes" } {
    append mess " it will be checked out at this time.\n"
  } else {
    append mess " it will not be checked out.\n"
  }

  set filelist [join $args]
  if {$filelist == ""} {
    append mess "\nYou are about to download from"
    append mess " the repository to your local"
    append mess " filespace ** ALL ** files which"
    append mess " have changed in it."
  } else {
    append mess "\nYou are about to download from"
    append mess " the repository to your local"
    append mess " filespace these files which"
    append mess " have changed:\n"
  
    foreach file $filelist {
      append mess "\n\t$file"
    }
  }
  append mess "\n\nAre you sure?"
  if {[cvsconfirm $mess] == 0} {
    # modified by jo to build the commandline incrementally
    set commandline "$cvs update -P"
    if { $normal_binary == "Binary" } {
      append commandline " -kb"
    }
    if { $get_all_dirs == "Yes" } {
      append commandline " -d $dir"
    }
    if { $tagname != "BASE" && $tagname != "HEAD" } {
      if { $action_if_no_tag == "Remove" } {
          append commandline " -r $tagname"
      } elseif { $action_if_no_tag == "Get_head" } {
          append commandline " -f -r $tagname"
      } elseif { $action_if_no_tag == "Skip" } {
          append commandline " -s -r $tagname"
      }
    }
    if { $tagname == "HEAD" } {
      append commandline " -A"
    }
    foreach file $filelist {
      append commandline " \"$file\""
    }

    gen_log:log C $commandline
    exec_command "CVS Update" $commandline
    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($localfile $branchver)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set mess "This will merge revision $branchver to"
  append mess " the head revision of $localfile"
  append mess "\n\nAre you sure?"
  if {[cvsconfirm $mess] == 0} {
    set commandline "$cvs -d $cvscfg(cvsroot) update -j$branchver \"$localfile\""
    gen_log:log C "$commandline"
    exec_command "CVS Merge" "$commandline"
    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
  gen_log:log T "LEAVE"
}

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

  gen_log:log T "ENTER ($localfile $ver1 $ver2)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$ver1 == {} || $ver2 == {}} {
    cvsfail "Must have two revision numbers for this function!"
    return 1
  }
  set mess "This will merge the changes between revision $ver1 and $ver2"
  append mess " (if $ver1 > $ver2 the changes are removed)"
  append mess " to the head revision of $localfile"
  append mess "\n\nAre you sure?"
  if {[cvsconfirm $mess] == 0} {
    set commandline "$cvs -d $cvscfg(cvsroot) update -j$ver1 -j$ver2 \"$localfile\""
    gen_log:log C "$commandline"
    exec_command "CVS Merge" "$commandline"
    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
}

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

  gen_log:log T "ENTER ($args)"

  if {$args == "."} {
    set args ""
  }
  # if there are selected files, I want verbose output for those files
  # so I'm going to save the current setting here
  # - added by Jo
  set verbosity_setting ""

  busy_start .workdir.main
  set filelist [join $args]
  # if recurse option is true or there are no selected files, recurse
  set cmd_options ""
  if {! [info exists cvscfg(recurse)]} {
    set cmd_options "-l"
  }

  # if there are selected files, use verbose output
  # but save the current setting so it can be reset
  # - added by Jo
  if {[llength $filelist] > 0 || \
      ([llength $filelist] == 1  && ! [file isdir $filelist])} {
    set verbosity_setting $cvscfg(rdetail)
    set cvscfg(rdetail) "verbose"
  }

  # support verious levels of verboseness. Ideas derived from GIC
  set commandline "$cvs -d $cvscfg(cvsroot) -Q status $cmd_options $filelist"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} raw_status

  if {$cvscfg(rdetail) == "verbose"} {
    view_output "CVS Status ($cvscfg(rdetail))" $raw_status
  } else {
    set cooked_status ""
    set stat_lines [split $raw_status "\n"]
    foreach statline $stat_lines {
      if {[string match "*Status:*" $statline]} {
        gen_log:log D "$statline"
        if {$cvscfg(rdetail) == "terse" &&\
            [string match "*Up-to-date*" $statline]} {
          continue
        } else {
          regsub {^File: } $statline {} statline
          regsub {Status:} $statline " " line
          append cooked_status $line
          append cooked_status "\n"
        }
      }
    }
    view_output "CVS Status ($cvscfg(rdetail))" $cooked_status
  }

  # reset the verbosity setting if necessary -jo
  if { $verbosity_setting != "" } {
    set cvscfg(rdetail) $verbosity_setting
  }
  busy_done .workdir.main
  gen_log:log T "LEAVE"
}


proc cvs_tag_status {args} {
#
# This processes the output of 'cvs status' to provide a simple
# report of the current sticky tags
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($args)"

  busy_start .workdir.main
  set filelist [join $args]

  set commandline "$cvs -d $cvscfg(cvsroot) -Q status -l $filelist"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} raw_status

  set cooked_status ""
  set stat_lines [split $raw_status "\n"]
  foreach statline $stat_lines {
    if {[string match "*Status:*" $statline]} {
      gen_log:log D "$statline"
      regsub {^File: } $statline {} statline
      regsub {Status:} $statline " " line
      append cooked_status $line
      append cooked_status "\n"
    }
    if {[string match "*Sticky Tag:*" $statline]} {
      regsub -all {[ \t]+} $statline " " statline
      set line [split $statline]
      gen_log:log D "$line"
      append cooked_status "   [lrange $line 4 end]"
      append cooked_status "\n"
    }

  }
  busy_done .workdir.main
  view_output "CVS Sticky Status" $cooked_status

  gen_log:log T "LEAVE"
}

proc format_check_msg {file msg} {
  return [format "%-40s: %s" $file $msg]
}

proc cvs_check_filter_proc {line} {
#
# This filter annotates each line of cvs_check output
#
  global cvscfg
  gen_log:log T "ENTER $line"

  regexp {^([UARMC?]) (.*)} $line junk mode file
  if {[info exists mode]} {
    switch -exact -- $mode {
      U {
        set new_line [format_check_msg $file \
                  "file changed in repository, needs updating"]
      }
      A {
        set new_line [format_check_msg $file \
                  "file added, not committed"]
      }
      R {
        set new_line [format_check_msg $file \
                  "file removed, not committed"]
      }
      M {
        set new_line [format_check_msg $file \
                  "file modified, not committed"]
      }
      C {
        set new_line [format_check_msg $file \
                  "file modified and in conflict, not committed"]
      }
      ? {
        # samba changes the case of the cvs file in different ways
	gen_log:log D "file: $file"
        if {! [regexp -nocase {^CVS$} [file tail $file]]} {
          set new_line [format_check_msg $file "file unknown, not in CVS"]
        }
      }
      default {
        set new_line $line
      }
    }
  } else {
    set new_line $line
  }
  gen_log:log T "LEAVE ($new_line)"
  return $new_line
}

proc cvs_check_eof_proc {directory} {
#
# This proc is called after cvs check is done, code is from cvscheck.tcl
#
# now find directories not added.  This is accomplished by finding all of
# the directories in the current directory seeing if there is a CVS
# control file in each one.
#
  global cvscfg

  gen_log:log T "ENTER ($directory)"
  if {![file isdirectory $directory]} {
    cvsfail "$directory is not a directory"
    return
  }
  set awd [pwd]
  cd $directory
  gen_log:log F "CD [pwd]"
  set dir_lines ""
  set files [glob -nocomplain -- .??* *]
  set dirs {}
  gen_log:log D "files: ($files)"
  foreach file $files {
    gen_log:log D "file: \"$file\""
    # samba changes the case of the cvs file in different ways
    if {[file isdirectory $file] && ! [regexp -nocase {^CVS$} $file]} {
      lappend dirs $file
    }
  }
  gen_log:log D "dirs: $dirs"
  # see if there are any directories not added.
  if {[llength $dirs]} {
    foreach dir $dirs {
      if {! [file exists [file join $dir "CVS"]] \
      || ! [file isdirectory [file join $dir "CVS"]]} {
        append dir_lines \
          [format_check_msg $dir "directory unknown, not in CVS\n"]
      }
    }
  }
  cd $awd
  gen_log:log F "CD [pwd]"

  gen_log:log T "LEAVE"
  return $dir_lines
}

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

  gen_log:log T "ENTER ($directory)"

  busy_start .workdir.main

  # The current directory doesn't have to be in CVS for cvs update to work.

  # Sometimes, cvs update doesn't work with ".", only with "" or an argument
  if {$directory == "."} {
    set directory ""
  }
  set commandline "$cvs -d $cvscfg(cvsroot) -n -q update $cvscfg(checkrecursive) $directory"
  # but cvs_check_eof_proc needs an argument
  if {$directory == ""} {
    set directory "."
  }
  set cvscfg(exec_eof) "cvs_check_eof_proc $directory"
  gen_log:log C "$commandline"
  exec_command "CVS Check" "$commandline" 0 "Nothing to report."
  set cvscfg(exec_eof) ""

  busy_done .workdir.main
  gen_log:log T "LEAVE"
}

proc cvs_checkout {mcode revision} {
  #
  # This checks out a new module into the current directory.
  #
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($mcode $revision)"
  if {$incvs} {
    set mess "You are already in a CVS controlled directory.  Are you"
    append mess " sure that you want to check out another module in"
    append mess " to this directory?"
    if {[cvsconfirm $mess] == 1} {
      return 1
    }
  }

  set mess "This will check out $mcode from CVS.\nAre you sure?"
  if {[cvsconfirm $mess] == 0} {
    if {$revision == {} || $revision == "HEAD"} {
      set commandline "$cvs -d $cvscfg(cvsroot) checkout -P $mcode"
      gen_log:log C "$commandline"
      exec_command "CVS Checkout" "$commandline"
    } else {
      set commandline \
          "$cvs -d $cvscfg(cvsroot) checkout -P -r $revision $mcode"
      gen_log:log C "$commandline"
      exec_command "CVS Checkout" "$commandline"
    }
    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
  gen_log:log T "LEAVE"
}

proc cvs_filelog {filename} {
#
# This looks at the revision log of a file.  It's called from filebrowse.tcl, 
# so we can't do operations such as merges.
#
  global cvs
  global cvscfg
  global cwd
  
  gen_log:log T "ENTER ($filename)"
  set pid [pid]
  set filetail [file tail $filename]
  
  set commandline "$cvs -d $cvscfg(cvsroot) -l checkout \"$filename\""
  gen_log:log C "$commandline"
  set ret [cvs_sandbox_runcmd "$commandline" cmd_output]
  if {$ret == $cwd} {
    cvsfail $cmd_output
    cd $cwd
    gen_log:log T "LEAVE -- cvs checkout failed"
    return
  }

  set commandline "$cvs -d $cvscfg(cvsroot) -l -n log -l \"$filename\""
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$ret} {
    cvsfail $view_this
    gen_log:log T "LEAVE ERROR ($view_this)"
    cd $cwd
    return
  }
  cd $cwd

  # Log canvas viewer
  new_logcanvas "no file" $view_this
  gen_log:log T "LEAVE"
}

proc cvs_fileview {filename revision} {
#
# This looks at a revision of a file from the repository.
# Called from Module Browser -> File Browse -> View
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($filename $revision)"
  if {$revision == {}} {
    set commandline "$cvs -d $cvscfg(cvsroot) checkout -p \"$filename\" 2>$cvscfg(null)"
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} view_this
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) checkout -p -r $revision \"filename\" 2>$cvscfg(null)"
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} view_this
  }
  view_output "CVS File View: $filename" $view_this
}

proc rcs_filediff {filename ver1 ver2} {
#
# This does a diff of an RCS file within the repository.  It can be done
# with a remote repository.
#
  global cvscfg

  if {$ver1 == {} || $ver2 == {}} {
    cvsfail "Must have two revision numbers for this function!"
    return 1
  }
  # view_output "CVS File Diff" $view_this
  gen_log:log C "$cvscfg(tkdiff) -r$ver1 -r$ver2 $filename &"
  catch {eval "exec $cvscfg(tkdiff) -r$ver1 -r$ver2 $filename &"} view_this
}

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

  gen_log:log T "ENTER ($mcode $revision)"

  if {$incvs} {
    set mess "You are already in a CVS controlled directory.  Are you"
    append mess " sure that you want to export a module in"
    append mess " to this directory?"
    if {[cvsconfirm $mess] == 1} {
      return 1
    }
  }

  if {$revision == {}} {
    cvsfail "You must enter a tag name for this function."
    return
  } elseif {$mcode == {}} {
    cvsfail "You must select a module to export."
    return
  }
  set mess "This will export $mcode from CVS.\nAre you sure?"
  if {[cvsconfirm $mess] == 0} {
    set commandline "$cvs -d $cvscfg(cvsroot) export -r $revision $mcode"
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} view_this
    view_output "CVS Export" $view_this
    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
  gen_log:log T "LEAVE"
}

proc cvs_patch {mcode rev1 rev2} {
#
# 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
 
  gen_log:log T "ENTER ($mcode $rev1 $rev2)"
  if {$mcode == ""} {
    cvsfail "Please select a module!"
    return
  }
  if {$rev1 == {}} {
    cvsfail "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?"
  if {[cvsconfirm $mess] == 0} {
    if {$rev2 == {}} {
      set commandline "$cvs -d $cvscfg(cvsroot) patch -r $rev1 $mcode >$mcode.pat"
    } else {
      set commandline "$cvs -d $cvscfg(cvsroot) patch -r $rev1 -r $rev2 $mcode >$mcode.pat"
    }
    gen_log:log C "$commandline"
    # Can't use exec_command because we redirected stdout
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret} {
       append view_this "Patch file is $mcode.pat"
    } else {
       cvsfail $view_this
    }
    view_output "CVS Patch" $view_this

    if {$cvscfg(auto_status)} {
      setup_dir
    }
  }
  gen_log:log T "LEAVE"
}

proc cvs_patch_summary {mcode rev1 rev2} {
#
# This creates a patch summary of a module between 2 revisions.
#
  global cvs
  global cvscfg
 
  gen_log:log T "ENTER ($mcode $rev1 $rev2)"
  if {$mcode == ""} {
    cvsfail "Please select a module!"
    return
  }
  if {$rev1 == {}} {
    cvsfail "You must enter a tag name for this function."
    return
  }
 
  if {$rev2 == {}} {
    set commandline "$cvs -d $cvscfg(cvsroot) patch -s -r $rev1 $mcode"
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) patch -s -r $rev1 -r $rev2 $mcode"
  }
  gen_log:log C "$commandline"
  exec_command "CVS Patch Summary" "$commandline"

  gen_log:log T "LEAVE"
}

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

  gen_log:log C "$cvs -d $cvscfg(cvsroot) -v"
  exec_command "CVS version" "$cvs -d $cvscfg(cvsroot) -v"
}

proc cvs_merge_conflict {args} {
  global cvscfg
  global cvs

  gen_log:log T "ENTER ($args)"

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select some files to merge first!"
    return
  }

  foreach file $filelist {
    # Make sure its really a conflict - tkdiff will bomb otherwise
    set commandline "$cvs -d $cvscfg(cvsroot) -n -q update \"$file\""
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} status
    gen_log:log C "$status"

    gen_log:log F "OPEN $file"
    set f [open $file]
    set match 0
    while { [eof $f] == 0 } {
      gets $f line
      if { [string match "<<<<<<< *" $line] } {
        set match 1
        break
      }
    }
    gen_log:log F "CLOSE $file"
    close $f
   
    if { [string match "C *" $status] } {
      # If its marked "Needs Merge", we have to update before
      # we can resolve the conflict
      gen_log:log C "$commandline"
      set commandline "$cvs -d $cvscfg(cvsroot) update \"$file\""
      gen_log:log C "$status"
      catch {eval "exec $commandline"} status
    } elseif { $match == 1 } { 
      # There are conflict markers already, dont update
      ;
    } else {
      cvsfail "This file does not appear to have a conflict."
      return
    }
    # Invoke tkdiff with the proper option for a conflict file
    # and have it write to the original file
    set commandline "$cvscfg(tkdiff) -conflict -o $file $file"
    gen_log:log C "$commandline"
    catch {eval "exec $commandline"} view_this
  }
  
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_gettaglist {filename} {
  global cvs
  global cvscfg
  global cwd

  set keepers ""
  set pid [pid]
  gen_log:log T "ENTER ($filename)"
  set filetail [file tail $filename]
  
  set commandline "$cvs -d $cvscfg(cvsroot) -l checkout \"$filename\"" 
  # run a command, possibly creating the sandbox to play in
  set ret [cvs_sandbox_runcmd $commandline cmd_output]
  if {$cwd == $ret} {
    cvsfail $cmd_output
    gen_log:log T "LEAVE ERROR ($cmd_output)"
    return $keepers
  }

  set commandline "$cvs -d $cvscfg(cvsroot) -l -n log -l \"$filename\""
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$ret} {
    cvsfail $view_this
    cd $cwd
    gen_log:log T "LEAVE ERROR"
    return $keepers
  }
  set view_lines [split $view_this "\n"]
  foreach line $view_lines {
    if {[string index $line 0] == "\t" } {
      set line [string trimleft $line]
      gen_log:log D "$line"
      append keepers "$line\n"
    }
  }
  if {$keepers == ""} {
    set keepers "No Tags"
  }

  gen_log:log T "LEAVE"
  return "$keepers"
}

proc cvs_release {directory} {
  global cvs
  global cvscfg
  global feedback

  gen_log:log T "ENTER ($directory)"
  if {! [file isdirectory $directory]} {
    cvsfail "$directory is not a directory"
    return
  }

  feedback_cvs $feedback(cvs) "Checking directory $directory"
  set commandline "$cvs -n -q update $directory"
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$view_this != ""} {
    view_output "CVS Check" $view_this
    set mess "$directory is not up-to-date."
    append mess "\nRelease anyway?"
    if {[cvsconfirm $mess] == 1} {
      return
    }
  }
  feedback_cvs $feedback(cvs) "Releasing directory $directory"
  set commandline "$cvs -Q release $directory"
  set ret [catch {eval "exec $commandline"} view_this]
  gen_log:log C "$commandline"
  if {$ret != 0} {
    view_output "CVS Release" $view_this
  }
  feedback_cvs $feedback(cvs) ""

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}
